@@ -1,4 +1,30 @@ |
| 1 | 1 | module fgof_devloop |
| 2 | + use fgof_jobs, only : & |
| 3 | + attach_job, & |
| 4 | + attach_pipeline_members, & |
| 5 | + clear_job_handle, & |
| 6 | + clear_job_spec, & |
| 7 | + configure_job, & |
| 8 | + FGOF_JOBS_SIGNAL_SCOPE_GROUP, & |
| 9 | + FGOF_JOBS_TERMINAL_HANDOFF_FOREGROUND, & |
| 10 | + job_continue_result, & |
| 11 | + job_exit_result, & |
| 12 | + job_handle, & |
| 13 | + job_is_configured, & |
| 14 | + job_is_finished, & |
| 15 | + job_is_running, & |
| 16 | + job_is_stopped, & |
| 17 | + job_needs_cleanup, & |
| 18 | + job_owns_process_group, & |
| 19 | + job_requires_terminal_handoff, & |
| 20 | + job_result, & |
| 21 | + job_signal_result, & |
| 22 | + job_signal_scope, & |
| 23 | + job_spec, & |
| 24 | + job_stop_result, & |
| 25 | + make_job_spec, & |
| 26 | + observe_wait_result, & |
| 27 | + release_job |
| 2 | 28 | use fgof_process, only : & |
| 3 | 29 | FGOF_PROCESS_OK, & |
| 4 | 30 | process_command, & |
@@ -22,6 +48,10 @@ module fgof_devloop |
| 22 | 48 | FGOF_DEVLOOP_COMMAND_NONE, & |
| 23 | 49 | FGOF_DEVLOOP_COMMAND_RUN, & |
| 24 | 50 | FGOF_DEVLOOP_COMMAND_SMOKE, & |
| 51 | + FGOF_DEVLOOP_JOB_ACTION_NONE, & |
| 52 | + FGOF_DEVLOOP_JOB_ACTION_RESTART, & |
| 53 | + FGOF_DEVLOOP_JOB_ACTION_START, & |
| 54 | + FGOF_DEVLOOP_JOB_ACTION_STOP, & |
| 25 | 55 | FGOF_DEVLOOP_TRIGGER_CHANGE, & |
| 26 | 56 | FGOF_DEVLOOP_TRIGGER_MANUAL, & |
| 27 | 57 | FGOF_DEVLOOP_TRIGGER_NONE, & |
@@ -30,6 +60,9 @@ module fgof_devloop |
| 30 | 60 | devloop_command_spec, & |
| 31 | 61 | devloop_cycle, & |
| 32 | 62 | devloop_decision, & |
| 63 | + devloop_job_plan, & |
| 64 | + devloop_job_spec, & |
| 65 | + devloop_job_state, & |
| 33 | 66 | devloop_options, & |
| 34 | 67 | devloop_state, & |
| 35 | 68 | devloop_supervision_result, & |
@@ -41,10 +74,15 @@ module fgof_devloop |
| 41 | 74 | character(len=*), parameter :: FGOF_DEVLOOP_BACKEND_MODEL = "model" |
| 42 | 75 | |
| 43 | 76 | public :: begin_devloop_cycle |
| 77 | + public :: attach_devloop_job |
| 78 | + public :: attach_devloop_pipeline_members |
| 44 | 79 | public :: clear_devloop_command_result |
| 45 | 80 | public :: clear_devloop_command_spec |
| 46 | 81 | public :: clear_devloop_cycle |
| 47 | 82 | public :: clear_devloop_decision |
| 83 | + public :: clear_devloop_job_plan |
| 84 | + public :: clear_devloop_job_spec |
| 85 | + public :: clear_devloop_job_state |
| 48 | 86 | public :: clear_devloop_options |
| 49 | 87 | public :: clear_devloop_state |
| 50 | 88 | public :: clear_devloop_supervision_result |
@@ -57,9 +95,14 @@ module fgof_devloop |
| 57 | 95 | public :: devloop_command_spec |
| 58 | 96 | public :: devloop_cycle |
| 59 | 97 | public :: devloop_decision |
| 98 | + public :: devloop_job_plan |
| 99 | + public :: devloop_job_restart_plan |
| 100 | + public :: devloop_job_spec |
| 101 | + public :: devloop_job_state |
| 60 | 102 | public :: devloop_manual_trigger |
| 61 | 103 | public :: devloop_options |
| 62 | 104 | public :: devloop_run_command |
| 105 | + public :: devloop_service_job |
| 63 | 106 | public :: devloop_smoke_command |
| 64 | 107 | public :: devloop_start_trigger |
| 65 | 108 | public :: devloop_state |
@@ -79,10 +122,23 @@ module fgof_devloop |
| 79 | 122 | public :: FGOF_DEVLOOP_COMMAND_NONE |
| 80 | 123 | public :: FGOF_DEVLOOP_COMMAND_RUN |
| 81 | 124 | public :: FGOF_DEVLOOP_COMMAND_SMOKE |
| 125 | + public :: FGOF_DEVLOOP_JOB_ACTION_NONE |
| 126 | + public :: FGOF_DEVLOOP_JOB_ACTION_RESTART |
| 127 | + public :: FGOF_DEVLOOP_JOB_ACTION_START |
| 128 | + public :: FGOF_DEVLOOP_JOB_ACTION_STOP |
| 82 | 129 | public :: FGOF_DEVLOOP_TRIGGER_CHANGE |
| 83 | 130 | public :: FGOF_DEVLOOP_TRIGGER_MANUAL |
| 84 | 131 | public :: FGOF_DEVLOOP_TRIGGER_NONE |
| 85 | 132 | public :: FGOF_DEVLOOP_TRIGGER_START |
| 133 | + public :: job_continue_result |
| 134 | + public :: job_exit_result |
| 135 | + public :: job_handle |
| 136 | + public :: job_result |
| 137 | + public :: job_signal_result |
| 138 | + public :: job_spec |
| 139 | + public :: job_stop_result |
| 140 | + public :: observe_devloop_job |
| 141 | + public :: release_devloop_job |
| 86 | 142 | public :: run_devloop_command |
| 87 | 143 | public :: run_devloop_cycle |
| 88 | 144 | public :: should_start_on_open |
@@ -198,6 +254,52 @@ contains |
| 198 | 254 | supervision%timed_out = .false. |
| 199 | 255 | end function clear_devloop_supervision_result |
| 200 | 256 | |
| 257 | + function clear_devloop_job_spec() result(spec) |
| 258 | + type(devloop_job_spec) :: spec |
| 259 | + |
| 260 | + spec%job = clear_job_spec() |
| 261 | + spec%enabled = .false. |
| 262 | + spec%stop_before_restart = .true. |
| 263 | + spec%release_on_handoff = .false. |
| 264 | + spec%label = "" |
| 265 | + end function clear_devloop_job_spec |
| 266 | + |
| 267 | + function clear_devloop_job_state() result(job_state) |
| 268 | + type(devloop_job_state) :: job_state |
| 269 | + |
| 270 | + job_state%spec = clear_devloop_job_spec() |
| 271 | + job_state%handle = clear_job_handle() |
| 272 | + job_state%pid = 0 |
| 273 | + job_state%process_group = 0 |
| 274 | + job_state%signal_scope = FGOF_JOBS_SIGNAL_SCOPE_GROUP |
| 275 | + job_state%configured = .false. |
| 276 | + job_state%attached = .false. |
| 277 | + job_state%running = .false. |
| 278 | + job_state%stopped = .false. |
| 279 | + job_state%finished = .false. |
| 280 | + job_state%cleanup_needed = .false. |
| 281 | + job_state%owns_process_group = .false. |
| 282 | + job_state%terminal_handoff_required = .false. |
| 283 | + job_state%released = .false. |
| 284 | + job_state%label = "" |
| 285 | + end function clear_devloop_job_state |
| 286 | + |
| 287 | + function clear_devloop_job_plan() result(plan) |
| 288 | + type(devloop_job_plan) :: plan |
| 289 | + |
| 290 | + plan%action = FGOF_DEVLOOP_JOB_ACTION_NONE |
| 291 | + plan%pid = 0 |
| 292 | + plan%process_group = 0 |
| 293 | + plan%signal_scope = FGOF_JOBS_SIGNAL_SCOPE_GROUP |
| 294 | + plan%should_start = .false. |
| 295 | + plan%should_stop = .false. |
| 296 | + plan%should_restart = .false. |
| 297 | + plan%should_release = .false. |
| 298 | + plan%cleanup_needed = .false. |
| 299 | + plan%terminal_handoff_required = .false. |
| 300 | + plan%reason = "" |
| 301 | + end function clear_devloop_job_plan |
| 302 | + |
| 201 | 303 | function clear_devloop_state() result(state) |
| 202 | 304 | type(devloop_state) :: state |
| 203 | 305 | |
@@ -301,6 +403,63 @@ contains |
| 301 | 403 | spec = make_devloop_command(FGOF_DEVLOOP_COMMAND_SMOKE, command_value, options, label) |
| 302 | 404 | end function devloop_smoke_command |
| 303 | 405 | |
| 406 | + function devloop_service_job(command, argv, label, background, new_process_group, signal_scope, & |
| 407 | + terminal_handoff, resume_sends_sigcont, stop_before_restart, & |
| 408 | + release_on_handoff) result(spec) |
| 409 | + character(len=*), intent(in) :: command |
| 410 | + character(len=*), intent(in), optional :: argv(:) |
| 411 | + character(len=*), intent(in), optional :: label |
| 412 | + logical, intent(in), optional :: background |
| 413 | + logical, intent(in), optional :: new_process_group |
| 414 | + integer, intent(in), optional :: signal_scope |
| 415 | + integer, intent(in), optional :: terminal_handoff |
| 416 | + logical, intent(in), optional :: resume_sends_sigcont |
| 417 | + logical, intent(in), optional :: stop_before_restart |
| 418 | + logical, intent(in), optional :: release_on_handoff |
| 419 | + type(devloop_job_spec) :: spec |
| 420 | + logical :: actual_background |
| 421 | + logical :: actual_new_process_group |
| 422 | + integer :: actual_signal_scope |
| 423 | + integer :: actual_terminal_handoff |
| 424 | + logical :: actual_resume_sends_sigcont |
| 425 | + |
| 426 | + spec = clear_devloop_job_spec() |
| 427 | + |
| 428 | + actual_background = .true. |
| 429 | + if (present(background)) actual_background = background |
| 430 | + actual_new_process_group = .true. |
| 431 | + if (present(new_process_group)) actual_new_process_group = new_process_group |
| 432 | + actual_signal_scope = FGOF_JOBS_SIGNAL_SCOPE_GROUP |
| 433 | + if (present(signal_scope)) actual_signal_scope = signal_scope |
| 434 | + actual_terminal_handoff = FGOF_JOBS_TERMINAL_HANDOFF_FOREGROUND |
| 435 | + if (present(terminal_handoff)) actual_terminal_handoff = terminal_handoff |
| 436 | + actual_resume_sends_sigcont = .true. |
| 437 | + if (present(resume_sends_sigcont)) actual_resume_sends_sigcont = resume_sends_sigcont |
| 438 | + |
| 439 | + if (present(argv)) then |
| 440 | + spec%job = make_job_spec(command, argv, background=actual_background, & |
| 441 | + new_process_group=actual_new_process_group, & |
| 442 | + signal_scope=actual_signal_scope, & |
| 443 | + terminal_handoff=actual_terminal_handoff, & |
| 444 | + resume_sends_sigcont=actual_resume_sends_sigcont) |
| 445 | + else |
| 446 | + spec%job = make_job_spec(command, background=actual_background, & |
| 447 | + new_process_group=actual_new_process_group, & |
| 448 | + signal_scope=actual_signal_scope, & |
| 449 | + terminal_handoff=actual_terminal_handoff, & |
| 450 | + resume_sends_sigcont=actual_resume_sends_sigcont) |
| 451 | + end if |
| 452 | + |
| 453 | + spec%enabled = allocated(spec%job%command) |
| 454 | + if (present(stop_before_restart)) spec%stop_before_restart = stop_before_restart |
| 455 | + if (present(release_on_handoff)) spec%release_on_handoff = release_on_handoff |
| 456 | + if (present(label)) then |
| 457 | + spec%label = label |
| 458 | + else if (allocated(spec%job%command)) then |
| 459 | + spec%label = spec%job%command |
| 460 | + end if |
| 461 | + end function devloop_service_job |
| 462 | + |
| 304 | 463 | function devloop_summarize_watch_events(events) result(summary) |
| 305 | 464 | type(watch_event), intent(in) :: events(:) |
| 306 | 465 | type(devloop_watch_summary) :: summary |
@@ -456,6 +615,93 @@ contains |
| 456 | 615 | supervision%decision = finish_devloop_cycle(state, supervision%succeeded, supervision%last_exit_code) |
| 457 | 616 | end function run_devloop_cycle |
| 458 | 617 | |
| 618 | + function attach_devloop_job(spec, pid, process_group, owns_process, owns_process_group) result(job_state) |
| 619 | + type(devloop_job_spec), intent(in) :: spec |
| 620 | + integer, intent(in) :: pid |
| 621 | + integer, intent(in), optional :: process_group |
| 622 | + logical, intent(in), optional :: owns_process |
| 623 | + logical, intent(in), optional :: owns_process_group |
| 624 | + type(devloop_job_state) :: job_state |
| 625 | + integer :: actual_process_group |
| 626 | + logical :: actual_owns_process |
| 627 | + logical :: actual_owns_process_group |
| 628 | + |
| 629 | + job_state = clear_devloop_job_state() |
| 630 | + if (.not. spec%enabled) return |
| 631 | + |
| 632 | + job_state%spec = spec |
| 633 | + call configure_job(job_state%handle, spec%job) |
| 634 | + |
| 635 | + actual_process_group = pid |
| 636 | + if (present(process_group)) actual_process_group = process_group |
| 637 | + actual_owns_process = .true. |
| 638 | + if (present(owns_process)) actual_owns_process = owns_process |
| 639 | + actual_owns_process_group = actual_owns_process .and. spec%job%new_process_group .and. & |
| 640 | + actual_process_group == pid |
| 641 | + if (present(owns_process_group)) actual_owns_process_group = owns_process_group |
| 642 | + |
| 643 | + call attach_job(job_state%handle, pid, process_group=actual_process_group, & |
| 644 | + owns_process=actual_owns_process, owns_process_group=actual_owns_process_group) |
| 645 | + call refresh_devloop_job_state(job_state) |
| 646 | + end function attach_devloop_job |
| 647 | + |
| 648 | + subroutine attach_devloop_pipeline_members(job_state, pids) |
| 649 | + type(devloop_job_state), intent(inout) :: job_state |
| 650 | + integer, intent(in) :: pids(:) |
| 651 | + |
| 652 | + call attach_pipeline_members(job_state%handle, pids) |
| 653 | + call refresh_devloop_job_state(job_state) |
| 654 | + end subroutine attach_devloop_pipeline_members |
| 655 | + |
| 656 | + subroutine observe_devloop_job(job_state, result_value) |
| 657 | + type(devloop_job_state), intent(inout) :: job_state |
| 658 | + type(job_result), intent(in) :: result_value |
| 659 | + |
| 660 | + call observe_wait_result(job_state%handle, result_value) |
| 661 | + call refresh_devloop_job_state(job_state) |
| 662 | + end subroutine observe_devloop_job |
| 663 | + |
| 664 | + subroutine release_devloop_job(job_state) |
| 665 | + type(devloop_job_state), intent(inout) :: job_state |
| 666 | + |
| 667 | + call release_job(job_state%handle) |
| 668 | + job_state%released = .true. |
| 669 | + call refresh_devloop_job_state(job_state) |
| 670 | + end subroutine release_devloop_job |
| 671 | + |
| 672 | + function devloop_job_restart_plan(job_state, trigger) result(plan) |
| 673 | + type(devloop_job_state), intent(in) :: job_state |
| 674 | + type(devloop_trigger), intent(in) :: trigger |
| 675 | + type(devloop_job_plan) :: plan |
| 676 | + |
| 677 | + plan = clear_devloop_job_plan() |
| 678 | + plan%pid = job_state%pid |
| 679 | + plan%process_group = job_state%process_group |
| 680 | + plan%signal_scope = job_state%signal_scope |
| 681 | + plan%cleanup_needed = job_state%cleanup_needed |
| 682 | + plan%terminal_handoff_required = job_state%terminal_handoff_required |
| 683 | + |
| 684 | + if (.not. job_state%spec%enabled) return |
| 685 | + if (.not. job_state%configured) return |
| 686 | + if (trigger%kind == FGOF_DEVLOOP_TRIGGER_NONE) return |
| 687 | + |
| 688 | + if (job_state%terminal_handoff_required .and. job_state%spec%release_on_handoff) then |
| 689 | + plan%should_release = .true. |
| 690 | + end if |
| 691 | + |
| 692 | + if (job_state%running .or. job_state%stopped .or. job_state%cleanup_needed) then |
| 693 | + plan%action = FGOF_DEVLOOP_JOB_ACTION_RESTART |
| 694 | + plan%should_restart = .true. |
| 695 | + plan%should_start = .true. |
| 696 | + plan%should_stop = job_state%spec%stop_before_restart |
| 697 | + plan%reason = "restart existing job" |
| 698 | + else |
| 699 | + plan%action = FGOF_DEVLOOP_JOB_ACTION_START |
| 700 | + plan%should_start = .true. |
| 701 | + plan%reason = "start job" |
| 702 | + end if |
| 703 | + end function devloop_job_restart_plan |
| 704 | + |
| 459 | 705 | function begin_devloop_cycle(state, trigger) result(cycle) |
| 460 | 706 | type(devloop_state), intent(inout) :: state |
| 461 | 707 | type(devloop_trigger), intent(in) :: trigger |
@@ -596,6 +842,27 @@ contains |
| 596 | 842 | supervision%timed_out = command_result%timed_out |
| 597 | 843 | end subroutine record_supervised_command |
| 598 | 844 | |
| 845 | + subroutine refresh_devloop_job_state(job_state) |
| 846 | + type(devloop_job_state), intent(inout) :: job_state |
| 847 | + logical :: was_released |
| 848 | + |
| 849 | + was_released = job_state%released |
| 850 | + job_state%configured = job_is_configured(job_state%handle) |
| 851 | + job_state%attached = job_state%handle%pid > 0 |
| 852 | + job_state%pid = job_state%handle%pid |
| 853 | + job_state%process_group = job_state%handle%process_group |
| 854 | + job_state%signal_scope = job_signal_scope(job_state%handle) |
| 855 | + job_state%running = job_is_running(job_state%handle) |
| 856 | + job_state%stopped = job_is_stopped(job_state%handle) |
| 857 | + job_state%finished = job_is_finished(job_state%handle) |
| 858 | + job_state%cleanup_needed = job_needs_cleanup(job_state%handle) |
| 859 | + job_state%owns_process_group = job_owns_process_group(job_state%handle) |
| 860 | + job_state%terminal_handoff_required = job_requires_terminal_handoff(job_state%handle) |
| 861 | + job_state%released = was_released |
| 862 | + job_state%label = "" |
| 863 | + if (allocated(job_state%spec%label)) job_state%label = job_state%spec%label |
| 864 | + end subroutine refresh_devloop_job_state |
| 865 | + |
| 599 | 866 | subroutine normalize_options(options) |
| 600 | 867 | type(devloop_options), intent(inout) :: options |
| 601 | 868 | |