fortrangoingonforty/fgof-devloop / 8479992

Browse files

Add devloop process supervision

Authored by mfwolffe <wolffemf@dukes.jmu.edu>
SHA
847999208253e14d63c6030328bff6be86a52081
Parents
639335c
Tree
0d4bb76

3 changed files

StatusFile+-
M fpm.toml 1 0
M src/fgof_devloop.f90 234 0
M src/fgof_devloop_types.f90 52 0
fpm.tomlmodified
@@ -20,4 +20,5 @@ implicit-external = false
2020
 source-form = "free"
2121
2222
 [dependencies]
23
+fgof-process = { git = "https://github.com/FortranGoingOnForty/fgof-process.git", tag = "v0.1.0" }
2324
 fgof-watch = { git = "https://github.com/FortranGoingOnForty/fgof-watch.git", tag = "v0.1.0" }
src/fgof_devloop.f90modified
@@ -1,4 +1,10 @@
11
 module fgof_devloop
2
+  use fgof_process, only : &
3
+    FGOF_PROCESS_OK, &
4
+    process_command, &
5
+    process_options, &
6
+    process_result, &
7
+    run_process => run
28
   use fgof_watch_types, only : &
39
     FGOF_WATCH_EVT_CREATED, &
410
     FGOF_WATCH_EVT_MODIFIED, &
@@ -12,14 +18,21 @@ module fgof_devloop
1218
     FGOF_DEVLOOP_DECISION_RESTART, &
1319
     FGOF_DEVLOOP_DECISION_RUN, &
1420
     FGOF_DEVLOOP_DECISION_STOP, &
21
+    FGOF_DEVLOOP_COMMAND_BUILD, &
22
+    FGOF_DEVLOOP_COMMAND_NONE, &
23
+    FGOF_DEVLOOP_COMMAND_RUN, &
24
+    FGOF_DEVLOOP_COMMAND_SMOKE, &
1525
     FGOF_DEVLOOP_TRIGGER_CHANGE, &
1626
     FGOF_DEVLOOP_TRIGGER_MANUAL, &
1727
     FGOF_DEVLOOP_TRIGGER_NONE, &
1828
     FGOF_DEVLOOP_TRIGGER_START, &
29
+    devloop_command_result, &
30
+    devloop_command_spec, &
1931
     devloop_cycle, &
2032
     devloop_decision, &
2133
     devloop_options, &
2234
     devloop_state, &
35
+    devloop_supervision_result, &
2336
     devloop_trigger, &
2437
     devloop_watch_summary
2538
   implicit none
@@ -28,20 +41,29 @@ module fgof_devloop
2841
   character(len=*), parameter :: FGOF_DEVLOOP_BACKEND_MODEL = "model"
2942
3043
   public :: begin_devloop_cycle
44
+  public :: clear_devloop_command_result
45
+  public :: clear_devloop_command_spec
3146
   public :: clear_devloop_cycle
3247
   public :: clear_devloop_decision
3348
   public :: clear_devloop_options
3449
   public :: clear_devloop_state
50
+  public :: clear_devloop_supervision_result
3551
   public :: clear_devloop_trigger
3652
   public :: clear_devloop_watch_summary
3753
   public :: devloop_backend_name
54
+  public :: devloop_build_command
3855
   public :: devloop_change_trigger
56
+  public :: devloop_command_result
57
+  public :: devloop_command_spec
3958
   public :: devloop_cycle
4059
   public :: devloop_decision
4160
   public :: devloop_manual_trigger
4261
   public :: devloop_options
62
+  public :: devloop_run_command
63
+  public :: devloop_smoke_command
4364
   public :: devloop_start_trigger
4465
   public :: devloop_state
66
+  public :: devloop_supervision_result
4567
   public :: devloop_summarize_watch_events
4668
   public :: devloop_trigger
4769
   public :: devloop_watch_failure_summary
@@ -53,10 +75,16 @@ module fgof_devloop
5375
   public :: FGOF_DEVLOOP_DECISION_RESTART
5476
   public :: FGOF_DEVLOOP_DECISION_RUN
5577
   public :: FGOF_DEVLOOP_DECISION_STOP
78
+  public :: FGOF_DEVLOOP_COMMAND_BUILD
79
+  public :: FGOF_DEVLOOP_COMMAND_NONE
80
+  public :: FGOF_DEVLOOP_COMMAND_RUN
81
+  public :: FGOF_DEVLOOP_COMMAND_SMOKE
5682
   public :: FGOF_DEVLOOP_TRIGGER_CHANGE
5783
   public :: FGOF_DEVLOOP_TRIGGER_MANUAL
