Fortran · 3873 bytes Raw Blame History
1 program test_watch_errors
2 use fgof_watch, only : init_watch, poll_watch, reset_watch, set_ignore_prefixes
3 use fgof_watch_types, only : FGOF_WATCH_ERR_NONE, FGOF_WATCH_ERR_SNAPSHOT_FAILED, watch_event, watch_options, watch_session
4 use watch_test_support, only : chmod_mode, ensure_clean_dir, expect_no_events, make_dir, remove_tree, write_text
5 implicit none
6
7 call test_runtime_snapshot_failure()
8 call test_hidden_pruning_avoids_failure()
9 call test_prefix_pruning_avoids_failure()
10
11 contains
12
13 subroutine test_runtime_snapshot_failure()
14 character(len=*), parameter :: root = "build/watch-tests-errors"
15 character(len=*), parameter :: locked_dir = "build/watch-tests-errors/locked"
16 character(len=*), parameter :: locked_file = "build/watch-tests-errors/locked/file.txt"
17 type(watch_event), allocatable :: events(:)
18 type(watch_session) :: session
19
20 call ensure_clean_dir(root)
21 call make_dir(locked_dir)
22 call write_text(locked_file, "alpha")
23
24 call init_watch(session, root)
25 if (session%last_error_code /= FGOF_WATCH_ERR_NONE) error stop "initial snapshot should succeed"
26
27 call chmod_mode(locked_dir, "000")
28 events = poll_watch(session)
29 call expect_no_events(events, "snapshot failure should not emit false remove events")
30 if (session%last_error_code /= FGOF_WATCH_ERR_SNAPSHOT_FAILED) error stop "snapshot failure should set the session error code"
31 if (.not. allocated(session%last_error_message)) error stop "snapshot failure should preserve an error message"
32 if (len(session%last_error_message) == 0) error stop "snapshot failure message should not be empty"
33
34 call chmod_mode(locked_dir, "755")
35 events = poll_watch(session)
36 call expect_no_events(events, "state should recover cleanly after access is restored")
37 if (session%last_error_code /= FGOF_WATCH_ERR_NONE) error stop "successful poll should clear the session error"
38
39 call reset_watch(session)
40 call remove_tree(root)
41 end subroutine test_runtime_snapshot_failure
42
43 subroutine test_hidden_pruning_avoids_failure()
44 character(len=*), parameter :: root = "build/watch-tests-hidden-prune"
45 character(len=*), parameter :: hidden_dir = "build/watch-tests-hidden-prune/.cache"
46 character(len=*), parameter :: hidden_file = "build/watch-tests-hidden-prune/.cache/file.txt"
47 type(watch_options) :: options
48 type(watch_session) :: session
49
50 call ensure_clean_dir(root)
51 call make_dir(hidden_dir)
52 call write_text(hidden_file, "alpha")
53 call chmod_mode(hidden_dir, "000")
54
55 options%ignore_hidden = .true.
56 call init_watch(session, root, options)
57 if (session%last_error_code /= FGOF_WATCH_ERR_NONE) error stop "ignored hidden subtree should be pruned before snapshot failure"
58
59 call chmod_mode(hidden_dir, "755")
60 call reset_watch(session)
61 call remove_tree(root)
62 end subroutine test_hidden_pruning_avoids_failure
63
64 subroutine test_prefix_pruning_avoids_failure()
65 character(len=*), parameter :: root = "build/watch-tests-prefix-prune"
66 character(len=*), parameter :: vendor_dir = "build/watch-tests-prefix-prune/vendor"
67 character(len=*), parameter :: vendor_file = "build/watch-tests-prefix-prune/vendor/file.txt"
68 type(watch_options) :: options
69 type(watch_session) :: session
70
71 call ensure_clean_dir(root)
72 call make_dir(vendor_dir)
73 call write_text(vendor_file, "alpha")
74 call chmod_mode(vendor_dir, "000")
75
76 call set_ignore_prefixes(options, [character(len=len(vendor_dir)) :: vendor_dir])
77 call init_watch(session, root, options)
78 if (session%last_error_code /= FGOF_WATCH_ERR_NONE) error stop "ignored prefix subtree should be pruned before snapshot failure"
79
80 call chmod_mode(vendor_dir, "755")
81 call reset_watch(session)
82 call remove_tree(root)
83 end subroutine test_prefix_pruning_avoids_failure
84 end program test_watch_errors
85