fortrangoingonforty/fgof-devloop / 148536d

Browse files

Test devloop process supervision

Authored by mfwolffe <wolffemf@dukes.jmu.edu>
SHA
148536db71146c71a05a02bed1a7be118de2fc61
Parents
8479992
Tree
4abc1d7

2 changed files

StatusFile+-
A test/test_devloop_process.f90 115 0
M test/test_scaffold.f90 19 0
test/test_devloop_process.f90added
@@ -0,0 +1,115 @@ 
1
+program test_devloop_process
2
+  use fgof_devloop, only : &
3
+    FGOF_DEVLOOP_COMMAND_BUILD, &
4
+    FGOF_DEVLOOP_COMMAND_SMOKE, &
5
+    FGOF_DEVLOOP_DECISION_IDLE, &
6
+    FGOF_DEVLOOP_DECISION_RESTART, &
7
+    FGOF_DEVLOOP_DECISION_STOP, &
8
+    clear_devloop_options, &
9
+    devloop_build_command, &
10
+    devloop_manual_trigger, &
11
+    devloop_run_command, &
12
+    devloop_smoke_command, &
13
+    devloop_start_trigger, &
14
+    run_devloop_cycle, &
15
+    start_devloop
16
+  use fgof_devloop_types, only : &
17
+    devloop_command_spec, &
18
+    devloop_options, &
19
+    devloop_state, &
20
+    devloop_supervision_result
21
+  use fgof_process, only : &
22
+    FGOF_PROCESS_ERR_TIMEOUT, &
23
+    process_options, &
24
+    shell
25
+  implicit none
26
+
27
+  call test_successful_build_command()
28
+  call test_build_failure_skips_later_commands()
29
+  call test_timeout_uses_failure_policy()
30
+
31
+contains
32
+
33
+  subroutine test_successful_build_command()
34
+    type(devloop_state) :: state
35
+    type(devloop_command_spec) :: build
36
+    type(devloop_supervision_result) :: supervision
37
+    type(process_options) :: process_config
38
+
39
+    process_config = process_options()
40
+    process_config%capture_stdout = .true.
41
+
42
+    call start_devloop(state)
43
+    build = devloop_build_command(shell("printf build"), process_config, "compile")
44
+    supervision = run_devloop_cycle(state, devloop_start_trigger(), build_command=build)
45
+
46
+    if (.not. supervision%started) error stop "process supervision should start a cycle"
47
+    if (.not. supervision%succeeded) error stop "successful process should succeed"
48
+    if (supervision%failed) error stop "successful process should not fail"
49
+    if (supervision%command_count /= 1) error stop "one build command should run"
50
+    if (supervision%build%kind /= FGOF_DEVLOOP_COMMAND_BUILD) error stop "build kind should be preserved"
51
+    if (.not. supervision%build%requested) error stop "build command should be requested"
52
+    if (.not. supervision%build%succeeded) error stop "build command should succeed"
53
+    if (supervision%build%label /= "compile") error stop "custom build label should be preserved"
54
+    if (supervision%build%process%stdout /= "build") error stop "build stdout should stay visible"
55
+    if (supervision%decision%kind /= FGOF_DEVLOOP_DECISION_IDLE) error stop "success should idle"
56
+    if (state%running) error stop "finished process cycle should not leave state running"
57
+  end subroutine test_successful_build_command
58
+
59
+  subroutine test_build_failure_skips_later_commands()
60
+    type(devloop_state) :: state
61
+    type(devloop_command_spec) :: build
62
+    type(devloop_command_spec) :: run_spec
63
+    type(devloop_supervision_result) :: supervision
64
+
65
+    call start_devloop(state)
66
+    build = devloop_build_command(shell("exit 7"))
67
+    run_spec = devloop_run_command(shell("exit 0"))
68
+    supervision = run_devloop_cycle(state, devloop_manual_trigger("manual"), &
69
+                                    build_command=build, run_command=run_spec)
70
+
71
+    if (.not. supervision%failed) error stop "failed build should fail supervision"
72
+    if (supervision%succeeded) error stop "failed build should not succeed"
73
+    if (supervision%command_count /= 1) error stop "run command should be skipped after build failure"
74
+    if (supervision%failed_command_kind /= FGOF_DEVLOOP_COMMAND_BUILD) then
75
+      error stop "failed command kind should identify build"
76
+    end if
77
+    if (supervision%last_exit_code /= 7) error stop "failed exit code should be preserved"
78
+    if (supervision%build%exit_code /= 7) error stop "build exit code should be preserved"
79
+    if (supervision%run%requested) error stop "run command should not execute after build failure"
80
+    if (.not. supervision%run%skipped) error stop "skipped run command should stay marked skipped"
81
+    if (supervision%decision%kind /= FGOF_DEVLOOP_DECISION_RESTART) error stop "failure should request restart"
82
+    if (.not. supervision%decision%should_run) error stop "restart decision should be runnable"
83
+    if (state%consecutive_failures /= 1) error stop "failure count should advance"
84
+  end subroutine test_build_failure_skips_later_commands
85
+
86
+  subroutine test_timeout_uses_failure_policy()
87
+    type(devloop_state) :: state
88
+    type(devloop_options) :: loop_options
89
+    type(devloop_command_spec) :: smoke
90
+    type(devloop_supervision_result) :: supervision
91
+    type(process_options) :: process_config
92
+
93
+    loop_options = clear_devloop_options()
94
+    loop_options%stop_on_failure = .true.
95
+    process_config = process_options()
96
+    process_config%timeout_ms = 100
97
+
98
+    call start_devloop(state, loop_options)
99
+    smoke = devloop_smoke_command(shell("sleep 1"), process_config)
100
+    supervision = run_devloop_cycle(state, devloop_manual_trigger("timeout"), smoke_command=smoke)
101
+
102
+    if (.not. supervision%failed) error stop "timed-out smoke should fail supervision"
103
+    if (.not. supervision%timed_out) error stop "timeout should be visible on supervision"
104
+    if (supervision%failed_command_kind /= FGOF_DEVLOOP_COMMAND_SMOKE) then
105
+      error stop "failed command kind should identify smoke"
106
+    end if
107
+    if (supervision%process_error_code /= FGOF_PROCESS_ERR_TIMEOUT) then
108
+      error stop "timeout should preserve process error code"
109
+    end if
110
+    if (.not. supervision%smoke%timed_out) error stop "smoke result should preserve timeout"
111
+    if (supervision%decision%kind /= FGOF_DEVLOOP_DECISION_STOP) error stop "stop policy should stop"
112
+    if (.not. state%stopped) error stop "stop policy should mark state stopped"
113
+  end subroutine test_timeout_uses_failure_policy
114
+
115
+end program test_devloop_process
test/test_scaffold.f90modified
@@ -1,19 +1,26 @@ 
1
 program test_scaffold