5884
   public :: FGOF_DEVLOOP_TRIGGER_NONE
5985
   public :: FGOF_DEVLOOP_TRIGGER_START
86
+  public :: run_devloop_command
87
+  public :: run_devloop_cycle
6088
   public :: should_start_on_open
6189
   public :: start_devloop
6290
   public :: stop_devloop
@@ -126,6 +154,50 @@ contains
126154
     summary%watch_error_message = ""
127155
   end function clear_devloop_watch_summary
128156
157
+  function clear_devloop_command_spec() result(spec)
158
+    type(devloop_command_spec) :: spec
159
+
160
+    spec%kind = FGOF_DEVLOOP_COMMAND_NONE
161
+    spec%enabled = .false.
162
+    spec%options = process_options()
163
+    spec%label = ""
164
+  end function clear_devloop_command_spec
165
+
166
+  function clear_devloop_command_result() result(command_result)
167
+    type(devloop_command_result) :: command_result
168
+
169
+    command_result%kind = FGOF_DEVLOOP_COMMAND_NONE
170
+    command_result%requested = .false.
171
+    command_result%skipped = .true.
172
+    command_result%launched = .false.
173
+    command_result%completed = .false.
174
+    command_result%succeeded = .false.
175
+    command_result%timed_out = .false.
176
+    command_result%exit_code = 0
177
+    command_result%process_error_code = FGOF_PROCESS_OK
178
+    command_result%process = clear_process_result()
179
+    command_result%label = ""
180
+    command_result%error_message = ""
181
+  end function clear_devloop_command_result
182
+
183
+  function clear_devloop_supervision_result() result(supervision)
184
+    type(devloop_supervision_result) :: supervision
185
+
186
+    supervision%cycle = clear_devloop_cycle()
187
+    supervision%decision = clear_devloop_decision()
188
+    supervision%build = clear_devloop_command_result()
189
+    supervision%run = clear_devloop_command_result()
190
+    supervision%smoke = clear_devloop_command_result()
191
+    supervision%command_count = 0
192
+    supervision%failed_command_kind = FGOF_DEVLOOP_COMMAND_NONE
193
+    supervision%last_exit_code = 0
194
+    supervision%process_error_code = FGOF_PROCESS_OK
195
+    supervision%started = .false.
196
+    supervision%succeeded = .false.
197
+    supervision%failed = .false.
198
+    supervision%timed_out = .false.
199
+  end function clear_devloop_supervision_result
200
+
129201
   function clear_devloop_state() result(state)
130202
     type(devloop_state) :: state
131203
@@ -202,6 +274,33 @@ contains
202274
     end if
203275
   end function devloop_manual_trigger
204276
277
+  function devloop_build_command(command_value, options, label) result(spec)
278
+    type(process_command), intent(in) :: command_value
279
+    type(process_options), intent(in), optional :: options
280
+    character(len=*), intent(in), optional :: label
281
+    type(devloop_command_spec) :: spec
282
+
283
+    spec = make_devloop_command(FGOF_DEVLOOP_COMMAND_BUILD, command_value, options, label)
284
+  end function devloop_build_command
285
+
286
+  function devloop_run_command(command_value, options, label) result(spec)
287
+    type(process_command), intent(in) :: command_value
288
+    type(process_options), intent(in), optional :: options
289
+    character(len=*), intent(in), optional :: label
290
+    type(devloop_command_spec) :: spec
291
+
292
+    spec = make_devloop_command(FGOF_DEVLOOP_COMMAND_RUN, command_value, options, label)
293
+  end function devloop_run_command
294
+
295
+  function devloop_smoke_command(command_value, options, label) result(spec)
296
+    type(process_command), intent(in) :: command_value
297
+    type(process_options), intent(in), optional :: options
298
+    character(len=*), intent(in), optional :: label
299
+    type(devloop_command_spec) :: spec
300
+
301
+    spec = make_devloop_command(FGOF_DEVLOOP_COMMAND_SMOKE, command_value, options, label)
302
+  end function devloop_smoke_command
303
+
205304
   function devloop_summarize_watch_events(events) result(summary)
206305
     type(watch_event), intent(in) :: events(:)
207306
     type(devloop_watch_summary) :: summary
@@ -292,6 +391,71 @@ contains
292391
     end if
293392
   end function devloop_watch_trigger
