Fortran · 4333 bytes Raw Blame History
1 program test_devloop_model
2 use fgof_devloop, only : &
3 FGOF_DEVLOOP_DECISION_IDLE, &
4 FGOF_DEVLOOP_DECISION_RESTART, &
5 FGOF_DEVLOOP_DECISION_STOP, &
6 FGOF_DEVLOOP_TRIGGER_CHANGE, &
7 FGOF_DEVLOOP_TRIGGER_NONE, &
8 FGOF_DEVLOOP_TRIGGER_START, &
9 begin_devloop_cycle, &
10 clear_devloop_options, &
11 clear_devloop_state, &
12 devloop_change_trigger, &
13 devloop_manual_trigger, &
14 devloop_start_trigger, &
15 finish_devloop_cycle, &
16 should_start_on_open, &
17 start_devloop, &
18 stop_devloop
19 use fgof_devloop_types, only : devloop_cycle, devloop_decision, devloop_options, devloop_state, devloop_trigger
20 implicit none
21
22 type(devloop_state) :: state
23 type(devloop_options) :: options
24 type(devloop_cycle) :: cycle
25 type(devloop_decision) :: decision
26 type(devloop_trigger) :: trigger
27
28 state = clear_devloop_state()
29 call start_devloop(state)
30 if (.not. state%active) error stop "start_devloop should activate the loop"
31 if (.not. should_start_on_open(state)) error stop "default options should request a start cycle"
32
33 cycle = begin_devloop_cycle(state, devloop_start_trigger())
34 if (.not. cycle%started) error stop "start trigger should begin a cycle"
35 if (cycle%id /= 1) error stop "first cycle should use id one"
36 if (cycle%trigger_kind /= FGOF_DEVLOOP_TRIGGER_START) error stop "cycle should record start trigger"
37 if (.not. state%running) error stop "begin cycle should mark the loop running"
38
39 decision = finish_devloop_cycle(state, succeeded=.true., exit_code=0)
40 if (decision%kind /= FGOF_DEVLOOP_DECISION_IDLE) error stop "successful cycle should idle"
41 if (state%running) error stop "finished cycle should clear running state"
42 if (state%last_cycle%exit_code /= 0) error stop "finish should preserve exit code"
43
44 cycle = begin_devloop_cycle(state, devloop_change_trigger(3, "source changed"))
45 if (.not. cycle%started) error stop "change trigger should begin a restart cycle"
46 if (cycle%trigger_kind /= FGOF_DEVLOOP_TRIGGER_CHANGE) error stop "change cycle should record trigger kind"
47 if (cycle%change_count /= 3) error stop "change cycle should preserve change count"
48 decision = finish_devloop_cycle(state, succeeded=.false., exit_code=2)
49 if (decision%kind /= FGOF_DEVLOOP_DECISION_RESTART) error stop "failed cycle should restart by default"
50 if (.not. decision%should_run) error stop "restart decision should request another run"
51 if (state%consecutive_failures /= 1) error stop "failed cycle should increment failure count"
52
53 call start_devloop(state)
54 trigger = devloop_change_trigger(0)
55 if (trigger%kind /= FGOF_DEVLOOP_TRIGGER_NONE) then
56 error stop "zero-count change trigger should be suppressed"
57 end if
58 trigger = devloop_change_trigger(-2)
59 if (trigger%kind /= FGOF_DEVLOOP_TRIGGER_NONE) then
60 error stop "negative-count change trigger should be suppressed"
61 end if
62 cycle = begin_devloop_cycle(state, devloop_change_trigger(0))
63 if (cycle%started) error stop "zero-count changes should not start a cycle"
64
65 options = clear_devloop_options()
66 options%restart_on_change = .false.
67 call start_devloop(state, options)
68 cycle = begin_devloop_cycle(state, devloop_change_trigger(1))
69 if (cycle%started) error stop "restart_on_change=false should suppress change cycles"
70 cycle = begin_devloop_cycle(state, devloop_manual_trigger())
71 if (.not. cycle%started) error stop "manual trigger should still begin a cycle"
72
73 options = clear_devloop_options()
74 options%max_failures = 1
75 call start_devloop(state, options)
76 cycle = begin_devloop_cycle(state, devloop_start_trigger())
77 decision = finish_devloop_cycle(state, succeeded=.false., exit_code=1)
78 if (decision%kind /= FGOF_DEVLOOP_DECISION_STOP) error stop "max failures should stop the loop"
79 if (.not. decision%should_stop) error stop "stop decision should request stop"
80 if (state%active) error stop "failure limit should deactivate the loop"
81 if (.not. state%stopped) error stop "failure limit should mark the loop stopped"
82
83 options = clear_devloop_options()
84 options%max_failures = -5
85 call start_devloop(state, options)
86 if (state%options%max_failures /= 0) error stop "negative max_failures should normalize to unlimited"
87
88 call stop_devloop(state)
89 if (state%active) error stop "stop_devloop should deactivate the loop"
90 end program test_devloop_model
91