FORTRAN90 test suite for Project Euler

Question

The intent of this test file is to go through each of my Project Euler solutions and see if they:

1. return the correct answer, and
2. do so in under 60 seconds (unless expected otherwise).

I am using this as a way to learn fortran, so any feedback on performance, clarity, or design would be incredibly helpful. I have no prior experience with fortran.

Relevant links:

• Git repo
• Website with docs
• Link to utils.f90, which defines AnswerT and get_answer(), though the intent should be mostly clear

test.f90

program test
    use utils
    use Problem0001
    use Problem0002
    use Problem0006
    use Problem0008
    use Problem0009
    use Problem0011
    use Problem0836

    implicit none
    integer(kind=4), dimension(:), allocatable :: problem_ids
    logical(kind=1), dimension(:), allocatable :: long_runtime
    integer :: num_problems
    
    num_problems = 7
    allocate(problem_ids(num_problems))
    allocate(long_runtime(num_problems))
    problem_ids = (/ &
        001, &
        002, &
        006, &
        008, &
        009, &
        011, &
        836 &
    /)
    long_runtime = (/ &
        .false., &
        .false., &
        .false., &
        .false., &
        .false., &
        .false., &
        .false. &
    /)

    call process_problems(problem_ids, long_runtime)
    deallocate(problem_ids, long_runtime)

contains

    subroutine process_problems(problem_ids, long_runtime)
        integer(kind=4), dimension(:), intent(in) :: problem_ids
        logical(kind=1), dimension(:), intent(in) :: long_runtime
        type(AnswerT) :: expected, answer
        integer(kind=4) :: i
        integer :: first_count, second_count, count_rate, count_max, tmp
        real :: time_elapsed

        ! Loop through each problem
        do i = 1, size(problem_ids)
            print *, "Processing Problem ID: ", problem_ids(i)
            if (long_runtime(i)) then
                print *, "  This problem will take more than 60 seconds."
            end if
            expected = get_answer(problem_ids(i))
            call system_clock(first_count, count_rate, count_max)
            answer = select_function(problem_ids(i))
            call system_clock(second_count, count_rate, count_max)
            if (expected%type /= answer%type) then
                print *, "  Error: type mismatch between expected answer and returned value"
                select case (answer%type)
                    case (int64t)
                        print *, "  Returned: int (", answer%int_value, ")"
                    case (stringt)
                        print *, "  Returned: string (" // answer%string_value // ")"
                    case (errort)
                        print *, "  Returned: error"
                end select
                select case (expected%type)
                    case (int64t)
                        print *, "  Expected: int (", expected%int_value, ")"
                    case (stringt)
                        print *, "  Expected: string (" // expected%string_value // ")"
                    case (errort)
                        print *, "  Expected: error"
                end select
                stop 3
            end if
            select case(expected%type)
                case (int64t)
                    if (expected%int_value /= answer%int_value) then
                        print *, "  Error: problem ", problem_ids(i), " failed!"
                        print *, "  Expected Answer  : ", expected%int_value
                        print *, "  Solution returned: ", answer%int_value
                        stop 1
                    end if
                case (stringt)
                    if (expected%string_value /= answer%string_value) then
                        print *, "  Error: problem ", problem_ids(i), " failed!"
                        print *, "  Expected Answer  : ", expected%string_value
                        print *, "  Solution returned: ", answer%string_value
                        stop 1
                    end if
                    deallocate(answer%string_value, expected%string_value)
                case (errort)
                    print *, "  Error retrieving answer!"
            end select
            tmp = second_count - first_count
            if (tmp < 0) then
                tmp = tmp + count_max
            end if
            time_elapsed = real(tmp) / real(count_rate)
            if (.NOT. long_runtime(i) .AND. time_elapsed > 60.0) then
                print *, "  Error: problem ", problem_ids(i), " timed out!"
                print *, "  Solution took    : ", time_elapsed, "s"
                stop 2
            end if
            print *, "  Completed        : ", problem_ids(i), "in ", time_elapsed, "s"
        end do
    end subroutine process_problems

    type(AnswerT) function select_function(problem_id) result(answer)
        integer(kind=4), intent(in) :: problem_id

        answer%type = int64t
        select case (problem_id)
            case (1)
                answer%int_value = p0001()
            case (2)
                answer%int_value = p0002()
            case (6)
                answer%int_value = p0006()
            case (8)
                answer%int_value = p0008()
            case (9)
                answer%int_value = p0009()
            case (11)
                answer%int_value = p0011()
            case (836)
                allocate(character(len=14) :: answer%string_value)
                if (.not. allocated(answer%string_value)) then
                    print *, "  Memory allocation failed for string_value. Returning error type"
                    answer%type = errort
                else
                    answer%type = stringt
                    answer%string_value = p0836()
                end if
            case default
                print *, "Unknown problem ID!"
                answer%type = errort
        end select
    end function select_function