294393
394
+  function run_devloop_command(spec) result(command_result)
395
+    type(devloop_command_spec), intent(in) :: spec
396
+    type(devloop_command_result) :: command_result
397
+    type(process_result) :: process_run_result
398
+
399
+    command_result = clear_devloop_command_result()
400
+    command_result%kind = spec%kind
401
+    command_result%label = command_kind_label(spec%kind)
402
+    if (allocated(spec%label)) then
403
+      if (len(spec%label) > 0) command_result%label = spec%label
404
+    end if
405
+
406
+    if (.not. spec%enabled) return
407
+
408
+    command_result%requested = .true.
409
+    command_result%skipped = .false.
410
+    process_run_result = run_process(spec%command, spec%options)
411
+    command_result%process = process_run_result
412
+    command_result%launched = process_run_result%launched
413
+    command_result%completed = process_run_result%completed
414
+    command_result%timed_out = process_run_result%timed_out
415
+    command_result%exit_code = process_run_result%exit_code
416
+    command_result%process_error_code = process_run_result%error_code
417
+    command_result%error_message = process_run_result%error_message
418
+    command_result%succeeded = process_run_result%error_code == FGOF_PROCESS_OK .and. &
419
+                               process_run_result%completed .and. &
420
+                               process_run_result%exited_normally .and. &
421
+                               process_run_result%exit_code == 0
422
+  end function run_devloop_command
423
+
424
+  function run_devloop_cycle(state, trigger, build_command, run_command, smoke_command) result(supervision)
425
+    type(devloop_state), intent(inout) :: state
426
+    type(devloop_trigger), intent(in) :: trigger
427
+    type(devloop_command_spec), intent(in), optional :: build_command
428
+    type(devloop_command_spec), intent(in), optional :: run_command
429
+    type(devloop_command_spec), intent(in), optional :: smoke_command
430
+    type(devloop_supervision_result) :: supervision
431
+    logical :: should_continue
432
+
433
+    supervision = clear_devloop_supervision_result()
434
+    supervision%cycle = begin_devloop_cycle(state, trigger)
435
+    supervision%started = supervision%cycle%started
436
+    if (.not. supervision%started) return
437
+
438
+    should_continue = .true.
439
+    if (present(build_command)) then
440
+      supervision%build = run_devloop_command(build_command)
441
+      call record_supervised_command(supervision, supervision%build, should_continue)
442
+    end if
443
+
444
+    if (should_continue .and. present(run_command)) then
445
+      supervision%run = run_devloop_command(run_command)
446
+      call record_supervised_command(supervision, supervision%run, should_continue)
447
+    end if
448
+
449
+    if (should_continue .and. present(smoke_command)) then
450
+      supervision%smoke = run_devloop_command(smoke_command)
451
+      call record_supervised_command(supervision, supervision%smoke, should_continue)
452
+    end if
453
+
454
+    supervision%succeeded = should_continue
455
+    supervision%failed = .not. should_continue
456
+    supervision%decision = finish_devloop_cycle(state, supervision%succeeded, supervision%last_exit_code)
457
+  end function run_devloop_cycle
458
+
295459
   function begin_devloop_cycle(state, trigger) result(cycle)
296460
     type(devloop_state), intent(inout) :: state
297461
     type(devloop_trigger), intent(in) :: trigger
@@ -362,6 +526,76 @@ contains
362526
     name = FGOF_DEVLOOP_BACKEND_MODEL
363527
   end function devloop_backend_name
364528
529
+  function make_devloop_command(kind, command_value, options, label) result(spec)
530
+    integer, intent(in) :: kind
531
+    type(process_command), intent(in) :: command_value
532
+    type(process_options), intent(in), optional :: options
533
+    character(len=*), intent(in), optional :: label
534
+    type(devloop_command_spec) :: spec
535
+
536
+    spec = clear_devloop_command_spec()
537
+    spec%kind = kind
538
+    spec%enabled = .true.
539
+    spec%command = command_value
540
+    spec%options = process_options()
541
+    if (present(options)) spec%options = options
542
+    if (present(label)) then
543
+      spec%label = label
544
+    else
545
+      spec%label = command_kind_label(kind)
546
+    end if
547
+  end function make_devloop_command
548
+
549
+  function clear_process_result() result(process_run_result)
550
+    type(process_result) :: process_run_result
551
+
552
+    process_run_result%launched = .false.
553
+    process_run_result%completed = .false.
554
+    process_run_result%timed_out = .false.
555
+    process_run_result%exited_normally = .false.
556
+    process_run_result%exit_code = -1
557
+    process_run_result%term_signal = 0
558
+    process_run_result%stdout = ""
559
+    process_run_result%stderr = ""
560
+    process_run_result%error_code = FGOF_PROCESS_OK
561
+    process_run_result%error_message = ""
562
+    process_run_result%elapsed_ms = 0
563
+  end function clear_process_result
564
+
565
+  function command_kind_label(kind) result(label)
566
+    integer, intent(in) :: kind
567
+    character(len=:), allocatable :: label
568
+
569
+    select case (kind)
570
+    case (FGOF_DEVLOOP_COMMAND_BUILD)
571
+      label = "build"
572
+    case (FGOF_DEVLOOP_COMMAND_RUN)
573
+      label = "run"
574
+    case (FGOF_DEVLOOP_COMMAND_SMOKE)
575
+      label = "smoke"
576
+    case default
577
+      label = "none"
578
+    end select
579
+  end function command_kind_label
580
+
581
+  subroutine record_supervised_command(supervision, command_result, should_continue)
582
+    type(devloop_supervision_result), intent(inout) :: supervision
583
+    type(devloop_command_result), intent(in) :: command_result
584
+    logical, intent(inout) :: should_continue
585
+
586
+    if (.not. command_result%requested) return
587
+
588
+    supervision%command_count = supervision%command_count + 1
589
+    supervision%last_exit_code = command_result%exit_code
590
+
591
+    if (command_result%succeeded) return
592
+
593
+    should_continue = .false.
594
+    supervision%failed_command_kind = command_result%kind
595
+    supervision%process_error_code = command_result%process_error_code
596
+    supervision%timed_out = command_result%timed_out
597
+  end subroutine record_supervised_command
598
+
365599
   subroutine normalize_options(options)
