run_parallel_tests Subroutine

public subroutine run_parallel_tests(options, total_passed, total_failed, total_time)

Arguments

Type IntentOptional Attributes Name
type(test_options_t), intent(in) :: options
integer, intent(out) :: total_passed
integer, intent(out) :: total_failed
real, intent(out) :: total_time

Source Code

    subroutine run_parallel_tests(options, total_passed, total_failed, total_time)
        type(test_options_t), intent(in) :: options
        integer, intent(out) :: total_passed, total_failed
        real, intent(out) :: total_time

        integer, parameter :: MAX_TESTS = 200
        type(test_case_t), allocatable :: tests(:)
        type(test_result_t), allocatable :: results(:)
        integer :: num_tests, i
        logical :: success

        integer :: next_test_index = 1
        integer :: completed_tests = 0
        real :: start_time, end_time

        ! OpenMP locks
        integer(omp_lock_kind) :: queue_lock
        integer(omp_lock_kind) :: output_lock

        total_passed = 0
        total_failed = 0
        total_time = 0.0

        ! Allocate arrays
        allocate (tests(MAX_TESTS))
        allocate (results(MAX_TESTS))

        ! Discover tests
       call discover_fpm_tests(tests, num_tests, options%filter, options%quiet, success)
        if (.not. success .or. num_tests == 0) then
            if (num_tests == 0) write (error_unit, '(A)') "No tests found"
            return
        end if

        ! Set number of threads if specified
        if (options%max_threads > 0) then
            call omp_set_num_threads(options%max_threads)
        end if

        if (.not. options%quiet) then
            write (output_unit, '(A,I0,A,I0,A)') "Running ", num_tests, " tests on ", &
                omp_get_max_threads(), " threads"
        end if

        ! Initialize OpenMP locks
        call omp_init_lock(queue_lock)
        call omp_init_lock(output_lock)

        ! Initialize results
        do i = 1, num_tests
            results(i)%name = tests(i)%name
            results(i)%executable = tests(i)%executable
            results(i)%status = TEST_PENDING
        end do

        ! Start timing
        start_time = omp_get_wtime()

        ! Run tests in parallel
        !$omp parallel shared(tests, results, num_tests, next_test_index, completed_tests, &
        !$omp                 queue_lock, output_lock, options)
    call run_tests_worker(tests, results, num_tests, next_test_index, completed_tests, &
                              queue_lock, output_lock, options)
        !$omp end parallel

        end_time = omp_get_wtime()
        total_time = end_time - start_time

        ! Clean up locks
        call omp_destroy_lock(queue_lock)
        call omp_destroy_lock(output_lock)

        ! Display results
        call display_results(results, num_tests, options, total_passed, total_failed, total_time)

    contains

        subroutine run_tests_worker(tests, results, num_tests, next_test_index, completed_tests, &
                                    queue_lock, output_lock, options)
            type(test_case_t), intent(in) :: tests(:)
            type(test_result_t), intent(inout) :: results(:)
            integer, intent(in) :: num_tests
            integer, intent(inout) :: next_test_index, completed_tests
            integer(omp_lock_kind), intent(inout) :: queue_lock, output_lock
            type(test_options_t), intent(in) :: options

            integer :: test_idx, thread_id, i
            character(len=512) :: test_name

            thread_id = omp_get_thread_num()

            do
                ! Get next test from queue (thread-safe)
                call omp_set_lock(queue_lock)
                if (next_test_index > num_tests) then
                    call omp_unset_lock(queue_lock)
                    exit
                end if
                test_idx = next_test_index
                next_test_index = next_test_index + 1
                results(test_idx)%status = TEST_RUNNING
                call omp_unset_lock(queue_lock)

                test_name = tests(test_idx)%name

                ! Run the test
                call run_single_test(tests(test_idx)%executable, results(test_idx))

                ! Update completion counter and show progress (thread-safe)
                call omp_set_lock(output_lock)
                completed_tests = completed_tests + 1
                if (.not. options%quiet) then
                    write (output_unit, '(A)', advance='no') char(13)
                    write (output_unit, '(A,I0,A,I0,A)', advance='no') &
                        'Completed: ', completed_tests, '/', num_tests, ' tests'
                    call flush (output_unit)
                end if
                call omp_unset_lock(output_lock)
            end do
        end subroutine run_tests_worker

    end subroutine run_parallel_tests