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

• Vladimir F Героям слава: The language has been called Fortran, not FORTRAN for many decades. It is unlikely that you are actually using Fortran 90, the compilers do not even consider this revision because it contained several problems and was quickly replaced by Fortran 95. In particular, thi file extension .f90 does not mean Fortran 90 but any free-form source.
• Vladimir F Героям слава: Using magic constants like 4 or 8 for the kind values is ugly and will fail to compile for some compilers in their default setting, see stackoverflow.com/questions/3170239/… I, personally, find writing the full kind=something unnecesarilly long and always remove the optional kind= so the proper integer(iknd) where iknd is a named integer constant is even shorter (and the constant name can also be even shorter).
• Olivia A: Working on updating my docs/code to address both of these. Thank you! ♥️

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.

• Vladimir F Героям слава: Given the lazy allocaten in modern OS's, testing if allocate failed will in practice fail to detect that there was actually not enough memory. The program will crash at the access anyway. I wouldn't bother.
• Toby Speight: @Vladimir, that's very dependent on the environment in which you run. For example, I normally run programming-challenge code with a sensible `ulimit -v, to prevent harming more important processes. That usually has the effect of preventing such over-allocation, but does mean that we need to deal with allocation failure.
• Olivia A: Okay, I've addressed a number of these things in my codebase now! 1. I am checking all allocate() calls now, not just the ones I wrote after learning I could. 2. I refactored get_answer so that it is caching the results, and no longer needing those excess reads 3. I now have a script which generates select_function(), which should reduce dev time overhead 4. I'm working to move the comparison and printing logic to a function, which should make that more clear