| 1 |
program test_watch_debounce |
| 2 |
use fgof_watch, only : init_watch, poll_watch, reset_watch |
| 3 |
use fgof_watch_types, only : & |
| 4 |
FGOF_WATCH_EVT_CREATED, & |
| 5 |
FGOF_WATCH_EVT_MODIFIED, & |
| 6 |
watch_event, & |
| 7 |
watch_options, & |
| 8 |
watch_session |
| 9 |
use watch_test_support, only : & |
| 10 |
append_text, & |
| 11 |
ensure_clean_dir, & |
| 12 |
expect_no_events, & |
| 13 |
expect_single_event, & |
| 14 |
remove_path, & |
| 15 |
remove_tree, & |
| 16 |
write_text |
| 17 |
implicit none |
| 18 |
|
| 19 |
call test_created_event_debounces() |
| 20 |
call test_modify_burst_coalesces() |
| 21 |
call test_create_remove_cancels() |
| 22 |
|
| 23 |
contains |
| 24 |
|
| 25 |
subroutine test_created_event_debounces() |
| 26 |
character(len=*), parameter :: root = "build/watch-tests-debounce-created" |
| 27 |
character(len=*), parameter :: file_path = "build/watch-tests-debounce-created/file.txt" |
| 28 |
type(watch_event), allocatable :: events(:) |
| 29 |
type(watch_options) :: options |
| 30 |
type(watch_session) :: session |
| 31 |
|
| 32 |
call ensure_clean_dir(root) |
| 33 |
|
| 34 |
options = watch_options(debounce_polls=1) |
| 35 |
call init_watch(session, root, options) |
| 36 |
|
| 37 |
call write_text(file_path, "alpha") |
| 38 |
events = poll_watch(session) |
| 39 |
call expect_no_events(events, "created event should wait for a quiet poll") |
| 40 |
|
| 41 |
events = poll_watch(session) |
| 42 |
call expect_single_event(events, FGOF_WATCH_EVT_CREATED, file_path, "", .false., "created event should emit after debounce settles") |
| 43 |
|
| 44 |
call reset_watch(session) |
| 45 |
call remove_tree(root) |
| 46 |
end subroutine test_created_event_debounces |
| 47 |
|
| 48 |
subroutine test_modify_burst_coalesces() |
| 49 |
character(len=*), parameter :: root = "build/watch-tests-debounce-modify" |
| 50 |
character(len=*), parameter :: file_path = "build/watch-tests-debounce-modify/file.txt" |
| 51 |
type(watch_event), allocatable :: events(:) |
| 52 |
type(watch_options) :: options |
| 53 |
type(watch_session) :: session |
| 54 |
|
| 55 |
call ensure_clean_dir(root) |
| 56 |
call write_text(file_path, "seed") |
| 57 |
|
| 58 |
options = watch_options(debounce_polls=1) |
| 59 |
call init_watch(session, root, options) |
| 60 |
|
| 61 |
call append_text(file_path, "-a") |
| 62 |
events = poll_watch(session) |
| 63 |
call expect_no_events(events, "first modify should debounce") |
| 64 |
|
| 65 |
call append_text(file_path, "-b") |
| 66 |
events = poll_watch(session) |
| 67 |
call expect_no_events(events, "modify burst should coalesce while debounce is active") |
| 68 |
|
| 69 |
events = poll_watch(session) |
| 70 |
call expect_single_event(events, FGOF_WATCH_EVT_MODIFIED, file_path, "", .false., "modify burst should collapse into one event") |
| 71 |
|
| 72 |
call reset_watch(session) |
| 73 |
call remove_tree(root) |
| 74 |
end subroutine test_modify_burst_coalesces |
| 75 |
|
| 76 |
subroutine test_create_remove_cancels() |
| 77 |
character(len=*), parameter :: root = "build/watch-tests-debounce-cancel" |
| 78 |
character(len=*), parameter :: file_path = "build/watch-tests-debounce-cancel/file.txt" |
| 79 |
type(watch_event), allocatable :: events(:) |
| 80 |
type(watch_options) :: options |
| 81 |
type(watch_session) :: session |
| 82 |
|
| 83 |
call ensure_clean_dir(root) |
| 84 |
|
| 85 |
options = watch_options(debounce_polls=1) |
| 86 |
call init_watch(session, root, options) |
| 87 |
|
| 88 |
call write_text(file_path, "alpha") |
| 89 |
events = poll_watch(session) |
| 90 |
call expect_no_events(events, "created event should enter debounce queue") |
| 91 |
|
| 92 |
call remove_path(file_path) |
| 93 |
events = poll_watch(session) |
| 94 |
call expect_no_events(events, "create then remove inside debounce window should cancel") |
| 95 |
|
| 96 |
events = poll_watch(session) |
| 97 |
call expect_no_events(events, "cancelled debounce sequence should stay quiet") |
| 98 |
|
| 99 |
call reset_watch(session) |
| 100 |
call remove_tree(root) |
| 101 |
end subroutine test_create_remove_cancels |
| 102 |
|
| 103 |
end program test_watch_debounce |
| 104 |
|