| 1 |
module watch_test_support |
| 2 |
use fgof_watch_types, only : watch_event |
| 3 |
implicit none |
| 4 |
private |
| 5 |
|
| 6 |
public :: append_text |
| 7 |
public :: chmod_mode |
| 8 |
public :: ensure_clean_dir |
| 9 |
public :: expect_no_events |
| 10 |
public :: expect_single_event |
| 11 |
public :: make_dir |
| 12 |
public :: move_path |
| 13 |
public :: remove_path |
| 14 |
public :: remove_tree |
| 15 |
public :: touch_path |
| 16 |
public :: write_text |
| 17 |
|
| 18 |
contains |
| 19 |
|
| 20 |
subroutine ensure_clean_dir(path) |
| 21 |
character(len=*), intent(in) :: path |
| 22 |
|
| 23 |
call remove_tree(path) |
| 24 |
call make_dir(path) |
| 25 |
end subroutine ensure_clean_dir |
| 26 |
|
| 27 |
subroutine chmod_mode(path, mode) |
| 28 |
character(len=*), intent(in) :: path |
| 29 |
character(len=*), intent(in) :: mode |
| 30 |
|
| 31 |
call run_command("chmod " // mode // " " // path) |
| 32 |
end subroutine chmod_mode |
| 33 |
|
| 34 |
subroutine make_dir(path) |
| 35 |
character(len=*), intent(in) :: path |
| 36 |
|
| 37 |
call run_command("mkdir -p " // path) |
| 38 |
end subroutine make_dir |
| 39 |
|
| 40 |
subroutine remove_tree(path) |
| 41 |
character(len=*), intent(in) :: path |
| 42 |
|
| 43 |
call run_command("rm -rf " // path) |
| 44 |
end subroutine remove_tree |
| 45 |
|
| 46 |
subroutine remove_path(path) |
| 47 |
character(len=*), intent(in) :: path |
| 48 |
|
| 49 |
call run_command("rm -f " // path) |
| 50 |
end subroutine remove_path |
| 51 |
|
| 52 |
subroutine touch_path(path) |
| 53 |
character(len=*), intent(in) :: path |
| 54 |
|
| 55 |
call run_command("touch " // shell_quote(path)) |
| 56 |
end subroutine touch_path |
| 57 |
|
| 58 |
subroutine move_path(source, destination) |
| 59 |
character(len=*), intent(in) :: source |
| 60 |
character(len=*), intent(in) :: destination |
| 61 |
|
| 62 |
call run_command("mv " // source // " " // destination) |
| 63 |
end subroutine move_path |
| 64 |
|
| 65 |
subroutine write_text(path, text) |
| 66 |
character(len=*), intent(in) :: path |
| 67 |
character(len=*), intent(in) :: text |
| 68 |
integer :: unit |
| 69 |
|
| 70 |
open(newunit=unit, file=path, status="replace", action="write") |
| 71 |
write(unit, "(A)", advance="no") text |
| 72 |
close(unit) |
| 73 |
end subroutine write_text |
| 74 |
|
| 75 |
subroutine append_text(path, text) |
| 76 |
character(len=*), intent(in) :: path |
| 77 |
character(len=*), intent(in) :: text |
| 78 |
integer :: unit |
| 79 |
|
| 80 |
open(newunit=unit, file=path, status="old", position="append", action="write") |
| 81 |
write(unit, "(A)", advance="no") text |
| 82 |
close(unit) |
| 83 |
end subroutine append_text |
| 84 |
|
| 85 |
subroutine expect_no_events(events, message) |
| 86 |
type(watch_event), intent(in) :: events(:) |
| 87 |
character(len=*), intent(in) :: message |
| 88 |
|
| 89 |
if (size(events) /= 0) error stop trim(message) |
| 90 |
end subroutine expect_no_events |
| 91 |
|
| 92 |
subroutine expect_single_event(events, kind, path, previous_path, is_directory, message) |
| 93 |
type(watch_event), intent(in) :: events(:) |
| 94 |
integer, intent(in) :: kind |
| 95 |
character(len=*), intent(in) :: path |
| 96 |
character(len=*), intent(in) :: previous_path |
| 97 |
logical, intent(in) :: is_directory |
| 98 |
character(len=*), intent(in) :: message |
| 99 |
|
| 100 |
if (size(events) /= 1) error stop trim(message) // ": expected one event" |
| 101 |
if (events(1)%kind /= kind) error stop trim(message) // ": wrong event kind" |
| 102 |
if (events(1)%path /= path) error stop trim(message) // ": wrong event path" |
| 103 |
if (events(1)%previous_path /= previous_path) error stop trim(message) // ": wrong event previous path" |
| 104 |
if (events(1)%is_directory .neqv. is_directory) error stop trim(message) // ": wrong directory flag" |
| 105 |
end subroutine expect_single_event |
| 106 |
|
| 107 |
subroutine run_command(command) |
| 108 |
character(len=*), intent(in) :: command |
| 109 |
integer :: exitstat |
| 110 |
|
| 111 |
call execute_command_line(command, exitstat=exitstat) |
| 112 |
if (exitstat /= 0) error stop "command failed: " // trim(command) |
| 113 |
end subroutine run_command |
| 114 |
|
| 115 |
function shell_quote(text) result(quoted) |
| 116 |
character(len=*), intent(in) :: text |
| 117 |
character(len=:), allocatable :: quoted |
| 118 |
integer :: i |
| 119 |
|
| 120 |
quoted = "'" |
| 121 |
do i = 1, len(text) |
| 122 |
if (text(i:i) == "'") then |
| 123 |
quoted = quoted // achar(39) // achar(34) // achar(39) // achar(34) // achar(39) |
| 124 |
else |
| 125 |
quoted = quoted // text(i:i) |
| 126 |
end if |
| 127 |
end do |
| 128 |
quoted = quoted // "'" |
| 129 |
end function shell_quote |
| 130 |
|
| 131 |
end module watch_test_support |
| 132 |
|