diff --git a/.github/workflows/build-with-flang.yml b/.github/workflows/build-with-flang.yml index 2dab8dd78..07ee2f212 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] @@ -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/CI.yml b/.github/workflows/build-with-gfortran.yml similarity index 62% rename from .github/workflows/CI.yml rename to .github/workflows/build-with-gfortran.yml index fea4ae1a9..777cf9350 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] @@ -8,6 +8,10 @@ jobs: strategy: matrix: os: [macos-13, ubuntu-24.04] + fail-fast: true + env: + FC: gfortran-14 + CXX: g++-14 steps: - name: Checkout code @@ -21,8 +25,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 diff --git a/README.md b/README.md index 9fb3ad678..485b10d10 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; @@ -250,12 +251,10 @@ GCC `gfortran` | 13, 14, 15 | see 1 below Intel `ifx` | 2025.1.1 Build 20250418 | see 2 below 1. `gfortran` issues: - - With GCC 14 or earlier, the `test_description_t` constructor's + - With GCC 14.2.0 or earlier, the `test_description_t` constructor's `diagnosis_function` actual argument must be a procedure pointer conforming conforming with the `diagnosis_function_i` abstract interface. - - The `string_t` `bracket` type-bound function crashes for GCC 14 or earlier. - - _Deprecated feature_: Each element of a [`vector_test_description_t`] array - must be defined in a separate statement. + - The `string_t` `bracket` type-bound function crashes for GCC 14.2.0 or earlier. 2. `ifx` issue: - Two `string_t` tests fail as described in issue [#51]. @@ -316,5 +315,4 @@ See our online [documentation] or build the documentation locally by installing [Garden]: https://gitlab.com/everythingfunctional/garden [handy-dandy]: https://github.com/rouson/handy-dandy/blob/7caaa4dc3d6e5331914a3025f0cb1db5ac1a886f/src/fresh-llvm-build.sh [Sourcery]: https://github.com/sourceryinstitute/sourcery -[`vector_test_diagnosis_i`]: https://github.com/BerkeleyLab/julienne/blob/37bcc959efa8f9e27ae50fecfd37a6bf52ef0a43/src/julienne/julienne_vector_test_description_m.F90#L18 [Veggies]: https://gitlab.com/everythingfunctional/veggies diff --git a/demo/README.md b/demo/README.md index 4d82c8baa..98ada1db6 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 @@ -117,7 +115,7 @@ Skipping Tests -------------- When a test is known to cause a compile-time or runtime crash in a specific scenario, e.g., with a specific compiler or compiler version, including that test will prevent the test suite from building or running to completion. It can be useful to skip a test with the problematic compiler but to report the test as skipped and account for the skipped tests in the tally of test results. -For this purpose, the `test_description_t` and `vector_test_description_t` constructor functions have optional second arguments `diagnosis_function` and `vector_diagnosis_function`, respectively. +For this purpose, the `test_description_t` constructor function has a `diagnosis_function` argument that is optional. When these arguments are not `present`, the `test_t`'s `report` procedure will report the test as skipped but will terminate normally as long as the sum of the passing tests and skipped tests equals the total number of tests. One might accomplish this with the compiler's predefined preprocessor macro: ``` @@ -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 ------------------ @@ -161,32 +159,3 @@ class string_t{ base_name(string_t) string_t } ``` - -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: -```mermaid - %%{init: { 'theme':'default', "class" : {"hideEmptyMembersBox": true} } }%% -classDiagram - -class vector_test_description_t{ - vector_test_description_t(description : string_t[1..*], vector_diagnosis_function : vector_diagnosis_function_i) - run() test_result_t[1..*] -} -vector_test_description_t --> test_diagnosis_t : run() invokes vector_diagnosis_function to construct array of -vector_test_description_t --> test_result_t : run() uses test_diagnostics_t array to construct array of - -class test_result_t{ - test_result_t(test_passed : logical, diagnosis : test_diagnosis_t) -} - -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/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/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 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 similarity index 64% rename from demo/test/specimen_test_m.F90 rename to 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 diff --git a/doc/uml/class-diagram.md b/doc/uml/class-diagram.md index 38cd15f56..a52af8670 100644 --- a/doc/uml/class-diagram.md +++ b/doc/uml/class-diagram.md @@ -5,7 +5,6 @@ classDiagram test_t --> test_result_t : produces test_description_t --> test_diagnosis_t : "'run' uses to construct test_result_t" -vector_test_description_t --> test_diagnosis_t : "'run' uses to construct test_result_t array" test_result_t --> test_diagnosis_t : "accepts as constructor argument" class test_t{ @@ -54,10 +53,3 @@ class test_description_t{ + contains_text(string_t) logical + operator(==) logical } - -class vector_test_description_t{ - + vector_test_description_t(description : string_t, vector_diagnosis_function : procedure(vector_diagnosis_function_i)) test_description_t - + run() test_result_t - + contains_text(character) logical - + contains_text(string_t) logical -} diff --git a/include/language-support.F90 b/include/language-support.F90 index f71dd6c2e..37e5df9b9 100644 --- a/include/language-support.F90 +++ b/include/language-support.F90 @@ -4,16 +4,21 @@ #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 ! 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 +#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 diff --git a/src/julienne/julienne_test_description_m.f90 b/src/julienne/julienne_test_description_m.f90 index 29deb2d16..36c405502 100644 --- a/src/julienne/julienne_test_description_m.f90 +++ b/src/julienne/julienne_test_description_m.f90 @@ -10,6 +10,7 @@ module julienne_test_description_m private public :: test_description_t + public :: filter public :: diagnosis_function_i abstract interface @@ -87,6 +88,15 @@ elemental module function equals(lhs, rhs) result(lhs_eq_rhs) logical lhs_eq_rhs end function + module function filter(test_descriptions, subject) result(filtered_descriptions) + !! The result is an array of test descriptions for which the command-line "--contains" flag value + !! is a substring of the test "subject" or the description_ component. + implicit none + class(test_description_t), intent(in) :: test_descriptions(:) + character(len=*), intent(in) :: subject + type(test_description_t), allocatable :: filtered_descriptions(:) + end function + end interface end module julienne_test_description_m diff --git a/src/julienne/julienne_test_description_s.F90 b/src/julienne/julienne_test_description_s.F90 index 5f0ed2328..277c8f996 100644 --- a/src/julienne/julienne_test_description_s.F90 +++ b/src/julienne/julienne_test_description_s.F90 @@ -7,9 +7,23 @@ submodule(julienne_test_description_m) julienne_test_description_s use assert_m use julienne_m, only : call_julienne_assert_ + use julienne_command_line_m, only : command_line_t implicit none contains + module procedure filter + + type(command_line_t) command_line + + associate(search_string => command_line%flag_value("--contains")) + filtered_descriptions = pack( & + array = test_descriptions & + , mask = index(subject, search_string) /= 0 .or. test_descriptions%contains_text(search_string) & + ) + end associate + + end procedure + module procedure construct_from_characters test_description%description_ = description if (present(diagnosis_function)) test_description%diagnosis_function_ => diagnosis_function 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/julienne_test_fixture_m.f90 b/src/julienne/julienne_test_fixture_m.f90 new file mode 100644 index 000000000..5809af8f7 --- /dev/null +++ b/src/julienne/julienne_test_fixture_m.f90 @@ -0,0 +1,43 @@ +! 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 + private + 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) :: 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..402556ab8 --- /dev/null +++ b/src/julienne/julienne_test_harness_m.f90 @@ -0,0 +1,43 @@ +! 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 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 + + private + public :: test_harness_t + + type test_harness_t + !! Encapsulate a set of test fixtures, each of which can run a set of tests. + private + type(test_fixture_t), allocatable :: test_fixture_(:) + contains + procedure report_results + end type + + interface test_harness_t + + module function component_constructor(test_fixtures) result(test_harness) ! can be pure in Fortran 2028 + !! Component-wise user-defined structure constructor + class(test_fixture_t) test_fixtures(:) + type(test_harness_t) test_harness + end function + + end interface + + interface + + 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 + 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..de1ddacfc --- /dev/null +++ b/src/julienne/julienne_test_harness_s.F90 @@ -0,0 +1,54 @@ +! 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 + use julienne_command_line_m, only : command_line_t + implicit none + +contains + + module procedure component_constructor + test_harness%test_fixture_ = test_fixtures + end procedure + + module procedure report_results + + call print_usage_info_and_stop_if_requested + + block + 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 + + 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 + + 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 diff --git a/src/julienne/julienne_test_m.F90 b/src/julienne/julienne_test_m.F90 index a16ff3a0a..71da14864 100644 --- a/src/julienne/julienne_test_m.F90 +++ b/src/julienne/julienne_test_m.F90 @@ -14,9 +14,7 @@ module julienne_test_m implicit none private - public :: test_t, test_description_substring - - character(len=:), allocatable, protected :: test_description_substring + public :: test_t type, abstract :: test_t !! Facilitate testing and test reporting diff --git a/src/julienne/julienne_test_s.F90 b/src/julienne/julienne_test_s.F90 index 7539f61f8..bf7fb2791 100644 --- a/src/julienne/julienne_test_s.F90 +++ b/src/julienne/julienne_test_s.F90 @@ -10,7 +10,8 @@ module procedure report - logical do_first_report + logical, save :: do_first_report = .true. + type(command_line_t) command_line #if HAVE_MULTI_IMAGE_SUPPORT associate(me => this_image()) @@ -18,28 +19,20 @@ integer me me = 1 #endif - - do_first_report = .false. - - if (.not. allocated(test_description_substring)) then - block - type(command_line_t) command_line - test_description_substring = command_line%flag_value("--contains") - do_first_report = .true. - end block - end if - if (me==1) then first_report: & if (do_first_report) then - print * - if (len(test_description_substring)==0) then - print '(a)',"Running all tests." - print '(a)',"(Add '-- --contains ' to run only tests with subjects or descriptions containing the specified string.)" - else - print '(*(a))',"Running only tests with subjects or descriptions containing '", test_description_substring,"'." - end if + do_first_report = .false. + associate(search_string => command_line%flag_value("--contains")) + if (len(search_string)==0) then + print * + print '(a)',"Running all tests." + print '(a)',"(Add '-- --contains ' to run only tests with subjects or descriptions containing the specified string.)" + else + print '(*(a))',"Running only tests with subjects or descriptions containing '", search_string, "'." + end if + end associate end if first_report print '(*(a))', new_line('a'), test%subject() diff --git a/src/julienne/julienne_vector_test_description_m.F90 b/src/julienne/julienne_vector_test_description_m.F90 deleted file mode 100644 index 4d3da0a7a..000000000 --- a/src/julienne/julienne_vector_test_description_m.F90 +++ /dev/null @@ -1,75 +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 - -module julienne_vector_test_description_m - !! Define an abstraction for describing test intentions and array-valued test functions - use julienne_string_m, only : string_t - use julienne_test_result_m, only : test_result_t - use julienne_test_diagnosis_m, only : test_diagnosis_t - implicit none - - private - public :: vector_test_description_t - public :: vector_diagnosis_function_i -#ifdef __GFORTRAN__ - public :: run -#endif - - abstract interface - function vector_diagnosis_function_i() result(diagnoses) - import test_diagnosis_t - implicit none - type(test_diagnosis_t), allocatable :: diagnoses(:) - end function - end interface - - type vector_test_description_t - private - type(string_t), allocatable :: descriptions_(:) - procedure(vector_diagnosis_function_i), pointer, nopass :: vector_diagnosis_function_ => null() - contains - procedure run - generic :: contains_text => contains_string_t, contains_characters - procedure, private:: contains_string_t, contains_characters - end type - - interface vector_test_description_t - - module function construct_from_strings(descriptions, vector_diagnosis_function) result(vector_test_description) - !! The result is a vector_test_description_t object with the components defined by the dummy arguments - implicit none - type(string_t), intent(in) :: descriptions(:) - procedure(vector_diagnosis_function_i), intent(in), pointer, optional :: vector_diagnosis_function - type(vector_test_description_t) vector_test_description - end function - - end interface - - interface - - impure module function run(self) result(test_results) - !! The result encapsulates the test description and test outcome - implicit none - class(vector_test_description_t), intent(in) :: self - type(test_result_t), allocatable :: test_results(:) - end function - - module function contains_characters(self, substring) result(match_vector) - !! The result is .true. if the test description includes the value of substring - implicit none - class(vector_test_description_t), intent(in) :: self - character(len=*), intent(in) :: substring - logical, allocatable :: match_vector(:) - end function - - module function contains_string_t(self, substring) result(match_vector) - !! The result is .true. if the test description includes the value of substring%string() - implicit none - class(vector_test_description_t), intent(in) :: self - type(string_t), intent(in) :: substring - logical, allocatable :: match_vector(:) - end function - - end interface - -end module julienne_vector_test_description_m diff --git a/src/julienne/julienne_vector_test_description_s.F90 b/src/julienne/julienne_vector_test_description_s.F90 deleted file mode 100644 index 307593f14..000000000 --- a/src/julienne/julienne_vector_test_description_s.F90 +++ /dev/null @@ -1,58 +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 "julienne-assert-macros.h" -#include "assert_macros.h" - -submodule(julienne_vector_test_description_m) julienne_vector_test_description_s - use julienne_m, only : call_julienne_assert_, operator(.equalsExpected.) - use assert_m - implicit none - -contains - - module procedure contains_characters - integer i - call_assert(allocated(self%descriptions_)) - match_vector = [(index(self%descriptions_(i)%string(), substring) /= 0, i = 1, size(self%descriptions_))] - end procedure - - module procedure contains_string_t - match_vector = self%contains_characters(substring%string()) - end procedure - -#ifndef __GFORTRAN__ - - module procedure construct_from_strings - vector_test_description%descriptions_ = descriptions - vector_test_description%vector_diagnosis_function_ => vector_diagnosis_function - end procedure - -#else - - module function construct_from_strings(descriptions, vector_diagnosis_function) result(vector_test_description) - type(string_t), intent(in) :: descriptions(:) - procedure(vector_diagnosis_function_i), intent(in), pointer, optional :: vector_diagnosis_function - type(vector_test_description_t) vector_test_description - vector_test_description%descriptions_ = descriptions - if (present(vector_diagnosis_function)) vector_test_description%vector_diagnosis_function_ => vector_diagnosis_function - end function - -#endif - - module procedure run - if (.not. associated(self%vector_diagnosis_function_)) then - test_results = test_result_t(self%descriptions_) - else - associate(diagnoses => self%vector_diagnosis_function_()) -#if defined(ASSERTIONS) - associate(num_descriptions => size(self%descriptions_), num_results => size(diagnoses)) - call_julienne_assert(num_descriptions .equalsExpected. num_results) - end associate -#endif - test_results = test_result_t(self%descriptions_, diagnoses) - end associate - end if - end procedure - -end submodule julienne_vector_test_description_s diff --git a/src/julienne_m.f90 b/src/julienne_m.f90 index 1540f6556..e7a0cf321 100644 --- a/src/julienne_m.f90 +++ b/src/julienne_m.f90 @@ -9,21 +9,19 @@ 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, filter + use julienne_test_diagnosis_m, only : test_diagnosis_t & ,operator(.all.) & ,operator(.and.) & ,operator(.also.) & ,operator(.approximates.) & ,operator(.equalsExpected.) & + ,operator(.expect.) & ,operator(.isAtLeast.) & ,operator(.isAtMost.) & ,operator(.isBefore.) & @@ -35,10 +33,12 @@ 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 + use julienne_test_result_m, only : test_result_t !! Deprecated features: - use julienne_vector_test_description_m, only : vector_test_description_t, vector_diagnosis_function_i + use julienne_test_description_m, only : diagnosis_function_i implicit none end module julienne_m diff --git a/test/legacy-main.F90 b/test/legacy-main.F90 new file mode 100644 index 000000000..e15384430 --- /dev/null +++ b/test/legacy-main.F90 @@ -0,0 +1,83 @@ +! 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 + !! Julienne unit tests driver + +#if defined(__GCC__) && (GCC_VERSION < 140300) + ! 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 + 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(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) + + 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 + +#endif +end program diff --git a/test/main.F90 b/test/main.F90 index f18803eac..2cb8f862d 100644 --- a/test/main.F90 +++ b/test/main.F90 @@ -1,84 +1,38 @@ ! 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 -program main - !! Julienne unit tests driver +#if ! defined(__GCC__) || (GCC_VERSION >= 140300) + ! Test infrastructure: + use julienne_m, only : test_fixture_t, test_harness_t - ! Internal utilities - use julienne_m ,only : command_line_t, GitHub_CI - - ! 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 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. _________" + use test_result_test_m ,only : test_result_test_t - if (passes + skips /= tests) error stop "Some executed tests failed." + implicit none -#if HAVE_MULTI_IMAGE_SUPPORT - end if + ! 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()) & + ,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( command_line_test_t()) & + ])) + call test_harness%report_results + end associate #endif - end program diff --git a/test/modules/assert_test_m.F90 b/test/modules/assert_test_m.F90 index 5933b469a..89670d053 100644 --- a/test/modules/assert_test_m.F90 +++ b/test/modules/assert_test_m.F90 @@ -10,12 +10,12 @@ module assert_test_m use assert_m ! Import call_assert macro use julienne_m, only : & call_julienne_assert_ & + ,filter & ,julienne_assert & ,operator(.equalsExpected.) & ,test_diagnosis_t & ,test_t & ,test_description_t & - ,test_description_substring & ,test_result_t & ,operator(.approximates.) & ,operator(.within.) @@ -41,21 +41,16 @@ 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 + ] + associate(matching_descriptions => filter(test_descriptions, subject())) + test_results = matching_descriptions%run() end associate - end function #else @@ -64,27 +59,20 @@ function results() result(test_results) !! Work around missing Fortran 2008 feature: associating a procedure actual argument with a procedure pointer dummy argument use julienne_m, only : diagnosis_function_i type(test_result_t), allocatable :: test_results(:) - type(test_description_t), allocatable :: descriptions(:) + type(test_description_t), allocatable :: test_descriptions(:) procedure(diagnosis_function_i), pointer :: & check_call_julienne_assert_macro_ptr => check_call_julienne_assert_macro & ,check_julienne_assert_call_ptr => check_julienne_assert_call & ,check_macro_removal_ptr => check_macro_removal - descriptions = [ & + + test_descriptions = [ & test_description_t("invoking the call_julienne_assert macro", check_call_julienne_assert_macro_ptr) & ,test_description_t("directly calling julienne_assert", check_julienne_assert_call_ptr) & ,test_description_t("removal when the ASSERTIONS macro is defined as 0", check_macro_removal_ptr) & ] - - 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) + associate(matching_descriptions => filter(test_descriptions, subject())) test_results = matching_descriptions%run() - end block + end associate end function #endif diff --git a/test/modules/bin_test_m.F90 b/test/modules/bin_test_m.F90 index 1acc53b30..e41f6d601 100644 --- a/test/modules/bin_test_m.F90 +++ b/test/modules/bin_test_m.F90 @@ -7,10 +7,10 @@ module bin_test_m !! Check data partitioning across bins use julienne_m, only : & bin_t & + ,filter & ,operator(.csv.) & ,string_t & ,test_description_t & - ,test_description_substring & ,test_diagnosis_t & ,test_result_t & ,test_t @@ -55,10 +55,9 @@ function results() result(test_results) test_description_t(string_t("partitioning all item across all bins without item loss"), check_all_items_ptr) & ] #endif - 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() + associate(matching_descriptions => filter(test_descriptions, subject())) + test_results = matching_descriptions%run() + end associate end function function check_block_partitioning() result(test_diagnosis) diff --git a/test/modules/command_line_test_m.F90 b/test/modules/command_line_test_m.F90 index b8118aa1d..ba16db7dd 100644 --- a/test/modules/command_line_test_m.F90 +++ b/test/modules/command_line_test_m.F90 @@ -7,8 +7,11 @@ module command_line_test_m !! Verify object pattern asbtract parent use julienne_m, only : & command_line_t & + ,filter & + ,GitHub_CI & + ,operator(.equalsExpected.) & + ,operator(.expect.) & ,string_t & - ,test_description_substring & ,test_description_t & ,test_diagnosis_t & ,test_result_t & @@ -38,21 +41,13 @@ 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 - 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: + 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_ptr & ,check_flag_value_missing_ptr & - ,check_flag_missing_ptr & - ,check_argument_missing_ptr & + ,check_flag_missing_ptr & + ,check_argument_missing_ptr & ,check_argument_present_ptr check_flag_value_ptr => check_flag_value @@ -60,83 +55,87 @@ function results() result(test_results) check_flag_missing_ptr => check_flag_missing check_argument_missing_ptr => check_argument_missing check_argument_present_ptr => check_argument_present +#endif - 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) & - ] + skip_all_tests_if_running_github_ci: & + 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 "(*(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")) & + ,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 + 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 - 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 if skip_all_tests_if_running_github_ci + + associate(matching_descriptions => filter(test_descriptions, subject())) + test_results = matching_descriptions%run() + end associate 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/formats_test_m.F90 b/test/modules/formats_test_m.F90 index 6ca6f87ea..631033a3f 100644 --- a/test/modules/formats_test_m.F90 +++ b/test/modules/formats_test_m.F90 @@ -6,11 +6,11 @@ module formats_test_m !! Verify that format strings provide the desired formatting use julienne_m, only : & - separated_values & + filter & ,operator(.csv.) & + ,separated_values & ,string_t & ,test_description_t & - ,test_description_substring & ,test_diagnosis_t & ,test_result_t & ,test_t @@ -67,11 +67,9 @@ function results() result(test_results) test_description_t(string_t("yielding a new-line-separated list of integer numbers"), check_new_line_ptr) & ] #endif - 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() - + associate(matching_descriptions => filter(test_descriptions, subject())) + test_results = matching_descriptions%run() + end associate end function function check_csv_reals() result(test_diagnosis) diff --git a/test/modules/string_test_m.F90 b/test/modules/string_test_m.F90 index 3969a32ad..fe43dfe85 100644 --- a/test/modules/string_test_m.F90 +++ b/test/modules/string_test_m.F90 @@ -8,10 +8,10 @@ module string_test_m use iso_c_binding, only : c_bool use julienne_m, only : & - test_t & + filter & + ,test_t & ,test_result_t & ,test_description_t & - ,test_description_substring & ,test_diagnosis_t & ,string_t & #if ! HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY @@ -142,10 +142,9 @@ function results() result(test_results) ,test_description_t('constructing bracketed strings', brackets_strings_ptr) & ] #endif - 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() + associate(matching_descriptions => filter(test_descriptions, subject())) + test_results = matching_descriptions%run() + end associate end function pure function check_allocation() result(test_diagnosis) diff --git a/test/modules/test_description_test_m.F90 b/test/modules/test_description_test_m.F90 index 5c4bf17c8..763921724 100644 --- a/test/modules/test_description_test_m.F90 +++ b/test/modules/test_description_test_m.F90 @@ -7,10 +7,10 @@ module test_description_test_m !! Verify test_description_t object behavior use julienne_m, only : & diagnosis_function_i & + ,filter & ,string_t & ,test_result_t & ,test_description_t & - ,test_description_substring & ,test_diagnosis_t & ,test_t implicit none @@ -33,45 +33,24 @@ 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) + associate(matching_descriptions => filter(test_descriptions, subject())) test_results = matching_descriptions%run() - end block -#endif - + end associate end function function check_constructors_match() result(test_diagnosis) diff --git a/test/modules/test_diagnosis_test_m.F90 b/test/modules/test_diagnosis_test_m.F90 index eec183c55..e81ebb909 100644 --- a/test/modules/test_diagnosis_test_m.F90 +++ b/test/modules/test_diagnosis_test_m.F90 @@ -7,10 +7,10 @@ module test_diagnosis_test_m !! Verify test_diagnosis_t object behavior use julienne_m, only : & - string_t & + filter & + ,string_t & ,test_t & ,test_description_t & - ,test_description_substring & ,test_diagnosis_t & ,test_result_t & #if ! HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY @@ -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) & @@ -127,29 +127,9 @@ function results() result(test_results) ,test_description_t("construction from the vector test_diagnostics_t expressions 'i .equalsExpected. [j,k]'" , check_and_with_vector_operands_ptr) & ] #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) + associate(matching_descriptions => filter(test_descriptions, subject())) test_results = matching_descriptions%run() - end block -#endif - + end associate end function function check_approximates_real() result(test_diagnosis) diff --git a/test/modules/test_result_test_m.F90 b/test/modules/test_result_test_m.F90 index b3006a926..7a80aebe3 100644 --- a/test/modules/test_result_test_m.F90 +++ b/test/modules/test_result_test_m.F90 @@ -6,8 +6,8 @@ module test_result_test_m !! Verify test_result_t object behavior use julienne_m, only : & - string_t & - ,test_description_substring & + filter & + ,string_t & ,test_description_t & ,test_diagnosis_t & ,test_result_t & @@ -52,10 +52,9 @@ function results() result(test_results) test_description_t(string_t("reporting failure if the test fails on one image"), check_single_ptr) & ] #endif - 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() + associate(matching_descriptions => filter(test_descriptions, subject())) + test_results = matching_descriptions%run() + end associate end function function check_array_result_construction() result(test_diagnosis) diff --git a/test/modules/vector_test_description_test_m.F90 b/test/modules/vector_test_description_test_m.F90 deleted file mode 100644 index cd79e0a74..000000000 --- a/test/modules/vector_test_description_test_m.F90 +++ /dev/null @@ -1,122 +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 - -module vector_test_description_test_m - !! Verify test_description_t object behavior - use julienne_m, only : & - diagnosis_function_i & - ,string_t & - ,test_result_t & - ,test_description_t & - ,test_description_substring & - ,test_diagnosis_t & - ,test_t & - ,vector_test_description_t -#if ! HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY - use julienne_vector_test_description_m, only : vector_diagnosis_function_i -#endif -#ifdef __GFORTRAN__ - use julienne_vector_test_description_m, only : run -#endif - implicit none - - private - public :: vector_test_description_test_t - - type, extends(test_t) :: vector_test_description_test_t - contains - procedure, nopass :: subject - procedure, nopass :: results - end type - -contains - - pure function subject() result(specimen) - character(len=:), allocatable :: specimen - specimen = "The vector_test_description_t type" - end function - - function results() result(test_results) - type(test_result_t), allocatable :: test_results(:), vector_test_results(:) - - associate(substring_in_subject => index(subject(), test_description_substring) /= 0) -#ifndef __GFORTRAN__ - associate(vector_test_descriptions => [ & - vector_test_description_t( [ & - string_t( "finding a substring in a test description") & - ,string_t("not finding a missing substring in a test description") & - ], check_substring_search & - )]) -#else - block - type(vector_test_description_t) vector_test_descriptions(1) - - vector_test_descriptions(1) = & - vector_test_description_t( [ & - string_t( "finding a substring in a test description") & - ,string_t("not finding a missing substring in a test description") & - ]) -#endif - associate(num_vector_tests => size(vector_test_descriptions)) - block - integer i - - if (substring_in_subject) then - test_results = [(vector_test_descriptions(i)%run(), i=1,num_vector_tests)] - else -#ifndef __GFORTRAN__ - associate(substring_in_description_vector => & - [(any(vector_test_descriptions(i)%contains_text(test_description_substring)), i=1,num_vector_tests)] & - ) -#else - block - logical, allocatable :: substring_in_description_vector(:) - substring_in_description_vector = & - [(any(vector_test_descriptions(i)%contains_text(test_description_substring)), i=1,num_vector_tests)] -#endif -#ifndef __GFORTRAN__ - associate(matching_vector_tests => pack(vector_test_descriptions, substring_in_description_vector)) - associate(results_with_matches => [(matching_vector_tests(i)%run(), i=1,size(matching_vector_tests))]) - test_results = pack(results_with_matches, results_with_matches%description_contains(test_description_substring)) - end associate - end associate -#else - block - type(test_result_t), allocatable :: results_with_matches(:) - type(vector_test_description_t), allocatable :: matching_vector_tests(:) - matching_vector_tests = pack(vector_test_descriptions, substring_in_description_vector) - results_with_matches = [(run(matching_vector_tests(i)), i=1,size(matching_vector_tests))] - test_results = pack(results_with_matches, results_with_matches%description_contains(test_description_substring)) - end block -#endif -#ifndef __GFORTRAN__ - end associate -#else - end block -#endif - end if - end block - end associate -#ifndef __GFORTRAN__ - end associate -#else - end block -#endif - end associate - end function - - function check_substring_search() result(diagnoses) - type(test_diagnosis_t), allocatable :: diagnoses(:) - procedure(diagnosis_function_i), pointer :: unused - - unused => null() - - associate(doing_something => test_description_t("doing something", unused)) - diagnoses = [ & - test_diagnosis_t(test_passed = doing_something%contains_text("something"), diagnostics_string="expected .true.") & - ,test_diagnosis_t(test_passed = .not. doing_something%contains_text("missing text"), diagnostics_string="expected .true.") & - ] - end associate - end function - -end module vector_test_description_test_m diff --git a/test/test-julienne_assert-intentional-failure.F90 b/test/test-julienne_assert-intentional-failure.F90 index 1b30dda14..e59ebd88f 100644 --- a/test/test-julienne_assert-intentional-failure.F90 +++ b/test/test-julienne_assert-intentional-failure.F90 @@ -5,22 +5,22 @@ program test_julienne_assert_intentional_failure !! Conditionally test an assertion that is hardwired to fail. - -#ifdef RUN_FALSE_ASSERTIONS - - use julienne_m, only : operator(.equalsExpected.), call_julienne_assert_ + use julienne_m, only : call_julienne_assert_, command_line_t, operator(.equalsExpected.) implicit none - print '(a)', new_line('') // 'Test julienne_assert intentional failure: ' // new_line('') - call_julienne_assert(1 .equalsExpected. 2) + associate(command_line => command_line_t()) + if (.not. command_line%argument_present([character(len=len("--help"))::"--help","-h"])) then +#ifdef RUN_FALSE_ASSERTIONS + 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 * - + 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 + end if + end associate end program