end program test

Answer 1

Generally this looks like beautiful modern Fortran code, nicely presented.

DRY

            select case(expected%type)
                case (int64t)
                    if (expected%int_value /= answer%int_value) then
                        print *, "  Error: problem ", problem_ids(i), " failed!"
                        print *, "  Expected Answer  : ", expected%int_value
                        print *, "  Solution returned: ", answer%int_value
                        stop 1
                    end if
                case (stringt)
                    if (expected%string_value /= answer%string_value) then
                        print *, "  Error: problem ", problem_ids(i), " failed!"
                        print *, "  Expected Answer  : ", expected%string_value
                        print *, "  Solution returned: ", answer%string_value
                        stop 1
                    end if

Consider turning int_value into a formatted string_value so you can use a single set of prints to report on the failure.

The business of having select_function() dynamically allocate string space which caller is responsible for deallocating seems like it's on the fragile side. The C and Java folks having been duking out that one for years. Given that you have a statically compiled set of problems with constant solutions, it might be feasible to punt by using a static buffer that is big enough for the configured set of problems.

malloc fail

We call allocate() from several different places. It's not clear why we need to test if (.not. allocated()) in just one place. Surely the other allocations could similarly fail, right?

Consider writing a helper which bails with fatal error if an allocation attempt is seen to fail.

SRP

If you feel you need to preserve the current type-safe duplicated behavior, at least push that functionality down into a helper which has just a single responsibility.

quadratic cost

function get_answer(id) result(answer) is a beautiful helper; good job with that. Nice contract. But with \$N\$ problems, the API + implementation leads to \$O(N^2)\$ cost.

Caching would be the obvious way out of it. Accept a burden of \$O(N)\$ linear memory complexity, and retain a memory-resident cached copy of the .tsv file which you can index into. Or adopt a revised API which lets the caller stream through the contents of an answers input file that we keep open until the end. Given the more than 900 Project Euler questions, quadratic re-reading implies a cost of around 800,000 re-reads, or still a wasteful 400,000 if we terminate early.

More generally, statically linking against 900 functions seems daunting on several levels. Consider exploring other approaches. Maybe a driver script should assemble the needed code components, compile them, execute, and put the result in an output.csv file for later analysis. Maybe dynamic linking is indicated. A given child subprocess could execute all Euler functions or just a subset of them, even just a single function. And then we fork off additional children for further answers.

timeout

Making long_runtime a boolean vector seems like the wrong design choice. Better to define an "expected" or "maximum" elapsed running time for each problem. If you'd care to keep it vague, maybe define such running times as powers of \$2\$, with the smallest limit being \$2^5\$ seconds.

This program's output speaks of "timeout", but it doesn't actually time out a miscreant while .true. loop. It patiently waits for the target code to eventually return, and then scores it as "incorrect" if it exceeded the time limit.

Consider using SIGALRM to terminate badly behaved code early. Consider running such code in a child process, to which you can send SIGTERM if needed.

multiple cores

Rome wasn't built within a day, and 900 solution routines won't all run within a millisecond. If you have actual elapsed run times that (a subset of) problems were seen to consume on a previous run, and you're forking off children to run them, then you're in a good position to keep all \$C\$ of your cores busy. Expected time for this run is roughly the observed time from previous run. Sort by descending expected time, and fork off \$C\$ child tasks. Upon seeing a task complete, fork off the next one. That way we do the big ones first and have just little ones at the end, avoiding the "straggler effect" where many idle cores wait for one busy core to eventually finish.