366600
     type(devloop_options), intent(inout) :: options
367601
src/fgof_devloop_types.f90modified
@@ -1,4 +1,9 @@
11
 module fgof_devloop_types
2
+  use fgof_process_types, only : &
3
+    FGOF_PROCESS_OK, &
4
+    process_command, &
5
+    process_options, &
6
+    process_result
27
   implicit none
38
   private
49
@@ -10,6 +15,14 @@ module fgof_devloop_types
1015
   integer, parameter, public :: FGOF_DEVLOOP_DECISION_RUN = 1
1116
   integer, parameter, public :: FGOF_DEVLOOP_DECISION_RESTART = 2
1217
   integer, parameter, public :: FGOF_DEVLOOP_DECISION_STOP = 3
18
+  integer, parameter, public :: FGOF_DEVLOOP_COMMAND_NONE = 0
19
+  integer, parameter, public :: FGOF_DEVLOOP_COMMAND_BUILD = 1
20
+  integer, parameter, public :: FGOF_DEVLOOP_COMMAND_RUN = 2
21
+  integer, parameter, public :: FGOF_DEVLOOP_COMMAND_SMOKE = 3
22
+
23
+  public :: process_command
24
+  public :: process_options
25
+  public :: process_result
1326
1427
   type, public :: devloop_options
1528
     logical :: run_on_start = .true.
@@ -64,6 +77,45 @@ module fgof_devloop_types
6477
     character(len=:), allocatable :: watch_error_message
6578
   end type devloop_watch_summary
6679
80
+  type, public :: devloop_command_spec
81
+    integer :: kind = FGOF_DEVLOOP_COMMAND_NONE
82
+    logical :: enabled = .false.
83
+    type(process_command) :: command
84
+    type(process_options) :: options
85
+    character(len=:), allocatable :: label
86
+  end type devloop_command_spec
87
+
88
+  type, public :: devloop_command_result
89
+    integer :: kind = FGOF_DEVLOOP_COMMAND_NONE
90
+    logical :: requested = .false.
91
+    logical :: skipped = .true.
92
+    logical :: launched = .false.
93
+    logical :: completed = .false.
94
+    logical :: succeeded = .false.
95
+    logical :: timed_out = .false.
96
+    integer :: exit_code = 0
97
+    integer :: process_error_code = FGOF_PROCESS_OK
98
+    type(process_result) :: process
99
+    character(len=:), allocatable :: label
100
+    character(len=:), allocatable :: error_message
101
+  end type devloop_command_result
102
+
103
+  type, public :: devloop_supervision_result
104
+    type(devloop_cycle) :: cycle
105
+    type(devloop_decision) :: decision
106
+    type(devloop_command_result) :: build
107
+    type(devloop_command_result) :: run
108
+    type(devloop_command_result) :: smoke
109
+    integer :: command_count = 0
110
+    integer :: failed_command_kind = FGOF_DEVLOOP_COMMAND_NONE
111
+    integer :: last_exit_code = 0
112
+    integer :: process_error_code = FGOF_PROCESS_OK
113
+    logical :: started = .false.
114
+    logical :: succeeded = .false.
115
+    logical :: failed = .false.
116
+    logical :: timed_out = .false.
117
+  end type devloop_supervision_result
118
+
67119
   type, public :: devloop_state
68120
     type(devloop_options) :: options
69121
     type(devloop_cycle) :: last_cycle