1
 program test_scaffold
2
   use fgof_devloop, only : &
2
   use fgof_devloop, only : &
3
     FGOF_DEVLOOP_DECISION_IDLE, &
3
     FGOF_DEVLOOP_DECISION_IDLE, &
4
+    FGOF_DEVLOOP_COMMAND_NONE, &
4
     FGOF_DEVLOOP_TRIGGER_NONE, &
5
     FGOF_DEVLOOP_TRIGGER_NONE, &
6
+    clear_devloop_command_result, &
7
+    clear_devloop_command_spec, &
5
     clear_devloop_cycle, &
8
     clear_devloop_cycle, &
6
     clear_devloop_decision, &
9
     clear_devloop_decision, &
7
     clear_devloop_options, &
10
     clear_devloop_options, &
8
     clear_devloop_state, &
11
     clear_devloop_state, &
12
+    clear_devloop_supervision_result, &
9
     clear_devloop_trigger, &
13
     clear_devloop_trigger, &
10
     clear_devloop_watch_summary, &
14
     clear_devloop_watch_summary, &
11
     devloop_backend_name
15
     devloop_backend_name
12
   use fgof_devloop_types, only : &
16
   use fgof_devloop_types, only : &
17
+    devloop_command_result, &
18
+    devloop_command_spec, &
13
     devloop_cycle, &
