From ddd1aa980970fd30d7c47a78f8e61b69de3b22e2 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 9 Aug 2025 07:05:11 -0700 Subject: [PATCH 01/33] feat(test): define/use test harness, test fixtures This commit introduces the test_harness_t and test_fixture_t derived types and uses them to refactor and simplify the test-suite driver program: test/main.F90. --- src/julienne/julienne_test_fixture_m.f90 | 42 ++++++++++ src/julienne/julienne_test_fixture_s.F90 | 17 ++++ src/julienne/julienne_test_harness_m.f90 | 41 ++++++++++ src/julienne/julienne_test_harness_s.F90 | 20 +++++ src/julienne_m.f90 | 16 ++-- test/main.F90 | 99 +++++++++--------------- 6 files changed, 166 insertions(+), 69 deletions(-) create mode 100644 src/julienne/julienne_test_fixture_m.f90 create mode 100644 src/julienne/julienne_test_fixture_s.F90 create mode 100644 src/julienne/julienne_test_harness_m.f90 create mode 100644 src/julienne/julienne_test_harness_s.F90 diff --git a/src/julienne/julienne_test_fixture_m.f90 b/src/julienne/julienne_test_fixture_m.f90 new file mode 100644 index 000000000..50d160684 --- /dev/null +++ b/src/julienne/julienne_test_fixture_m.f90 @@ -0,0 +1,42 @@ +! Copyright (c) 2024-2025, The Regents of the University of California and Sourcery Institute +! Terms of use are as specified in LICENSE.txt + +module julienne_test_fixture_m + !! Define a wrapper type for the test_t type to facilitate creating a polymorphic + !! array of test_t objects. + use julienne_test_m, only : test_t + + implicit none + + private + public :: test_fixture_t + + type test_fixture_t + class(test_t), allocatable :: test_ + contains + procedure report + end type + + interface test_fixture_t + + module function component_constructor(test) result(test_fixture) ! can be pure in Fortran 2023 + !! Construct a test_fixture_t object from its components + implicit none + class(test_t), intent(in), allocatable :: test + type(test_fixture_t) test_fixture + end function + + end interface + + interface + + module subroutine report(self, passes, tests, skips) + !! Print the test results and increment the tallies of passing tests, total tests, and skipped tests. + implicit none + class(test_fixture_t), intent(in) :: self + integer, intent(inout) :: passes, tests, skips + end subroutine + + end interface + +end module julienne_test_fixture_m \ No newline at end of file diff --git a/src/julienne/julienne_test_fixture_s.F90 b/src/julienne/julienne_test_fixture_s.F90 new file mode 100644 index 000000000..a65cc6d3b --- /dev/null +++ b/src/julienne/julienne_test_fixture_s.F90 @@ -0,0 +1,17 @@ +! Copyright (c) 2024-2025, The Regents of the University of California and Sourcery Institute +! Terms of use are as specified in LICENSE.txt + +submodule(julienne_test_fixture_m) julienne_test_fixture_s + implicit none + +contains + + module procedure component_constructor + test_fixture%test_ = test + end procedure + + module procedure report + call self%test_%report(passes, tests, skips) + end procedure + +end submodule julienne_test_fixture_s \ No newline at end of file diff --git a/src/julienne/julienne_test_harness_m.f90 b/src/julienne/julienne_test_harness_m.f90 new file mode 100644 index 000000000..703ce2e28 --- /dev/null +++ b/src/julienne/julienne_test_harness_m.f90 @@ -0,0 +1,41 @@ +! Copyright (c) 2024-2025, The Regents of the University of California and Sourcery Institute +! Terms of use are as specified in LICENSE.txt + +module julienne_test_harness_m + !! Define a wrapper type for the test_t type to facilitate creating a polymorphic + !! array of test_t objects. + use julienne_test_fixture_m, only : test_fixture_t + + implicit none + + private + public :: test_harness_t + + type test_harness_t + class(test_fixture_t), allocatable :: test_fixture_(:) + contains + procedure report + end type + + interface test_harness_t + + module function component_constructor(test_fixtures) result(test_harness) ! can be pure in Fortran 2028 + !! Construct a test_harness_t object from its components + class(test_fixture_t), allocatable :: test_fixtures(:) + type(test_harness_t) test_harness + end function + + end interface + + interface + + module subroutine report(self, passes, tests, skips) + !! Print the test results and increment the tallies of passing tests, total tests, and skipped tests. + implicit none + class(test_harness_t), intent(in) :: self + integer, intent(inout) :: passes, tests, skips + end subroutine + + end interface + +end module julienne_test_harness_m \ No newline at end of file diff --git a/src/julienne/julienne_test_harness_s.F90 b/src/julienne/julienne_test_harness_s.F90 new file mode 100644 index 000000000..8fbf52a56 --- /dev/null +++ b/src/julienne/julienne_test_harness_s.F90 @@ -0,0 +1,20 @@ +! Copyright (c) 2024-2025, The Regents of the University of California and Sourcery Institute +! Terms of use are as specified in LICENSE.txt + +submodule(julienne_test_harness_m) julienne_test_harness_s + implicit none + +contains + + module procedure component_constructor + test_harness%test_fixture_ = test_fixtures + end procedure + + module procedure report + integer i + do i = 1, size(self%test_fixture_) + call self%test_fixture_(i)%report(passes, tests, skips) + end do + end procedure + +end submodule julienne_test_harness_s \ No newline at end of file diff --git a/src/julienne_m.f90 b/src/julienne_m.f90 index 1540f6556..9cc93fc30 100644 --- a/src/julienne_m.f90 +++ b/src/julienne_m.f90 @@ -9,16 +9,13 @@ module julienne_m use julienne_file_m, only : file_t use julienne_formats_m, only : separated_values, csv use julienne_github_ci_m, only : github_ci - use julienne_string_m, only : & - string_t & - ,array_of_strings & + use julienne_string_m, only : string_t, array_of_strings & ,operator(.cat.) & ,operator(.csv.) & ,operator(.separatedBy.) & ! same as operator(.sv.) ,operator(.sv.) - use julienne_test_description_m, only : test_description_t, diagnosis_function_i - use julienne_test_diagnosis_m, only : & - test_diagnosis_t & + use julienne_test_description_m, only : test_description_t + use julienne_test_diagnosis_m, only : test_diagnosis_t & ,operator(.all.) & ,operator(.and.) & ,operator(.also.) & @@ -35,10 +32,13 @@ module julienne_m ,operator(.within.) & ,operator(.withinFraction.) & ,operator(.withinPercentage.) - use julienne_test_m, only : test_t, test_description_substring - use julienne_test_result_m, only : test_result_t + use julienne_test_fixture_m, only : test_fixture_t + use julienne_test_harness_m, only : test_harness_t + use julienne_test_m, only : test_t, test_description_substring + use julienne_test_result_m, only : test_result_t !! Deprecated features: + use julienne_test_description_m, only : diagnosis_function_i use julienne_vector_test_description_m, only : vector_test_description_t, vector_diagnosis_function_i implicit none end module julienne_m diff --git a/test/main.F90 b/test/main.F90 index f18803eac..45a2aeacf 100644 --- a/test/main.F90 +++ b/test/main.F90 @@ -1,84 +1,61 @@ ! Copyright (c) 2024-2025, The Regents of the University of California and Sourcery Institute ! Terms of use are as specified in LICENSE.txt -#include "language-support.F90" +program test_suite_driver + !! Julienne test-suite driver + use julienne_m, only : test_fixture_t, test_harness_t, command_line_t, GitHub_CI -program main - !! Julienne unit tests driver - - ! Internal utilities - use julienne_m ,only : command_line_t, GitHub_CI - - ! Test modules + ! Test modules: use assert_test_m ,only : assert_test_t use bin_test_m ,only : bin_test_t use command_line_test_m ,only : command_line_test_t use formats_test_m ,only : formats_test_t use string_test_m ,only : string_test_t - use test_result_test_m ,only : test_result_test_t use test_description_test_m ,only : test_description_test_t use test_diagnosis_test_m ,only : test_diagnosis_test_t + use test_result_test_m ,only : test_result_test_t use vector_test_description_test_m ,only : vector_test_description_test_t - implicit none - - type(assert_test_t) assert_test - type(bin_test_t) bin_test - type(command_line_test_t) command_line_test - type(formats_test_t) formats_test - type(string_test_t) string_test - type(test_result_test_t) test_result_test - type(test_description_test_t) test_description_test - type(test_diagnosis_test_t) test_diagnosis_test - type(vector_test_description_test_t) vector_test_description_test - type(command_line_t) command_line + implicit none + type(test_harness_t) test_harness integer :: passes=0, tests=0, skips=0 - character(len=*), parameter :: usage = & - new_line('') // new_line('') // & - 'Usage: fpm test -- [--help] | [--contains ]' // & - new_line('') // new_line('') // & - 'where square brackets ([]) denote optional arguments, a pipe (|) separates alternative arguments,' // new_line('') // & - 'angular brackets (<>) denote a user-provided value, and passing a substring limits execution to' // new_line('') // & - 'the tests with test subjects or test descriptions containing the user-specified substring.' // new_line('') - - if (command_line%argument_present([character(len=len("--help"))::"--help","-h"])) stop usage - - print "(a)", new_line("") // "Append '-- --help' or '-- -h' to your `fpm test` command to display usage information." - - call assert_test%report(passes, tests, skips) - call bin_test%report(passes, tests, skips) - call formats_test%report(passes, tests, skips) - call string_test%report(passes, tests, skips) - call test_result_test%report(passes, tests, skips) - call test_description_test%report(passes, tests, skips) - call test_diagnosis_test%report(passes, tests, skips) - call vector_test_description_test%report(passes,tests, skips) + ! Construct test harness from an array of test fixtures, each + ! of which is constructed from a test structure constructors: + associate(test_harness => test_harness_t([ & + test_fixture_t( assert_test_t()) & + ,test_fixture_t( bin_test_t()) & + ,test_fixture_t( formats_test_t()) & + ,test_fixture_t( string_test_t()) & + ,test_fixture_t( test_description_test_t()) & + ,test_fixture_t( test_diagnosis_test_t()) & + ,test_fixture_t( test_result_test_t()) & + ,test_fixture_t(vector_test_description_test_t()) & + ])) + call test_harness%report(passes, tests, skips) + end associate if (.not. GitHub_CI()) then - if (command_line%argument_present(["--test"])) then - call command_line_test%report(passes, tests, skips) - else - write(*,"(a)") & - new_line("") // & - "To also test Julienne's command_line_t type, append the following to your fpm test command:" // & - new_line("") // & - "-- --test command_line_t --type" - end if + block + type(command_line_t) command_line + type(command_line_test_t) command_line_test + + if (command_line%argument_present(["--test"])) then + call command_line_test%report(passes, tests, skips) + else + write(*,"(a)") & + new_line("") // & + "To also test Julienne's command_line_t type, append the following to your fpm test command:" // & + new_line("") // & + "-- --test command_line_t --type" + end if + end block end if -#if HAVE_MULTI_IMAGE_SUPPORT - if (this_image()==1) then -#endif + print * + print '(*(a,:,g0))', "_________ In total, ",passes," of ",tests, " tests pass. ", skips, " tests were skipped. _________" - print * - print '(*(a,:,g0))', "_________ In total, ",passes," of ",tests, " tests pass. ", skips, " tests were skipped. _________" - - if (passes + skips /= tests) error stop "Some executed tests failed." - -#if HAVE_MULTI_IMAGE_SUPPORT - end if -#endif + if (passes + skips /= tests) error stop "Some executed tests failed." end program From c2f951c0ecb73a91e67418e8d5bbda7d459b6b2b Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 9 Aug 2025 07:39:33 -0700 Subject: [PATCH 02/33] refac(test_harness): mv help I/O to harness report --- src/julienne/julienne_test_harness_s.F90 | 35 +++++++++++++++++++++--- 1 file changed, 31 insertions(+), 4 deletions(-) diff --git a/src/julienne/julienne_test_harness_s.F90 b/src/julienne/julienne_test_harness_s.F90 index 8fbf52a56..b8de5a371 100644 --- a/src/julienne/julienne_test_harness_s.F90 +++ b/src/julienne/julienne_test_harness_s.F90 @@ -2,6 +2,7 @@ ! Terms of use are as specified in LICENSE.txt submodule(julienne_test_harness_m) julienne_test_harness_s + use julienne_command_line_m, only : command_line_t implicit none contains @@ -11,10 +12,36 @@ end procedure module procedure report - integer i - do i = 1, size(self%test_fixture_) - call self%test_fixture_(i)%report(passes, tests, skips) - end do + + call print_usage_info_and_stop_if_requested + + block + integer i + do i = 1, size(self%test_fixture_) + call self%test_fixture_(i)%report(passes, tests, skips) + end do + end block + end procedure + subroutine print_usage_info_and_stop_if_requested + + associate(command_line => command_line_t()) + block + character(len=*), parameter :: usage = & + new_line('') // new_line('') // & + 'Usage: fpm test -- [--help] | [--contains ]' // & + new_line('') // new_line('') // & + 'where square brackets ([]) denote optional arguments, a pipe (|) separates alternative arguments,' // new_line('') // & + 'angular brackets (<>) denote a user-provided value, and passing a substring limits execution to' // new_line('') // & + 'the tests with test subjects or test descriptions containing the user-specified substring.' // new_line('') + + if (command_line%argument_present([character(len=len("--help"))::"--help","-h"])) stop usage + end block + end associate + + print "(a)", new_line("") // "Append '-- --help' or '-- -h' to your `fpm test` command to display usage information." + + end subroutine + end submodule julienne_test_harness_s \ No newline at end of file From a738cacbf756b43bfcd6d59f5956279173c3c6fe Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 9 Aug 2025 07:40:25 -0700 Subject: [PATCH 03/33] feat(test):don't run intentional fail if --help/-h --- ...st-julienne_assert-intentional-failure.F90 | 24 +++++++++++-------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/test/test-julienne_assert-intentional-failure.F90 b/test/test-julienne_assert-intentional-failure.F90 index 1b30dda14..9516c95d2 100644 --- a/test/test-julienne_assert-intentional-failure.F90 +++ b/test/test-julienne_assert-intentional-failure.F90 @@ -5,22 +5,26 @@ program test_julienne_assert_intentional_failure !! Conditionally test an assertion that is hardwired to fail. + use julienne_m, only : call_julienne_assert_, command_line_t, operator(.equalsExpected.) -#ifdef RUN_FALSE_ASSERTIONS + associate(command_line => command_line_t()) - use julienne_m, only : operator(.equalsExpected.), call_julienne_assert_ - implicit none - print '(a)', new_line('') // 'Test julienne_assert intentional failure: ' // new_line('') - call_julienne_assert(1 .equalsExpected. 2) + if (.not. command_line%argument_present([character(len=len("--help"))::"--help","-h"])) then +#ifdef RUN_FALSE_ASSERTIONS + implicit none + print '(a)', new_line('') // 'Test julienne_assert intentional failure: ' // new_line('') + call_julienne_assert(1 .equalsExpected. 2) #else + print * + print '(a)', 'Skipping the test in ' // __FILE__ // '.' + print '(a)', 'Add the following to your fpm command to test assertion failure: --flag "-DASSERTIONS -DRUN_FALSE_ASSERTIONS"' + print * +#endif - print * - print '(a)', 'Skipping the test in ' // __FILE__ // '.' - print '(a)', 'Add the following to your fpm command to test assertion failure: --flag "-DASSERTIONS -DRUN_FALSE_ASSERTIONS"' - print * + end if -#endif + end associate end program From b0c034bbe14502da661689e0060273f5a9985084 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 9 Aug 2025 07:56:07 -0700 Subject: [PATCH 04/33] fix(intentional-fail): mv 'implicit none' --- test/test-julienne_assert-intentional-failure.F90 | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/test/test-julienne_assert-intentional-failure.F90 b/test/test-julienne_assert-intentional-failure.F90 index 9516c95d2..e59ebd88f 100644 --- a/test/test-julienne_assert-intentional-failure.F90 +++ b/test/test-julienne_assert-intentional-failure.F90 @@ -6,13 +6,11 @@ program test_julienne_assert_intentional_failure !! Conditionally test an assertion that is hardwired to fail. use julienne_m, only : call_julienne_assert_, command_line_t, operator(.equalsExpected.) + implicit none associate(command_line => command_line_t()) - if (.not. command_line%argument_present([character(len=len("--help"))::"--help","-h"])) then - #ifdef RUN_FALSE_ASSERTIONS - implicit none print '(a)', new_line('') // 'Test julienne_assert intentional failure: ' // new_line('') call_julienne_assert(1 .equalsExpected. 2) #else @@ -21,9 +19,7 @@ program test_julienne_assert_intentional_failure print '(a)', 'Add the following to your fpm command to test assertion failure: --flag "-DASSERTIONS -DRUN_FALSE_ASSERTIONS"' print * #endif - end if - end associate end program From 162628d897356bb9686476299ed222f405a5b797 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 9 Aug 2025 08:01:11 -0700 Subject: [PATCH 05/33] feat(test_harness): automatically report tally This commit reduces the amount of code that end users must write by moving the reporting of the final tally of test passes, test count, and skipped tests to the test_harness_t's "report" type-bound procedure. --- src/julienne/julienne_test_harness_s.F90 | 5 +++++ test/main.F90 | 6 ------ 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/src/julienne/julienne_test_harness_s.F90 b/src/julienne/julienne_test_harness_s.F90 index b8de5a371..4a3e6f5c3 100644 --- a/src/julienne/julienne_test_harness_s.F90 +++ b/src/julienne/julienne_test_harness_s.F90 @@ -22,6 +22,11 @@ end do end block + print * + print '(*(a,:,g0))', "_________ ", passes, " of ", tests, " tests pass. ", skips, " tests were skipped. _________" + + if (passes + skips /= tests) error stop "Some tests failed." + end procedure subroutine print_usage_info_and_stop_if_requested diff --git a/test/main.F90 b/test/main.F90 index 45a2aeacf..744141474 100644 --- a/test/main.F90 +++ b/test/main.F90 @@ -18,7 +18,6 @@ program test_suite_driver implicit none - type(test_harness_t) test_harness integer :: passes=0, tests=0, skips=0 ! Construct test harness from an array of test fixtures, each @@ -53,9 +52,4 @@ program test_suite_driver end block end if - print * - print '(*(a,:,g0))', "_________ In total, ",passes," of ",tests, " tests pass. ", skips, " tests were skipped. _________" - - if (passes + skips /= tests) error stop "Some executed tests failed." - end program From 3bed85c8c44992cae8e2cf653ce093b4885f41b5 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 9 Aug 2025 08:44:51 -0700 Subject: [PATCH 06/33] refac(test): further simplify test driver This commit the code that checks whether the test suite is running in GitHub CI and checks whether the user requested to run the command_line_t tests. The code is moved from the test-suite driver to the actual test, which further simplifies the test-suite main program. --- test/main.F90 | 24 ++------- test/modules/command_line_test_m.F90 | 77 ++++++++++++++++++---------- 2 files changed, 53 insertions(+), 48 deletions(-) diff --git a/test/main.F90 b/test/main.F90 index 744141474..253430eee 100644 --- a/test/main.F90 +++ b/test/main.F90 @@ -3,7 +3,7 @@ program test_suite_driver !! Julienne test-suite driver - use julienne_m, only : test_fixture_t, test_harness_t, command_line_t, GitHub_CI + use julienne_m, only : test_fixture_t, test_harness_t ! Test modules: use assert_test_m ,only : assert_test_t @@ -20,8 +20,8 @@ program test_suite_driver integer :: passes=0, tests=0, skips=0 - ! Construct test harness from an array of test fixtures, each - ! of which is constructed from a test structure constructors: + ! Construct a test harness from an array of test fixtures, each of which is constructed + ! from the result of invoking a test_t child type's structure constructor: associate(test_harness => test_harness_t([ & test_fixture_t( assert_test_t()) & ,test_fixture_t( bin_test_t()) & @@ -31,25 +31,9 @@ program test_suite_driver ,test_fixture_t( test_diagnosis_test_t()) & ,test_fixture_t( test_result_test_t()) & ,test_fixture_t(vector_test_description_test_t()) & + ,test_fixture_t( command_line_test_t()) & ])) call test_harness%report(passes, tests, skips) end associate - if (.not. GitHub_CI()) then - block - type(command_line_t) command_line - type(command_line_test_t) command_line_test - - if (command_line%argument_present(["--test"])) then - call command_line_test%report(passes, tests, skips) - else - write(*,"(a)") & - new_line("") // & - "To also test Julienne's command_line_t type, append the following to your fpm test command:" // & - new_line("") // & - "-- --test command_line_t --type" - end if - end block - end if - end program diff --git a/test/modules/command_line_test_m.F90 b/test/modules/command_line_test_m.F90 index b8118aa1d..20498aab4 100644 --- a/test/modules/command_line_test_m.F90 +++ b/test/modules/command_line_test_m.F90 @@ -7,6 +7,7 @@ module command_line_test_m !! Verify object pattern asbtract parent use julienne_m, only : & command_line_t & + ,GitHub_CI & ,string_t & ,test_description_substring & ,test_description_t & @@ -38,37 +39,57 @@ pure function subject() result(specimen) function results() result(test_results) type(test_result_t), allocatable :: test_results(:) type(test_description_t), allocatable :: test_descriptions(:) + + cl: associate(command_line => command_line_t()) + + skip_all_tests_if_running_github_ci: & + if (GitHub_CI() .or. (.not. command_line%argument_present(["--test"]))) then + + test_descriptions = [ & + test_description_t(string_t("flag_value() result is the value passed after a command-line flag")) & + ,test_description_t(string_t("flag_value() result is an empty string if command-line flag value is missing")) & + ,test_description_t(string_t("flag_value() result is an empty string if command-line flag is missing")) & + ,test_description_t(string_t("argument_present() result is .false. if a command-line argument is missing")) & + ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present")) & + ] + print * + write(*,"(a)") "----> To test command_line_t, append the following to the fpm test command: -- --test command_line_t --type" + print * + else #if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY - test_descriptions = [ & - test_description_t(string_t("flag_value() result is the value passed after a command-line flag"), check_flag_value) & - ,test_description_t(string_t("flag_value() result is an empty string if command-line flag value is missing"), check_flag_value_missing) & - ,test_description_t(string_t("flag_value() result is an empty string if command-line flag is missing"), check_flag_missing) & - ,test_description_t(string_t("argument_present() result is .false. if a command-line argument is missing"), check_argument_missing) & - ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present"), check_argument_present) & - ] + test_descriptions = [ & + test_description_t(string_t("flag_value() result is the value passed after a command-line flag"), check_flag_value) & + ,test_description_t(string_t("flag_value() result is an empty string if command-line flag value is missing"), check_flag_value_missing) & + ,test_description_t(string_t("flag_value() result is an empty string if command-line flag is missing"), check_flag_missing) & + ,test_description_t(string_t("argument_present() result is .false. if a command-line argument is missing"), check_argument_missing) & + ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present"), check_argument_present) & + ] #else - ! Work around missing Fortran 2008 feature: associating a procedure actual argument with a procedure pointer dummy argument: - procedure(diagnosis_function_i), pointer :: & - check_flag_value_ptr & - ,check_flag_value_missing_ptr & - ,check_flag_missing_ptr & - ,check_argument_missing_ptr & - ,check_argument_present_ptr - - check_flag_value_ptr => check_flag_value - check_flag_value_missing_ptr => check_flag_value_missing - check_flag_missing_ptr => check_flag_missing - check_argument_missing_ptr => check_argument_missing - check_argument_present_ptr => check_argument_present - - test_descriptions = [ & - test_description_t(string_t("flag_value() result is the value passed after a command-line flag"), check_flag_value_ptr) & - ,test_description_t(string_t("flag_value() result is an empty string if command-line flag value is missing"), check_flag_value_missing_ptr) & - ,test_description_t(string_t("flag_value() result is an empty string if command-line flag is missing"), check_flag_missing_ptr) & - ,test_description_t(string_t("argument_present() result is .false. if a command-line argument is missing"), check_argument_missing_ptr) & - ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present"), check_argument_present_ptr) & - ] + ! Work around missing Fortran 2008 feature: associating a procedure actual argument with a procedure pointer dummy argument: + procedure(diagnosis_function_i), pointer :: & + check_flag_value_ptr & + ,check_flag_value_missing_ptr & + ,check_flag_missing_ptr & + ,check_argument_missing_ptr & + ,check_argument_present_ptr + + check_flag_value_ptr => check_flag_value + check_flag_value_missing_ptr => check_flag_value_missing + check_flag_missing_ptr => check_flag_missing + check_argument_missing_ptr => check_argument_missing + check_argument_present_ptr => check_argument_present + + test_descriptions = [ & + test_description_t(string_t("flag_value() result is the value passed after a command-line flag"), check_flag_value_ptr) & + ,test_description_t(string_t("flag_value() result is an empty string if command-line flag value is missing"), check_flag_value_missing_ptr) & + ,test_description_t(string_t("flag_value() result is an empty string if command-line flag is missing"), check_flag_missing_ptr) & + ,test_description_t(string_t("argument_present() result is .false. if a command-line argument is missing"), check_argument_missing_ptr) & + ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present"), check_argument_present_ptr) & + ] + end if #endif + end if skip_all_tests_if_running_github_ci + end associate cl test_descriptions = pack(test_descriptions, & index(subject(), test_description_substring) /= 0 .or. & test_descriptions%contains_text(string_t(test_description_substring))) From d40d33494e54582f661490c5f7d0aa13bde80681 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 9 Aug 2025 08:53:52 -0700 Subject: [PATCH 07/33] feat: default preprocessing of test main --- test/{main.F90 => main.f90} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename test/{main.F90 => main.f90} (100%) diff --git a/test/main.F90 b/test/main.f90 similarity index 100% rename from test/main.F90 rename to test/main.f90 From 5820af7eaa8a4250c33b2043a34b570f55cb241d Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 9 Aug 2025 10:28:04 -0700 Subject: [PATCH 08/33] feat(test_diagnosis): add .expect. operator This commit adds a binary operator that produces a test_diagnosis_t result when applied to a logical operand. --- src/julienne/julienne_test_diagnosis_m.F90 | 11 +++++++++++ src/julienne/julienne_test_diagnosis_s.F90 | 8 ++++++++ src/julienne_m.f90 | 1 + 3 files changed, 20 insertions(+) diff --git a/src/julienne/julienne_test_diagnosis_m.F90 b/src/julienne/julienne_test_diagnosis_m.F90 index 901866a84..31ea81b88 100644 --- a/src/julienne/julienne_test_diagnosis_m.F90 +++ b/src/julienne/julienne_test_diagnosis_m.F90 @@ -22,6 +22,7 @@ module julienne_test_diagnosis_m public :: operator(.withinFraction.) public :: operator(.withinPercentage.) public :: operator(.equalsExpected.) + public :: operator(.expect.) public :: operator(.lessThan.) public :: operator(.lessThanOrEqualTo.) public :: operator(.greaterThan.) @@ -199,6 +200,16 @@ elemental module function approximates_double_precision(actual, expected) result end interface + interface operator(.expect.) + + elemental module function expect(expected_true) result(test_diagnosis) + implicit none + logical, intent(in) :: expected_true + type(test_diagnosis_t) test_diagnosis + end function + + end interface + interface operator(.equalsExpected.) elemental module function equals_expected_integer(actual, expected) result(test_diagnosis) diff --git a/src/julienne/julienne_test_diagnosis_s.F90 b/src/julienne/julienne_test_diagnosis_s.F90 index 241a032b9..57398e293 100644 --- a/src/julienne/julienne_test_diagnosis_s.F90 +++ b/src/julienne/julienne_test_diagnosis_s.F90 @@ -228,6 +228,14 @@ pure function aggregate_vector_diagnosis(diagnoses) result(diagnosis) test_diagnosis = rhs .isBefore. lhs end procedure + module procedure expect + if (expected_true) then + test_diagnosis = test_diagnosis_t(test_passed=.true., diagnostics_string="") + else + test_diagnosis = test_diagnosis_t(test_passed=.false., diagnostics_string="expected to be true") + end if + end procedure + module procedure equals_expected_integer if (actual == expected) then diff --git a/src/julienne_m.f90 b/src/julienne_m.f90 index 9cc93fc30..ec5bcfadf 100644 --- a/src/julienne_m.f90 +++ b/src/julienne_m.f90 @@ -21,6 +21,7 @@ module julienne_m ,operator(.also.) & ,operator(.approximates.) & ,operator(.equalsExpected.) & + ,operator(.expect.) & ,operator(.isAtLeast.) & ,operator(.isAtMost.) & ,operator(.isBefore.) & From 559c1ed1ddbea5055e311107c2b3d7867059143c Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 9 Aug 2025 10:29:43 -0700 Subject: [PATCH 09/33] fix(include): use GCC minor and patch versions --- include/language-support.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/include/language-support.F90 b/include/language-support.F90 index f71dd6c2e..313ac8a06 100644 --- a/include/language-support.F90 +++ b/include/language-support.F90 @@ -9,8 +9,9 @@ ! If not already determined, make a compiler-dependent determination of whether Julienne may pass ! procedure actual arguments to procedure pointer dummy arguments, a feature introduced in ! Fortran 2008 and described in Fortran 2023 clause 15.5.2.10 paragraph 5. + #ifndef HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY -# if defined(__GFORTRAN__) +# if (GCC_VERSION < 140300) # define HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY 0 # else # define HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY 1 From f110cbc68ec2e7813723022f1b340e40c1218693 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 9 Aug 2025 10:45:01 -0700 Subject: [PATCH 10/33] fix: work around gfortran 14 builds Caveat: The newly refactored test/main.f90 program causes an ICE with gfortran 13.4. --- test/modules/assert_test_m.F90 | 15 ++-- test/modules/command_line_test_m.F90 | 94 +++++++----------------- test/modules/test_description_test_m.F90 | 26 ++----- test/modules/test_diagnosis_test_m.F90 | 23 ++---- 4 files changed, 45 insertions(+), 113 deletions(-) diff --git a/test/modules/assert_test_m.F90 b/test/modules/assert_test_m.F90 index 5933b469a..328264cf0 100644 --- a/test/modules/assert_test_m.F90 +++ b/test/modules/assert_test_m.F90 @@ -41,20 +41,15 @@ pure function subject() result(specimen) function results() result(test_results) type(test_result_t), allocatable :: test_results(:) + type(test_description_t), allocatable :: test_descriptions(:) - associate(descriptions => [ & + test_descriptions = [ & test_description_t("invocation via the call_julienne_assert macro", check_call_julienne_assert_macro) & ,test_description_t("invocation via direct call", check_julienne_assert_call) & ,test_description_t("invocation removal after undefining the ASSERTIONS macro", check_macro_removal) & - ]) - associate(substring_in_subject => index(subject(), test_description_substring) /= 0) - associate(substring_in_test_diagnosis => descriptions%contains_text(test_description_substring)) - associate(matching_descriptions => pack(descriptions, substring_in_subject .or. substring_in_test_diagnosis)) - test_results = matching_descriptions%run() - end associate - end associate - end associate - end associate + ] + test_descriptions = pack(test_descriptions, (index(subject(), test_description_substring) /= 0).or. test_descriptions%contains_text(test_description_substring)) + test_results = test_descriptions%run() end function diff --git a/test/modules/command_line_test_m.F90 b/test/modules/command_line_test_m.F90 index 20498aab4..53aac0be0 100644 --- a/test/modules/command_line_test_m.F90 +++ b/test/modules/command_line_test_m.F90 @@ -8,6 +8,8 @@ module command_line_test_m use julienne_m, only : & command_line_t & ,GitHub_CI & + ,operator(.equalsExpected.) & + ,operator(.expect.) & ,string_t & ,test_description_substring & ,test_description_t & @@ -39,8 +41,14 @@ pure function subject() result(specimen) function results() result(test_results) type(test_result_t), allocatable :: test_results(:) type(test_description_t), allocatable :: test_descriptions(:) - - cl: associate(command_line => command_line_t()) + type(command_line_t) command_line + procedure(diagnosis_function_i), pointer :: & + check_flag_value_ptr => check_flag_value & + ,check_flag_value_missing_ptr => check_flag_value_missing & + ,check_flag_missing_ptr => check_flag_missing & + ,check_argument_missing_ptr => check_argument_missing & + ,check_argument_present_ptr => check_argument_present + integer i skip_all_tests_if_running_github_ci: & if (GitHub_CI() .or. (.not. command_line%argument_present(["--test"]))) then @@ -65,99 +73,51 @@ function results() result(test_results) ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present"), check_argument_present) & ] #else - ! Work around missing Fortran 2008 feature: associating a procedure actual argument with a procedure pointer dummy argument: - procedure(diagnosis_function_i), pointer :: & - check_flag_value_ptr & - ,check_flag_value_missing_ptr & - ,check_flag_missing_ptr & - ,check_argument_missing_ptr & - ,check_argument_present_ptr - - check_flag_value_ptr => check_flag_value - check_flag_value_missing_ptr => check_flag_value_missing - check_flag_missing_ptr => check_flag_missing - check_argument_missing_ptr => check_argument_missing - check_argument_present_ptr => check_argument_present - - test_descriptions = [ & - test_description_t(string_t("flag_value() result is the value passed after a command-line flag"), check_flag_value_ptr) & - ,test_description_t(string_t("flag_value() result is an empty string if command-line flag value is missing"), check_flag_value_missing_ptr) & - ,test_description_t(string_t("flag_value() result is an empty string if command-line flag is missing"), check_flag_missing_ptr) & - ,test_description_t(string_t("argument_present() result is .false. if a command-line argument is missing"), check_argument_missing_ptr) & - ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present"), check_argument_present_ptr) & - ] - end if + gfortran_work_around: & + block + + test_descriptions = [ & + test_description_t(string_t("flag_value() result is the value passed after a command-line flag"), check_flag_value_ptr) & + ,test_description_t(string_t("flag_value() result is an empty string if command-line flag value is missing"), check_flag_value_missing_ptr) & + ,test_description_t(string_t("flag_value() result is an empty string if command-line flag is missing"), check_flag_missing_ptr) & + ,test_description_t(string_t("argument_present() result is .false. if a command-line argument is missing"), check_argument_missing_ptr) & + ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present"), check_argument_present_ptr) & + ] + end block gfortran_work_around #endif end if skip_all_tests_if_running_github_ci - end associate cl - test_descriptions = pack(test_descriptions, & - index(subject(), test_description_substring) /= 0 .or. & - test_descriptions%contains_text(string_t(test_description_substring))) + test_results = test_descriptions%run() end function function check_flag_value() result(test_diagnosis) type(test_diagnosis_t) test_diagnosis type(command_line_t) command_line - character(len=*), parameter :: expected_flag_value = "command_line_t" - - associate(actual_flag_value => command_line%flag_value("--test")) - test_diagnosis = test_diagnosis_t( & - test_passed = expected_flag_value == actual_flag_value & - ,diagnostics_string = "expected " // expected_flag_value // ", actual " // actual_flag_value & - ) - end associate + test_diagnosis = command_line%flag_value("--test") .equalsExpected. "command_line_t" end function function check_flag_value_missing() result(test_diagnosis) type(test_diagnosis_t) test_diagnosis type(command_line_t) command_line - character(len=*), parameter :: expected_flag_value = "" - - associate(actual_flag_value => command_line%flag_value("--type")) - test_diagnosis = test_diagnosis_t( & - test_passed = expected_flag_value == actual_flag_value & - ,diagnostics_string = "expected '" // expected_flag_value // "', actual '" // actual_flag_value // "'" & - ) - end associate + test_diagnosis = command_line%flag_value("--type") .equalsExpected. "" end function function check_flag_missing() result(test_diagnosis) type(test_diagnosis_t) test_diagnosis type(command_line_t) command_line - character(len=*), parameter :: expected_flag_value = "" - - associate(actual_flag_value => command_line%flag_value("r@nd0m.Junk-H3R3")) - test_diagnosis = test_diagnosis_t( & - test_passed = expected_flag_value == actual_flag_value & - ,diagnostics_string = "expected '" // expected_flag_value // "', actual '" // actual_flag_value // "'" & - ) - end associate + test_diagnosis = command_line%flag_value("r@nd0m.Junk-H3R3") .equalsExpected. "" end function function check_argument_missing() result(test_diagnosis) type(test_diagnosis_t) test_diagnosis type(command_line_t) command_line - character(len=*), parameter :: expected_flag_value = "" - - associate(argument_found => command_line%argument_present(["M1ss1ng-argUment"])) - test_diagnosis = test_diagnosis_t( & - test_passed = .not. argument_found & - ,diagnostics_string = "expected .false., actual .true." & - ) - end associate + test_diagnosis = .expect. (.not. command_line%argument_present(["M1ss1ng-argUment"])) end function function check_argument_present() result(test_diagnosis) type(test_diagnosis_t) test_diagnosis type(command_line_t) command_line - - associate(argument_found => command_line%argument_present(["--type"])) - test_diagnosis = test_diagnosis_t( & - test_passed = argument_found & - ,diagnostics_string = "expected .true., actual .false." & - ) - end associate + test_diagnosis = .expect. command_line%argument_present(["--type"]) end function end module command_line_test_m diff --git a/test/modules/test_description_test_m.F90 b/test/modules/test_description_test_m.F90 index 5c4bf17c8..0f52b108c 100644 --- a/test/modules/test_description_test_m.F90 +++ b/test/modules/test_description_test_m.F90 @@ -33,44 +33,32 @@ pure function subject() result(specimen) function results() result(test_results) type(test_result_t), allocatable :: test_results(:) + type(test_description_t), allocatable :: test_descriptions(:) #if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY - associate(descriptions => & - [test_description_t("identical construction from string_t or character argument", check_constructors_match)] & - ) + test_descriptions = [ & + test_description_t("identical construction from string_t or character argument", check_constructors_match) & + ] #else ! Work around missing Fortran 2008 feature: associating a procedure actual argument with a procedure pointer dummy argument: procedure(diagnosis_function_i), pointer :: check_constructors_match_ptr - type(test_description_t), allocatable :: descriptions(:) check_constructors_match_ptr => check_constructors_match - descriptions = [ & + test_descriptions = [ & test_description_t("identical construction from string_t or character argument", check_constructors_match_ptr) & ] #endif -#ifndef __GFORTRAN__ - associate(substring_in_subject => index(subject(), test_description_substring) /= 0) - associate(substring_in_test_description => descriptions%contains_text(test_description_substring)) - associate(matching_descriptions => pack(descriptions, substring_in_subject .or. substring_in_test_description)) - test_results = matching_descriptions%run() - end associate - end associate - end associate - end associate - -#else block logical substring_in_subject logical, allocatable :: substring_in_test_description(:) type(test_description_t), allocatable :: matching_descriptions(:) substring_in_subject = index(subject(), test_description_substring) /= 0 - substring_in_test_description = descriptions%contains_text(test_description_substring) - matching_descriptions = pack(descriptions, substring_in_subject .or. substring_in_test_description) + substring_in_test_description = test_descriptions%contains_text(test_description_substring) + matching_descriptions = pack(test_descriptions, substring_in_subject .or. substring_in_test_description) test_results = matching_descriptions%run() end block -#endif end function diff --git a/test/modules/test_diagnosis_test_m.F90 b/test/modules/test_diagnosis_test_m.F90 index eec183c55..05c32e016 100644 --- a/test/modules/test_diagnosis_test_m.F90 +++ b/test/modules/test_diagnosis_test_m.F90 @@ -49,9 +49,10 @@ pure function subject() result(specimen) function results() result(test_results) type(test_result_t), allocatable :: test_results(:) + type(test_description_t), allocatable :: test_descriptions(:) #if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY - associate(descriptions => [ & + test_descriptions = [ & test_description_t("construction from the real expression 'x .approximates. y .within. tolerance'" , check_approximates_real) & ,test_description_t("construction from the real expression 'x .approximates. y .withinFraction. tolerance'" , check_approximates_real_fraction) & ,test_description_t("construction from the real expression 'x .approximates. y .withinPercentage. tolerance'" , check_approximates_real_percentage) & @@ -74,10 +75,9 @@ function results() result(test_results) ,test_description_t("construction from the integer expression '[i,j] .greaterThanOrEqualTo. k" , check_greater_than_or_equal_to_integer) & ,test_description_t("construction from the scalar test_diagnostics_t expression 't .and. u'" , check_and_with_scalar_operands) & ,test_description_t("construction from the vector test_diagnostics_t expressions 'i .equalsExpected. [j,k]'" , check_and_with_vector_operands) & - ] ) + ] #else ! Work around missing Fortran 2008 feature: associating a procedure actual argument with a procedure pointer dummy argument: - type(test_description_t), allocatable :: descriptions(:) procedure(diagnosis_function_i), pointer :: & check_approximates_real_ptr => check_approximates_real & ,check_approximates_real_fraction_ptr => check_approximates_real_fraction & @@ -102,7 +102,7 @@ function results() result(test_results) ,check_and_with_scalar_operands_ptr => check_and_with_scalar_operands & ,check_and_with_vector_operands_ptr => check_and_with_vector_operands - descriptions = [ & + test_descriptions = [ & test_description_t("construction from the real expression 'x .approximates. y .within. tolerance'" , check_approximates_real_ptr) & ,test_description_t("construction from the real expression 'x .approximates. y .withinFraction. tolerance'" , check_approximates_real_fraction_ptr) & ,test_description_t("construction from the real expression 'x .approximates. y .withinPercentage. tolerance'" , check_approximates_real_percentage_ptr) & @@ -128,27 +128,16 @@ function results() result(test_results) ] #endif -#ifndef __GFORTRAN__ - associate(substring_in_subject => index(subject(), test_description_substring) /= 0) - associate(substring_in_test_diagnosis => descriptions%contains_text(test_description_substring)) - associate(matching_descriptions => pack(descriptions, substring_in_subject .or. substring_in_test_diagnosis)) - test_results = matching_descriptions%run() - end associate - end associate - end associate - end associate -#else block logical substring_in_subject logical, allocatable :: substring_in_test_diagnosis(:) type(test_description_t), allocatable :: matching_descriptions(:) substring_in_subject = index(subject(), test_description_substring) /= 0 - substring_in_test_diagnosis = descriptions%contains_text(test_description_substring) - matching_descriptions = pack(descriptions, substring_in_subject .or. substring_in_test_diagnosis) + substring_in_test_diagnosis = test_descriptions%contains_text(test_description_substring) + matching_descriptions = pack(test_descriptions, substring_in_subject .or. substring_in_test_diagnosis) test_results = matching_descriptions%run() end block -#endif end function From ebc5be13bc4b3106d027311b221e6057fe48fc85 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 9 Aug 2025 11:35:56 -0700 Subject: [PATCH 11/33] fix(command_line_test): mv code --- test/modules/command_line_test_m.F90 | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/test/modules/command_line_test_m.F90 b/test/modules/command_line_test_m.F90 index 53aac0be0..ef7665753 100644 --- a/test/modules/command_line_test_m.F90 +++ b/test/modules/command_line_test_m.F90 @@ -42,13 +42,6 @@ function results() result(test_results) type(test_result_t), allocatable :: test_results(:) type(test_description_t), allocatable :: test_descriptions(:) type(command_line_t) command_line - procedure(diagnosis_function_i), pointer :: & - check_flag_value_ptr => check_flag_value & - ,check_flag_value_missing_ptr => check_flag_value_missing & - ,check_flag_missing_ptr => check_flag_missing & - ,check_argument_missing_ptr => check_argument_missing & - ,check_argument_present_ptr => check_argument_present - integer i skip_all_tests_if_running_github_ci: & if (GitHub_CI() .or. (.not. command_line%argument_present(["--test"]))) then @@ -75,6 +68,12 @@ function results() result(test_results) #else gfortran_work_around: & block + procedure(diagnosis_function_i), pointer :: & + check_flag_value_ptr => check_flag_value & + ,check_flag_value_missing_ptr => check_flag_value_missing & + ,check_flag_missing_ptr => check_flag_missing & + ,check_argument_missing_ptr => check_argument_missing & + ,check_argument_present_ptr => check_argument_present test_descriptions = [ & test_description_t(string_t("flag_value() result is the value passed after a command-line flag"), check_flag_value_ptr) & From fe2f192290fd60cde0360f2b71ad68ac7e0b5978 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 9 Aug 2025 11:44:11 -0700 Subject: [PATCH 12/33] chore(CI): use more descriptive names --- .github/workflows/build-with-flang.yml | 2 +- .github/workflows/{CI.yml => build-with-gfortran.yml} | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) rename .github/workflows/{CI.yml => build-with-gfortran.yml} (95%) diff --git a/.github/workflows/build-with-flang.yml b/.github/workflows/build-with-flang.yml index 2dab8dd78..7317fd19d 100644 --- a/.github/workflows/build-with-flang.yml +++ b/.github/workflows/build-with-flang.yml @@ -1,4 +1,4 @@ -name: Build with LLVM Flang +name: Build with LLVM Flang 20 on: [push, pull_request] diff --git a/.github/workflows/CI.yml b/.github/workflows/build-with-gfortran.yml similarity index 95% rename from .github/workflows/CI.yml rename to .github/workflows/build-with-gfortran.yml index fea4ae1a9..9ed18aa76 100644 --- a/.github/workflows/CI.yml +++ b/.github/workflows/build-with-gfortran.yml @@ -1,4 +1,4 @@ -name: CI +name: Build with gfortran-14 on: [push, pull_request] From f4c44d183ddddb89ef87a0dd4cc79dc07fbb9573 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 9 Aug 2025 11:59:02 -0700 Subject: [PATCH 13/33] chore(CI): print versions, set env vars --- .github/workflows/build-with-flang.yml | 2 +- .github/workflows/build-with-gfortran.yml | 13 ++++++++++--- 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/.github/workflows/build-with-flang.yml b/.github/workflows/build-with-flang.yml index 7317fd19d..07ee2f212 100644 --- a/.github/workflows/build-with-flang.yml +++ b/.github/workflows/build-with-flang.yml @@ -28,5 +28,5 @@ jobs: fpm --version $FC --version export FPM_FC=$FC - export FPM_FFLAGS="-mmlir -allow-assumed-rank -O3" + export FPM_FFLAGS="-O3" fpm test diff --git a/.github/workflows/build-with-gfortran.yml b/.github/workflows/build-with-gfortran.yml index 9ed18aa76..b6149ddbd 100644 --- a/.github/workflows/build-with-gfortran.yml +++ b/.github/workflows/build-with-gfortran.yml @@ -8,6 +8,11 @@ jobs: strategy: matrix: os: [macos-13, ubuntu-24.04] + fail-fast: true + env: + GCC_VER: 14 + FC: gfortran-$GCC_VER + CXX: g++-$GCC-VER steps: - name: Checkout code @@ -21,8 +26,10 @@ jobs: if: contains(matrix.os, 'ubuntu') run: | sudo apt update - sudo apt install -y build-essential gfortran-14 g++-14 + sudo apt install -y build-essential $FC $CC - - name: Build and Run unit tests + - name: Build and Test with GCC run: | - fpm test --compiler gfortran-14 + fpm --version + $FC --version + fpm test --compiler $FC From 56e126f73dd92db6e062b2c0c5fa7f6e1b4c0b65 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 9 Aug 2025 12:08:26 -0700 Subject: [PATCH 14/33] fix(include/language-support): add compilers --- include/language-support.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/include/language-support.F90 b/include/language-support.F90 index 313ac8a06..9a5d131d4 100644 --- a/include/language-support.F90 +++ b/include/language-support.F90 @@ -11,10 +11,10 @@ ! Fortran 2008 and described in Fortran 2023 clause 15.5.2.10 paragraph 5. #ifndef HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY -# if (GCC_VERSION < 140300) -# define HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY 0 -# else +#if defined(_CRAYFTN) || defined(__INTEL_COMPILER) || defined(NAGFOR) || defined(__flang__) || (GCC_VERSION > 140200) # define HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY 1 +# else +# define HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY 0 # endif #endif From 5ea38ecdfa976af1799adaa36cfd656e3b96d240 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 10 Aug 2025 09:55:25 -0700 Subject: [PATCH 15/33] chore(test_fixture): priv component, non-alloc arg --- src/julienne/julienne_test_fixture_m.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/julienne/julienne_test_fixture_m.f90 b/src/julienne/julienne_test_fixture_m.f90 index 50d160684..5809af8f7 100644 --- a/src/julienne/julienne_test_fixture_m.f90 +++ b/src/julienne/julienne_test_fixture_m.f90 @@ -12,6 +12,7 @@ module julienne_test_fixture_m public :: test_fixture_t type test_fixture_t + private class(test_t), allocatable :: test_ contains procedure report @@ -22,7 +23,7 @@ module julienne_test_fixture_m module function component_constructor(test) result(test_fixture) ! can be pure in Fortran 2023 !! Construct a test_fixture_t object from its components implicit none - class(test_t), intent(in), allocatable :: test + class(test_t), intent(in) :: test type(test_fixture_t) test_fixture end function From 9e7528583ba8f1b1e4d3dcbd8a3c7ca22045fe49 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 10 Aug 2025 10:03:34 -0700 Subject: [PATCH 16/33] chore(test_harness): priv component, non-alloc arg --- src/julienne/julienne_test_harness_m.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/julienne/julienne_test_harness_m.f90 b/src/julienne/julienne_test_harness_m.f90 index 703ce2e28..845e0edfd 100644 --- a/src/julienne/julienne_test_harness_m.f90 +++ b/src/julienne/julienne_test_harness_m.f90 @@ -12,6 +12,7 @@ module julienne_test_harness_m public :: test_harness_t type test_harness_t + private class(test_fixture_t), allocatable :: test_fixture_(:) contains procedure report @@ -21,7 +22,7 @@ module julienne_test_harness_m module function component_constructor(test_fixtures) result(test_harness) ! can be pure in Fortran 2028 !! Construct a test_harness_t object from its components - class(test_fixture_t), allocatable :: test_fixtures(:) + class(test_fixture_t) test_fixtures(:) type(test_harness_t) test_harness end function From 932edcc37a89fcfdcad5b52bf84a3772261b405e Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 10 Aug 2025 10:56:40 -0700 Subject: [PATCH 17/33] doc(test/main,harness): add/edit comments --- src/julienne/julienne_test_harness_m.f90 | 10 ++++++---- test/main.f90 | 8 +++++--- 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/src/julienne/julienne_test_harness_m.f90 b/src/julienne/julienne_test_harness_m.f90 index 845e0edfd..b86eb7b6a 100644 --- a/src/julienne/julienne_test_harness_m.f90 +++ b/src/julienne/julienne_test_harness_m.f90 @@ -2,8 +2,7 @@ ! Terms of use are as specified in LICENSE.txt module julienne_test_harness_m - !! Define a wrapper type for the test_t type to facilitate creating a polymorphic - !! array of test_t objects. + !! Define a test harness encapsulating an array of text fixtures, each of which can run a set of tests. use julienne_test_fixture_m, only : test_fixture_t implicit none @@ -12,6 +11,7 @@ module julienne_test_harness_m public :: test_harness_t type test_harness_t + !! Encapsulate a set of test fixtures, each of which can run a set of tests. private class(test_fixture_t), allocatable :: test_fixture_(:) contains @@ -21,7 +21,7 @@ module julienne_test_harness_m interface test_harness_t module function component_constructor(test_fixtures) result(test_harness) ! can be pure in Fortran 2028 - !! Construct a test_harness_t object from its components + !! Component-wise user-defined structure constructor class(test_fixture_t) test_fixtures(:) type(test_harness_t) test_harness end function @@ -31,7 +31,9 @@ module function component_constructor(test_fixtures) result(test_harness) ! can interface module subroutine report(self, passes, tests, skips) - !! Print the test results and increment the tallies of passing tests, total tests, and skipped tests. + !! If command line includes -h or --help, print usage information and stop. + !! Otherwise, run tests and print results, including diagnostics for any failures. + !! Also, tally and print the numbers of passing tests, total tests, skipped tests. implicit none class(test_harness_t), intent(in) :: self integer, intent(inout) :: passes, tests, skips diff --git a/test/main.f90 b/test/main.f90 index 253430eee..76f460ef1 100644 --- a/test/main.f90 +++ b/test/main.f90 @@ -3,9 +3,11 @@ program test_suite_driver !! Julienne test-suite driver + + ! Test infrastructure: use julienne_m, only : test_fixture_t, test_harness_t - ! Test modules: + ! Modules containing test_t child types: use assert_test_m ,only : assert_test_t use bin_test_m ,only : bin_test_t use command_line_test_m ,only : command_line_test_t @@ -20,8 +22,8 @@ program test_suite_driver integer :: passes=0, tests=0, skips=0 - ! Construct a test harness from an array of test fixtures, each of which is constructed - ! from the result of invoking a test_t child type's structure constructor: + ! Construct a test harness from an array of test fixtures, each of which is + ! constructed from an invocation of a test_t child type's structure constructor: associate(test_harness => test_harness_t([ & test_fixture_t( assert_test_t()) & ,test_fixture_t( bin_test_t()) & From db2981e25bffe9e5f587341e7327e746464c5296 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 10 Aug 2025 11:03:59 -0700 Subject: [PATCH 18/33] chore(test_harness): mk component array non-poly --- src/julienne/julienne_test_harness_m.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/julienne/julienne_test_harness_m.f90 b/src/julienne/julienne_test_harness_m.f90 index b86eb7b6a..158b56146 100644 --- a/src/julienne/julienne_test_harness_m.f90 +++ b/src/julienne/julienne_test_harness_m.f90 @@ -13,7 +13,7 @@ module julienne_test_harness_m type test_harness_t !! Encapsulate a set of test fixtures, each of which can run a set of tests. private - class(test_fixture_t), allocatable :: test_fixture_(:) + type(test_fixture_t), allocatable :: test_fixture_(:) contains procedure report end type From 6120c8fb2b63e90e4a73f6519323aec7106f47f8 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 10 Aug 2025 11:21:57 -0700 Subject: [PATCH 19/33] refac(test_harness): disambiguate binding name --- src/julienne/julienne_test_harness_s.F90 | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/src/julienne/julienne_test_harness_s.F90 b/src/julienne/julienne_test_harness_s.F90 index 4a3e6f5c3..fb65dcca5 100644 --- a/src/julienne/julienne_test_harness_s.F90 +++ b/src/julienne/julienne_test_harness_s.F90 @@ -16,16 +16,19 @@ call print_usage_info_and_stop_if_requested block - integer i + integer i, passes, tests, skips + + passes=0; tests=0; skips=0 + do i = 1, size(self%test_fixture_) call self%test_fixture_(i)%report(passes, tests, skips) end do - end block - print * - print '(*(a,:,g0))', "_________ ", passes, " of ", tests, " tests pass. ", skips, " tests were skipped. _________" + print * + print '(*(a,:,g0))', "_________ ", passes, " of ", tests, " tests pass. ", skips, " tests were skipped. _________" - if (passes + skips /= tests) error stop "Some tests failed." + if (passes + skips /= tests) error stop "Some tests failed." + end block end procedure From 4df3368b4817d32d376a3757b1201c0b9ec439d3 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 10 Aug 2025 11:25:53 -0700 Subject: [PATCH 20/33] refac(test_harness): rm dummy args --- src/julienne/julienne_test_harness_m.f90 | 5 ++--- src/julienne/julienne_test_harness_s.F90 | 2 +- test/main.f90 | 4 +--- 3 files changed, 4 insertions(+), 7 deletions(-) diff --git a/src/julienne/julienne_test_harness_m.f90 b/src/julienne/julienne_test_harness_m.f90 index 158b56146..402556ab8 100644 --- a/src/julienne/julienne_test_harness_m.f90 +++ b/src/julienne/julienne_test_harness_m.f90 @@ -15,7 +15,7 @@ module julienne_test_harness_m private type(test_fixture_t), allocatable :: test_fixture_(:) contains - procedure report + procedure report_results end type interface test_harness_t @@ -30,13 +30,12 @@ module function component_constructor(test_fixtures) result(test_harness) ! can interface - module subroutine report(self, passes, tests, skips) + module subroutine report_results(self) !! If command line includes -h or --help, print usage information and stop. !! Otherwise, run tests and print results, including diagnostics for any failures. !! Also, tally and print the numbers of passing tests, total tests, skipped tests. implicit none class(test_harness_t), intent(in) :: self - integer, intent(inout) :: passes, tests, skips end subroutine end interface diff --git a/src/julienne/julienne_test_harness_s.F90 b/src/julienne/julienne_test_harness_s.F90 index fb65dcca5..a4873a644 100644 --- a/src/julienne/julienne_test_harness_s.F90 +++ b/src/julienne/julienne_test_harness_s.F90 @@ -11,7 +11,7 @@ test_harness%test_fixture_ = test_fixtures end procedure - module procedure report + module procedure report_results call print_usage_info_and_stop_if_requested diff --git a/test/main.f90 b/test/main.f90 index 76f460ef1..11ecb4191 100644 --- a/test/main.f90 +++ b/test/main.f90 @@ -20,8 +20,6 @@ program test_suite_driver implicit none - integer :: passes=0, tests=0, skips=0 - ! Construct a test harness from an array of test fixtures, each of which is ! constructed from an invocation of a test_t child type's structure constructor: associate(test_harness => test_harness_t([ & @@ -35,7 +33,7 @@ program test_suite_driver ,test_fixture_t(vector_test_description_test_t()) & ,test_fixture_t( command_line_test_t()) & ])) - call test_harness%report(passes, tests, skips) + call test_harness%report_results end associate end program From 7ed84373a0392d08d267edde75b677b066c058c4 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 10 Aug 2025 11:36:27 -0700 Subject: [PATCH 21/33] refac(test_harness): collapse print statements --- src/julienne/julienne_test_harness_s.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/julienne/julienne_test_harness_s.F90 b/src/julienne/julienne_test_harness_s.F90 index a4873a644..de1ddacfc 100644 --- a/src/julienne/julienne_test_harness_s.F90 +++ b/src/julienne/julienne_test_harness_s.F90 @@ -24,8 +24,7 @@ call self%test_fixture_(i)%report(passes, tests, skips) end do - print * - print '(*(a,:,g0))', "_________ ", passes, " of ", tests, " tests pass. ", skips, " tests were skipped. _________" + print '(a,*(a,:,g0))', new_line(''), "_______ ", passes, " of ", tests, " tests pass. ", skips, " tests were skipped _______" if (passes + skips /= tests) error stop "Some tests failed." end block From 664578e2745012a603d96816c4d7a2a8ba9735ff Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 10 Aug 2025 11:39:48 -0700 Subject: [PATCH 22/33] chore(CI): fix compiler names --- .github/workflows/build-with-gfortran.yml | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/.github/workflows/build-with-gfortran.yml b/.github/workflows/build-with-gfortran.yml index b6149ddbd..777cf9350 100644 --- a/.github/workflows/build-with-gfortran.yml +++ b/.github/workflows/build-with-gfortran.yml @@ -10,9 +10,8 @@ jobs: os: [macos-13, ubuntu-24.04] fail-fast: true env: - GCC_VER: 14 - FC: gfortran-$GCC_VER - CXX: g++-$GCC-VER + FC: gfortran-14 + CXX: g++-14 steps: - name: Checkout code From a928d8f7c83fc62d8ea59c712180bbcdbbca44ac Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 10 Aug 2025 17:58:18 -0700 Subject: [PATCH 23/33] fix(CI): only run command-line tests if not in CI --- test/modules/command_line_test_m.F90 | 74 ++++++++++++++-------------- 1 file changed, 38 insertions(+), 36 deletions(-) diff --git a/test/modules/command_line_test_m.F90 b/test/modules/command_line_test_m.F90 index ef7665753..0d754edda 100644 --- a/test/modules/command_line_test_m.F90 +++ b/test/modules/command_line_test_m.F90 @@ -44,46 +44,48 @@ function results() result(test_results) type(command_line_t) command_line skip_all_tests_if_running_github_ci: & - if (GitHub_CI() .or. (.not. command_line%argument_present(["--test"]))) then - - test_descriptions = [ & - test_description_t(string_t("flag_value() result is the value passed after a command-line flag")) & - ,test_description_t(string_t("flag_value() result is an empty string if command-line flag value is missing")) & - ,test_description_t(string_t("flag_value() result is an empty string if command-line flag is missing")) & - ,test_description_t(string_t("argument_present() result is .false. if a command-line argument is missing")) & - ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present")) & - ] - print * - write(*,"(a)") "----> To test command_line_t, append the following to the fpm test command: -- --test command_line_t --type" - print * - else + if (.not. GitHub_CI()) then + skip_all_tests_if_not_explicitly_requested: & + if (.not. command_line%argument_present(["--test"])) then + test_descriptions = [ & + test_description_t(string_t("flag_value() result is the value passed after a command-line flag")) & + ,test_description_t(string_t("flag_value() result is an empty string if command-line flag value is missing")) & + ,test_description_t(string_t("flag_value() result is an empty string if command-line flag is missing")) & + ,test_description_t(string_t("argument_present() result is .false. if a command-line argument is missing")) & + ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present")) & + ] + print * + write(*,"(a)") "----> To test command_line_t, append the following to the fpm test command: -- --test command_line_t --type" + print * + else ! run the tests #if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY - test_descriptions = [ & - test_description_t(string_t("flag_value() result is the value passed after a command-line flag"), check_flag_value) & - ,test_description_t(string_t("flag_value() result is an empty string if command-line flag value is missing"), check_flag_value_missing) & - ,test_description_t(string_t("flag_value() result is an empty string if command-line flag is missing"), check_flag_missing) & - ,test_description_t(string_t("argument_present() result is .false. if a command-line argument is missing"), check_argument_missing) & - ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present"), check_argument_present) & - ] -#else - gfortran_work_around: & - block - procedure(diagnosis_function_i), pointer :: & - check_flag_value_ptr => check_flag_value & - ,check_flag_value_missing_ptr => check_flag_value_missing & - ,check_flag_missing_ptr => check_flag_missing & - ,check_argument_missing_ptr => check_argument_missing & - ,check_argument_present_ptr => check_argument_present - test_descriptions = [ & - test_description_t(string_t("flag_value() result is the value passed after a command-line flag"), check_flag_value_ptr) & - ,test_description_t(string_t("flag_value() result is an empty string if command-line flag value is missing"), check_flag_value_missing_ptr) & - ,test_description_t(string_t("flag_value() result is an empty string if command-line flag is missing"), check_flag_missing_ptr) & - ,test_description_t(string_t("argument_present() result is .false. if a command-line argument is missing"), check_argument_missing_ptr) & - ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present"), check_argument_present_ptr) & + test_description_t(string_t("flag_value() result is the value passed after a command-line flag"), check_flag_value) & + ,test_description_t(string_t("flag_value() result is an empty string if command-line flag value is missing"), check_flag_value_missing) & + ,test_description_t(string_t("flag_value() result is an empty string if command-line flag is missing"), check_flag_missing) & + ,test_description_t(string_t("argument_present() result is .false. if a command-line argument is missing"), check_argument_missing) & + ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present"), check_argument_present) & ] - end block gfortran_work_around +#else + gfortran_work_around: & + block + procedure(diagnosis_function_i), pointer :: & + check_flag_value_ptr => check_flag_value & + ,check_flag_value_missing_ptr => check_flag_value_missing & + ,check_flag_missing_ptr => check_flag_missing & + ,check_argument_missing_ptr => check_argument_missing & + ,check_argument_present_ptr => check_argument_present + + test_descriptions = [ & + test_description_t(string_t("flag_value() result is the value passed after a command-line flag"), check_flag_value_ptr) & + ,test_description_t(string_t("flag_value() result is an empty string if command-line flag value is missing"), check_flag_value_missing_ptr) & + ,test_description_t(string_t("flag_value() result is an empty string if command-line flag is missing"), check_flag_missing_ptr) & + ,test_description_t(string_t("argument_present() result is .false. if a command-line argument is missing"), check_argument_missing_ptr) & + ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present"), check_argument_present_ptr) & + ] + end block gfortran_work_around #endif + end if skip_all_tests_if_not_explicitly_requested end if skip_all_tests_if_running_github_ci test_results = test_descriptions%run() From cff34b601aaa7dd1392bbfa179628131a799b9ec Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 10 Aug 2025 18:19:30 -0700 Subject: [PATCH 24/33] fix(CI): fix logic to skip command_line_t tests --- test/modules/command_line_test_m.F90 | 83 +++++++++++++++------------- 1 file changed, 45 insertions(+), 38 deletions(-) diff --git a/test/modules/command_line_test_m.F90 b/test/modules/command_line_test_m.F90 index 0d754edda..30909f3da 100644 --- a/test/modules/command_line_test_m.F90 +++ b/test/modules/command_line_test_m.F90 @@ -44,48 +44,55 @@ function results() result(test_results) type(command_line_t) command_line skip_all_tests_if_running_github_ci: & - if (.not. GitHub_CI()) then - skip_all_tests_if_not_explicitly_requested: & - if (.not. command_line%argument_present(["--test"])) then - test_descriptions = [ & - test_description_t(string_t("flag_value() result is the value passed after a command-line flag")) & - ,test_description_t(string_t("flag_value() result is an empty string if command-line flag value is missing")) & - ,test_description_t(string_t("flag_value() result is an empty string if command-line flag is missing")) & - ,test_description_t(string_t("argument_present() result is .false. if a command-line argument is missing")) & - ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present")) & - ] - print * - write(*,"(a)") "----> To test command_line_t, append the following to the fpm test command: -- --test command_line_t --type" - print * - else ! run the tests + if (GitHub_CI()) then + test_descriptions = [ & + test_description_t(string_t("flag_value() result is the value passed after a command-line flag")) & + ,test_description_t(string_t("flag_value() result is an empty string if command-line flag value is missing")) & + ,test_description_t(string_t("flag_value() result is an empty string if command-line flag is missing")) & + ,test_description_t(string_t("argument_present() result is .false. if a command-line argument is missing")) & + ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present")) & + ] + print * + write(*,"(a)") "----> To test command_line_t, append the following to the fpm test command: -- --test command_line_t --type" + print * + else if (.not. command_line%argument_present(["--test"])) then ! skip the tests if not explicitly requested + test_descriptions = [ & + test_description_t(string_t("flag_value() result is the value passed after a command-line flag")) & + ,test_description_t(string_t("flag_value() result is an empty string if command-line flag value is missing")) & + ,test_description_t(string_t("flag_value() result is an empty string if command-line flag is missing")) & + ,test_description_t(string_t("argument_present() result is .false. if a command-line argument is missing")) & + ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present")) & + ] + print "(*(a))", new_line(''), & + "----> To test command_line_t, append the following to the fpm test command: -- --test command_line_t --type", new_line('') + else ! run the tests #if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY + test_descriptions = [ & + test_description_t(string_t("flag_value() result is the value passed after a command-line flag"), check_flag_value) & + ,test_description_t(string_t("flag_value() result is an empty string if command-line flag value is missing"), check_flag_value_missing) & + ,test_description_t(string_t("flag_value() result is an empty string if command-line flag is missing"), check_flag_missing) & + ,test_description_t(string_t("argument_present() result is .false. if a command-line argument is missing"), check_argument_missing) & + ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present"), check_argument_present) & + ] +#else + gfortran_work_around: & + block + procedure(diagnosis_function_i), pointer :: & + check_flag_value_ptr => check_flag_value & + ,check_flag_value_missing_ptr => check_flag_value_missing & + ,check_flag_missing_ptr => check_flag_missing & + ,check_argument_missing_ptr => check_argument_missing & + ,check_argument_present_ptr => check_argument_present + test_descriptions = [ & - test_description_t(string_t("flag_value() result is the value passed after a command-line flag"), check_flag_value) & - ,test_description_t(string_t("flag_value() result is an empty string if command-line flag value is missing"), check_flag_value_missing) & - ,test_description_t(string_t("flag_value() result is an empty string if command-line flag is missing"), check_flag_missing) & - ,test_description_t(string_t("argument_present() result is .false. if a command-line argument is missing"), check_argument_missing) & - ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present"), check_argument_present) & + test_description_t(string_t("flag_value() result is the value passed after a command-line flag"), check_flag_value_ptr) & + ,test_description_t(string_t("flag_value() result is an empty string if command-line flag value is missing"), check_flag_value_missing_ptr) & + ,test_description_t(string_t("flag_value() result is an empty string if command-line flag is missing"), check_flag_missing_ptr) & + ,test_description_t(string_t("argument_present() result is .false. if a command-line argument is missing"), check_argument_missing_ptr) & + ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present"), check_argument_present_ptr) & ] -#else - gfortran_work_around: & - block - procedure(diagnosis_function_i), pointer :: & - check_flag_value_ptr => check_flag_value & - ,check_flag_value_missing_ptr => check_flag_value_missing & - ,check_flag_missing_ptr => check_flag_missing & - ,check_argument_missing_ptr => check_argument_missing & - ,check_argument_present_ptr => check_argument_present - - test_descriptions = [ & - test_description_t(string_t("flag_value() result is the value passed after a command-line flag"), check_flag_value_ptr) & - ,test_description_t(string_t("flag_value() result is an empty string if command-line flag value is missing"), check_flag_value_missing_ptr) & - ,test_description_t(string_t("flag_value() result is an empty string if command-line flag is missing"), check_flag_missing_ptr) & - ,test_description_t(string_t("argument_present() result is .false. if a command-line argument is missing"), check_argument_missing_ptr) & - ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present"), check_argument_present_ptr) & - ] - end block gfortran_work_around + end block gfortran_work_around #endif - end if skip_all_tests_if_not_explicitly_requested end if skip_all_tests_if_running_github_ci test_results = test_descriptions%run() From 03a05c81b23997b930bdacac33a1ec24e35ed9ba Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 10 Aug 2025 18:43:42 -0700 Subject: [PATCH 25/33] fix(command_line_test_t): fix output statements --- test/modules/command_line_test_m.F90 | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/test/modules/command_line_test_m.F90 b/test/modules/command_line_test_m.F90 index 30909f3da..7a9e506ee 100644 --- a/test/modules/command_line_test_m.F90 +++ b/test/modules/command_line_test_m.F90 @@ -52,9 +52,11 @@ function results() result(test_results) ,test_description_t(string_t("argument_present() result is .false. if a command-line argument is missing")) & ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present")) & ] - print * - write(*,"(a)") "----> To test command_line_t, append the following to the fpm test command: -- --test command_line_t --type" - print * + print "(*(a))" & + ,new_line('') & + ,"----> Skipping the command_line_t tests in GitHub CI.", new_line('') & + ,"----> To test locally, append the following flags to the 'fpm test' command: -- --test command_line_t --type" & + ,new_line('') else if (.not. command_line%argument_present(["--test"])) then ! skip the tests if not explicitly requested test_descriptions = [ & test_description_t(string_t("flag_value() result is the value passed after a command-line flag")) & @@ -63,8 +65,10 @@ function results() result(test_results) ,test_description_t(string_t("argument_present() result is .false. if a command-line argument is missing")) & ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present")) & ] - print "(*(a))", new_line(''), & - "----> To test command_line_t, append the following to the fpm test command: -- --test command_line_t --type", new_line('') + print "(*(a))" & + ,new_line('') & + ,"-----> To test command_line_t, append the following to the 'fpm test' command: -- --test command_line_t --type" & + ,new_line('') else ! run the tests #if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY test_descriptions = [ & From 06ca10775edb6526242d6337dada3a399014c6d9 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 10 Aug 2025 19:35:26 -0700 Subject: [PATCH 26/33] fix(CI): use legacy-main with GCC version < 14.3.0 --- include/language-support.F90 | 4 ++ test/legacy-main.F90 | 88 ++++++++++++++++++++++++++++++++++++ test/{main.f90 => main.F90} | 4 ++ 3 files changed, 96 insertions(+) create mode 100644 test/legacy-main.F90 rename test/{main.f90 => main.F90} (96%) diff --git a/include/language-support.F90 b/include/language-support.F90 index 9a5d131d4..37e5df9b9 100644 --- a/include/language-support.F90 +++ b/include/language-support.F90 @@ -4,7 +4,11 @@ #ifndef _JULIENNE_LANGUAGE_SUPPORT_H #define _JULIENNE_LANGUAGE_SUPPORT_H +#ifdef __GNUC__ #define GCC_VERSION (__GNUC__ * 10000 + __GNUC_MINOR__ * 100 + __GNUC_PATCHLEVEL__) +#else +#define GCC_VERSION 0 +#endif ! If not already determined, make a compiler-dependent determination of whether Julienne may pass ! procedure actual arguments to procedure pointer dummy arguments, a feature introduced in diff --git a/test/legacy-main.F90 b/test/legacy-main.F90 new file mode 100644 index 000000000..d1244550c --- /dev/null +++ b/test/legacy-main.F90 @@ -0,0 +1,88 @@ +! Copyright (c) 2024-2025, The Regents of the University of California and Sourcery Institute +! Terms of use are as specified in LICENSE.txt + +#include "language-support.F90" + +#if defined(__GCC__) && (GCC_VERSION < 140300) + +program main + !! Julienne unit tests driver + + ! Internal utilities + use julienne_m ,only : command_line_t, GitHub_CI + + ! Test modules + use assert_test_m ,only : assert_test_t + use bin_test_m ,only : bin_test_t + use command_line_test_m ,only : command_line_test_t + use formats_test_m ,only : formats_test_t + use string_test_m ,only : string_test_t + use test_result_test_m ,only : test_result_test_t + use test_description_test_m ,only : test_description_test_t + use test_diagnosis_test_m ,only : test_diagnosis_test_t + use vector_test_description_test_m ,only : vector_test_description_test_t + implicit none + + type(assert_test_t) assert_test + type(bin_test_t) bin_test + type(command_line_test_t) command_line_test + type(formats_test_t) formats_test + type(string_test_t) string_test + type(test_result_test_t) test_result_test + type(test_description_test_t) test_description_test + type(test_diagnosis_test_t) test_diagnosis_test + type(vector_test_description_test_t) vector_test_description_test + + type(command_line_t) command_line + + integer :: passes=0, tests=0, skips=0 + + character(len=*), parameter :: usage = & + new_line('') // new_line('') // & + 'Usage: fpm test -- [--help] | [--contains ]' // & + new_line('') // new_line('') // & + 'where square brackets ([]) denote optional arguments, a pipe (|) separates alternative arguments,' // new_line('') // & + 'angular brackets (<>) denote a user-provided value, and passing a substring limits execution to' // new_line('') // & + 'the tests with test subjects or test descriptions containing the user-specified substring.' // new_line('') + + if (command_line%argument_present([character(len=len("--help"))::"--help","-h"])) stop usage + + print "(a)", new_line("") // "Append '-- --help' or '-- -h' to your `fpm test` command to display usage information." + + call assert_test%report(passes, tests, skips) + call bin_test%report(passes, tests, skips) + call formats_test%report(passes, tests, skips) + call string_test%report(passes, tests, skips) + call test_result_test%report(passes, tests, skips) + call test_description_test%report(passes, tests, skips) + call test_diagnosis_test%report(passes, tests, skips) + call vector_test_description_test%report(passes,tests, skips) + + if (.not. GitHub_CI()) then + if (command_line%argument_present(["--test"])) then + call command_line_test%report(passes, tests, skips) + else + write(*,"(a)") & + new_line("") // & + "To also test Julienne's command_line_t type, append the following to your fpm test command:" // & + new_line("") // & + "-- --test command_line_t --type" + end if + end if + +#if HAVE_MULTI_IMAGE_SUPPORT + if (this_image()==1) then +#endif + + print * + print '(*(a,:,g0))', "_________ In total, ",passes," of ",tests, " tests pass. ", skips, " tests were skipped. _________" + + if (passes + skips /= tests) error stop "Some executed tests failed." + +#if HAVE_MULTI_IMAGE_SUPPORT + end if +#endif + +end program + +#endif diff --git a/test/main.f90 b/test/main.F90 similarity index 96% rename from test/main.f90 rename to test/main.F90 index 11ecb4191..a78c4e0ae 100644 --- a/test/main.f90 +++ b/test/main.F90 @@ -1,6 +1,8 @@ ! Copyright (c) 2024-2025, The Regents of the University of California and Sourcery Institute ! Terms of use are as specified in LICENSE.txt +#if ! defined(__GCC__) || (GCC_VERSION >= 140300) + program test_suite_driver !! Julienne test-suite driver @@ -37,3 +39,5 @@ program test_suite_driver end associate end program + +#endif From 5a5ab9c36d3ff4155b1beb2ff32456ce5cd48210 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 10 Aug 2025 19:43:24 -0700 Subject: [PATCH 27/33] fix(CI): ensure non-empty test-suite main programs --- test/legacy-main.F90 | 6 ++---- test/main.F90 | 7 ++----- 2 files changed, 4 insertions(+), 9 deletions(-) diff --git a/test/legacy-main.F90 b/test/legacy-main.F90 index d1244550c..bdc91cd57 100644 --- a/test/legacy-main.F90 +++ b/test/legacy-main.F90 @@ -3,11 +3,10 @@ #include "language-support.F90" -#if defined(__GCC__) && (GCC_VERSION < 140300) - program main !! Julienne unit tests driver +#if defined(__GCC__) && (GCC_VERSION < 140300) ! Internal utilities use julienne_m ,only : command_line_t, GitHub_CI @@ -83,6 +82,5 @@ program main end if #endif -end program - #endif +end program diff --git a/test/main.F90 b/test/main.F90 index a78c4e0ae..bd4daa043 100644 --- a/test/main.F90 +++ b/test/main.F90 @@ -1,11 +1,10 @@ ! Copyright (c) 2024-2025, The Regents of the University of California and Sourcery Institute ! Terms of use are as specified in LICENSE.txt -#if ! defined(__GCC__) || (GCC_VERSION >= 140300) - program test_suite_driver !! Julienne test-suite driver +#if ! defined(__GCC__) || (GCC_VERSION >= 140300) ! Test infrastructure: use julienne_m, only : test_fixture_t, test_harness_t @@ -37,7 +36,5 @@ program test_suite_driver ])) call test_harness%report_results end associate - -end program - #endif +end program From e049da7b6c0bd5d3909738c2ea305ace2eaf2fac Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 10 Aug 2025 20:18:53 -0700 Subject: [PATCH 28/33] fix(command_line_test): separate ptr decl/def --- test/modules/command_line_test_m.F90 | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/test/modules/command_line_test_m.F90 b/test/modules/command_line_test_m.F90 index 7a9e506ee..c0e891d49 100644 --- a/test/modules/command_line_test_m.F90 +++ b/test/modules/command_line_test_m.F90 @@ -82,11 +82,17 @@ function results() result(test_results) gfortran_work_around: & block procedure(diagnosis_function_i), pointer :: & - check_flag_value_ptr => check_flag_value & - ,check_flag_value_missing_ptr => check_flag_value_missing & - ,check_flag_missing_ptr => check_flag_missing & - ,check_argument_missing_ptr => check_argument_missing & - ,check_argument_present_ptr => check_argument_present + check_flag_value_ptr & + ,check_flag_value_missing_ptr & + ,check_flag_missing_ptr & + ,check_argument_missing_ptr & + ,check_argument_present_ptr + + check_flag_value_ptr => check_flag_value + check_flag_value_missing_ptr => check_flag_value_missing + check_flag_missing_ptr => check_flag_missing + check_argument_missing_ptr => check_argument_missing + check_argument_present_ptr => check_argument_present test_descriptions = [ & test_description_t(string_t("flag_value() result is the value passed after a command-line flag"), check_flag_value_ptr) & From 0c9dd15e880dfdb6b447dd1c04b10a27453911ac Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 10 Aug 2025 20:23:19 -0700 Subject: [PATCH 29/33] fix(command_line_test): gfoetran 12 workaround move pointer declarations & definitions outside a block construct --- test/modules/command_line_test_m.F90 | 44 +++++++++++++--------------- 1 file changed, 21 insertions(+), 23 deletions(-) diff --git a/test/modules/command_line_test_m.F90 b/test/modules/command_line_test_m.F90 index c0e891d49..172cfedbd 100644 --- a/test/modules/command_line_test_m.F90 +++ b/test/modules/command_line_test_m.F90 @@ -42,6 +42,20 @@ function results() result(test_results) type(test_result_t), allocatable :: test_results(:) type(test_description_t), allocatable :: test_descriptions(:) type(command_line_t) command_line +#if ! HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY + procedure(diagnosis_function_i), pointer :: & + check_flag_value_ptr & + ,check_flag_value_missing_ptr & + ,check_flag_missing_ptr & + ,check_argument_missing_ptr & + ,check_argument_present_ptr + + check_flag_value_ptr => check_flag_value + check_flag_value_missing_ptr => check_flag_value_missing + check_flag_missing_ptr => check_flag_missing + check_argument_missing_ptr => check_argument_missing + check_argument_present_ptr => check_argument_present +#endif skip_all_tests_if_running_github_ci: & if (GitHub_CI()) then @@ -79,29 +93,13 @@ function results() result(test_results) ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present"), check_argument_present) & ] #else - gfortran_work_around: & - block - procedure(diagnosis_function_i), pointer :: & - check_flag_value_ptr & - ,check_flag_value_missing_ptr & - ,check_flag_missing_ptr & - ,check_argument_missing_ptr & - ,check_argument_present_ptr - - check_flag_value_ptr => check_flag_value - check_flag_value_missing_ptr => check_flag_value_missing - check_flag_missing_ptr => check_flag_missing - check_argument_missing_ptr => check_argument_missing - check_argument_present_ptr => check_argument_present - - test_descriptions = [ & - test_description_t(string_t("flag_value() result is the value passed after a command-line flag"), check_flag_value_ptr) & - ,test_description_t(string_t("flag_value() result is an empty string if command-line flag value is missing"), check_flag_value_missing_ptr) & - ,test_description_t(string_t("flag_value() result is an empty string if command-line flag is missing"), check_flag_missing_ptr) & - ,test_description_t(string_t("argument_present() result is .false. if a command-line argument is missing"), check_argument_missing_ptr) & - ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present"), check_argument_present_ptr) & - ] - end block gfortran_work_around + test_descriptions = [ & + test_description_t(string_t("flag_value() result is the value passed after a command-line flag"), check_flag_value_ptr) & + ,test_description_t(string_t("flag_value() result is an empty string if command-line flag value is missing"), check_flag_value_missing_ptr) & + ,test_description_t(string_t("flag_value() result is an empty string if command-line flag is missing"), check_flag_missing_ptr) & + ,test_description_t(string_t("argument_present() result is .false. if a command-line argument is missing"), check_argument_missing_ptr) & + ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present"), check_argument_present_ptr) & + ] #endif end if skip_all_tests_if_running_github_ci From c94c0cf51e3647e3656291832da1f23fa0da21a3 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 10 Aug 2025 21:46:15 -0700 Subject: [PATCH 30/33] doc(README): add example of operator(.expect.) also delete redundant example --- README.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index 9fb3ad678..c50491a41 100644 --- a/README.md +++ b/README.md @@ -24,12 +24,13 @@ Example expressions | Operand types `(i .lessThan. j) .also. (k .equalsExpected. m))` | `integer`, `real`, `double precision` `x .lessThan. y` | `integer`, `real`, `double precision` `x .greaterThan. y` | `integer`, `real`, `double precision` -`i .greaterThan. j` | `integer`, `real`, `double precision` `i .equalsExpected. j` | `integer`, `character` `i .isAtLeast. j` | `integer`, `real`, `double precision` `i .isAtMost. j` | `integer`, `real`, `double precision` `s .isBefore. t` | `character` `s .isAfter. t` | `character` +`.expect. command_line%argument_present("--help")`| `logical` + where `.isAtLeast.` and `.isAtMost.` can alternatively be spelled `.greaterThanOrEqualTo.` and `.lessThanOrEqualTo.`, respectively; From d268f93366c3c6cd186a0598e0538ccb876fc2bc Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 10 Aug 2025 23:27:17 -0700 Subject: [PATCH 31/33] doc(demo): refactor driver using test harness --- demo/fpm.toml | 2 +- demo/include/language-support.F90 | 38 ----------------------- demo/test/main.F90 | 51 ------------------------------- demo/test/main.f90 | 41 +++++++++++++++++++++++++ demo/test/specimen_test_m.F90 | 43 +++----------------------- 5 files changed, 46 insertions(+), 129 deletions(-) delete mode 100644 demo/include/language-support.F90 delete mode 100644 demo/test/main.F90 create mode 100644 demo/test/main.f90 diff --git a/demo/fpm.toml b/demo/fpm.toml index 9bebbc833..97d45a379 100644 --- a/demo/fpm.toml +++ b/demo/fpm.toml @@ -1,4 +1,4 @@ name = "Example-Test-Suite" [dependencies] -julienne = {git = "https://github.com/berkeleylab/julienne", tag = "2.1.0-rc5"} +julienne = {path = "../"} diff --git a/demo/include/language-support.F90 b/demo/include/language-support.F90 deleted file mode 100644 index d27c70243..000000000 --- a/demo/include/language-support.F90 +++ /dev/null @@ -1,38 +0,0 @@ -! Copyright (c) 2024-2025, The Regents of the University of California -! Terms of use are as specified in LICENSE.txt - -#ifndef _JULIENNE_LANGUAGE_SUPPORT_H -#define _JULIENNE_LANGUAGE_SUPPORT_H - -! If not already determined, make a compiler-dependent determination of whether Julienne may pass -! procedure actual arguments to procedure pointer dummy arguments, a feature introduced in -! Fortran 2008 and described in Fortran 2023 clause 15.5.2.10 paragraph 5. -#ifndef HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY -# if defined(__GFORTRAN__) -# define HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY 0 -# else -# define HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY 1 -# endif -#endif - -! If not already determined, make a compiler-dependent determination of whether Julienne may use -! multi-image features such as `this_image()` and `sync all`. -#ifndef HAVE_MULTI_IMAGE_SUPPORT -# if defined(__flang__) -# define HAVE_MULTI_IMAGE_SUPPORT 0 -# else -# define HAVE_MULTI_IMAGE_SUPPORT 1 -# endif -#endif - -! If not already determined, make a compiler-dependent determination of whether Julienne may use -! kind type parameters for derived types. -#ifndef HAVE_DERIVED_TYPE_KIND_PARAMETERS -# if defined(__GFORTRAN__) -# define HAVE_DERIVED_TYPE_KIND_PARAMETERS 0 -# else -# define HAVE_DERIVED_TYPE_KIND_PARAMETERS 1 -# endif -#endif - -#endif diff --git a/demo/test/main.F90 b/demo/test/main.F90 deleted file mode 100644 index b5ef45de9..000000000 --- a/demo/test/main.F90 +++ /dev/null @@ -1,51 +0,0 @@ -! Copyright (c) 2024-2025, The Regents of the University of California and Sourcery Institute -! Terms of use are as specified in LICENSE.txt - -#include "language-support.F90" - -program main - !! Example test main program to demonstrate the printing of diagnostic output when a test fails - use julienne_m, only : command_line_t - use specimen_test_m, only : specimen_test_t - implicit none - - type(specimen_test_t) specimen_test - integer :: passes=0, tests=0, skips=0 - - call print_usage_and_stop_if_help_requested - call specimen_test%report(passes, tests, skips) - call report_tally_and_error_stop_if_test_fails - -contains - - subroutine print_usage_and_stop_if_help_requested - type(command_line_t) command_line - if (command_line%argument_present([character(len=len("--help"))::"--help","-h"])) then - print * - print '(a)', 'Usage: fpm run --example main -- [--help] | [--contains ]' - print * - print '(a)', 'where square brackets ([]) denote optional arguments, a pipe (|) separates alternative arguments,' - print '(a)', 'angular brackets (<>) denote a user-provided value, and passing a substring limits execution to' - print '(a)', 'the tests with test subjects or test descriptions containing the user-specified substring.' - stop - else - print * - print "(a)", "Append '-- --help' or '-- -h' to your `fpm test` command to display usage information." - end if - end subroutine - - subroutine report_tally_and_error_stop_if_test_fails - -#if HAVE_MULTI_IMAGE_SUPPORT - if (this_image()==1) then -#endif - print * - print '(*(a,:,g0))', "_________ In total, ",passes," of ",tests, " tests pass. ", skips , " tests were skipped _________" - if (passes /= tests) error stop "Some tests failed." -#if HAVE_MULTI_IMAGE_SUPPORT - end if -#endif - - end subroutine - -end program diff --git a/demo/test/main.f90 b/demo/test/main.f90 new file mode 100644 index 000000000..8278b46b9 --- /dev/null +++ b/demo/test/main.f90 @@ -0,0 +1,41 @@ +! Copyright (c) 2024-2025, The Regents of the University of California and Sourcery Institute +! Terms of use are as specified in LICENSE.txt + +program test_suite_driver + !! Example test-suite driver + use julienne_m ,only : test_fixture_t, test_harness_t ! Import test infrastructure + use specimen_test_m ,only : specimen_test_t ! Must be a non-abstract child type extending Julienne's test_t type + use iso_fortran_env ,only : compiler_version + implicit none + + call stop_if_compiler_too_old + + ! Construct a test harness from an array of test fixtures, each of which is + ! constructed from a structure constructor for a type that extends test_t. + associate(test_harness => test_harness_t( [ test_fixture_t(specimen_test_t()) ] )) + call test_harness%report_results + end associate + +contains + subroutine stop_if_compiler_too_old + character(len=:), allocatable :: compiler_identity + integer major, minor + compiler_identity = compiler_version() + if (index(compiler_identity, "GCC")==1) then + associate( final_dot => index(compiler_identity ,"." ,back=.true.)) + associate( penultimate_dot => index(compiler_identity(:final_dot-1) ,"." ,back=.true.)) + associate(space_before_version => index(compiler_identity(:penultimate_dot-1) ," " ,back=.true.)) + associate( & + major_string => compiler_identity(space_before_version+1 : penultimate_dot-1) & + ,minor_string => compiler_identity( penultimate_dot+1 : final_dot-1) & + ) + read(major_string, '(i2)') major + read(minor_string, '(i1)') minor + if ((major < 14) .or. (major==14 .and. minor<3)) stop "'"// compiler_identity //"' too old: GCC >= 14.3.0 required" + end associate + end associate + end associate + end associate + end if + end subroutine +end program diff --git a/demo/test/specimen_test_m.F90 b/demo/test/specimen_test_m.F90 index 9cfb923b7..3624da1ed 100644 --- a/demo/test/specimen_test_m.F90 +++ b/demo/test/specimen_test_m.F90 @@ -1,8 +1,6 @@ ! Copyright (c) 2024-2025, The Regents of the University of California and Sourcery Institute ! Terms of use are as specified in LICENSE.txt -#include "language-support.F90" - module specimen_test_m !! Example unit test for the specimen_t test subject use specimen_m, only : specimen_t @@ -17,11 +15,8 @@ module specimen_test_m ,operator(.within.) & ,operator(.all.) & ,operator(.equalsExpected.) & - ,operator(.greaterThan.) & - ,operator(.lessThan.) -#if defined(__GFORTRAN__) - use julienne_m, only : diagnosis_function_i ! work around gfortran's missing Fortran 2008 feature -#endif + ,operator(.lessThan.) & + ,operator(.isAtMost.) implicit none @@ -41,8 +36,6 @@ pure function subject() result(specimen_description) specimen_description = "A specimen_t object" end function -#if ! defined(__GFORTRAN__) - function results() result(test_results) type(test_result_t), allocatable :: test_results(:) type(test_description_t), allocatable :: test_descriptions(:) @@ -61,35 +54,6 @@ function results() result(test_results) test_results = test_descriptions%run() end function -#else - - function results() result(test_results) - !! work around missing Fortran 2008 feature in gfortran versions earlier than 15 - type(test_result_t), allocatable :: test_results(:) - type(test_description_t), allocatable :: test_descriptions(:) - procedure(diagnosis_function_i), pointer :: check_operators_ptr => check_zero_using_operators - procedure(diagnosis_function_i), pointer :: check_constructor_ptr => check_zero_using_constructor - procedure(diagnosis_function_i), pointer :: check_aggregate_ptr => check_aggregate_diagnosis - procedure(diagnosis_function_i), pointer :: check_print_diagnosis_ptr => check_print_diagnosis - - ! Omitting the optional 2nd argument in the 3rd test_description_t constructor below skips the described - ! test. When the test suite runs, it reports the test as skipped and reports a tally of skippped tests. - - test_descriptions = [ & - test_description_t("diagnosing the zero function using Julienne operators", check_operators_ptr) & - ,test_description_t("diagnosing the zero function using a diagnosis constructor", check_constructor_ptr) & - ,test_description_t("aggregating diagnoses of the zero and one functions using operator(.all.)") & - ,test_description_t("(intentional failure to demonstrate diagnostic output)", check_print_diagnosis_ptr) & - ,test_description_t("skipping a test when no diagnosis function is specified") & - ] - test_descriptions = pack( & - array = test_descriptions & - ,mask = test_descriptions%contains_text(test_description_substring) .or. index(subject(), test_description_substring)/=0 & - ) - test_results = test_descriptions%run() - end function -#endif - function check_zero_using_operators() result(test_diagnosis) !! Construct a test diagnosis using Julienne's operator(.approximates.) and operator(.within.) type(test_diagnosis_t) test_diagnosis @@ -123,8 +87,9 @@ function check_aggregate_diagnosis() result(test_diagnosis) end function function check_print_diagnosis() result(test_diagnosis) + !! Intentional test failure to demonstrate diagnostic output type(test_diagnosis_t) test_diagnosis - test_diagnosis = 2 .lessThan. 1 ! intentional test failure + test_diagnosis = 2 .isAtMost. 1 end function end module \ No newline at end of file From f49a117ca1bba403c4e62ffe8b54e98b31d6c11e Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 10 Aug 2025 23:38:08 -0700 Subject: [PATCH 32/33] doc(demo): update README.md Also switch file to lower-case .f90 extension because the preprocessor is no longer needed. --- demo/README.md | 37 ++++++++----------- ...pecimen_test_m.F90 => specimen_test_m.f90} | 0 2 files changed, 16 insertions(+), 21 deletions(-) rename demo/test/{specimen_test_m.F90 => specimen_test_m.f90} (100%) diff --git a/demo/README.md b/demo/README.md index 4d82c8baa..82dcccf18 100644 --- a/demo/README.md +++ b/demo/README.md @@ -1,38 +1,36 @@ Getting Started =============== To get started with Julienne, review and test the demonstration project in this directory. -Then copy the `main.F90` and `specimen_test_m.F90` files to your project's test directory. +Then copy the `main.f90` and `specimen_test_m.f90` files to your project's test directory. Finally, modify the files as described below to adapt them to your project. Testing the Demonstration Project -------------------------------- This demonstration project defines a trivial library named "specimen" in the `src` -subdirectory and a test suite the `test` subdirectory. The test suite includes five tests: +subdirectory and a test suite in the `test` subdirectory. The test suite includes five tests: -1. Two tests pass. +1. Three tests pass. 2. One test intentionally fails to demonstrate diagnostic output. 3. One test is skipped to demonstrate the reporting and tallying of skipped tests. -4. One test passes with three compilers but is skipped with GCC due to a compiler bug. Test Julienne by setting your present working directory to the `demo/` subdirectory in a terminal window and then building and running the demonstration project's test suite using the command corresponding to your compiler in the table below. -|Vendor | Version/Build | Example shell command | -|---------|-------------------------|------------------------------------------------------------------------------------| -|LLVM | 20.1.4 (Homebrew) | `fpm test --compiler flang-new` | -|GCC | 14.2.0_1 (Homebrew) | `fpm test --compiler gfortran --profile release` | -|GCC | 13.3.0_1 (Homebrew) | `fpm test --compiler gfortran --profile release --flag "-ffree-line-length-0"` | -|NAG | 7.2 Build 7227 | `fpm test --compiler nagfor --flag -fpp` | -|Intel | 2025.1.0 Build 20250317 | `fpm test --compiler ifx --flag "-fpp -O3 -coarray"` | +|Vendor | Version/Build Tested | Example shell command | +|---------|-------------------------|------------------------------------------------------| +|LLVM | 20.1.4 | `fpm test --compiler flang-new` | +|GCC | 14.3.0 | `fpm test --compiler gfortran --profile release` | +|NAG | 7.2 Build 7235 | `fpm test --compiler nagfor --flag -fpp` | +|Intel | 2025.1.0 Build 20250317 | `fpm test --compiler ifx --flag "-fpp -O3 -coarray"` | Setting Up Your Project's Test Suite ------------------------------------ -1. If you build your project with the Fortran Package Manager ([`fpm`](https://github.com/fotran-lang/fpm)), then you might copy the `main.F90` and `specimen_test_m.F90` files from this subdirectory to a `test/` subdirectory in the root of your project's source tree. -2. Rename the `specimen_test_m.F90` file, the `specimen_test_m` module, and the `specimen_test_t` derived type and any references thereto, replacing `specimen` with the name of an entity that you intend to test -- most likely a module containing procedures or derived type with type-bound procedures. -3. Similarly replace occurrences of `specimen` in the resulting`test/main.F90` file. -4. In the `results()` function body of your new `*_test_m.F90` file, replace the `test_descriptions_t` array constructor elements with your own test descriptions. The test output will read most naturally if your description string (the first argument) contains a gerund: a verb ending in "ing" and used as a noun, such as `producing` above +1. If you build your project with the Fortran Package Manager ([`fpm`](https://github.com/fotran-lang/fpm)), then you might copy the `main.f90` and `specimen_test_m.f90` files from this subdirectory to a `test/` subdirectory in the root of your project's source tree. +2. Rename the `specimen_test_m.f90` file, the `specimen_test_m` module, and the `specimen_test_t` derived type and any references thereto, replacing `specimen` with the name of an entity that you intend to test -- most likely a module containing procedures or derived type with type-bound procedures. +3. Similarly replace occurrences of `specimen` in the resulting`test/main.f90` file. +4. In the `results()` function body of your new `*_test_m.f90` file, replace the `test_descriptions_t` array constructor elements with your own test descriptions. The test output will read most naturally if your description string (the first argument) contains a gerund: a verb ending in "ing" and used as a noun, such as `producing` above. 5. Replace the function name (the second argument) with the name of a function that will perform your test. 7. Edit the correspondingly-renamed function to perform the test. The function must take no arguments and define a `test_diagnosis_t` result. @@ -43,7 +41,7 @@ The options include 2. Invoking the `test_diagnosis_t` constructor and using Julienne's `string_t` constructors to form a diagnostic string. `String_t` is a generic interface to various specific functions, each of which takes an argument of a different data type, kind, and rank (TKR) and defines a `string_t` result containing a charater representation of the function argument. -Please see Julienne's online [documentation] for the currently supported TKR. +Please see Julienne's online [documentation](https://berkeleylab.github.io/julienne) for the currently supported TKR. Please submit an issue to request support for additional TKR or submit a pull request to contribute such support. #### Forming diagnostic strings from array data @@ -127,7 +125,7 @@ One might accomplish this with the compiler's predefined preprocessor macro: ,test_description_t('constructing bracketed strings' ) & #endif ``` -which presently appears in Julienne `test/string_test_m.F90` test in order to work around a runtime crash known to be caused by a `gfortran` bug. +which presently appears in Julienne `test/string_test_m.f90` test in order to work around a runtime crash known to be caused by a `gfortran` bug. String_t Functions ------------------ @@ -167,7 +165,7 @@ Deprecated: Vector Diagnosis Function Julienne's `vector_diagnosis_function_i` abstract interface and the corresponding `vector_test_description_t` type were developed before Julienne's `operator(.all.)` and `operator(.and.)`. Because the operators replace the interface and type with simpler functionality, it is likely that a future release will remove the `vector_*` entities. -The Unified Modeling Language ([UML]) class diagram below depicts the class relationships involved when test function performs multiple checks and defines a result containing an array of corresponding `test_diagnosis_t` objects: +The Unified Modeling Language ([UML](https://wikipedia.org/Unified_modeling_language)) class diagram below depicts the class relationships involved when test function performs multiple checks and defines a result containing an array of corresponding `test_diagnosis_t` objects: ```mermaid %%{init: { 'theme':'default', "class" : {"hideEmptyMembersBox": true} } }%% classDiagram @@ -187,6 +185,3 @@ class test_diagnosis_t{ test_diagnosis_t(test_passed : logical, diagnostics_string : string_t) } ``` - -[documentation]: https://berkeleylab.github.io/julienne -[UML]: https://wikipedia.org/Unified_modeling_language diff --git a/demo/test/specimen_test_m.F90 b/demo/test/specimen_test_m.f90 similarity index 100% rename from demo/test/specimen_test_m.F90 rename to demo/test/specimen_test_m.f90 From 0d34d8cb408d6a7cb992c706b060187f5e0a9433 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 10 Aug 2025 23:40:24 -0700 Subject: [PATCH 33/33] chore: use .f90 file extension --- demo/src/{specimen_m.F90 => specimen_m.f90} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename demo/src/{specimen_m.F90 => specimen_m.f90} (100%) diff --git a/demo/src/specimen_m.F90 b/demo/src/specimen_m.f90 similarity index 100% rename from demo/src/specimen_m.F90 rename to demo/src/specimen_m.f90