From cf448a1ecfec90f2b6436062f6d662b23fb47af3 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 6 Dec 2021 15:50:08 -0500 Subject: [PATCH] MOM_file_parser unit test implementation This patch introduces new features to support unit testing of the MOM6 source code. The patch includes two new modules (MOM_unit_testing, MOM_file_parser_tests), two new classes (UnitTest, TestSuite), and a new driver (unit_testing). A UnitTest object consists of the following: * The test subroutine * Test name (for reporting) * A flag indicating whether the test should fail (FATAL) * An optional cleanup subroutine The UnitTest objects are gathered into a TestSuite object, which provides a batch job for running all of its tests. The use of these features is demonstrated in a driver, unit_tests, which runs the tests provided in the MOM_file_parser_tests module This patch also includes changes to the ".testing" build system. * The optional FCFLAGS_COVERAGE has been removed from the testing Makefile. Instead, a new "cov" target is optionally built if one wants to check the coverage. It is currently based on "symmetric". * A new "unit" target has been added to run the unit testing driver and report its code coverage. * GitHub Actions has been modified to include the unit driver test. * The gcov output now includes branching (-b), which allows reporting of partial line coverage in some cases. * codecov.io "smart" report searching has been replaced with an explicit setting of the root directory (-R) and *.gcda paths. Other minor changes: * MOM_coms include an infra-level sync function (sync_PEs) as a wrapper to mpp_sync (or others in the future). --- .codecov.yml | 5 +- .github/actions/testing-setup/action.yml | 1 - .github/workflows/coverage.yml | 11 +- .testing/Makefile | 105 +- ac/configure.ac | 6 +- .../unit_tests/MOM_unit_test_driver.F90 | 65 + config_src/infra/FMS1/MOM_coms_infra.F90 | 9 +- config_src/infra/FMS2/MOM_coms_infra.F90 | 9 +- src/framework/MOM_coms.F90 | 2 + src/framework/MOM_unit_testing.F90 | 306 +++ .../testing/MOM_file_parser_tests.F90 | 1924 +++++++++++++++++ 11 files changed, 2411 insertions(+), 32 deletions(-) create mode 100644 config_src/drivers/unit_tests/MOM_unit_test_driver.F90 create mode 100644 src/framework/MOM_unit_testing.F90 create mode 100644 src/framework/testing/MOM_file_parser_tests.F90 diff --git a/.codecov.yml b/.codecov.yml index 84e438145e..aa85b2b3ac 100644 --- a/.codecov.yml +++ b/.codecov.yml @@ -9,5 +9,6 @@ coverage: threshold: 100% base: parent comment: - # This must be set to the number of test cases (TCs) - after_n_builds: 8 + # This is set to the number of TCs, plus unit, but can be removed + # (i.e. set to 1) when reporting is separated from coverage. + after_n_builds: 9 diff --git a/.github/actions/testing-setup/action.yml b/.github/actions/testing-setup/action.yml index 1ab96aa3df..e95145c1a1 100644 --- a/.github/actions/testing-setup/action.yml +++ b/.github/actions/testing-setup/action.yml @@ -52,7 +52,6 @@ runs: echo "FCFLAGS_DEBUG=-g -O0 -Wextra -Wno-compare-reals -fbacktrace -ffpe-trap=invalid,zero,overflow -fcheck=bounds" >> config.mk echo "FCFLAGS_REPRO=-g -O2 -fbacktrace" >> config.mk echo "FCFLAGS_INIT=-finit-real=snan -finit-integer=2147483647 -finit-derived" >> config.mk - echo "FCFLAGS_COVERAGE=--coverage" >> config.mk cat config.mk echo "::endgroup::" diff --git a/.github/workflows/coverage.yml b/.github/workflows/coverage.yml index 60b85e412b..84fc4c75ff 100644 --- a/.github/workflows/coverage.yml +++ b/.github/workflows/coverage.yml @@ -20,5 +20,14 @@ jobs: - uses: ./.github/actions/testing-setup + - name: Compile unit testing + run: make -j build/unit/MOM6 + + - name: Run unit tests + run: make unit.cov.upload + + - name: Compile MOM6 with code coverage + run: make -j build/cov/MOM6 + - name: Run and post coverage - run: make run.symmetric -k -s + run: make run.cov -k -s diff --git a/.testing/Makefile b/.testing/Makefile index 4096436f30..d9feb25f0b 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -28,7 +28,7 @@ # MPIRUN MPI job launcher (mpirun, srun, etc) # DO_REPRO_TESTS Enable production ("repro") testing equivalence # DO_REGRESSION_TESTS Enable regression tests (usually dev/gfdl) -# REPORT_COVERAGE Enable code coverage and report to codecov +# REPORT_COVERAGE Enable code coverage and generate reports # # Compiler configuration: # CC C compiler @@ -82,11 +82,11 @@ export MPIFC FCFLAGS_DEBUG ?= -g -O0 FCFLAGS_REPRO ?= -g -O2 FCFLAGS_OPT ?= -g -O3 -mavx -fno-omit-frame-pointer +FCFLAGS_COVERAGE ?= -g -O0 -fbacktrace --coverage FCFLAGS_INIT ?= -FCFLAGS_COVERAGE ?= # Additional notes: # - These default values are simple, minimalist flags, supported by nearly all -# compilers which are comparable to GFDL's canonical DEBUG and REPRO builds. +# compilers, and are comparable to GFDL's canonical DEBUG and REPRO builds. # # - These flags should be configured outside of the Makefile, either with # config.mk or as environment variables. @@ -95,6 +95,7 @@ FCFLAGS_COVERAGE ?= # so FCFLAGS_INIT is used to provide additional MOM6 configuration. # User-defined LDFLAGS (applied to all builds and FMS) +LDFLAGS_COVERAGE ?= --coverage LDFLAGS_USER ?= # Set to `true` to require identical results from DEBUG and REPRO builds @@ -139,6 +140,9 @@ ifeq ($(DO_PROFILE), false) BUILDS += opt opt_target endif +# Unit test testing +BUILDS += cov unit + # The following variables are configured by Travis: # DO_REGRESSION_TESTS: true if $(TRAVIS_PULL_REQUEST) is a PR number # MOM_TARGET_SLUG: TRAVIS_REPO_SLUG @@ -165,8 +169,6 @@ else TARGET_CODEBASE = endif - - # List of source files to link this Makefile's dependencies to model Makefiles # Assumes a depth of two, and the following extensions: F90 inc c h # (1): Root directory @@ -220,10 +222,8 @@ build.prof: $(foreach b,opt opt_target,build/$(b)/MOM6) BUILD_TARGETS = MOM6 Makefile path_names .PRECIOUS: $(foreach b,$(BUILDS),$(foreach f,$(BUILD_TARGETS),build/$(b)/$(f))) -# Compiler flags -# Conditionally build symmetric with coverage support -COVERAGE=$(if $(REPORT_COVERAGE),$(FCFLAGS_COVERAGE),) +# Compiler flags # .testing dependencies # TODO: We should probably build TARGET with the FMS that it was configured @@ -234,28 +234,31 @@ PATH_FMS = PATH="${PATH}:../../$(DEPS)/bin" # Define the build targets in terms of the traditional DEBUG/REPRO/etc labels -SYMMETRIC_FCFLAGS := FCFLAGS="$(FCFLAGS_DEBUG) $(FCFLAGS_INIT) $(COVERAGE) $(FCFLAGS_FMS)" +SYMMETRIC_FCFLAGS := FCFLAGS="$(FCFLAGS_DEBUG) $(FCFLAGS_INIT) $(FCFLAGS_FMS)" ASYMMETRIC_FCFLAGS := FCFLAGS="$(FCFLAGS_DEBUG) $(FCFLAGS_INIT) $(FCFLAGS_FMS)" REPRO_FCFLAGS := FCFLAGS="$(FCFLAGS_REPRO) $(FCFLAGS_FMS)" OPT_FCFLAGS := FCFLAGS="$(FCFLAGS_OPT) $(FCFLAGS_FMS)" OPENMP_FCFLAGS := FCFLAGS="$(FCFLAGS_DEBUG) $(FCFLAGS_INIT) $(FCFLAGS_FMS)" TARGET_FCFLAGS := FCFLAGS="$(FCFLAGS_DEBUG) $(FCFLAGS_INIT) $(FCFLAGS_FMS)" +COV_FCFLAGS := FCFLAGS="$(FCFLAGS_COVERAGE) $(FCFLAGS_FMS)" MOM_LDFLAGS := LDFLAGS="$(LDFLAGS_FMS) $(LDFLAGS_USER)" -SYMMETRIC_LDFLAGS := LDFLAGS="$(COVERAGE) $(LDFLAGS_FMS) $(LDFLAGS_USER)" +COV_LDFLAGS := LDFLAGS="$(LDFLAGS_COVERAGE) $(LDFLAGS_FMS) $(LDFLAGS_USER)" # Environment variable configuration -build/symmetric/Makefile: MOM_ENV=$(PATH_FMS) $(SYMMETRIC_FCFLAGS) $(SYMMETRIC_LDFLAGS) +build/symmetric/Makefile: MOM_ENV=$(PATH_FMS) $(SYMMETRIC_FCFLAGS) $(MOM_LDFLAGS) build/asymmetric/Makefile: MOM_ENV=$(PATH_FMS) $(ASYMMETRIC_FCFLAGS) $(MOM_LDFLAGS) build/repro/Makefile: MOM_ENV=$(PATH_FMS) $(REPRO_FCFLAGS) $(MOM_LDFLAGS) build/openmp/Makefile: MOM_ENV=$(PATH_FMS) $(OPENMP_FCFLAGS) $(MOM_LDFLAGS) build/target/Makefile: MOM_ENV=$(PATH_FMS) $(TARGET_FCFLAGS) $(MOM_LDFLAGS) build/opt/Makefile: MOM_ENV=$(PATH_FMS) $(OPT_FCFLAGS) $(MOM_LDFLAGS) build/opt_target/Makefile: MOM_ENV=$(PATH_FMS) $(OPT_FCFLAGS) $(MOM_LDFLAGS) -build/coupled/Makefile: MOM_ENV=$(PATH_FMS) $(SYMMETRIC_FCFLAGS) $(SYMMETRIC_LDFLAGS) -build/nuopc/Makefile: MOM_ENV=$(PATH_FMS) $(SYMMETRIC_FCFLAGS) $(SYMMETRIC_LDFLAGS) -build/mct/Makefile: MOM_ENV=$(PATH_FMS) $(SYMMETRIC_FCFLAGS) $(SYMMETRIC_LDFLAGS) +build/coupled/Makefile: MOM_ENV=$(PATH_FMS) $(SYMMETRIC_FCFLAGS) $(MOM_LDFLAGS) +build/nuopc/Makefile: MOM_ENV=$(PATH_FMS) $(SYMMETRIC_FCFLAGS) $(MOM_LDFLAGS) +build/mct/Makefile: MOM_ENV=$(PATH_FMS) $(SYMMETRIC_FCFLAGS) $(MOM_LDFLAGS) +build/cov/Makefile: MOM_ENV=$(PATH_FMS) $(COV_FCFLAGS) $(COV_LDFLAGS) +build/unit/Makefile: MOM_ENV=$(PATH_FMS) $(COV_FCFLAGS) $(COV_LDFLAGS) # Configure script flags build/symmetric/Makefile: MOM_ACFLAGS= @@ -268,6 +271,8 @@ build/opt_target/Makefile: MOM_ACFLAGS= build/coupled/Makefile: MOM_ACFLAGS=--with-driver=FMS_cap build/nuopc/Makefile: MOM_ACFLAGS=--with-driver=nuopc_cap build/mct/Makefile: MOM_ACFLAGS=--with-driver=mct_cap +build/cov/Makefile: MOM_ACFLAGS= +build/unit/Makefile: MOM_ACFLAGS=--with-driver=unit_tests # Fetch regression target source code build/target/Makefile: | $(TARGET_CODEBASE) @@ -276,7 +281,7 @@ build/opt_target/Makefile: | $(TARGET_CODEBASE) # Define source code dependencies # NOTE: ./configure is too much, but Makefile is not enough! -# Ideally we would want to re-run both Makefile and mkmf, but our mkmf call +# Ideally we only want to re-run both Makefile and mkmf, but the mkmf call # is inside ./configure, so we must re-run ./configure as well. $(foreach b,$(filter-out target,$(BUILDS)),build/$(b)/Makefile): $(MOM_SOURCE) build/target_codebase/configure: $(TARGET_SOURCE) @@ -362,11 +367,13 @@ $(DEPS)/Makefile: ../ac/deps/Makefile #--- -# The following block does a non-library build of a coupled driver interface to MOM, along with everything below it. -# This simply checks that we have not broken the ability to compile. This is not a means to build a complete coupled executable. -# Todo: -# - avoid re-building FMS and MOM6 src by re-using existing object/mod files -# - use autoconf rather than mkmf templates +# The following block does a non-library build of a coupled driver interface to +# MOM, along with everything below it. This simply checks that we have not +# broken the ability to compile. This is not a means to build a complete +# coupled executable. +# TODO: +# - Avoid re-building FMS and MOM6 src by re-using existing object/mod files +# - Use autoconf rather than mkmf templates MK_TEMPLATE ?= ../../$(DEPS)/mkmf/templates/ncrc-gnu.mk # NUOPC driver build/nuopc/mom_ocean_model_nuopc.o: build/nuopc/Makefile @@ -425,11 +432,12 @@ test.dim.$(1): $(foreach c,$(CONFIGS),$(c).dim.$(1) $(c).dim.$(1).diag) endef $(foreach d,$(DIMS),$(eval $(call TEST_DIM_RULE,$(d)))) -.PHONY: run.symmetric run.asymmetric run.nans run.openmp +.PHONY: run.symmetric run.asymmetric run.nans run.openmp run.cov run.symmetric: $(foreach c,$(CONFIGS),work/$(c)/symmetric/ocean.stats) run.asymmetric: $(foreach c,$(filter-out tc3,$(CONFIGS)),$(CONFIGS),work/$(c)/asymmetric/ocean.stats) run.nan: $(foreach c,$(CONFIGS),work/$(c)/nan/ocean.stats) run.openmp: $(foreach c,$(CONFIGS),work/$(c)/openmp/ocean.stats) +run.cov: $(foreach c,$(CONFIGS),work/$(c)/cov/ocean.stats) # Configuration test rules # $(1): Configuration name (tc1, tc2, &c.) @@ -573,11 +581,11 @@ work/%/$(1)/ocean.stats work/%/$(1)/chksum_diag: build/$(2)/MOM6 $(VENV_PATH) @echo -e "$(DONE): $$*.$(1); no runtime errors." if [ $(3) ]; then \ mkdir -p results/$$* ; \ - cd build/symmetric ; \ - gcov *.gcda > gcov.$$*.$(1).out ; \ + cd build/$(2) ; \ + gcov -b *.gcda > gcov.$$*.$(1).out ; \ curl -s $(CODECOV_UPLOADER_URL) -o codecov ; \ chmod +x codecov ; \ - ./codecov -Z -f "*.gcov" -n $$@ \ + ./codecov -R . -Z -f "*.gcov" -n $$@ \ > codecov.$$*.$(1).out \ 2> codecov.$$*.$(1).err \ && echo -e "${MAGENTA}Report uploaded to codecov.${RESET}"; \ @@ -603,6 +611,7 @@ $(eval $(call STAT_RULE,dim.z,symmetric,,Z_RESCALE_POWER=11,,1)) $(eval $(call STAT_RULE,dim.q,symmetric,,Q_RESCALE_POWER=11,,1)) $(eval $(call STAT_RULE,dim.r,symmetric,,R_RESCALE_POWER=11,,1)) +$(eval $(call STAT_RULE,cov,cov,$(REPORT_COVERAGE),,,1)) # Generate the half-period input namelist as follows: # 1. Fetch DAYMAX and TIMEUNIT from MOM_input @@ -652,7 +661,6 @@ work/%/restart/ocean.stats: build/symmetric/MOM6 $(VENV_PATH) # TODO: Restart checksum diagnostics - #--- # Not a true rule; only call this after `make test` to summarize test results. .PHONY: test.summary @@ -679,6 +687,53 @@ test.summary: fi +#--- +# unit test + +.PHONY: unit.cov +unit.cov: build/unit/MOM_new_unit_tests.gcov + +work/unit/std.out: build/unit/MOM6 + if [ $(REPORT_COVERAGE) ]; then \ + find build/unit -name *.gcda -exec rm -f '{}' \; ; \ + fi + rm -rf $(@D) + mkdir -p $(@D) + cd $(@D) \ + && $(TIME) $(MPIRUN) -n 1 ../../$< 2> std.err > std.out \ + || !( \ + cat std.out | tail -n 100 ; \ + cat std.err | tail -n 100 ; \ + ) + cd $(@D) \ + && $(TIME) $(MPIRUN) -n 2 ../../$< 2> p2.std.err > p2.std.out \ + || !( \ + cat p2.std.out | tail -n 100 ; \ + cat p2.std.err | tail -n 100 ; \ + ) + +build/unit/codecov: + mkdir -p $(@D) + cd $(@D) \ + && curl -s $(CODECOV_UPLOADER_URL) -o $(@F) + chmod +x $@ + +# Use driver coverage file as a proxy for the run +# TODO: Replace work/unit/std.out with *.gcda? +build/unit/MOM_new_unit_tests.gcov: work/unit/std.out + mkdir -p $(@D) + cd $(@D) \ + && gcov -b *.gcda > gcov.unit.out + +# Use driver coverage file as a proxy for the run +.PHONY: unit.cov.upload +unit.cov.upload: build/unit/MOM_new_unit_tests.gcov build/unit/codecov + cd build/unit \ + && ./codecov -R . -Z -f "*.gcov" -n "Unit tests" \ + > codecov.unit.out \ + 2> codecov.unit.err \ + && echo -e "${MAGENTA}Report uploaded to codecov.${RESET}" + #--- # Profiling # XXX: This is experimental work to track, log, and report changes in runtime diff --git a/ac/configure.ac b/ac/configure.ac index 3d1af81b05..00c8917734 100644 --- a/ac/configure.ac +++ b/ac/configure.ac @@ -51,7 +51,11 @@ AS_IF([test "$enable_asymmetric" = yes], # Default to solo_driver DRIVER_DIR=${srcdir}/config_src/drivers/solo_driver AC_ARG_WITH([driver], - AS_HELP_STRING([--with-driver=coupled_driver|solo_driver], [Select directory for driver source code])) + AS_HELP_STRING( + [--with-driver=coupled_driver|solo_driver|unit_tests], + [Select directory for driver source code] + ) +) AS_IF([test "x$with_driver" != "x"], [DRIVER_DIR=${srcdir}/config_src/drivers/${with_driver}]) diff --git a/config_src/drivers/unit_tests/MOM_unit_test_driver.F90 b/config_src/drivers/unit_tests/MOM_unit_test_driver.F90 new file mode 100644 index 0000000000..eafa8fa722 --- /dev/null +++ b/config_src/drivers/unit_tests/MOM_unit_test_driver.F90 @@ -0,0 +1,65 @@ +program MOM_unit_tests + +use MPI +use MOM_domains, only : MOM_infra_init +use MOM_domains, only : MOM_infra_end +use MOM_file_parser_tests, only : run_file_parser_tests + +implicit none + +integer, parameter :: comm = MPI_COMM_WORLD +integer, parameter :: root = 0 +integer :: rank +logical :: file_exists_on_rank +logical :: input_nml_exists, MOM_input_exists +integer :: io_unit +logical :: is_open, is_file +integer :: rc + +! NOTE: Bootstrapping requires external MPI configuration. +! - FMS initialization requires the presence of input.nml +! - MOM initialization requires MOM_input (if unspecificed by input.nml) +! - Any MPI-based I/O prior to MOM and FMS init will MPI initialization +! Thus, we need to do some minimal MPI setup. +call MPI_Init(rc) +call MPI_Comm_rank(comm, rank, rc) + +inquire(file='input.nml', exist=file_exists_on_rank) +call MPI_Reduce(file_exists_on_rank, input_nml_exists, 1, MPI_LOGICAL, & + MPI_LOR, root, comm, rc) + +inquire(file='MOM_input', exist=file_exists_on_rank) +call MPI_Reduce(file_exists_on_rank, MOM_input_exists, 1, MPI_LOGICAL, & + MPI_LOR, root, comm, rc) + +if (rank == root) then + ! Abort if at least one rank sees either input.nml or MOM_input + if (input_nml_exists) error stop "Remove existing 'input.nml' file." + if (MOM_input_exists) error stop "Remove existing 'MOM_input' file." + + ! Otherwise, create the (empty) files + open(newunit=io_unit, file='input.nml', status='replace') + write(io_unit, '(a)') "&fms2_io_nml /" + close(io_unit) + + open(newunit=io_unit, file='MOM_input', status='replace') + close(io_unit) +endif + +call MOM_infra_init(comm) + +! Run tests +call run_file_parser_tests + +! Cleanup +call MOM_infra_end + +if (rank == root) then + open(newunit=io_unit, file='MOM_input') + close(io_unit, status='delete') + + open(newunit=io_unit, file='input.nml') + close(io_unit, status='delete') +endif + +end program MOM_unit_tests diff --git a/config_src/infra/FMS1/MOM_coms_infra.F90 b/config_src/infra/FMS1/MOM_coms_infra.F90 index 561cf6c333..939161875e 100644 --- a/config_src/infra/FMS1/MOM_coms_infra.F90 +++ b/config_src/infra/FMS1/MOM_coms_infra.F90 @@ -14,7 +14,7 @@ module MOM_coms_infra implicit none ; private -public :: PE_here, root_PE, num_PEs, set_rootPE, Set_PElist, Get_PElist +public :: PE_here, root_PE, num_PEs, set_rootPE, Set_PElist, Get_PElist, sync_PEs public :: broadcast, sum_across_PEs, min_across_PEs, max_across_PEs public :: any_across_PEs, all_across_PEs public :: field_chksum, MOM_infra_init, MOM_infra_end @@ -108,6 +108,13 @@ subroutine Get_PEList(pelist, name, commID) call mpp_get_current_pelist(pelist, name, commiD) end subroutine Get_PEList +!> Sync the PEs at a defined point in the model +subroutine sync_PEs(pelist) + integer, optional, intent(in) :: pelist(:) !< The list of PEs to be synced + + call mpp_sync(pelist) +end subroutine sync_PEs + !> Communicate a 1-D array of character strings from one PE to others subroutine broadcast_char(dat, length, from_PE, PElist, blocking) character(len=*), intent(inout) :: dat(:) !< The data to communicate and destination diff --git a/config_src/infra/FMS2/MOM_coms_infra.F90 b/config_src/infra/FMS2/MOM_coms_infra.F90 index 561cf6c333..939161875e 100644 --- a/config_src/infra/FMS2/MOM_coms_infra.F90 +++ b/config_src/infra/FMS2/MOM_coms_infra.F90 @@ -14,7 +14,7 @@ module MOM_coms_infra implicit none ; private -public :: PE_here, root_PE, num_PEs, set_rootPE, Set_PElist, Get_PElist +public :: PE_here, root_PE, num_PEs, set_rootPE, Set_PElist, Get_PElist, sync_PEs public :: broadcast, sum_across_PEs, min_across_PEs, max_across_PEs public :: any_across_PEs, all_across_PEs public :: field_chksum, MOM_infra_init, MOM_infra_end @@ -108,6 +108,13 @@ subroutine Get_PEList(pelist, name, commID) call mpp_get_current_pelist(pelist, name, commiD) end subroutine Get_PEList +!> Sync the PEs at a defined point in the model +subroutine sync_PEs(pelist) + integer, optional, intent(in) :: pelist(:) !< The list of PEs to be synced + + call mpp_sync(pelist) +end subroutine sync_PEs + !> Communicate a 1-D array of character strings from one PE to others subroutine broadcast_char(dat, length, from_PE, PElist, blocking) character(len=*), intent(inout) :: dat(:) !< The data to communicate and destination diff --git a/src/framework/MOM_coms.F90 b/src/framework/MOM_coms.F90 index 8bf1164a70..38ad55fd96 100644 --- a/src/framework/MOM_coms.F90 +++ b/src/framework/MOM_coms.F90 @@ -9,10 +9,12 @@ module MOM_coms use MOM_coms_infra, only : sum_across_PEs, max_across_PEs, min_across_PEs use MOM_coms_infra, only : all_across_PEs, any_across_PEs use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING +use MOM_coms_infra, only : sync_PEs implicit none ; private public :: PE_here, root_PE, num_PEs, MOM_infra_init, MOM_infra_end +public :: sync_PEs public :: broadcast, sum_across_PEs, min_across_PEs, max_across_PEs, field_chksum public :: all_across_PEs, any_across_PEs public :: set_PElist, Get_PElist, Set_rootPE diff --git a/src/framework/MOM_unit_testing.F90 b/src/framework/MOM_unit_testing.F90 new file mode 100644 index 0000000000..312914933c --- /dev/null +++ b/src/framework/MOM_unit_testing.F90 @@ -0,0 +1,306 @@ +module MOM_unit_testing + +use posix, only : chmod +use posix, only : sigsetjmp +use posix, only : sigjmp_buf + +use MOM_coms, only : num_PEs, sync_PEs +use MOM_error_handler, only : is_root_pe +use MOM_error_handler, only : disable_fatal_errors +use MOM_error_handler, only : enable_fatal_errors + +implicit none ; private + +public :: string +public :: create_test_file +public :: delete_test_file +public :: TestSuite + + +!> String container type +type :: string + character(len=:), allocatable :: s + !< Internal character array of string +end type string + + +!> String constructor +interface string + module procedure init_string_char + module procedure init_string_int +end interface string + + +!> A generalized instance of a unit test function +type :: UnitTest + private + procedure(), nopass, pointer :: proc => null() + !< Unit test function/subroutine + procedure(), nopass, pointer :: cleanup => null() + !< Cleanup function to be run after proc + character(len=:), allocatable :: name + !< Unit test name (usually set to name of proc) + logical :: is_fatal + !< True if proc() is expected to fail +contains + procedure :: run => run_unit_test + !< Run the unit test function, proc +end type UnitTest + + +!> Unit test constructor +interface UnitTest + module procedure create_unit_test_basic + module procedure create_unit_test_full +end interface UnitTest + + +!> Collection of unit tests +type :: TestSuite + private + type(UnitTestNode), pointer :: head => null() + !< Head of the unit test linked list + type(UnitTestNode), pointer :: tail => null() + !< Tail of the unit test linked list (pre-allocated and unconfigured) + + ! Public API + procedure(), nopass, pointer, public :: cleanup => null() + !< Default cleanup function for unit tests in suite +contains + private + procedure :: add_basic => add_unit_test_basic + !< Add a unit test without a cleanup function + procedure :: add_full => add_unit_test_full + !< Add a unit test with an explicit cleanup function + generic, public :: add => add_basic, add_full + !< Add a unit test to the test suite + procedure, public :: run => run_test_suite + !< Run all unit tests in the suite +end type TestSuite + + +!> TestSuite constructor +interface TestSuite + module procedure create_test_suite +end interface TestSuite + + +!> UnitTest node of TestSuite's linked list +type :: UnitTestNode + private + type(UnitTest), pointer :: test => null() + !< Node contents + type(UnitTestNode), pointer :: next => null() + !< Pointer to next node in list +end type UnitTestNode + +contains + +!> Return a new unit test without a cleanup function +function create_unit_test_basic(proc, name, fatal) result(test) + procedure() :: proc + !< Subroutine which defines the unit test + character(len=*), intent(in) :: name + !< Name of the unit test + logical, intent(in), optional :: fatal + !< True if the test is expected to raise a FATAL error + type(UnitTest) :: test + + procedure(), pointer :: cleanup + cleanup => null() + + test = create_unit_test_full(proc, name, fatal, cleanup) +end function create_unit_test_basic + + +!> Return a new unit test with an explicit cleanup function +function create_unit_test_full(proc, name, fatal, cleanup) result(test) + procedure() :: proc + !< Subroutine which defines the unit test + character(len=*), intent(in) :: name + !< Name of the unit test + logical, optional :: fatal + !< True if the test is expected to raise a FATAL error + procedure() :: cleanup + !< Cleanup subroutine, called after test + type(UnitTest) :: test + + test%proc => proc + test%name = name + test%is_fatal = .false. + if (present(fatal)) test%is_fatal = fatal + test%cleanup => cleanup +end function create_unit_test_full + + +!> Launch a unit test with a custom cleanup procedure +subroutine run_unit_test(test) + class(UnitTest), intent(in) :: test + + type(sigjmp_buf) :: env + integer :: rc + + call sync_PEs + + ! FIXME: Some FATAL tests under MPI are unable to recover after jumpback, so + ! we disable these tests for now. + if (test%is_fatal .and. num_PEs() > 1) return + + if (test%is_fatal) then + rc = sigsetjmp(env, 1) + if (rc == 0) then + call disable_fatal_errors(env) + call test%proc + endif + call enable_fatal_errors + else + call test%proc + endif + + if (associated(test%cleanup)) call test%cleanup +end subroutine run_unit_test + + +!> Return a new test suite +function create_test_suite() result(suite) + type(TestSuite) :: suite + + ! Setup the head node, but do not populate it + allocate(suite%head) + suite%tail => suite%head +end function create_test_suite + + +subroutine add_unit_test_basic(suite, test, name, fatal) + class(TestSuite), intent(inout) :: suite + procedure() :: test + character(len=*), intent(in) :: name + logical, intent(in), optional :: fatal + + procedure(), pointer :: cleanup + + cleanup => null() + if (associated(suite%cleanup)) cleanup => suite%cleanup + + call add_unit_test_full(suite, test, name, fatal, cleanup) +end subroutine add_unit_test_basic + + +subroutine add_unit_test_full(suite, test, name, fatal, cleanup) + class(TestSuite), intent(inout) :: suite + procedure() :: test + character(len=*), intent(in) :: name + procedure() :: cleanup + logical, intent(in), optional :: fatal + + type(UnitTest), pointer :: utest + type(UnitTestNode), pointer :: node + + ! Populate the current tail + allocate(utest) + utest = UnitTest(test, name, fatal, cleanup) + suite%tail%test => utest + + ! Create and append the new (empty) node, and update the tail + allocate(node) + suite%tail%next => node + suite%tail => node +end subroutine add_unit_test_full + + +subroutine run_test_suite(suite) + class(TestSuite), intent(in) :: suite + + type(UnitTestNode), pointer :: node + + node => suite%head + do while(associated(node%test)) + ! TODO: Capture FMS stdout/stderr + print '(/a)', "=== "//node%test%name + + call node%test%run + if (associated(node%test%cleanup)) call node%test%cleanup + + node => node%next + enddo +end subroutine run_test_suite + + +!> Initialize string with a character array. +function init_string_char(c) result(str) + character(len=*), dimension(:), intent(in) :: c + !< List of character arrays + type(string), dimension(size(c)) :: str + !< String output + + integer :: i + + do i = 1, size(c) + str(i)%s = c(i) + enddo +end function init_string_char + + +!> Convert an integer to a string +function init_string_int(n) result(str) + integer, intent(in) :: n + !< Integer input + type(string) :: str + !< String output + + ! TODO: Estimate this with integer arithmetic + character(1 + floor(log10(real(abs(n)))) + (1 - sign(1, n))/2) :: chr + + write(chr, '(i0)') n + str = string(chr) +end function init_string_int + + +!> Create a text file for unit testing +subroutine create_test_file(filename, lines, mode) + character(len=*), intent(in) :: filename + !< Name of file to be created + type(string), intent(in), optional :: lines(:) + !< list of strings to write to file + integer, optional, intent(in) :: mode + !< Permissions of new file + + integer :: param_unit + integer :: i + integer :: rc + logical :: sync + + if (is_root_PE()) then + open(newunit=param_unit, file=filename, status='replace') + if (present(lines)) then + do i = 1, size(lines) + write(param_unit, '(a)') lines(i)%s + enddo + endif + close(param_unit) + if (present(mode)) rc = chmod(filename, mode) + endif + call sync_PEs +end subroutine create_test_file + + +!> Delete a file created during testing +subroutine delete_test_file(filename) + character(len=*), intent(in) :: filename + !< Name of file to be deleted + + logical :: is_file, is_open + integer :: io_unit + + if (is_root_PE()) then + inquire(file=filename, exist=is_file, opened=is_open, number=io_unit) + + if (is_file) then + if (.not. is_open) open(newunit=io_unit, file=filename) + close(io_unit, status='delete') + endif + endif + call sync_PEs +end subroutine delete_test_file + +end module MOM_unit_testing diff --git a/src/framework/testing/MOM_file_parser_tests.F90 b/src/framework/testing/MOM_file_parser_tests.F90 new file mode 100644 index 0000000000..5ad90caf1b --- /dev/null +++ b/src/framework/testing/MOM_file_parser_tests.F90 @@ -0,0 +1,1924 @@ +module MOM_file_parser_tests + +use posix, only : chmod + +use MOM_file_parser, only : param_file_type +use MOM_file_parser, only : open_param_file +use MOM_file_parser, only : close_param_file +use MOM_file_parser, only : read_param +use MOM_file_parser, only : log_param +use MOM_file_parser, only : get_param +use MOM_file_parser, only : log_version +use MOM_file_parser, only : clearParameterBlock +use MOM_file_parser, only : openParameterBlock +use MOM_file_parser, only : closeParameterBlock + +use MOM_time_manager, only : time_type +use MOM_time_manager, only : set_date +use MOM_time_manager, only : set_ticks_per_second +use MOM_time_manager, only : set_calendar_type +use MOM_time_manager, only : NOLEAP, NO_CALENDAR + +use MOM_error_handler, only : assert +use MOM_error_handler, only : MOM_error +use MOM_error_handler, only : FATAL + +use MOM_unit_testing, only : TestSuite +use MOM_unit_testing, only : string +use MOM_unit_testing, only : create_test_file +use MOM_unit_testing, only : delete_test_file + +implicit none ; private + +public :: run_file_parser_tests + +character(len=*), parameter :: param_filename = 'TEST_input' +character(len=*), parameter :: missing_param_filename = 'MISSING_input' +character(len=*), parameter :: netcdf_param_filename = 'TEST_input.nc' + +character(len=*), parameter :: sample_param_name = 'SAMPLE_PARAMETER' +character(len=*), parameter :: missing_param_name = 'MISSING_PARAMETER' + +character(len=*), parameter :: module_name = "SAMPLE_module" +character(len=*), parameter :: module_version = "SAMPLE_version" +character(len=*), parameter :: module_desc = "Description here" + +character(len=9), parameter :: param_docfiles(4) = [ & + "all ", & + "debugging", & + "layout ", & + "short " & +] + +contains + +subroutine test_open_param_file + type(param_file_type) :: param + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call close_param_file(param) +end subroutine test_open_param_file + + +subroutine test_close_param_file_quiet + type(param_file_type) :: param + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call close_param_file(param, quiet_close=.true.) +end subroutine test_close_param_file_quiet + + +subroutine test_open_param_file_component + type(param_file_type) :: param + integer :: i + + call create_test_file(param_filename) + + call open_param_file(param_filename, param, component="TEST") + call close_param_file(param, component="TEST") +end subroutine test_open_param_file_component + + +subroutine cleanup_open_param_file_component + integer :: i + + call delete_test_file(param_filename) + do i = 1, 4 + call delete_test_file("TEST_parameter_doc."//param_docfiles(i)) + enddo +end subroutine cleanup_open_param_file_component + + +subroutine test_open_param_file_docdir + ! TODO: Make a new directory...? + type(param_file_type) :: param + + call create_test_file(param_filename) + + call open_param_file(param_filename, param, doc_file_dir='./') + call close_param_file(param) +end subroutine test_open_param_file_docdir + + +subroutine test_open_param_file_empty_filename + type(param_file_type) :: param + + call open_param_file('', param) + ! FATAL; return to program +end subroutine test_open_param_file_empty_filename + + +subroutine test_open_param_file_long_name + !> Store filename in a variable longer than FILENAME_LENGTH + type(param_file_type) :: param + character(len=250) :: long_filename + + long_filename = param_filename + + call create_test_file(long_filename) + + call open_param_file(long_filename, param) + call close_param_file(param) +end subroutine test_open_param_file_long_name + + +subroutine test_missing_param_file + type(param_file_type) :: param + logical :: file_exists + + inquire(file=missing_param_filename, exist=file_exists) + if (file_exists) call MOM_error(FATAL, "Missing file already exists!") + + call open_param_file(missing_param_filename, param) + ! FATAL; return to program +end subroutine test_missing_param_file + + +subroutine test_open_param_file_ioerr + type(param_file_type) :: param + ! NOTE: Induce an I/O error in open() by making the file unreadable + + call create_test_file(param_filename, mode=int(o'000')) + + call open_param_file(param_filename, param) + ! FATAL; return to program +end subroutine test_open_param_file_ioerr + + +subroutine cleanup_open_param_file_ioerr + integer :: rc + + rc = chmod(param_filename, int(o'700')) + call cleanup_file_parser() +end subroutine cleanup_open_param_file_ioerr + + +subroutine test_open_param_file_netcdf + type(param_file_type) :: param + + call create_test_file(netcdf_param_filename) + + call open_param_file(netcdf_param_filename, param) + ! FATAL; return to program +end subroutine test_open_param_file_netcdf + + +subroutine cleanup_open_param_file_netcdf + integer :: param_unit + logical :: is_open + + call delete_test_file(netcdf_param_filename) +end subroutine cleanup_open_param_file_netcdf + + +subroutine test_open_param_file_checkable + type(param_file_type) :: param + + call create_test_file(param_filename) + + call open_param_file(param_filename, param, checkable=.false.) + call close_param_file(param) +end subroutine test_open_param_file_checkable + + +subroutine test_reopen_param_file + type(param_file_type) :: param + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call open_param_file(param_filename, param) + call close_param_file(param) +end subroutine test_reopen_param_file + + +subroutine test_open_param_file_no_doc + type(param_file_type) :: param + type(string) :: lines(1) + + lines(1) = string('DOCUMENT_FILE = ""') + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call close_param_file(param) +end subroutine test_open_param_file_no_doc + + +subroutine test_read_param_int + type(param_file_type) :: param + integer :: sample + type(string) :: lines(1) + character(len=*), parameter :: sample_input = '123' + integer, parameter :: sample_result = 123 + + lines = string(sample_param_name // ' = ' // sample_input) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(sample == sample_result, 'Incorrect value') +end subroutine test_read_param_int + + +subroutine test_read_param_int_missing + type(param_file_type) :: param + integer :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call read_param(param, missing_param_name, sample, fail_if_missing=.true.) + ! FATAL; return to program +end subroutine test_read_param_int_missing + + +subroutine test_read_param_int_undefined + type(param_file_type) :: param + integer :: sample + type(string) :: lines(1) + + lines = string('#undef ' // sample_param_name) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample, fail_if_missing=.true.) + ! FATAL; return to program +end subroutine test_read_param_int_undefined + + +subroutine test_read_param_int_type_err + type(param_file_type) :: param + integer :: sample + type(string) :: lines(1) + + lines = string(sample_param_name // ' = not_an_integer') + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_int_type_err + + +subroutine test_read_param_int_array + type(param_file_type) :: param + integer :: sample(3) + type(string) :: lines(1) + character(len=*), parameter :: sample_input = '1, 2, 3' + integer, parameter :: sample_result(3) = [1, 2, 3] + + lines = string(sample_param_name // ' = ' // sample_input) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(all(sample == sample_result), 'Incorrect value') +end subroutine test_read_param_int_array + + +subroutine test_read_param_int_array_missing + type(param_file_type) :: param + integer :: sample(3) + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call read_param(param, missing_param_name, sample, fail_if_missing=.true.) + ! FATAL; return to program +end subroutine test_read_param_int_array_missing + + +subroutine test_read_param_int_array_undefined + type(param_file_type) :: param + integer :: sample(3) + type(string) :: lines(1) + + lines = string('#undef ' // sample_param_name) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample, fail_if_missing=.true.) + ! FATAL; return to program +end subroutine test_read_param_int_array_undefined + + +subroutine test_read_param_int_array_type_err + type(param_file_type) :: param + integer :: sample(3) + type(string) :: lines(1) + + lines = string(sample_param_name // ' = not_an_int_array') + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_int_array_type_err + + +subroutine test_read_param_real + type(param_file_type) :: param + real :: sample + type(string) :: lines(1) + character(len=*), parameter :: sample_input = '3.14' + real, parameter :: sample_result = 3.14 + + lines = string(sample_param_name // ' = ' // sample_input) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(sample == sample_result, 'Incorrect value') +end subroutine test_read_param_real + + +subroutine test_read_param_real_missing + type(param_file_type) :: param + real :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call read_param(param, missing_param_name, sample, fail_if_missing=.true.) + ! FATAL; return to program +end subroutine test_read_param_real_missing + + +subroutine test_read_param_real_undefined + type(param_file_type) :: param + real :: sample + type(string) :: lines(1) + + lines = string('#undef ' // sample_param_name) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample, fail_if_missing=.true.) + ! FATAL; return to program +end subroutine test_read_param_real_undefined + + +subroutine test_read_param_real_type_err + type(param_file_type) :: param + real :: sample + type(string) :: lines(1) + + lines = string(sample_param_name // ' = not_a_real') + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_real_type_err + + +subroutine test_read_param_real_array + type(param_file_type) :: param + real :: sample(3) + type(string) :: lines(1) + character(len=*), parameter :: sample_input = '1., 2., 3.' + real, parameter :: sample_result(3) = [1., 2., 3.] + + lines = string(sample_param_name // ' = ' // sample_input) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(all(sample == sample_result), 'Incorrect value') +end subroutine test_read_param_real_array + + +subroutine test_read_param_real_array_missing + type(param_file_type) :: param + real :: sample(3) + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call read_param(param, missing_param_name, sample, fail_if_missing=.true.) + ! FATAL; return to program +end subroutine test_read_param_real_array_missing + + +subroutine test_read_param_real_array_undefined + type(param_file_type) :: param + real :: sample(3) + type(string) :: lines(1) + + lines = string('#undef ' // sample_param_name) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample, fail_if_missing=.true.) + ! FATAL; return to program +end subroutine test_read_param_real_array_undefined + + +subroutine test_read_param_real_array_type_err + type(param_file_type) :: param + real :: sample(3) + type(string) :: lines(1) + + lines = string(sample_param_name // ' = not_a_real_array') + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_real_array_type_err + + +subroutine test_read_param_logical + type(param_file_type) :: param + logical :: sample + type(string) :: lines(1) + character(len=*), parameter :: sample_input = 'True' + logical, parameter :: sample_result = .true. + + lines = string(sample_param_name // ' = ' // sample_input) + + !lines = string(sample_param_name // ' = True') + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(sample .eqv. sample_result, 'Incorrect value') +end subroutine test_read_param_logical + + +subroutine test_read_param_logical_missing + type(param_file_type) :: param + logical :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call read_param(param, missing_param_name, sample, fail_if_missing=.true.) + ! FATAL; return to program +end subroutine test_read_param_logical_missing + + +subroutine test_read_param_char_no_delim + type(param_file_type) :: param + character(len=8) :: sample + type(string) :: lines(1) + character(len=*), parameter :: sample_input = "abcdefgh" + character(len=*), parameter :: sample_result = "abcdefgh" + + lines = string(sample_param_name // ' = ' // sample_input) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(sample == sample_result, 'Incorrect value') +end subroutine test_read_param_char_no_delim + + +subroutine test_read_param_char_quote_delim + type(param_file_type) :: param + character(len=8) :: sample + type(string) :: lines(1) + character(len=*), parameter :: sample_input = '"abcdefgh"' + character(len=*), parameter :: sample_result = "abcdefgh" + + lines = string(sample_param_name // ' = ' // sample_input) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(sample == sample_result, 'Incorrect value') +end subroutine test_read_param_char_quote_delim + + +subroutine test_read_param_char_apostrophe_delim + type(param_file_type) :: param + character(len=8) :: sample + type(string) :: lines(1) + character(len=*), parameter :: sample_input = "'abcdefgh'" + character(len=*), parameter :: sample_result = "abcdefgh" + + lines = string(sample_param_name // " = " // sample_input) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(sample == sample_result, 'Incorrect value') +end subroutine test_read_param_char_apostrophe_delim + + +subroutine test_read_param_char_missing + type(param_file_type) :: param + character(len=8) :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call read_param(param, missing_param_name, sample, fail_if_missing=.true.) + ! FATAL; return to program +end subroutine test_read_param_char_missing + + +subroutine test_read_param_char_array + type(param_file_type) :: param + character(len=3) :: sample(3) + type(string) :: lines(1) + character(len=*), parameter :: sample_input = '"abc", "def", "ghi"' + character(len=*), parameter :: sample_result(3) = ["abc", "def", "ghi"] + + lines = string(sample_param_name // ' = ' // sample_input) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(all(sample == sample_result), 'Incorrect value') +end subroutine test_read_param_char_array + + +subroutine test_read_param_char_array_missing + type(param_file_type) :: param + character(len=8) :: sample(3) + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call read_param(param, missing_param_name, sample, fail_if_missing=.true.) + ! FATAL; return to program +end subroutine test_read_param_char_array_missing + + +subroutine test_read_param_time_date + type(param_file_type) :: param + type(time_type) :: sample + type(string) :: lines(1) + + lines = string(sample_param_name // ' = 1980-01-01 00:00:00') + call create_test_file(param_filename, lines) + + call set_calendar_type(NOLEAP) + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) +end subroutine test_read_param_time_date + + +subroutine test_read_param_time_date_bad_format + type(param_file_type) :: param + type(time_type) :: sample + type(string) :: lines(1) + + lines = string(sample_param_name // ' = 1980--01--01 00::00::00') + call create_test_file(param_filename, lines) + + call set_calendar_type(NOLEAP) + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_time_date_bad_format + + +subroutine test_read_param_time_tuple + type(param_file_type) :: param + type(time_type) :: sample + type(string) :: lines(1) + + lines = string(sample_param_name // ' = 1980,1,1,0,0,0') + call create_test_file(param_filename, lines) + + call set_calendar_type(NOLEAP) + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) +end subroutine test_read_param_time_tuple + + +subroutine test_read_param_time_bad_tuple + type(param_file_type) :: param + type(time_type) :: sample + type(string) :: lines(1) + + lines = string(sample_param_name // ' = 1980, 1') + call create_test_file(param_filename, lines) + + call set_calendar_type(NOLEAP) + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_time_bad_tuple + + +subroutine test_read_param_time_bad_tuple_values + type(param_file_type) :: param + type(time_type) :: sample + type(string) :: lines(1) + + lines = string(sample_param_name // ' = 0, 0, 0, 0, 0, 0') + call create_test_file(param_filename, lines) + + call set_calendar_type(NOLEAP) + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_time_bad_tuple_values + + +subroutine test_read_param_time_unit + type(param_file_type) :: param + type(time_type) :: sample + type(string) :: lines(1) + + lines = string(sample_param_name // ' = 0.5') + call create_test_file(param_filename, lines) + + call set_calendar_type(NOLEAP) + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample, timeunit=86400.) + call close_param_file(param) +end subroutine test_read_param_time_unit + + +subroutine test_read_param_time_missing + type(param_file_type) :: param + type(time_type) :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call read_param(param, missing_param_name, sample, fail_if_missing=.true.) + ! FATAL; return to program +end subroutine test_read_param_time_missing + + +subroutine test_read_param_time_undefined + type(param_file_type) :: param + type(time_type) :: sample + type(string) :: lines(1) + + lines = string('#undef ' // sample_param_name) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample, fail_if_missing=.true.) + ! FATAL; return to program +end subroutine test_read_param_time_undefined + + +subroutine test_read_param_time_type_err + type(param_file_type) :: param + type(time_type) :: sample + type(string) :: lines(1) + + lines = string(sample_param_name // ' = 1., 2., 3., 4., 5., 6.') + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_time_type_err + +! Generic parameter tests + +subroutine test_read_param_unused_fatal + type(param_file_type) :: param + type(string) :: lines(2) + + lines = [ & + string('FATAL_UNUSED_PARAMS = True'), & + string(sample_param_name // ' = 1') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call close_param_file(param) + ! FATAL; return to program +end subroutine test_read_param_unused_fatal + + +subroutine test_read_param_replace_tabs + type(param_file_type) :: param + integer :: sample + type(string) :: lines(1) + character(len=*), parameter :: sample_input = "1" + integer, parameter :: sample_result = 1 + character, parameter :: tab = achar(9) + + lines = string(sample_param_name // tab // '=' // tab // sample_input) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(sample == sample_result, 'Incorrect value') +end subroutine test_read_param_replace_tabs + + +subroutine test_read_param_pad_equals + type(param_file_type) :: param + integer :: sample + type(string) :: lines(1) + character(len=*), parameter :: sample_input = "1" + integer, parameter :: sample_result = 1 + + lines = string(sample_param_name // '=' // sample_input) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(sample == sample_result, 'Incorrect value') +end subroutine test_read_param_pad_equals + + +subroutine test_read_param_multiline_param + type(param_file_type) :: param + integer :: sample + type(string) :: lines(2) + integer, parameter :: sample_result = 1 + character, parameter :: backslash = achar(92) + + lines = [ & + string(sample_param_name // ' = ' // backslash), & + string(' 1') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(sample == sample_result, 'Incorrect result') +end subroutine test_read_param_multiline_param + + +subroutine test_read_param_multiline_param_unclosed + type(param_file_type) :: param + integer :: sample + type(string) :: lines(1) + character, parameter :: backslash = achar(92) + + lines = string(sample_param_name // ' = ' // backslash) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + ! FATAL; return to program +end subroutine test_read_param_multiline_param_unclosed + + +subroutine test_read_param_multiline_comment + type(param_file_type) :: param + integer :: sample + + type(string) :: lines(6) + + lines = [ & + string('/* First C comment line'), & + string(' Second C comment line */'), & + string('// First C++ comment line'), & + string('// Second C++ comment line'), & + string('! First Fortran comment line'), & + string('! Second Fortran comment line') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call close_param_file(param) +end subroutine test_read_param_multiline_comment + + +subroutine test_read_param_multiline_comment_unclosed + type(param_file_type) :: param + integer :: sample + type(string) :: lines(1) + + lines = string('/* Unclosed C comment') + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + ! FATAL; return to program +end subroutine test_read_param_multiline_comment_unclosed + + +subroutine test_read_param_misplaced_quote + type(param_file_type) :: param + character(len=20) :: sample + type(string) :: lines(1) + + lines = string(sample_param_name // ' = "abc') + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + ! FATAL; return to program +end subroutine test_read_param_misplaced_quote + + +subroutine test_read_param_define + type(param_file_type) :: param + integer :: sample + type(string) :: lines(1) + integer, parameter :: sample_result = 2 + + lines = string('#define ' // sample_param_name // ' 2') + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(sample == sample_result, 'Incorrect value') +end subroutine test_read_param_define + + +subroutine test_read_param_define_as_flag + type(param_file_type) :: param + integer :: sample + type(string) :: lines(1) + + lines = string('#define ' // sample_param_name) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) +end subroutine test_read_param_define_as_flag + + +subroutine test_read_param_override + type(param_file_type) :: param + integer :: sample + type(string) :: lines(2) + integer, parameter :: sample_result = 2 + + lines = [ & + string(sample_param_name // ' = 1'), & + string('#override ' // sample_param_name // ' = 2') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(sample == sample_result, 'Incorrect value') +end subroutine test_read_param_override + + +subroutine test_read_param_override_misplaced + type(param_file_type) :: param + integer :: sample + type(string) :: lines(1) + + lines(1) = string('#define #override ' // sample_param_name // ' = 1') + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + ! FATAL; return to program +end subroutine test_read_param_override_misplaced + + +subroutine test_read_param_override_twice + type(param_file_type) :: param + integer :: sample + type(string) :: lines(3) + + lines = [ & + string(sample_param_name // ' = 1'), & + string('#override ' // sample_param_name // ' = 2'), & + string('#override ' // sample_param_name // ' = 3') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_override_twice + + +subroutine test_read_param_override_repeat + type(param_file_type) :: param + integer :: sample + type(string) :: lines(3) + + lines = [ & + string(sample_param_name // ' = 1'), & + string('#override ' // sample_param_name // ' = 2'), & + string('#override ' // sample_param_name // ' = 2') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_override_repeat + + +subroutine test_read_param_override_warn_chain + type(param_file_type) :: param + integer :: sample + character(len=*), parameter :: other_param_name = 'OTHER_PARAMETER' + type(string) :: lines(4) + + lines = [ & + string(other_param_name // ' = 1'), & + string(sample_param_name // ' = 2'), & + string('#override ' // other_param_name // ' = 3'), & + string('#override ' // sample_param_name // ' = 4') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + ! First invoke the "other" override, adding it to the chain + call read_param(param, other_param_name, sample) + ! Now invoke the "sample" override, with "other" in the chain + call read_param(param, sample_param_name, sample) + ! Finally, re-invoke the "other" override, having already been issued. + call read_param(param, other_param_name, sample) + call close_param_file(param) +end subroutine test_read_param_override_warn_chain + + +subroutine test_read_param_assign_after_override + type(param_file_type) :: param + integer :: sample + type(string) :: lines(2) + + lines = [ & + string('#override ' // sample_param_name // ' = 2'), & + string(sample_param_name // ' = 3') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) +end subroutine test_read_param_assign_after_override + + +subroutine test_read_param_override_no_def + type(param_file_type) :: param + integer :: sample + type(string) :: lines(1) + + lines(1) = string('#override ' // sample_param_name) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_override_no_def + + +subroutine test_read_param_assign_twice + type(param_file_type) :: param + integer :: sample + type(string) :: lines(2) + + lines = [ & + string(sample_param_name // ' = 1'), & + string(sample_param_name // ' = 2') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_assign_twice + + +subroutine test_read_param_assign_repeat + type(param_file_type) :: param + integer :: sample + type(string) :: lines(2) + + lines = [ & + string(sample_param_name // ' = 1'), & + string(sample_param_name // ' = 1') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) +end subroutine test_read_param_assign_repeat + + +subroutine test_read_param_null_stmt + type(param_file_type) :: param + integer :: sample + type(string) :: lines(1) + + lines(1) = string(sample_param_name) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_null_stmt + + +subroutine test_read_param_assign_in_define + type(param_file_type) :: param + integer :: sample + type(string) :: lines(1) + + lines = string('#define ' // sample_param_name // ' = 1') + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_assign_in_define + +!-- Blocks + +subroutine test_read_param_block + type(param_file_type) :: param + integer :: sample + type(string) :: lines(3) + integer, parameter :: sample_result = 123 + + lines = [ & + string('ABC%'), & + string('ABC%' // sample_param_name // ' = 123'), & + string('%ABC') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call openParameterBlock(param, 'ABC') + call read_param(param, sample_param_name, sample) + call closeParameterBlock(param) + call clearParameterBlock(param) + call close_param_file(param) + + call assert(sample == sample_result, 'Incorrect value') +end subroutine test_read_param_block + + +! TODO: This test fails due to an implementation issue. +subroutine test_read_param_block_stack + type(param_file_type) :: param + integer :: sample + type(string) :: lines(5) + + lines = [ & + string('ABC%'), & + string('DEF%'), & + string(sample_param_name // ' = 123'), & + string('DEF%'), & + string('%ABC') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call openParameterBlock(param, 'ABC') + call openParameterBlock(param, 'DEF') + call read_param(param, sample_param_name, sample) + call closeParameterBlock(param) + call clearParameterBlock(param) + call close_param_file(param) +end subroutine test_read_param_block_stack + + +! NOTE: This is a simpler version of the block_stack test which works +subroutine test_read_param_block_inline_stack + type(param_file_type) :: param + integer :: sample + type(string) :: lines(3) + + lines = [ & + string('ABC%'), & + string('DEF%' // sample_param_name // ' = 123'), & + string('%ABC') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call openParameterBlock(param, 'ABC') + call openParameterBlock(param, 'DEF') + call read_param(param, sample_param_name, sample) + call closeParameterBlock(param) + call clearParameterBlock(param) + call close_param_file(param) +end subroutine test_read_param_block_inline_stack + + +subroutine test_read_param_block_empty_pop + type(param_file_type) :: param + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call openParameterBlock(param, '%') + call openParameterBlock(param, 'ABC') + call closeParameterBlock(param) + call closeParameterBlock(param) + ! FATAL; return to program +end subroutine test_read_param_block_empty_pop + + +subroutine test_read_param_block_close_unnamed + type(param_file_type) :: param + type(string) :: lines(2) + + lines = [ & + string('ABC%'), & + string('%ABC') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call openParameterBlock(param, 'ABC') + call closeParameterBlock(param) + call closeParameterBlock(param) + ! FATAL; return to program +end subroutine test_read_param_block_close_unnamed + + +subroutine test_read_param_block_close_unopened + type(param_file_type) :: param + type(string) :: lines(1) + + lines = string('%CBA') + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + ! FATAL; return to program +end subroutine test_read_param_block_close_unopened + + +subroutine test_read_param_block_unmatched + type(param_file_type) :: param + type(string) :: lines(2) + + lines = [ & + string('ABC%'), & + string('%CBA') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + ! FATAL; return to program +end subroutine test_read_param_block_unmatched + + +subroutine test_open_unallocated_block + type(param_file_type) :: param + character(len=*), parameter :: block_name = "ABC" + + call openParameterBlock(param, block_name) + ! FATAL; return to program +end subroutine test_open_unallocated_block + + +subroutine test_close_unallocated_block + type(param_file_type) :: param + + call closeParameterBlock(param) + ! FATAL; return to program +end subroutine test_close_unallocated_block + + +subroutine test_clear_unallocated_block + type(param_file_type) :: param + + call clearParameterBlock(param) + ! FATAL; return to program +end subroutine test_clear_unallocated_block + + +subroutine test_read_param_block_outside_block + type(param_file_type) :: param + integer :: sample + type(string) :: lines(3) + + lines = [ & + string('ABC%'), & + string(sample_param_name // ' = 1'), & + string('%ABC') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) +end subroutine test_read_param_block_outside_block + +!--- + +subroutine test_log_version_cs + type(param_file_type) :: param + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call log_version(param, module_name, module_version, desc=module_desc) + call close_param_file(param) +end subroutine test_log_version_cs + + +subroutine test_log_version_plain + call log_version(module_name, module_version) +end subroutine test_log_version_plain + + +subroutine test_log_param_int + type(param_file_type) :: param + integer, parameter :: sample = 1 + character(len=*), parameter :: desc = "Parameter description" + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call log_param(param, module_name, sample_param_name, sample, desc=desc) + call close_param_file(param) +end subroutine test_log_param_int + + +subroutine test_log_param_int_array + type(param_file_type) :: param + integer, parameter :: sample(3) = [1, 2, 3] + character(len=*), parameter :: desc = "Parameter description" + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call log_param(param, module_name, sample_param_name, sample, desc=desc) + call close_param_file(param) +end subroutine test_log_param_int_array + + +subroutine test_log_param_real + type(param_file_type) :: param + real, parameter :: sample = 1. + character(len=*), parameter :: desc = "Parameter description" + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call log_param(param, module_name, sample_param_name, sample, desc=desc) + call close_param_file(param) +end subroutine test_log_param_real + + +subroutine test_log_param_real_array + type(param_file_type) :: param + real, parameter :: sample(3) = [1., 2., 3.] + character(len=*), parameter :: desc = "Parameter description" + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call log_param(param, module_name, sample_param_name, sample, desc=desc) + call close_param_file(param) +end subroutine test_log_param_real_array + + +subroutine test_log_param_time + type(param_file_type) :: param + type(time_type) :: sample + character(len=*), parameter :: desc = "Parameter description" + type(string) :: lines(1) + + lines = string(sample_param_name // ' = 1980,1,1,0,0,0') + + call set_calendar_type(NOLEAP) + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call log_param(param, module_name, sample_param_name, sample, desc=desc) + call close_param_file(param) +end subroutine test_log_param_time + + +subroutine test_log_param_time_as_date + type(param_file_type) :: param + type(time_type) :: sample + character(len=*), parameter :: desc = "Parameter description" + + call set_calendar_type(NOLEAP) + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + sample = set_date(1980, 1, 1, 0, 0, 0) + call log_param(param, module_name, sample_param_name, sample, desc=desc, & + log_date=.true.) + call close_param_file(param) +end subroutine test_log_param_time_as_date + + +subroutine test_log_param_time_as_date_default + type(param_file_type) :: param + type(time_type) :: sample + type(time_type) :: default_date + character(len=*), parameter :: desc = "Parameter description" + + call set_calendar_type(NOLEAP) + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + + call set_ticks_per_second(60) + default_date = set_date(1980, 1, 1, 0, 0, 0, 30) + call log_param(param, module_name, sample_param_name, sample, desc=desc, & + log_date=.true., default=default_date) + + call set_ticks_per_second(300) + default_date = set_date(1980, 1, 1, 0, 0, 0, 150) + call log_param(param, module_name, sample_param_name, sample, desc=desc, & + log_date=.true., default=default_date) + + call close_param_file(param) +end subroutine test_log_param_time_as_date_default + + +subroutine test_log_param_time_as_date_tick + type(param_file_type) :: param + type(time_type) :: sample + character(len=*), parameter :: desc = "Parameter description" + + call set_calendar_type(NOLEAP) + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call log_param(param, module_name, sample_param_name, sample, desc=desc, & + log_date=.true.) + call close_param_file(param) +end subroutine test_log_param_time_as_date_tick + + +subroutine test_log_param_time_with_unit + type(param_file_type) :: param + type(time_type) :: sample + type(time_type) :: default_date + character(len=*), parameter :: desc = "Parameter description" + character(len=*), parameter :: sample_units = "days since whatever" + + call set_calendar_type(NOLEAP) + call create_test_file(param_filename) + + call set_ticks_per_second(60) + sample = set_date(1980, 1, 1, 0, 0, 0, 30) + + default_date = set_date(1980, 1, 1, 0, 0, 0, 30) + + call open_param_file(param_filename, param) + call log_param(param, module_name, sample_param_name, sample, desc=desc, & + units=sample_units, timeunit=86400., default=default_date) + call close_param_file(param) +end subroutine test_log_param_time_with_unit + + +subroutine test_log_param_time_with_timeunit + type(param_file_type) :: param + type(time_type) :: sample + integer :: i + character(len=*), parameter :: desc = "Parameter description" + real, parameter :: timeunits(5) = [1., 3600., 86400., 3.1e7, 1e8] + + call set_calendar_type(NOLEAP) + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + do i = 1,5 + call log_param(param, module_name, sample_param_name, sample, desc=desc, & + timeunit=timeunits(i)) + enddo + call close_param_file(param) +end subroutine test_log_param_time_with_timeunit + +!---- + +subroutine test_get_param_int + type(param_file_type) :: param + integer :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample) + call close_param_file(param) +end subroutine test_get_param_int + + +subroutine test_get_param_int_no_read_no_log + type(param_file_type) :: param + integer :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample, & + do_not_read=.true., do_not_log=.true.) + call close_param_file(param) +end subroutine test_get_param_int_no_read_no_log + + +subroutine test_get_param_int_array + type(param_file_type) :: param + integer :: sample(3) + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample) + call close_param_file(param) +end subroutine test_get_param_int_array + + +subroutine test_get_param_int_array_no_read_no_log + type(param_file_type) :: param + integer :: sample(3) + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample, & + do_not_read=.true., do_not_log=.true.) + call close_param_file(param) +end subroutine test_get_param_int_array_no_read_no_log + + +subroutine test_get_param_real + type(param_file_type) :: param + real :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample) + call close_param_file(param) +end subroutine test_get_param_real + + +subroutine test_get_param_real_no_read_no_log + type(param_file_type) :: param + real :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample, & + do_not_read=.true., do_not_log=.true.) + call close_param_file(param) +end subroutine test_get_param_real_no_read_no_log + + +subroutine test_get_param_real_array + type(param_file_type) :: param + real :: sample(3) + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample) + call close_param_file(param) +end subroutine test_get_param_real_array + + +subroutine test_get_param_real_array_no_read_no_log + type(param_file_type) :: param + real :: sample(3) + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample, & + do_not_read=.true., do_not_log=.true.) + call close_param_file(param) +end subroutine test_get_param_real_array_no_read_no_log + + +subroutine test_get_param_char + type(param_file_type) :: param + character(len=8) :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample) + call close_param_file(param) +end subroutine test_get_param_char + + +subroutine test_get_param_char_no_read_no_log + type(param_file_type) :: param + character(len=8) :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample, & + do_not_read=.true., do_not_log=.true.) + call close_param_file(param) +end subroutine test_get_param_char_no_read_no_log + + +subroutine test_get_param_char_array + type(param_file_type) :: param + character(len=8) :: sample(3) + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample) + call close_param_file(param) +end subroutine test_get_param_char_array + + +subroutine test_get_param_logical + type(param_file_type) :: param + logical :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample) + call close_param_file(param) +end subroutine test_get_param_logical + + +subroutine test_get_param_logical_no_read_no_log + type(param_file_type) :: param + logical :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample, & + do_not_read=.true., do_not_log=.true.) + call close_param_file(param) +end subroutine test_get_param_logical_no_read_no_log + + +subroutine test_get_param_logical_default + type(param_file_type) :: param + logical :: sample + logical, parameter :: default_value = .false. + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample, & + default=default_value) + call close_param_file(param) +end subroutine test_get_param_logical_default + + +subroutine test_get_param_time + type(param_file_type) :: param + type(time_type) :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample) + call close_param_file(param) +end subroutine test_get_param_time + + +subroutine test_get_param_time_no_read_no_log + type(param_file_type) :: param + type(time_type) :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample, & + do_not_read=.true., do_not_log=.true.) + call close_param_file(param) +end subroutine test_get_param_time_no_read_no_log + + +! Utility functions +! TODO: Move to a generic testing module + +subroutine cleanup_file_parser + integer :: i + + call delete_test_file(param_filename) + do i = 1, 4 + call delete_test_file("MOM_parameter_doc."//param_docfiles(i)) + enddo + + call set_calendar_type(NO_CALENDAR) +end subroutine cleanup_file_parser + + +subroutine run_file_parser_tests + ! testing... + type(TestSuite) :: suite + + ! Delete any pre-existing test parameter files + call cleanup_file_parser + + ! Build the test suite + suite = TestSuite() + suite%cleanup => cleanup_file_parser + + call suite%add(test_open_param_file, "test_open_param_file") + + call suite%add(test_close_param_file_quiet, "test_close_param_file_quiet") + + call suite%add(test_open_param_file_component, "test_open_param_file_component", & + cleanup=cleanup_open_param_file_component) + + call suite%add(test_open_param_file_docdir, "test_open_param_file_docdir") + + call suite%add(test_open_param_file_empty_filename, & + "test_open_param_file_empty_filename", fatal=.true.) + + call suite%add(test_open_param_file_long_name, & + "test_open_param_file_longname") + + call suite%add(test_missing_param_file, "test_missing_param_file", & + fatal=.true.) + + call suite%add(test_open_param_file_ioerr, "test_open_param_file_ioerr", & + fatal=.true., cleanup=cleanup_open_param_file_ioerr) + + call suite%add(test_open_param_file_checkable, & + "test_open_param_file_checkable") + + call suite%add(test_reopen_param_file, "test_reopen_param_file") + + call suite%add(test_open_param_file_netcdf, "test_open_param_file_netcdf", & + fatal=.true., cleanup=cleanup_open_param_file_netcdf) + + call suite%add(test_open_param_file_no_doc, "test_open_param_file_no_doc") + + call suite%add(test_read_param_int, "test_read_param_int") + + call suite%add(test_read_param_int_missing, "test_read_param_int_missing", & + fatal=.true.) + + call suite%add(test_read_param_int_undefined, & + "test_read_param_int_undefined", fatal=.true.) + + call suite%add(test_read_param_int_type_err, & + "test_read_param_int_type_err", fatal=.true.) + + call suite%add(test_read_param_int_array, "test_read_param_int_array") + + call suite%add(test_read_param_int_array_missing, & + "test_read_param_int_array_missing", fatal=.true.) + + call suite%add(test_read_param_int_array_undefined, & + "test_read_param_int_array_undefined", fatal=.true.) + + call suite%add(test_read_param_int_array_type_err, & + "test_read_param_int_array_type_err", fatal=.true.) + + call suite%add(test_read_param_real, "test_read_param_real") + + call suite%add(test_read_param_real_missing, & + "test_read_param_real_missing", fatal=.true.) + + call suite%add(test_read_param_real_undefined, & + "test_read_param_real_undefined", fatal=.true.) + + call suite%add(test_read_param_real_type_err, & + "test_read_param_real_type_err", fatal=.true.) + + call suite%add(test_read_param_real_array, "test_read_param_real_array") + + call suite%add(test_read_param_real_array_missing, & + "test_read_param_real_array_missing", fatal=.true.) + + call suite%add(test_read_param_real_array_undefined, & + "test_read_param_real_array_undefined", fatal=.true.) + + call suite%add(test_read_param_real_array_type_err, & + "test_read_param_real_array_type_err", fatal=.true.) + + call suite%add(test_read_param_logical, "test_read_param_logical") + + call suite%add(test_read_param_logical_missing, & + "test_read_param_logical_missing", fatal=.true.) + + call suite%add(test_read_param_char_no_delim, & + "test_read_param_char_no_delim") + + call suite%add(test_read_param_char_quote_delim, & + "test_read_param_char_quote_delim") + + call suite%add(test_read_param_char_apostrophe_delim, & + "test_read_param_char_apostrophe_delim") + + call suite%add(test_read_param_char_missing, & + "test_read_param_char_missing", fatal=.true.) + + call suite%add(test_read_param_char_array, "test_read_param_char_array") + + call suite%add(test_read_param_char_array_missing, & + "test_read_param_char_array_missing", fatal=.true.) + + call suite%add(test_read_param_time_date, "test_read_param_time_date") + + call suite%add(test_read_param_time_date_bad_format, & + "test_read_param_time_date_bad_format", fatal=.true.) + + call suite%add(test_read_param_time_tuple, "test_read_param_time_tuple") + + call suite%add(test_read_param_time_bad_tuple, & + "test_read_param_time_bad_tuple", fatal=.true.) + + call suite%add(test_read_param_time_bad_tuple_values, & + "test_read_param_time_bad_tuple_values", fatal=.true.) + + call suite%add(test_read_param_time_missing, & + "test_read_param_time_missing", fatal=.true.) + + call suite%add(test_read_param_time_undefined, & + "test_read_param_time_undefined", fatal=.true.) + + call suite%add(test_read_param_time_type_err, & + "test_read_param_time_type_err", fatal=.true.) + + call suite%add(test_read_param_time_unit, "test_read_param_time_unit") + + call suite%add(test_read_param_unused_fatal, & + "test_read_param_unused_fatal", fatal=.true.) + + call suite%add(test_read_param_multiline_comment, & + "test_read_param_multiline_comment") + + call suite%add(test_read_param_multiline_comment_unclosed, & + "test_read_param_multiline_comment_unclosed", fatal=.true.) + + call suite%add(test_read_param_multiline_param, & + "test_read_param_multiline_param") + + call suite%add(test_read_param_multiline_param_unclosed, & + "test_read_param_multiline_param_unclosed", fatal=.true.) + + call suite%add(test_read_param_replace_tabs, "test_read_param_replace_tabs") + + call suite%add(test_read_param_pad_equals, "test_read_param_pad_equals") + + call suite%add(test_read_param_misplaced_quote, & + "test_read_param_misplaced_quote", fatal=.true.) + + call suite%add(test_read_param_define, "test_read_param_define") + + call suite%add(test_read_param_define_as_flag, & + "test_read_param_define_as_flag") + + call suite%add(test_read_param_override, "test_read_param_override") + + call suite%add(test_read_param_override_misplaced, & + "test_read_param_override_misplaced", fatal=.true.) + + call suite%add(test_read_param_override_twice, & + "test_read_param_override_twice", fatal=.true.) + + call suite%add(test_read_param_override_repeat, & + "test_read_param_override_repeat", fatal=.true.) + + call suite%add(test_read_param_override_warn_chain, & + "test_read_param_override_warn_chain") + + call suite%add(test_read_param_override_no_def, & + "test_read_param_override_no_def", fatal=.true.) + + call suite%add(test_read_param_assign_after_override, & + "test_read_param_assign_after_override") + + call suite%add(test_read_param_assign_twice, & + "test_read_param_assign_twice", fatal=.true.) + + call suite%add(test_read_param_assign_repeat, & + "test_read_param_assign_repeat") + + call suite%add(test_read_param_null_stmt, "test_read_param_null_stmt", & + fatal=.true.) + + call suite%add(test_read_param_assign_in_define, & + "test_read_param_assign_in_define", fatal=.true.) + + call suite%add(test_read_param_block, "test_read_param_block") + + ! FIXME: Test does not pass + !call suite%add(test_read_param_block_stack, "test_read_param_block_stack") + + call suite%add(test_read_param_block_inline_stack, & + "test_read_param_block_inline_stack") + + call suite%add(test_read_param_block_empty_pop, & + "test_read_param_block_empty_pop", fatal=.true.) + + call suite%add(test_read_param_block_close_unopened, & + "test_read_param_block_close_unopened", fatal=.true.) + + call suite%add(test_read_param_block_close_unnamed, & + "test_read_param_block_close_unnamed", fatal=.true.) + + call suite%add(test_read_param_block_unmatched, & + "test_read_param_block_unmatched", fatal=.true.) + + call suite%add(test_read_param_block_outside_block, & + "test_read_param_block_outside_block") + + call suite%add(test_open_unallocated_block, "test_open_unallocated_block", & + fatal=.true.) + + call suite%add(test_close_unallocated_block, & + "test_close_unallocated_block", fatal=.true.) + + call suite%add(test_clear_unallocated_block, & + "test_clear_unallocated_block", fatal=.true.) + + call suite%add(test_log_version_cs, "test_log_version_cs") + + call suite%add(test_log_version_plain, "test_log_version_plain") + + call suite%add(test_log_param_int, "test_log_param_int") + + call suite%add(test_log_param_int_array, "test_log_param_int_array") + + call suite%add(test_log_param_real, "test_log_param_real") + + call suite%add(test_log_param_real_array, "test_log_param_real_array") + + call suite%add(test_log_param_time, "test_log_param_time") + + call suite%add(test_log_param_time_as_date, "test_log_param_time_as_date") + + call suite%add(test_log_param_time_as_date_default, & + "test_log_param_time_as_date_default") + + call suite%add(test_log_param_time_as_date_tick, & + "test_log_param_time_as_date_tick") + + call suite%add(test_log_param_time_with_unit, & + "test_log_param_time_with_unit") + + call suite%add(test_log_param_time_with_timeunit, & + "test_log_param_time_with_timeunit") + + call suite%add(test_get_param_int, "test_get_param_int") + + call suite%add(test_get_param_int_no_read_no_log, & + "test_get_param_int_no_read_no_log") + + call suite%add(test_get_param_int_array, "test_get_param_int_array") + + call suite%add(test_get_param_int_array_no_read_no_log, & + "test_get_param_int_array_no_read_no_log") + + call suite%add(test_get_param_real, "test_get_param_real") + + call suite%add(test_get_param_real_no_read_no_log, & + "test_get_param_real_n_read_no_log") + + call suite%add(test_get_param_real_array, "test_get_param_real_array") + + call suite%add(test_get_param_real_array_no_read_no_log, & + "test_get_param_real_array_no_read_no_log") + + call suite%add(test_get_param_char, "test_get_param_char") + + call suite%add(test_get_param_char_no_read_no_log, & + "test_get_param_char_no_read_no_log") + + call suite%add(test_get_param_char_array, "test_get_param_char_array") + + call suite%add(test_get_param_logical, "test_get_param_logical") + + call suite%add(test_get_param_logical_default, & + "test_get_param_logical_default") + + call suite%add(test_get_param_logical_no_read_no_log, & + "test_get_param_logical_no_read_no_log") + + call suite%add(test_get_param_time, "test_get_param_time") + + call suite%add(test_get_param_time_no_read_no_log, & + "test_get_param_time_np_read_no_log") + + call suite%run() +end subroutine run_file_parser_tests + +end module MOM_file_parser_tests