19
     devloop_cycle, &
14
     devloop_decision, &
20
     devloop_decision, &
15
     devloop_options, &
21
     devloop_options, &
16
     devloop_state, &
22
     devloop_state, &
23
+    devloop_supervision_result, &
17
     devloop_trigger, &
24
     devloop_trigger, &
18
     devloop_watch_summary
25
     devloop_watch_summary
19
   implicit none
26
   implicit none
@@ -23,6 +30,9 @@ program test_scaffold
23
   type(devloop_trigger) :: trigger
30
   type(devloop_trigger) :: trigger
24
   type(devloop_cycle) :: cycle
31
   type(devloop_cycle) :: cycle
25
   type(devloop_decision) :: decision
32
   type(devloop_decision) :: decision
33
+  type(devloop_command_spec) :: command_spec
34
+  type(devloop_command_result) :: command_result
35
+  type(devloop_supervision_result) :: supervision
26
   type(devloop_watch_summary) :: watch_summary
36
   type(devloop_watch_summary) :: watch_summary
27
 
37
 
28
   state = clear_devloop_state()
38
   state = clear_devloop_state()
@@ -30,6 +40,9 @@ program test_scaffold
30
   trigger = clear_devloop_trigger()
40
   trigger = clear_devloop_trigger()
31
   cycle = clear_devloop_cycle()
41
   cycle = clear_devloop_cycle()
32
   decision = clear_devloop_decision()
42
   decision = clear_devloop_decision()
43
+  command_spec = clear_devloop_command_spec()
44
+  command_result = clear_devloop_command_result()
45
+  supervision = clear_devloop_supervision_result()
33
   watch_summary = clear_devloop_watch_summary()
46
   watch_summary = clear_devloop_watch_summary()
34
 
47
 
35
   if (state%options%max_failures /= 0) error stop "devloop options should start with unlimited failures"
48
   if (state%options%max_failures /= 0) error stop "devloop options should start with unlimited failures"
@@ -48,6 +61,12 @@ program test_scaffold
48
   if (trigger%kind /= FGOF_DEVLOOP_TRIGGER_NONE) error stop "clear trigger should produce no trigger"
61
   if (trigger%kind /= FGOF_DEVLOOP_TRIGGER_NONE) error stop "clear trigger should produce no trigger"
49
   if (cycle%started) error stop "clear cycle should not start a cycle"
62
   if (cycle%started) error stop "clear cycle should not start a cycle"
50
   if (decision%kind /= FGOF_DEVLOOP_DECISION_IDLE) error stop "clear decision should idle"
63
   if (decision%kind /= FGOF_DEVLOOP_DECISION_IDLE) error stop "clear decision should idle"
64
+  if (command_spec%enabled) error stop "clear command spec should be disabled"
65
+  if (command_spec%kind /= FGOF_DEVLOOP_COMMAND_NONE) error stop "clear command spec should have no kind"
66
+  if (command_result%requested) error stop "clear command result should not be requested"
67
+  if (.not. command_result%skipped) error stop "clear command result should be skipped"
68
+  if (supervision%started) error stop "clear supervision should not be started"
69
+  if (supervision%command_count /= 0) error stop "clear supervision should have no commands"
51
   if (options%stop_on_failure) error stop "clear options should not stop on failure by default"
70
   if (options%stop_on_failure) error stop "clear options should not stop on failure by default"
52
   if (options%ignore_hidden) error stop "clear options should not ignore hidden paths by default"
71
   if (options%ignore_hidden) error stop "clear options should not ignore hidden paths by default"
53
   if (options%debounce_polls /= 0) error stop "clear options should not debounce by default"
72
   if (options%debounce_polls /= 0) error stop "clear options should not debounce by default"