From 90583aeb369831b01296ab4b0e7e6a1b69ed91b1 Mon Sep 17 00:00:00 2001 From: uramirez8707 <49168881+uramirez8707@users.noreply.github.com> Date: Fri, 12 Nov 2021 12:07:37 -0500 Subject: [PATCH] Yaml Parser (#858) Adds fortran wrappers to libyaml, enabled via the -Duse_yaml macro Adds unit test to test if the parser is working/crashing as expected Adds an option, --with-yaml to autotools that checks that the environment is set up correctly and adds the -Duse_yaml macro to your compilation. Implements the parser to read data_table.yaml and tests this using an ongrid data_override test --- Makefile.am | 1 + configure.ac | 21 + data_override/data_override.F90 | 304 ++++++++----- docs/Doxyfile.in | 2 +- docs/grouping.h | 4 + fms/fms.F90 | 2 +- libFMS/Makefile.am | 1 + parser/Makefile.am | 42 ++ parser/yaml_parser.F90 | 429 ++++++++++++++++++ parser/yaml_parser_binding.c | 342 ++++++++++++++ test_fms/Makefile.am | 2 +- test_fms/data_override/Makefile.am | 2 +- test_fms/data_override/test_data_override2.sh | 13 + test_fms/parser/Makefile.am | 54 +++ test_fms/parser/check_crashes.F90 | 255 +++++++++++ test_fms/parser/parser_demo.F90 | 119 +++++ test_fms/parser/parser_demo2.F90 | 108 +++++ test_fms/parser/test_yaml_parser.F90 | 155 +++++++ test_fms/parser/test_yaml_parser.sh | 218 +++++++++ 19 files changed, 1953 insertions(+), 121 deletions(-) create mode 100644 parser/Makefile.am create mode 100644 parser/yaml_parser.F90 create mode 100644 parser/yaml_parser_binding.c create mode 100644 test_fms/parser/Makefile.am create mode 100644 test_fms/parser/check_crashes.F90 create mode 100644 test_fms/parser/parser_demo.F90 create mode 100644 test_fms/parser/parser_demo2.F90 create mode 100644 test_fms/parser/test_yaml_parser.F90 create mode 100755 test_fms/parser/test_yaml_parser.sh diff --git a/Makefile.am b/Makefile.am index 5f414d5746..9254d916e5 100644 --- a/Makefile.am +++ b/Makefile.am @@ -42,6 +42,7 @@ SUBDIRS = \ fms2_io \ mosaic2 \ fms \ + parser \ affinity \ mosaic \ time_manager \ diff --git a/configure.ac b/configure.ac index b340c72510..2ec32cd803 100644 --- a/configure.ac +++ b/configure.ac @@ -67,6 +67,12 @@ AC_ARG_WITH([mpi], AS_IF([test ${with_mpi:-yes} = yes], [with_mpi=yes], [with_mpi=no]) +AC_ARG_WITH([yaml], + [AS_HELP_STRING([--with-yaml], + [Build with YAML support. This option will be ignored if --disable-fortran-flag-setting is also given. (Default no)])]) +AS_IF([test ${with_yaml:-no} = no], + [with_yaml=no], + [with_yaml=yes]) AC_ARG_ENABLE([setting-flags], [AS_HELP_STRING([--enable-setting-flags], [Allow configure to set some compiler flags. Disabling this will also disable any other --with or --enable options that set flags, and will only use user-provided falgs. (Default yes)])]) @@ -122,6 +128,19 @@ if test $with_mpi = yes; then AC_CHECK_FUNC([MPI_Init], [], [AC_MSG_ERROR([Can't find the MPI C library. Set CC/LDFLAGS/LIBS])]) fi +# Require yaml +if test $with_yaml = yes; then + AC_CHECK_HEADERS([yaml.h], [], [AC_MSG_ERROR(["Can't find the libYAML C header file. Set CC/CPPFLAGS/CFLAGS"])]) + AC_SEARCH_LIBS([yaml_parser_initialize], [yaml], [], [AC_MSG_ERROR(["Can't find the libYAML C library. Set CC/LDFLAGS/LIBS"])]) + + #If the test pass, define use_yaml macro + AC_DEFINE([use_yaml], [1], [This is required to use yaml parser]) + + AM_CONDITIONAL([SKIP_PARSER_TESTS], false ) +else + AM_CONDITIONAL([SKIP_PARSER_TESTS], true ) +fi + # Require netCDF AC_CHECK_HEADERS([netcdf.h], [], [AC_MSG_ERROR([Can't find the netCDF C header file. Set CPPFLAGS/CFLAGS])]) AC_SEARCH_LIBS([nc_create], [netcdf], [], [AC_MSG_ERROR([Can't find the netCDF C library. Set LDFLAGS/LIBS])]) @@ -337,6 +356,7 @@ AC_CONFIG_FILES([ random_numbers/Makefile libFMS/Makefile docs/Makefile + parser/Makefile test_fms/test_common.sh test_fms/Makefile test_fms/diag_manager/Makefile @@ -357,6 +377,7 @@ AC_CONFIG_FILES([ test_fms/mosaic/Makefile test_fms/affinity/Makefile test_fms/coupler/Makefile + test_fms/parser/Makefile FMS.pc ]) diff --git a/data_override/data_override.F90 b/data_override/data_override.F90 index 013897aec6..e6f9dcd575 100644 --- a/data_override/data_override.F90 +++ b/data_override/data_override.F90 @@ -40,6 +40,7 @@ !> @brief File for @ref data_override_mod module data_override_mod +use yaml_parser_mod use constants_mod, only: PI use mpp_mod, only : mpp_error, FATAL, WARNING, stdout, stdlog, mpp_max use mpp_mod, only : input_nml_file @@ -139,7 +140,12 @@ module data_override_mod real :: min_glo_lon_lnd, max_glo_lon_lnd real :: min_glo_lon_ice, max_glo_lon_ice integer:: num_fields = 0 !< number of fields in override_array already processed +#ifdef use_yaml +type(data_type), dimension(:), allocatable :: data_table !< user-provided data table +#else type(data_type), dimension(max_table) :: data_table !< user-provided data table +#endif + type(data_type) :: default_table type(override_type), dimension(max_array), save :: override_array !< to store processed fields type(override_type), save :: default_array @@ -188,15 +194,10 @@ subroutine data_override_init(Atm_domain_in, Ocean_domain_in, Ice_domain_in, Lan character(len=128) :: grid_file = 'INPUT/grid_spec.nc' integer :: is,ie,js,je,use_get_grid_version - integer :: i, iunit, ntable, ntable_lima, ntable_new, unit,io_status, ierr - character(len=256) :: record + integer :: i, unit, io_status, ierr logical :: file_open - logical :: ongrid - character(len=128) :: region, region_type type(FmsNetcdfFile_t) :: fileobj - type(data_type) :: data_entry - debug_data_override = .false. read (input_nml_file, data_override_nml, iostat=io_status) @@ -235,9 +236,133 @@ subroutine data_override_init(Atm_domain_in, Ocean_domain_in, Ice_domain_in, Lan default_table%file_name = 'none' default_table%factor = 1. default_table%interpol_method = 'bilinear' + +#ifdef use_yaml + call read_table_yaml(data_table) +#else do i = 1,max_table data_table(i) = default_table enddo + call read_table(data_table) +#endif + +! Initialize override array + default_array%gridname = 'NONE' + default_array%fieldname = 'NONE' + default_array%t_index = -1 + default_array%dims = -1 + default_array%comp_domain = -1 + do i = 1, max_array + override_array(i) = default_array + enddo + call time_interp_external_init + end if + + module_is_initialized = .TRUE. + + if ( .NOT. (atm_on .or. ocn_on .or. lnd_on .or. ice_on .or. lndUG_on)) return + call fms2_io_init + +! Test if grid_file is already opened + inquire (file=trim(grid_file), opened=file_open) + if(file_open) call mpp_error(FATAL, trim(grid_file)//' already opened') + + if(.not. open_file(fileobj, grid_file, 'read' )) then + call mpp_error(FATAL, 'data_override_mod: Error in opening file '//trim(grid_file)) + endif + + if(variable_exists(fileobj, "x_T" ) .OR. variable_exists(fileobj, "geolon_t" ) ) then + use_get_grid_version = 1 + call close_file(fileobj) + else if(variable_exists(fileobj, "ocn_mosaic_file" ) .OR. variable_exists(fileobj, "gridfiles" ) ) then + use_get_grid_version = 2 + if(variable_exists(fileobj, "gridfiles" ) ) then + if(count_ne_1((ocn_on .OR. ice_on), lnd_on, atm_on)) call mpp_error(FATAL, 'data_override_mod: the grid file ' // & + 'is a solo mosaic, one and only one of atm_on, lnd_on or ice_on/ocn_on should be true') + end if + else + call mpp_error(FATAL, 'data_override_mod: none of x_T, geolon_t, ocn_mosaic_file or gridfiles exist in '//trim(grid_file)) + endif + + if(use_get_grid_version .EQ. 1) then + if (atm_on .and. .not. allocated(lon_local_atm) ) then + call mpp_get_compute_domain( atm_domain,is,ie,js,je) + allocate(lon_local_atm(is:ie,js:je), lat_local_atm(is:ie,js:je)) + call get_grid_version_1(grid_file, 'atm', atm_domain, is, ie, js, je, lon_local_atm, lat_local_atm, & + min_glo_lon_atm, max_glo_lon_atm, grid_center_bug ) + endif + if (ocn_on .and. .not. allocated(lon_local_ocn) ) then + call mpp_get_compute_domain( ocn_domain,is,ie,js,je) + allocate(lon_local_ocn(is:ie,js:je), lat_local_ocn(is:ie,js:je)) + call get_grid_version_1(grid_file, 'ocn', ocn_domain, is, ie, js, je, lon_local_ocn, lat_local_ocn, & + min_glo_lon_ocn, max_glo_lon_ocn, grid_center_bug ) + endif + + if (lnd_on .and. .not. allocated(lon_local_lnd) ) then + call mpp_get_compute_domain( lnd_domain,is,ie,js,je) + allocate(lon_local_lnd(is:ie,js:je), lat_local_lnd(is:ie,js:je)) + call get_grid_version_1(grid_file, 'lnd', lnd_domain, is, ie, js, je, lon_local_lnd, lat_local_lnd, & + min_glo_lon_lnd, max_glo_lon_lnd, grid_center_bug ) + endif + + if (ice_on .and. .not. allocated(lon_local_ice) ) then + call mpp_get_compute_domain( ice_domain,is,ie,js,je) + allocate(lon_local_ice(is:ie,js:je), lat_local_ice(is:ie,js:je)) + call get_grid_version_1(grid_file, 'ice', ice_domain, is, ie, js, je, lon_local_ice, lat_local_ice, & + min_glo_lon_ice, max_glo_lon_ice, grid_center_bug ) + endif + else + if (atm_on .and. .not. allocated(lon_local_atm) ) then + call mpp_get_compute_domain(atm_domain,is,ie,js,je) + allocate(lon_local_atm(is:ie,js:je), lat_local_atm(is:ie,js:je)) + call get_grid_version_2(fileobj, 'atm', atm_domain, is, ie, js, je, lon_local_atm, lat_local_atm, & + min_glo_lon_atm, max_glo_lon_atm ) + endif + + if (ocn_on .and. .not. allocated(lon_local_ocn) ) then + call mpp_get_compute_domain( ocn_domain,is,ie,js,je) + allocate(lon_local_ocn(is:ie,js:je), lat_local_ocn(is:ie,js:je)) + call get_grid_version_2(fileobj, 'ocn', ocn_domain, is, ie, js, je, lon_local_ocn, lat_local_ocn, & + min_glo_lon_ocn, max_glo_lon_ocn ) + endif + + if (lnd_on .and. .not. allocated(lon_local_lnd) ) then + call mpp_get_compute_domain( lnd_domain,is,ie,js,je) + allocate(lon_local_lnd(is:ie,js:je), lat_local_lnd(is:ie,js:je)) + call get_grid_version_2(fileobj, 'lnd', lnd_domain, is, ie, js, je, lon_local_lnd, lat_local_lnd, & + min_glo_lon_lnd, max_glo_lon_lnd ) + endif + + if (ice_on .and. .not. allocated(lon_local_ice) ) then + call mpp_get_compute_domain( ice_domain,is,ie,js,je) + allocate(lon_local_ice(is:ie,js:je), lat_local_ice(is:ie,js:je)) + call get_grid_version_2(fileobj, 'ocn', ice_domain, is, ie, js, je, lon_local_ice, lat_local_ice, & + min_glo_lon_ice, max_glo_lon_ice ) + endif + end if + if(use_get_grid_version .EQ. 2) then + call close_file(fileobj) + end if + +end subroutine data_override_init + +#ifndef use_yaml +subroutine read_table(data_table) + type(data_type), dimension(max_table), intent(inout) :: data_table + + integer :: ntable + integer :: ntable_lima + integer :: ntable_new + + integer :: iunit + integer :: io_status + character(len=256) :: record + type(data_type) :: data_entry + + logical :: ongrid + character(len=128) :: region, region_type + + integer :: sunit ! Read coupler_table open(newunit=iunit, file='data_table', action='READ', iostat=io_status) @@ -273,13 +398,13 @@ subroutine data_override_init(Atm_domain_in, Ocean_domain_in, Ice_domain_in, Lan data_entry%interpol_method == 'bicubic' .or. & data_entry%interpol_method == 'bilinear' .or. & data_entry%interpol_method == 'none')) then - unit = stdout() - write(unit,*)" gridname is ", trim(data_entry%gridname) - write(unit,*)" fieldname_code is ", trim(data_entry%fieldname_code) - write(unit,*)" fieldname_file is ", trim(data_entry%fieldname_file) - write(unit,*)" file_name is ", trim(data_entry%file_name) - write(unit,*)" factor is ", data_entry%factor - write(unit,*)" interpol_method is ", trim(data_entry%interpol_method) + sunit = stdout() + write(sunit,*)" gridname is ", trim(data_entry%gridname) + write(sunit,*)" fieldname_code is ", trim(data_entry%fieldname_code) + write(sunit,*)" fieldname_file is ", trim(data_entry%fieldname_file) + write(sunit,*)" file_name is ", trim(data_entry%file_name) + write(sunit,*)" factor is ", data_entry%factor + write(sunit,*)" interpol_method is ", trim(data_entry%interpol_method) call mpp_error(FATAL, 'data_override_mod: invalid last entry in data_override_table, ' & //'its value should be "default", "bicubic", "bilinear" or "none" ') endif @@ -328,13 +453,13 @@ subroutine data_override_init(Atm_domain_in, Ocean_domain_in, Ice_domain_in, Lan data_entry%interpol_method == 'bicubic' .or. & data_entry%interpol_method == 'bilinear' .or. & data_entry%interpol_method == 'none')) then - unit = stdout() - write(unit,*)" gridname is ", trim(data_entry%gridname) - write(unit,*)" fieldname_code is ", trim(data_entry%fieldname_code) - write(unit,*)" fieldname_file is ", trim(data_entry%fieldname_file) - write(unit,*)" file_name is ", trim(data_entry%file_name) - write(unit,*)" factor is ", data_entry%factor - write(unit,*)" interpol_method is ", trim(data_entry%interpol_method) + sunit = stdout() + write(sunit,*)" gridname is ", trim(data_entry%gridname) + write(sunit,*)" fieldname_code is ", trim(data_entry%fieldname_code) + write(sunit,*)" fieldname_file is ", trim(data_entry%fieldname_file) + write(sunit,*)" file_name is ", trim(data_entry%file_name) + write(sunit,*)" factor is ", data_entry%factor + write(sunit,*)" interpol_method is ", trim(data_entry%interpol_method) call mpp_error(FATAL, 'data_override_mod: invalid last entry in data_override_table, ' & //'its value should be "default", "bicubic", "bilinear" or "none" ') endif @@ -354,106 +479,51 @@ subroutine data_override_init(Atm_domain_in, Ocean_domain_in, Ice_domain_in, Lan 'data_override_mod: New and old formats together in same data_table not supported') close(iunit, iostat=io_status) if(io_status/=0) call mpp_error(FATAL, 'data_override_mod: Error in closing file data_table') +end subroutine read_table + +#else +subroutine read_table_yaml(data_table) + type(data_type), dimension(:), allocatable, intent(out) :: data_table + + integer, allocatable :: entry_id(:) + integer :: nentries + integer :: i + character(len=50) :: buffer + integer :: file_id + + file_id = open_and_parse_file("data_table.yaml") + nentries = get_num_blocks(file_id, "data_table") + allocate(data_table(nentries)) + allocate(entry_id(nentries)) + call get_block_ids(file_id, "data_table", entry_id) + + do i = 1, nentries + call get_value_from_key(file_id, entry_id(i), "gridname", data_table(i)%gridname) + call get_value_from_key(file_id, entry_id(i), "fieldname_code", data_table(i)%fieldname_code) + call get_value_from_key(file_id, entry_id(i), "fieldname_file", data_table(i)%fieldname_file) + call get_value_from_key(file_id, entry_id(i), "file_name", data_table(i)%file_name) + call get_value_from_key(file_id, entry_id(i), "interpol_method", data_table(i)%interpol_method) + call get_value_from_key(file_id, entry_id(i), "factor", data_table(i)%factor) + call get_value_from_key(file_id, entry_id(i), "region_type", buffer, is_optional=.true.) + + if(trim(buffer) == "inside_region" ) then + data_table(i)%region_type = INSIDE_REGION + else if( trim(buffer) == "outside_region" ) then + data_table(i)%region_type = OUTSIDE_REGION + else + data_table(i)%region_type = NO_REGION + endif -! Initialize override array - default_array%gridname = 'NONE' - default_array%fieldname = 'NONE' - default_array%t_index = -1 - default_array%dims = -1 - default_array%comp_domain = -1 - do i = 1, max_array - override_array(i) = default_array - enddo - call time_interp_external_init - end if - - module_is_initialized = .TRUE. - - if ( .NOT. (atm_on .or. ocn_on .or. lnd_on .or. ice_on .or. lndUG_on)) return - call fms2_io_init - -! Test if grid_file is already opened - inquire (file=trim(grid_file), opened=file_open) - if(file_open) call mpp_error(FATAL, trim(grid_file)//' already opened') - - if(.not. open_file(fileobj, grid_file, 'read' )) then - call mpp_error(FATAL, 'data_override_mod: Error in opening file '//trim(grid_file)) - endif - - if(variable_exists(fileobj, "x_T" ) .OR. variable_exists(fileobj, "geolon_t" ) ) then - use_get_grid_version = 1 - call close_file(fileobj) - else if(variable_exists(fileobj, "ocn_mosaic_file" ) .OR. variable_exists(fileobj, "gridfiles" ) ) then - use_get_grid_version = 2 - if(variable_exists(fileobj, "gridfiles" ) ) then - if(count_ne_1((ocn_on .OR. ice_on), lnd_on, atm_on)) call mpp_error(FATAL, 'data_override_mod: the grid file ' // & - 'is a solo mosaic, one and only one of atm_on, lnd_on or ice_on/ocn_on should be true') - end if - else - call mpp_error(FATAL, 'data_override_mod: none of x_T, geolon_t, ocn_mosaic_file or gridfiles exist in '//trim(grid_file)) - endif - - if(use_get_grid_version .EQ. 1) then - if (atm_on .and. .not. allocated(lon_local_atm) ) then - call mpp_get_compute_domain( atm_domain,is,ie,js,je) - allocate(lon_local_atm(is:ie,js:je), lat_local_atm(is:ie,js:je)) - call get_grid_version_1(grid_file, 'atm', atm_domain, is, ie, js, je, lon_local_atm, lat_local_atm, & - min_glo_lon_atm, max_glo_lon_atm, grid_center_bug ) - endif - if (ocn_on .and. .not. allocated(lon_local_ocn) ) then - call mpp_get_compute_domain( ocn_domain,is,ie,js,je) - allocate(lon_local_ocn(is:ie,js:je), lat_local_ocn(is:ie,js:je)) - call get_grid_version_1(grid_file, 'ocn', ocn_domain, is, ie, js, je, lon_local_ocn, lat_local_ocn, & - min_glo_lon_ocn, max_glo_lon_ocn, grid_center_bug ) - endif - - if (lnd_on .and. .not. allocated(lon_local_lnd) ) then - call mpp_get_compute_domain( lnd_domain,is,ie,js,je) - allocate(lon_local_lnd(is:ie,js:je), lat_local_lnd(is:ie,js:je)) - call get_grid_version_1(grid_file, 'lnd', lnd_domain, is, ie, js, je, lon_local_lnd, lat_local_lnd, & - min_glo_lon_lnd, max_glo_lon_lnd, grid_center_bug ) - endif - - if (ice_on .and. .not. allocated(lon_local_ice) ) then - call mpp_get_compute_domain( ice_domain,is,ie,js,je) - allocate(lon_local_ice(is:ie,js:je), lat_local_ice(is:ie,js:je)) - call get_grid_version_1(grid_file, 'ice', ice_domain, is, ie, js, je, lon_local_ice, lat_local_ice, & - min_glo_lon_ice, max_glo_lon_ice, grid_center_bug ) - endif - else - if (atm_on .and. .not. allocated(lon_local_atm) ) then - call mpp_get_compute_domain(atm_domain,is,ie,js,je) - allocate(lon_local_atm(is:ie,js:je), lat_local_atm(is:ie,js:je)) - call get_grid_version_2(fileobj, 'atm', atm_domain, is, ie, js, je, lon_local_atm, lat_local_atm, & - min_glo_lon_atm, max_glo_lon_atm ) - endif - - if (ocn_on .and. .not. allocated(lon_local_ocn) ) then - call mpp_get_compute_domain( ocn_domain,is,ie,js,je) - allocate(lon_local_ocn(is:ie,js:je), lat_local_ocn(is:ie,js:je)) - call get_grid_version_2(fileobj, 'ocn', ocn_domain, is, ie, js, je, lon_local_ocn, lat_local_ocn, & - min_glo_lon_ocn, max_glo_lon_ocn ) - endif - - if (lnd_on .and. .not. allocated(lon_local_lnd) ) then - call mpp_get_compute_domain( lnd_domain,is,ie,js,je) - allocate(lon_local_lnd(is:ie,js:je), lat_local_lnd(is:ie,js:je)) - call get_grid_version_2(fileobj, 'lnd', lnd_domain, is, ie, js, je, lon_local_lnd, lat_local_lnd, & - min_glo_lon_lnd, max_glo_lon_lnd ) - endif + call get_value_from_key(file_id, entry_id(i), "lon_start", data_table(i)%lon_start, is_optional=.true.) + call get_value_from_key(file_id, entry_id(i), "lon_end", data_table(i)%lon_end, is_optional=.true.) + call get_value_from_key(file_id, entry_id(i), "lat_start", data_table(i)%lat_start, is_optional=.true.) + call get_value_from_key(file_id, entry_id(i), "lat_end", data_table(i)%lat_end, is_optional=.true.) - if (ice_on .and. .not. allocated(lon_local_ice) ) then - call mpp_get_compute_domain( ice_domain,is,ie,js,je) - allocate(lon_local_ice(is:ie,js:je), lat_local_ice(is:ie,js:je)) - call get_grid_version_2(fileobj, 'ocn', ice_domain, is, ie, js, je, lon_local_ice, lat_local_ice, & - min_glo_lon_ice, max_glo_lon_ice ) - endif - end if - if(use_get_grid_version .EQ. 2) then - call close_file(fileobj) - end if + end do -end subroutine data_override_init + table_size = nentries !< Because one variable is not enough +end subroutine read_table_yaml +#endif !> @brief Unset domains that had previously been set for use by data_override. !! diff --git a/docs/Doxyfile.in b/docs/Doxyfile.in index 345e0d82cc..63ac4a5084 100644 --- a/docs/Doxyfile.in +++ b/docs/Doxyfile.in @@ -2033,7 +2033,7 @@ INCLUDE_FILE_PATTERNS = *.inc # recursively expanded use the := operator instead of the = operator. # This tag requires that the tag ENABLE_PREPROCESSING is set to YES. -PREDEFINED = +PREDEFINED = use_yaml # If the MACRO_EXPANSION and EXPAND_ONLY_PREDEF tags are set to YES then this # tag can be used to specify a list of macro names that should be expanded. The diff --git a/docs/grouping.h b/docs/grouping.h index c2c75a631d..2e2f7a82de 100644 --- a/docs/grouping.h +++ b/docs/grouping.h @@ -114,6 +114,10 @@ * */ +/** @defgroup parser Parser + * + */ + /** @defgroup platform Platform * */ diff --git a/fms/fms.F90 b/fms/fms.F90 index ff8beca362..63decdbaeb 100644 --- a/fms/fms.F90 +++ b/fms/fms.F90 @@ -839,7 +839,7 @@ function fms_c2f_string (cstring) result(fstring) allocate(character(len=length) :: fstring) !> Set the length of fstring fstring = string_buffer - + deallocate(string_buffer) end function fms_c2f_string !####################################################################### !> @brief Prints to the log file (or a specified unit) the version id string and diff --git a/libFMS/Makefile.am b/libFMS/Makefile.am index 05a151b814..7ec87e39d2 100644 --- a/libFMS/Makefile.am +++ b/libFMS/Makefile.am @@ -62,6 +62,7 @@ libFMS_la_LIBADD += $(top_builddir)/tracer_manager/libtracer_manager.la libFMS_la_LIBADD += $(top_builddir)/random_numbers/librandom_numbers.la libFMS_la_LIBADD += $(top_builddir)/diag_integral/libdiag_integral.la libFMS_la_LIBADD += $(top_builddir)/sat_vapor_pres/libsat_vapor_pres.la +libFMS_la_LIBADD += $(top_builddir)/parser/libparser.la libFMS_la_LIBADD += $(top_builddir)/libFMS_mod.la # At least one source file must be included to please Automake. diff --git a/parser/Makefile.am b/parser/Makefile.am new file mode 100644 index 0000000000..a0b6c6bb0b --- /dev/null +++ b/parser/Makefile.am @@ -0,0 +1,42 @@ +#*********************************************************************** +#* GNU Lesser General Public License +#* +#* This file is part of the GFDL Flexible Modeling System (FMS). +#* +#* FMS is free software: you can redistribute it and/or modify it under +#* the terms of the GNU Lesser General Public License as published by +#* the Free Software Foundation, either version 3 of the License, or (at +#* your option) any later version. +#* +#* FMS is distributed in the hope that it will be useful, but WITHOUT +#* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +#* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +#* for more details. +#* +#* You should have received a copy of the GNU Lesser General Public +#* License along with FMS. If not, see . +#*********************************************************************** + +# This is an automake file for the constants directory of the FMS +# package. + +# Ed Hartnett 2/22/19 + +# Include .h and .mod files. +AM_CPPFLAGS = -I$(top_srcdir)/include +AM_FCFLAGS = $(FC_MODINC). $(FC_MODOUT)$(MODDIR) + +# Build this uninstalled convenience library. +noinst_LTLIBRARIES = libparser.la + +# The convenience library depends on its source. +libparser_la_SOURCES = \ + yaml_parser.F90 \ + yaml_parser_binding.c + +MODFILES = \ + yaml_parser_mod.$(FC_MODEXT) +BUILT_SOURCES = $(MODFILES) +nodist_include_HEADERS = $(MODFILES) + +include $(top_srcdir)/mkmods.mk diff --git a/parser/yaml_parser.F90 b/parser/yaml_parser.F90 new file mode 100644 index 0000000000..74f5a48421 --- /dev/null +++ b/parser/yaml_parser.F90 @@ -0,0 +1,429 @@ +!*********************************************************************** +!* GNU Lesser General Public License +!* +!* This file is part of the GFDL Flexible Modeling System (FMS). +!* +!* FMS is free software: you can redistribute it and/or modify it under +!* the terms of the GNU Lesser General Public License as published by +!* the Free Software Foundation, either version 3 of the License, or (at +!* your option) any later version. +!* +!* FMS is distributed in the hope that it will be useful, but WITHOUT +!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +!* for more details. +!* +!* You should have received a copy of the GNU Lesser General Public +!* License along with FMS. If not, see . +!*********************************************************************** + +!> @defgroup yaml_parser_mod yaml_parser_mod +!> @ingroup parser +!> @brief Routines to use for parsing yaml files + +!> @file +!> @brief File for @ref yaml_parser_mod + +!> @addtogroup yaml_parser_mod +!> @{ +module yaml_parser_mod + +#ifdef use_yaml +use fms_mod, only: fms_c2f_string +use platform_mod +use mpp_mod +use iso_c_binding + +implicit none +private + +public :: open_and_parse_file +public :: get_num_blocks +public :: get_block_ids +public :: get_value_from_key +public :: get_nkeys +public :: get_key_ids +public :: get_key_name +public :: get_key_value +!public :: clean_up +!> @} + +!> @brief Dermine the value of a key from a keyname +!> @ingroup yaml_parser_mod +interface get_value_from_key + module procedure get_value_from_key_0d + module procedure get_value_from_key_1d +end interface get_value_from_key + +!> @brief c functions binding +!> @ingroup yaml_parser_mod +interface + +!> @brief Private c function that opens and parses a yaml file (see yaml_parser_binding.c) +!! @return Flag indicating if the read was sucessful +function open_and_parse_file_wrap(filename, file_id) bind(c) & + result(sucess) + use iso_c_binding, only: c_char, c_int, c_bool + character(kind=c_char), intent(in) :: filename(*) !< Filename of the yaml file + integer(kind=c_int), intent(out) :: file_id !< File id corresponding to the yaml file that was opened + logical(kind=c_bool) :: sucess !< Flag indicating if the read was sucessful +end function open_and_parse_file_wrap + +!> @brief Private c function that checks if a file_id is valid (see yaml_parser_binding.c) +!! @return Flag indicating if the file_id is valid +function is_valid_file_id(file_id) bind(c) & + result(is_valid) + use iso_c_binding, only: c_char, c_int, c_bool + integer(kind=c_int), intent(in) :: file_id !< File id corresponding to the yaml file that was opened + logical(kind=c_bool) :: is_valid !< Flag indicating if the file_id is valid +end function is_valid_file_id + +!> @brief Private c function that gets the number of key-value pairs in a block (see yaml_parser_binding.c) +!! @return Number of key-value pairs in this block +function get_nkeys_binding(file_id, block_id) bind(c) & + result(nkeys) + use iso_c_binding, only: c_char, c_int, c_bool + integer(kind=c_int), intent(in) :: file_id !< File id corresponding to the yaml file that was opened + integer(kind=c_int), intent(in) :: block_id !< Id of the parent_block + integer(kind=c_int) :: nkeys +end function get_nkeys_binding + +!> @brief Private c function that gets the ids of the key-value pairs in a block (see yaml_parser_binding.c) +subroutine get_key_ids_binding(file_id, block_id, key_ids) bind(c) + use iso_c_binding, only: c_char, c_int, c_bool + integer(kind=c_int), intent(in) :: file_id !< File id corresponding to the yaml file that was opened + integer(kind=c_int), intent(in) :: block_id !< Id of the parent_block + integer(kind=c_int), intent(inout) :: key_ids(*) !< Ids of the key-value pairs +end subroutine get_key_ids_binding + +!> @brief Private c function that checks if a key_id is valid (see yaml_parser_binding.c) +!! @return Flag indicating if the key_id is valid +function is_valid_key_id(file_id, key_id) bind(c) & + result(is_valid) + use iso_c_binding, only: c_char, c_int, c_bool + integer(kind=c_int), intent(in) :: file_id !< File id corresponding to the yaml file that was opened + integer(kind=c_int), intent(in) :: key_id !< Key id to check if valid + logical(kind=c_bool) :: is_valid !< Flag indicating if the file_id is valid +end function is_valid_key_id + +!> @brief Private c function that get the key from a key_id in a yaml file +!! @return Name of the key obtained +function get_key(file_id, key_id) bind(c) & + result(key_name) + use iso_c_binding, only: c_ptr, c_int, c_bool + integer(kind=c_int), intent(in) :: file_id !< File id corresponding to the yaml file that was opened + integer(kind=c_int), intent(in) :: key_id !< Id of the key-value pair of interest + type(c_ptr) :: key_name +end function get_key + +!> @brief Private c function that get the value from a key_id in a yaml file +!! @return String containing the value obtained +function get_value(file_id, key_id) bind(c) & + result(key_value) + use iso_c_binding, only: c_ptr, c_int, c_bool + integer(kind=c_int), intent(in) :: file_id !< File id corresponding to the yaml file that was opened + integer(kind=c_int), intent(in) :: key_id !< Id of the key-value pair of interest + type(c_ptr) :: key_value +end function get_value + +!> @brief Private c function that determines they value of a key in yaml_file (see yaml_parser_binding.c) +!! @return c pointer with the value obtained +function get_value_from_key_wrap(file_id, block_id, key_name, sucess) bind(c) & + result(key_value2) + + use iso_c_binding, only: c_ptr, c_char, c_int, c_bool + integer(kind=c_int), intent(in) :: file_id !< File id of the yaml file to search + integer(kind=c_int), intent(in) :: block_id !< ID corresponding to the block you want the key for + character(kind=c_char), intent(in) :: key_name(*) !< Name of the key you want the value for + integer(kind=c_int), intent(out) :: sucess !< Flag indicating if the call was sucessful + type(c_ptr) :: key_value2 +end function get_value_from_key_wrap + +!> @brief Private c function that determines the number of blocks with block_name in the yaml file +!! (see yaml_parser_binding.c) +!! @return Number of blocks with block_name +function get_num_blocks_all(file_id, block_name) bind(c) & + result(nblocks) + use iso_c_binding, only: c_char, c_int, c_bool + integer(kind=c_int), intent(in) :: file_id !< File id of the yaml file to search + character(kind=c_char), intent(in) :: block_name(*) !< The name of the block you are looking for + + integer(kind=c_int) :: nblocks +end function get_num_blocks_all + +!> @brief Private c function that determines the number of blocks with block_name that belong to +!! a parent block with parent_block_id in the yaml file (see yaml_parser_binding.c) +!! @return Number of blocks with block_name +function get_num_blocks_child(file_id, block_name, parent_block_id) bind(c) & + result(nblocks) + use iso_c_binding, only: c_char, c_int, c_bool + integer(kind=c_int), intent(in) :: file_id !< File id of the yaml file to search + character(kind=c_char), intent(in) :: block_name(*) !< The name of the block you are looking for + integer(kind=c_int) :: parent_block_id !< Id of the parent block + + integer(kind=c_int) :: nblocks +end function get_num_blocks_child + +!> @brief Private c function that gets the the ids of the blocks with block_name in the yaml file +!! (see yaml_parser_binding.c) +subroutine get_block_ids_all(file_id, block_name, block_ids) bind(c) + use iso_c_binding, only: c_char, c_int, c_bool + integer(kind=c_int), intent(in) :: file_id !< File id of the yaml file to search + character(kind=c_char), intent(in) :: block_name(*) !< The name of the block you are looking for + integer(kind=c_int), intent(inout) :: block_ids(*) !< Id of the parent_block +end subroutine get_block_ids_all + +!> @brief Private c function that gets the the ids of the blocks with block_name and that +!! belong to a parent block id in the yaml file (see yaml_parser_binding.c) +subroutine get_block_ids_child(file_id, block_name, block_ids, parent_block_id) bind(c) + use iso_c_binding, only: c_char, c_int, c_bool + integer(kind=c_int), intent(in) :: file_id !< File id of the yaml file to search + character(kind=c_char), intent(in) :: block_name(*) !< The name of the block you are looking for + integer(kind=c_int), intent(inout) :: block_ids(*) !< Id of the parent_block + integer(kind=c_int) :: parent_block_id !< Id of the parent block +end subroutine get_block_ids_child + +!> @brief Private c function that checks if a block_id is valid (see yaml_parser_binding.c) +!! @return Flag indicating if the block_id is valid +function is_valid_block_id(file_id, block_id) bind(c) & + result(is_valid) + use iso_c_binding, only: c_char, c_int, c_bool + integer(kind=c_int), intent(in) :: file_id !< File id corresponding to the yaml file that was opened + integer(kind=c_int), intent(in) :: block_id !< Block id to check if valid + logical(kind=c_bool) :: is_valid !< Flag indicating if the file_id is valid +end function is_valid_block_id + +end interface + +!> @addtogroup yaml_parser_mod +!> @{ +contains + +!> @brief Opens and parses a yaml file +!! @return A file id corresponding to the file that was opened +function open_and_parse_file(filename) & + result(file_id) + + character(len=*), intent(in) :: filename !< Filename of the yaml file + logical :: sucess !< Flag indicating if the read was sucessful + + integer :: file_id + + sucess = open_and_parse_file_wrap(trim(filename)//c_null_char, file_id) + if (.not. sucess) call mpp_error(FATAL, "Error opening the yaml file:"//trim(filename)//". Check the file!") + +end function open_and_parse_file + +!> @brief Gets the key from a file id +subroutine get_key_name(file_id, key_id, key_name) + integer, intent(in) :: key_id !< Id of the key-value pair of interest + integer, intent(in) :: file_id !< File id of the yaml file to search + character(len=*), intent(out) :: key_name + + if (.not. is_valid_file_id(file_id)) call mpp_error(FATAL, "The file id in your get_key_name call is invalid! Check your call.") + if (.not. is_valid_key_id(file_id, key_id)) call mpp_error(FATAL, "The key id in your get_key_name call is invalid! Check your call.") + + key_name = fms_c2f_string(get_key(file_id, key_id)) + +end subroutine get_key_name + +!> @brief Gets the value from a file id +subroutine get_key_value(file_id, key_id, key_value) + integer, intent(in) :: key_id !< Id of the key-value pair of interest + integer, intent(in) :: file_id !< File id of the yaml file to search + character(len=*), intent(out) :: key_value + + if (.not. is_valid_file_id(file_id)) call mpp_error(FATAL, "The file id in your get_key_value call is invalid! Check your call.") + if (.not. is_valid_key_id(file_id, key_id)) call mpp_error(FATAL, "The key id in your get_key_value call is invalid! Check your call.") + + key_value = fms_c2f_string(get_value(file_id, key_id)) + +end subroutine get_key_value + +!> @brief Used to dermine the value of a key from a keyname +subroutine get_value_from_key_0d(file_id, block_id, key_name, key_value, is_optional) + integer, intent(in) :: file_id !< File id of the yaml file to search + integer, intent(in) :: block_id !< ID corresponding to the block you want the key for + character(len=*), intent(in) :: key_name !< Name of the key you want the value for + class(*), intent(inout):: key_value !< Value of the key + logical, intent(in), optional :: is_optional !< Flag indicating if it is okay for they key to not exist. + !! If the key does not exist key_value will not be set, so it + !! is the user's responsibility to initialize it before the call + + character(len=255) :: buffer !< String buffer with the value + + type(c_ptr) :: c_buffer !< c pointer with the value + integer(kind=c_int) :: sucess !< Flag indicating if the value was obtained sucessfully + logical :: optional !< Flag indicating that the key was optional + integer :: err_unit !< integer with io error + + optional = .false. + if (present(is_optional)) optional = is_optional + + if (.not. is_valid_file_id(file_id)) call mpp_error(FATAL, "The file id in your get_value_from_key call is invalid! Check your call.") + if (.not. is_valid_block_id(file_id, block_id)) call mpp_error(FATAL, "The block id in your get_value_from_key call is invalid! Check your call.") + + c_buffer = get_value_from_key_wrap(file_id, block_id, trim(key_name)//c_null_char, sucess) + if (sucess == 1) then + buffer = fms_c2f_string(c_buffer) + + select type (key_value) + type is (integer(kind=i4_kind)) + read(buffer,*, iostat=err_unit) key_value + if (err_unit .ne. 0) call mpp_error(FATAL, "Key:"//trim(key_name)//" Error converting '"//trim(buffer)//"' to i4") + type is (integer(kind=i8_kind)) + read(buffer,*, iostat=err_unit) key_value + if (err_unit .ne. 0) call mpp_error(FATAL, "Key:"//trim(key_name)//" Error converting '"//trim(buffer)//"' to i8") + type is (real(kind=r4_kind)) + read(buffer,*, iostat=err_unit) key_value + if (err_unit .ne. 0) call mpp_error(FATAL, "Key:"//trim(key_name)//" Error converting '"//trim(buffer)//"' to r4") + type is (real(kind=r8_kind)) + read(buffer,*, iostat=err_unit) key_value + if (err_unit .ne. 0) call mpp_error(FATAL, "Key:"//trim(key_name)//" Error converting '"//trim(buffer)//"' to r8") + type is (character(len=*)) + key_value = buffer + class default + call mpp_error(FATAL, "The type of your buffer in your get_value_from_key call for key "//trim(key_name)//& + &" is not supported. Only i4, i8, r4, r8 and strings are supported.") + end select + else + if(.not. optional) call mpp_error(FATAL, "Error getting the value for key:"//trim(key_name)) + endif + +end subroutine get_value_from_key_0d + +!> @brief Used' to dermine the 1D value of a key from a keyname +subroutine get_value_from_key_1d(file_id, block_id, key_name, key_value, is_optional) + integer, intent(in) :: file_id !< File id of the yaml file to search + integer, intent(in) :: block_id !< ID corresponding to the block you want the key for + character(len=*), intent(in) :: key_name !< Name of the key you want the value for + class(*), intent(inout):: key_value(:) !< Value of the key + logical, intent(in), optional :: is_optional !< Flag indicating if it is okay for they key' to not exist. + !! If the key does not exist key_value will not be set, so it + !! is the user's responsibility to initialize it before the call + + character(len=255) :: buffer !< String buffer with the value + + type(c_ptr) :: c_buffer !< c pointer with the value + integer(kind=c_int) :: sucess !< Flag indicating if the value was obtained sucessfully + logical :: optional !< Flag indicating that the key was optional + integer :: err_unit !< integer with io error + + optional=.false. + if (present(is_optional)) optional = is_optional + + if (.not. is_valid_file_id(file_id)) call mpp_error(FATAL, "The file id in your get_value_from_key call is invalid! Check your call.") + if (.not. is_valid_block_id(file_id, block_id)) call mpp_error(FATAL, "The block id in your get_value_from_key call is invalid! Check your call.") + + c_buffer = get_value_from_key_wrap(file_id, block_id, trim(key_name)//c_null_char, sucess) + if (sucess == 1) then + buffer = fms_c2f_string(c_buffer) + + select type (key_value) + type is (integer(kind=i4_kind)) + read(buffer,*, iostat=err_unit) key_value + if (err_unit .ne. 0) call mpp_error(FATAL, "Key:"//trim(key_name)//" Error converting '"//trim(buffer)//"' to i4") + type is (integer(kind=i8_kind)) + read(buffer,*, iostat=err_unit) key_value + if (err_unit .ne. 0) call mpp_error(FATAL, "Key:"//trim(key_name)//" Error converting '"//trim(buffer)//"' to i8") + type is (real(kind=r4_kind)) + read(buffer,*, iostat=err_unit) key_value + if (err_unit .ne. 0) call mpp_error(FATAL, "Key:"//trim(key_name)//" Error converting '"//trim(buffer)//"' to r4") + type is (real(kind=r8_kind)) + read(buffer,*, iostat=err_unit) key_value + if (err_unit .ne. 0) call mpp_error(FATAL, "Key:"//trim(key_name)//" Error converting '"//trim(buffer)//"' to r8") + type is (character(len=*)) + call mpp_error(FATAL, "get_value_from_key 1d string variables are not supported. Contact developers") + class default + call mpp_error(FATAL, "The type of your buffer in your get_value_from_key call for key "//trim(key_name)//& + &" is not supported. Only i4, i8, r4, r8 and strings are supported.") + end select + else + if(.not. optional) call mpp_error(FATAL, "Error getting the value for key:"//trim(key_name)) + endif +end subroutine get_value_from_key_1d + +!> @brief Determines the number of blocks with block_name in the yaml file +!! If parent_block_id is present, it only counts those that belong to that block +!! @return Number of blocks with block_name +function get_num_blocks(file_id, block_name, parent_block_id) & + result(nblocks) + + integer, intent(in) :: file_id !< File id of the yaml file to search + character(len=*), intent(in) :: block_name !< The name of the block you are looking for + integer, intent(in), optional :: parent_block_id !< Id of the parent block + integer :: nblocks + + if (.not. is_valid_file_id(file_id)) call mpp_error(FATAL, "The file id in your get_num_blocks call is invalid! Check your call.") + + if (.not. present(parent_block_id)) then + nblocks=get_num_blocks_all(file_id, trim(block_name)//c_null_char) + else + if (.not. is_valid_block_id(file_id, parent_block_id)) call mpp_error(FATAL, "The parent_block id in your get_num_blocks call is invalid! Check your call.") + nblocks=get_num_blocks_child(file_id, trim(block_name)//c_null_char, parent_block_id) + endif +end function get_num_blocks + +!> @brief Gets the the ids of the blocks with block_name in the yaml file +!! If parent_block_id is present, it only gets those that belong to that block +subroutine get_block_ids(file_id, block_name, block_ids, parent_block_id) + + integer, intent(in) :: file_id !< File id of the yaml file to search + character(len=*), intent(in) :: block_name !< The name of the block you are looking for + integer, intent(inout) :: block_ids(:) !< Id of blocks with block_name + integer, intent(in), optional :: parent_block_id !< Id of the parent_block + integer :: nblocks_id + integer :: nblocks + + if (.not. is_valid_file_id(file_id)) call mpp_error(FATAL, "The file id in your get_block_ids call is invalid! Check your call.") + + nblocks_id = size(block_ids) + nblocks = get_num_blocks(file_id, block_name, parent_block_id) + if (nblocks .ne. nblocks_id) call mpp_error(FATAL, "The size of your block_ids array is not correct") + + if (.not. present(parent_block_id)) then + call get_block_ids_all(file_id, trim(block_name)//c_null_char, block_ids) + else + if (.not. is_valid_block_id(file_id, parent_block_id)) call mpp_error(FATAL, "The parent_block id in your get_block_ids call is invalid! Check your call.") + call get_block_ids_child(file_id, trim(block_name)//c_null_char, block_ids, parent_block_id) + endif +end subroutine get_block_ids + +!> @brief Gets the number of key-value pairs in a block +!! @return Number of key-value pairs in this block +function get_nkeys(file_id, block_id) & + result(nkeys) + integer, intent(in) :: file_id !< File id corresponding to the yaml file that was opened + integer, intent(in) :: block_id !< Id of the parent_block + integer :: nkeys + + if (.not. is_valid_file_id(file_id)) call mpp_error(FATAL, "The file id in your get_nkeys call is invalid! Check your call.") + if (.not. is_valid_block_id(file_id, block_id)) call mpp_error(FATAL, "The block id in your get_nkeys call is invalid! Check your call.") + + nkeys = get_nkeys_binding(file_id, block_id) +end function get_nkeys + +!> @brief Gets the ids of the key-value pairs in a block +subroutine get_key_ids (file_id, block_id, key_ids) + integer, intent(in) :: file_id !< File id corresponding to the yaml file that was opened + integer, intent(in) :: block_id !< Id of the parent_block + integer, intent(inout) :: key_ids(:) !< Ids of the key-value pairs + + integer :: nkey_ids !< Size of key_ids + integer :: nkeys !< Actual number of keys + + if (.not. is_valid_file_id(file_id)) call mpp_error(FATAL, "The file id in your get_key_ids call is invalid! Check your call.") + if (.not. is_valid_block_id(file_id, block_id)) call mpp_error(FATAL, "The block id in your get_key_ids call is invalid! Check your call.") + + nkey_ids = size(key_ids) + nkeys = get_nkeys(file_id, block_id) + + if (nkeys .ne. nkey_ids) call mpp_error(FATAL, "The size of your key_ids array is not correct.") + + call get_key_ids_binding (file_id, block_id, key_ids) +end subroutine get_key_ids + +#endif +end module yaml_parser_mod +!> @} +! close documentation grouping diff --git a/parser/yaml_parser_binding.c b/parser/yaml_parser_binding.c new file mode 100644 index 0000000000..9c4fdaefab --- /dev/null +++ b/parser/yaml_parser_binding.c @@ -0,0 +1,342 @@ +/*********************************************************************** + * GNU Lesser General Public License + * + * This file is part of the GFDL Flexible Modeling System (FMS). + * + * FMS is free software: you can redistribute it and/or modify it under + * the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or (at + * your option) any later version. + * + * FMS is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with FMS. If not, see . + **********************************************************************/ + +#ifdef use_yaml + +#include +#include +#include + +/* Type to store info about key */ +typedef struct { + int key_number; /* Id of this key */ + char key[255]; /* Name of the key */ + char value[255]; /* Value of the key */ + char parent_name[255]; /* Name of the block the key belongs to */ + int parent_key; /* Id of the block the key belongs to */ +}key_value_pairs; + +/* Type to store all of the keys */ +typedef struct { + int nkeys; + key_value_pairs *keys; +}yaml_file; + +/* Type to store all the yaml files that are opened */ +typedef struct { + yaml_file *files; +}file_type; + +file_type my_files; /* Array of opened yaml files */ +int nfiles = 0; /* Number of files in the yaml file */ + +/* @brief Private c function that gets the number of key-value pairs in a block + @return Number of key-value pairs in this block */ +int get_nkeys_binding(int *file_id, int *block_id) +{ + int nkeys = 0; /* Number of key-value pairs */ + int i; /* For loops */ + int j = *file_id; /* To minimize the typing :) */ + + for ( i = 1; i <= my_files.files[j].nkeys; i++ ) + { + if(my_files.files[j].keys[i].parent_key == *block_id && !strcmp(my_files.files[j].keys[i].parent_name, "") ) nkeys = nkeys + 1; + } + + return nkeys; + +} + +/* @brief Private c function that gets the ids of the key-value pairs in a block */ +void get_key_ids_binding(int *file_id, int *block_id, int *key_ids) +{ + int i; /* For loops */ + int key_count = -1; /* Number of key-value pairs */ + int j = *file_id; /* To minimize the typing :) */ + + for ( i = 1; i <= my_files.files[j].nkeys; i++ ) + { + if(my_files.files[j].keys[i].parent_key == *block_id && !strcmp(my_files.files[j].keys[i].parent_name, "") ){ + key_count = key_count + 1; + key_ids[key_count] = i; + } + } + + return; +} + +/* @brief Private c function that get the key from a key_id in a yaml file + @return Name of the key obtained */ +char *get_key(int *file_id, int *key_id) +{ + int j = *file_id; /* To minimize the typing :) */ + return my_files.files[j].keys[*key_id].key; +} + +/* @brief Private c function that get the value from a key_id in a yaml file + @return String containing the value obtained */ +char *get_value(int *file_id, int *key_id) +{ + int j = *file_id; /* To minimize the typing :) */ + return my_files.files[j].keys[*key_id].value; +} + +/* @brief Private c function that determines they value of a key in yaml_file + @return c pointer with the value obtained */ +char *get_value_from_key_wrap(int *file_id, int *block_id, char *key_name, int *sucess) /*, char *key_name) */ +{ + int i; /* For loops */ + int j = *file_id; /* To minimize the typing :) */ + + *sucess = 0; /* Flag indicating if the search was sucessful */ + + for ( i = 1; i <= my_files.files[j].nkeys; i++ ) + { + if (my_files.files[j].keys[i].parent_key == *block_id) + { + if( strcmp(my_files.files[j].keys[i].key, key_name) == 0) + { + *sucess = 1; + break; + } + } + } + if (*sucess == 1) {return my_files.files[j].keys[i].value;} else {return "";} +} + +/* @brief Private c function that determines the number of blocks with block_name in the yaml file + @return Number of blocks with block_name */ +int get_num_blocks_all(int *file_id, char *block_name) +{ + int nblocks = 0; /* Number of blocks */ + int i; /* For loops */ + int j = *file_id; /* To minimize the typing :) */ + + for ( i = 1; i <= my_files.files[j].nkeys; i++ ) + { + if(strcmp(my_files.files[j].keys[i].parent_name, block_name) == 0) nblocks = nblocks + 1; + } + + return nblocks; +} + +/* @brief Private c function that determines the number of blocks with block_name that belong to + a parent block with parent_block_id in the yaml file + @return Number of blocks with block_name */ +int get_num_blocks_child(int *file_id, char *block_name, int *parent_block_id) +{ + int nblocks = 0; /* Number of blocks */ + int i; /* For loops */ + int j = *file_id; /* To minimize the typing :) */ + + for ( i = 1; i <= my_files.files[j].nkeys; i++ ) + { + if(strcmp(my_files.files[j].keys[i].parent_name, block_name) == 0 && my_files.files[j].keys[i].parent_key == *parent_block_id) nblocks = nblocks + 1; + } + + return nblocks; +} + + +/* @brief Private c function that gets the the ids of the blocks with block_name in the yaml file */ +void get_block_ids_all(int *file_id, char *block_name, int *block_ids) +{ + int i; /* For loops */ + int nblocks = -1; /* Number of blocks */ + int j = *file_id; /* To minimize the typing :) */ + + for ( i = 1; i <= my_files.files[j].nkeys; i++ ) + { + if(strcmp(my_files.files[j].keys[i].parent_name, block_name) == 0) { + nblocks = nblocks + 1; + block_ids[nblocks] = my_files.files[j].keys[i].key_number; + } + } + return; +} + +/* @brief Private c function that gets the the ids of the blocks with block_name and that + belong to a parent block id in the yaml file */ +void get_block_ids_child(int *file_id, char *block_name, int *block_ids, int *parent_key_id ) +{ + int i; /* For loops */ + int nblocks = -1; /* Number of blocks */ + int j = *file_id; /* To minimize the typing :) */ + + for ( i = 1; i <= my_files.files[j].nkeys; i++ ) + { + if(strcmp(my_files.files[j].keys[i].parent_name, block_name) == 0 && my_files.files[j].keys[i].parent_key == *parent_key_id) { + nblocks = nblocks + 1; + block_ids[nblocks] = my_files.files[j].keys[i].key_number; + } + } + return; +} + +/* @brief Private c function to determine if a block_id is valid */ +bool is_valid_block_id(int *file_id, int *block_id) +{ + /* If the block id it not in the allowed range is not a valid block id */ + if (*block_id <= -1 || *block_id > my_files.files[*file_id].nkeys) {return false;} + + /* If the block id has an empty parent name then it is not a valid block id */ + if (*block_id != 0 && strcmp(my_files.files[*file_id].keys[*block_id].parent_name, "") == 0) {return false;} + return true; +} + +/* @brief Private c function to determine if a key_id is valid */ +bool is_valid_key_id(int *file_id, int *key_id) +{ + if (*key_id > -1 && *key_id <= my_files.files[*file_id].nkeys) {return true;} + else { return false;} +} + +/* @brief Private c function to determine if a file_id is valid */ +bool is_valid_file_id(int *file_id) +{ + if (*file_id > -1 && *file_id < nfiles) {return true;} + else { return false;} +} + +/* @brief Private c function that opens and parses a yaml file and saves it in a struct + @return Flag indicating if the read was sucessful */ +bool open_and_parse_file_wrap(char *filename, int *file_id) +{ + yaml_parser_t parser; + yaml_token_t token; + FILE *file; + + bool is_key = false; /* Flag indicating if the current token in a key */ + char key_value[255]; /* Value of a key */ + int layer = 0; /* Current layer (block level) */ + int key_count=0; /* Current number of keys */ + int parent[10]; /* Ids of blocks */ + int current_parent; /* Id of the current block */ + char layer_name[10][255]; /* Array of block names */ + char current_layername[255]; /* Name of the current block */ + int i; /* To minimize the typing :) */ + int j; /* To minimize the typing :) */ + + if (nfiles == 0 ) + { + my_files.files = (yaml_file*)calloc(1, sizeof(yaml_file)); + } else + { + my_files.files = realloc(my_files.files, (nfiles+1)*sizeof(yaml_file)); + } + + j = nfiles; + *file_id =j; + +/* printf("Opening file: %s.\nThere are %i files opened.\n", filename, j); */ + file = fopen(filename, "r"); + if (file == NULL) return false; + + if(!yaml_parser_initialize(&parser)) return false; + + my_files.files[j].keys = (key_value_pairs*)calloc(1, sizeof(key_value_pairs)); + + parent[0]=0; + strcpy(layer_name[0], "TOP"); + /* Set input file */ + yaml_parser_set_input_file(&parser, file); + do { + yaml_parser_scan(&parser, &token); + switch(token.type) + { + case YAML_KEY_TOKEN: + { + is_key = true; + break; + } + case YAML_VALUE_TOKEN: + { + is_key = false; + break; + } + case YAML_BLOCK_ENTRY_TOKEN: + { + layer = layer + 1; + + if (strcmp(key_value, "")) + { + strcpy(layer_name[layer], key_value); + } + key_count = key_count + 1; + i = key_count; + my_files.files[j].keys = realloc(my_files.files[j].keys, (i+1)*sizeof(key_value_pairs)); + my_files.files[j].keys[i].key_number=i; + my_files.files[j].keys[i].parent_key = parent[layer-1]; + strcpy(my_files.files[j].keys[i].parent_name, layer_name[layer]); + strcpy(my_files.files[j].keys[i].key, ""); + strcpy(my_files.files[j].keys[i].value, ""); + parent[layer]=key_count; + /*printf("KEY:%i LAYER:%i NAME:%s for %s=%i\n", key_count, layer, layer_name[layer], layer_name[layer-1], parent[layer-1]); */ + + break; + } + case YAML_BLOCK_END_TOKEN: + { + layer = layer - 1; + break; + } + case YAML_SCALAR_TOKEN: + { + if ( ! is_key) + { + current_parent = parent[layer]; + strcpy(current_layername, ""); + key_count = key_count + 1; + i = key_count; + my_files.files[j].keys = realloc(my_files.files[j].keys, (i+1)*sizeof(key_value_pairs)); + my_files.files[j].keys[i].key_number=i; + my_files.files[j].keys[i].parent_key = current_parent; + strcpy(my_files.files[j].keys[i].parent_name, current_layername); + strcpy(my_files.files[j].keys[i].key, key_value); + strcpy(my_files.files[j].keys[i].value, token.data.scalar.value); + my_files.files[j].nkeys = key_count; + /* printf("----> LAYER:%i LAYER_NAME=%s PARENT:%i, KEYCOUNT:%i KEY: %s VALUE: %s \n", layer, current_layername, current_parent, key_count, key_value, token.data.scalar.value); */ + strcpy(key_value,""); + } + else + {strcpy(key_value,token.data.scalar.value);} + } + break; + } + if(token.type != YAML_STREAM_END_TOKEN) + yaml_token_delete(&token); + } while(token.type != YAML_STREAM_END_TOKEN); + yaml_token_delete(&token); + yaml_parser_delete(&parser); + + /* + for ( i = 1; i <= my_files.files[j].nkeys; i++ ) { + printf("Key_number:%i Parent_key:%i Parent_name:%s Key:%s Value:%s \n", my_files.files[j].keys[i].key_number, my_files.files[j].keys[i].parent_key, my_files.files[j].keys[i].parent_name, my_files.files[j].keys[i].key, my_files.files[j].keys[i].value); + } + printf("/\n"); + */ + + nfiles = nfiles + 1; +/* printf("closing file: %s\n", filename); */ + fclose(file); + + return true; +} + +#endif diff --git a/test_fms/Makefile.am b/test_fms/Makefile.am index 9e070def22..639a69c5b0 100644 --- a/test_fms/Makefile.am +++ b/test_fms/Makefile.am @@ -26,7 +26,7 @@ ACLOCAL_AMFLAGS = -I m4 # Make targets will be run in each subdirectory. Order is significant. SUBDIRS = coupler diag_manager data_override exchange monin_obukhov drifters \ mosaic interpolator fms mpp mpp_io time_interp time_manager \ -horiz_interp field_manager axis_utils affinity fms2_io +horiz_interp field_manager axis_utils affinity fms2_io parser # This input file must be distributed, it is turned into # test_common.sh by configure. diff --git a/test_fms/data_override/Makefile.am b/test_fms/data_override/Makefile.am index 252533e24b..7564bec265 100644 --- a/test_fms/data_override/Makefile.am +++ b/test_fms/data_override/Makefile.am @@ -44,4 +44,4 @@ EXTRA_DIST = input_base.nml diag_table_base data_table_base \ test_data_override2.sh # Clean up -CLEANFILES = input.nml *.nc* *.out diag_table data_table +CLEANFILES = input.nml *.nc* *.out diag_table data_table data_table.yaml diff --git a/test_fms/data_override/test_data_override2.sh b/test_fms/data_override/test_data_override2.sh index 873b97d686..785c14a496 100755 --- a/test_fms/data_override/test_data_override2.sh +++ b/test_fms/data_override/test_data_override2.sh @@ -30,18 +30,31 @@ # Run the ongrid test case with 2 halos in x and y touch input.nml +cat <<_EOF > data_table.yaml +data_table: + - gridname : "OCN" + fieldname_code : "runoff" + fieldname_file : "runoff" + file_name : "INPUT/runoff.daitren.clim.1440x1080.v20180328.nc" + interpol_method : "none" + factor : 1.0 +_EOF + printf '"OCN", "runoff", "runoff", "./INPUT/runoff.daitren.clim.1440x1080.v20180328.nc", "none" , 1.0' | cat > data_table [ ! -d "INPUT" ] && mkdir -p "INPUT" +echo "TEST 1" run_test test_data_override_ongrid 6 rm -rf "INPUT" # Run the ongrid test case again with no halos printf "&test_data_override_ongrid_nml \n nhalox=0 \n nhaloy=0\n/" | cat > input.nml [ ! -d "INPUT" ] && mkdir -p "INPUT" +echo "TEST 2" run_test test_data_override_ongrid 6 rm -rf "INPUT" # Run the get_grid_v1 test: +echo "TEST 3" run_test test_get_grid_v1 1 # Copy to builddir and rename data files for tests. diff --git a/test_fms/parser/Makefile.am b/test_fms/parser/Makefile.am new file mode 100644 index 0000000000..469538ce11 --- /dev/null +++ b/test_fms/parser/Makefile.am @@ -0,0 +1,54 @@ +#*********************************************************************** +#* GNU Lesser General Public License +#* +#* This file is part of the GFDL Flexible Modeling System (FMS). +#* +#* FMS is free software: you can redistribute it and/or modify it under +#* the terms of the GNU Lesser General Public License as published by +#* the Free Software Foundation, either version 3 of the License, or (at +#* your option) any later version. +#* +#* FMS is distributed in the hope that it will be useful, but WITHOUT +#* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +#* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +#* for more details. +#* +#* You should have received a copy of the GNU Lesser General Public +#* License along with FMS. If not, see . +#*********************************************************************** + +# This is an automake file for the test_fms/data_override directory of the FMS +# package. + +# uramirez, Ed Hartnett + +# Find the needed mod and .inc files. +AM_CPPFLAGS = -I${top_srcdir}/include -I$(MODDIR) + +# Link to the FMS library. +LDADD = ${top_builddir}/libFMS/libFMS.la + +# Build this test program. +check_PROGRAMS = parser_demo2 test_yaml_parser check_crashes parser_demo + +# This is the source code for the test. +test_yaml_parser_SOURCES = test_yaml_parser.F90 +check_crashes_SOURCES = check_crashes.F90 +parser_demo_SOURCES = parser_demo.F90 +parser_demo2_SOURCES = parser_demo2.F90 + +# Run the test program. +TESTS = test_yaml_parser.sh + +# Include these files with the distribution. +EXTRA_DIST = test_yaml_parser.sh + +if SKIP_PARSER_TESTS +skipflag="skip" +else +skipflag="" +endif + +TESTS_ENVIRONMENT = parser_skip=${skipflag} +# Clean up +CLEANFILES = input.nml *.nc* *.out *.yaml diff --git a/test_fms/parser/check_crashes.F90 b/test_fms/parser/check_crashes.F90 new file mode 100644 index 0000000000..d454ed6cf7 --- /dev/null +++ b/test_fms/parser/check_crashes.F90 @@ -0,0 +1,255 @@ +!*********************************************************************** +!* GNU Lesser General Public License +!* +!* This file is part of the GFDL Flexible Modeling System (FMS). +!* +!* FMS is free software: you can redistribute it and/or modify it under +!* the terms of the GNU Lesser General Public License as published by +!* the Free Software Foundation, either version 3 of the License, or (at +!* your option) any later version. +!* +!* FMS is distributed in the hope that it will be useful, but WITHOUT +!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +!* for more details. +!* +!* You should have received a copy of the GNU Lesser General Public +!* License along with FMS. If not, see . +!*********************************************************************** + +program check_crashes +!> @brief This programs tests if the public subroutines in parser/yaml_parser.F90 +!! crash as expected +#ifdef use_yaml +use yaml_parser_mod +use mpp_mod +use fms_mod, only : fms_init, fms_end + +implicit none + +integer :: io_status !< io_status when reading a namelist +logical :: missing_file = .false. !< try to open files that do not exist +logical :: bad_conversion = .false. !< try type conversions that are not possible +logical :: missing_key = .false. !< try to get the value of a key that does not exist +logical :: wrong_buffer_size_key_id = .false. !< try to send an array of key_id that is the wrong size +logical :: wrong_buffer_size_block_id = .false. !< try to send an array of block_id that is the wrong size +logical :: get_key_name_bad_key_id = .false. !< try to send a bad key_id to get_key_name +logical :: get_key_value_bad_key_id = .false. !< try to send a bad key_id to get_key_value +logical :: get_block_ids_bad_id = .false. !< try to send a bad file_id to get_block_ids +logical :: get_key_name_bad_id = .false. !< try to send a bad file_id to get_key_name +logical :: get_key_value_bad_id = .false. !< try to send a bad file_id to get_key_value +logical :: get_num_blocks_bad_id = .false. !< try to send a bad file_id to get_num_blocks +logical :: get_value_from_key_bad_id = .false. !< try to send a bad file_id to get_value_from_key +logical :: get_nkeys_bad_id = .false. !< try to send a bad file_id to get_nkeys +logical :: get_key_ids_bad_id = .false. !< try to send a bad file_id to get_key_ids +logical :: get_key_ids_bad_block_id = .false. !< try to send a bad block_id to get_key_ids +logical :: get_nkeys_bad_block_id = .false. !< try to send a bad block_id to get_nkeys +logical :: get_block_ids_bad_block_id = .false. !< try to send a bad block_id to get_block_ids +logical :: get_num_blocks_bad_block_id = .false. !< try to send a bad block_id to get_num_blocks +logical :: get_value_from_key_bad_block_id = .false. !< try to send a bad block_id to get_value_from_key + +namelist / check_crashes_nml / missing_file, bad_conversion, missing_key, get_block_ids_bad_id, & + get_key_name_bad_id, get_key_value_bad_id, get_num_blocks_bad_id, get_value_from_key_bad_id, & + get_nkeys_bad_id, get_key_ids_bad_id, & + get_key_name_bad_key_id, get_key_value_bad_key_id, & + get_key_ids_bad_block_id, get_nkeys_bad_block_id, get_block_ids_bad_block_id, get_num_blocks_bad_block_id, & + get_value_from_key_bad_block_id, & + wrong_buffer_size_key_id, wrong_buffer_size_block_id + +call fms_init + +read (input_nml_file, check_crashes_nml, iostat=io_status) +if (io_status > 0) call mpp_error(FATAL,'=>check_crashes: Error reading input.nml') + +if (missing_file) call check_read_and_parse_file_missing +if (get_block_ids_bad_id) call check_get_block_ids_bad_id +if (get_key_name_bad_id) call check_get_key_name_bad_id +if (get_key_value_bad_id) call check_get_key_value_bad_id +if (get_num_blocks_bad_id) call check_get_num_blocks_bad_id +if (get_value_from_key_bad_id) call check_get_value_from_key_bad_id +if (get_nkeys_bad_id) call check_get_nkeys_bad_id +if (get_key_ids_bad_id) call check_get_key_ids_bad_id +if (bad_conversion) call check_bad_conversion +if (missing_key) call check_missing_key +if (wrong_buffer_size_key_id) call check_wrong_buffer_size_key_id +if (wrong_buffer_size_block_id) call check_wrong_buffer_size_block_id +if (get_key_name_bad_key_id) call check_get_key_name_bad_key_id +if (get_key_value_bad_key_id) call check_get_key_value_bad_key_id +if (get_key_ids_bad_block_id) call check_get_key_ids_bad_block_id +if (get_nkeys_bad_block_id) call check_get_nkeys_bad_block_id +if (get_block_ids_bad_block_id) call check_get_block_ids_bad_block_id +if (get_num_blocks_bad_block_id) call check_get_num_blocks_bad_block_id +if (get_value_from_key_bad_block_id) call check_get_value_from_key_bad_block_id + +call fms_end + +contains +!> @brief This is to check if the parser crashes correctly if user sends a bad block_id to get_key_ids +subroutine check_get_key_ids_bad_block_id + integer :: yaml_file_id !< file_id for a yaml file + integer :: key_ids(10) !< array of key ids + + yaml_file_id = open_and_parse_file("diag_table.yaml") + call get_key_ids (yaml_file_id, -40, key_ids) + +end subroutine check_get_key_ids_bad_block_id + +!> @brief This is to check if the parser crashes correctly if user sends a bad block_id to get_nkeys +subroutine check_get_nkeys_bad_block_id + integer :: yaml_file_id !< file_id for a yaml file + integer :: nkeys !< number of keys + + yaml_file_id = open_and_parse_file("diag_table.yaml") + nkeys = get_nkeys(yaml_file_id, 9999) + +end subroutine check_get_nkeys_bad_block_id + +!> @brief This is to check if the parser crashes correctly if user sends a bad parent_block_id to get_block_ids +subroutine check_get_block_ids_bad_block_id + integer :: yaml_file_id !< file_id for a yaml file + integer :: block_ids(10)!< array of block ids + + yaml_file_id = open_and_parse_file("diag_table.yaml") + call get_block_ids(yaml_file_id, "varList", block_ids, parent_block_id=-40) + +end subroutine check_get_block_ids_bad_block_id + +!> @brief This is to check if the parser crashes correctly if user sends a bad parent_block_id to get_num_blocks +subroutine check_get_num_blocks_bad_block_id + integer :: yaml_file_id !< file_id for a yaml file + integer :: nblocks !< number of blocks + + yaml_file_id = open_and_parse_file("diag_table.yaml") + + nblocks = get_num_blocks(yaml_file_id, "varList", parent_block_id=-30) + +end subroutine check_get_num_blocks_bad_block_id + +!> @brief This is to check if the parser crashes correctly if user sends a bad parent_block_id to get_value_from_key +subroutine check_get_value_from_key_bad_block_id + integer :: yaml_file_id !< file_id for a yaml file + integer :: key_value !< integer buffer + + yaml_file_id = open_and_parse_file("diag_table.yaml") + call get_value_from_key(yaml_file_id, 999, "mullions", key_value) + +end subroutine check_get_value_from_key_bad_block_id + +!> @brief This is to check if the parser crashes correctly if user tries to open a missing file. +subroutine check_read_and_parse_file_missing + integer :: yaml_file_id !< file_id for a yaml file + + yaml_file_id = open_and_parse_file("missing") +end subroutine check_read_and_parse_file_missing + +!> @brief This is to check if the parser crashes correctly if user sends an invalid file id to get_block_ids +subroutine check_get_block_ids_bad_id + integer :: block_ids(10) !< array of block ids + + call get_block_ids(-40, "diagFiles", block_ids) +end subroutine check_get_block_ids_bad_id + +!> @brief This is to check if the parser crashes correctly if user sends an invalid file id to get_key_name +subroutine check_get_key_name_bad_id + character(len=10) :: buffer !< string buffer + + call get_key_name(-45, 1, buffer) +end subroutine check_get_key_name_bad_id + +!> @brief This is to check if the parser crashes correctly if user sends an invalid file id to get_key_value +subroutine check_get_key_value_bad_id + character(len=10) :: buffer !< string buffer + + call get_key_value(-45, 1, buffer) +end subroutine check_get_key_value_bad_id + +!> @brief This is to check if the parser crashes correctly if user sends an invalid file id to get_num_blocks +subroutine check_get_num_blocks_bad_id + integer :: nblocks !< number of blocks + + nblocks = get_num_blocks(-45, "diagFiles") +end subroutine check_get_num_blocks_bad_id + +!> @brief This is to check if the parser crashes correctly if user sends an invalid file id to get_value_from_key +subroutine check_get_value_from_key_bad_id + character(len=10) :: string_buffer !< string buffer + + call get_value_from_key(-45, 1, "varName", string_buffer) +end subroutine check_get_value_from_key_bad_id + +!> @brief This is to check if the parser crashes correctly if user sends an invalid file id to get_nkeys +subroutine check_get_nkeys_bad_id + integer :: nkeys !< number of keys + + nkeys = get_nkeys(-45, 1) +end subroutine check_get_nkeys_bad_id + +!> @brief This is to check if the parser crashes correctly if user sends an invalid file id to get_key_ids +subroutine check_get_key_ids_bad_id + integer :: key_ids(10) !< array of key ids + + call get_key_ids(-45, 1, key_ids) +end subroutine check_get_key_ids_bad_id + +!> @brief This is to check if the parser crashes correctly if user sends a buffer of the wrong type +subroutine check_bad_conversion + integer :: yaml_file_id !< file_id for a yaml file + real :: buffer !< real buffer + + yaml_file_id = open_and_parse_file("diag_table.yaml") + call get_value_from_key(yaml_file_id, 9, "varName", buffer) +end subroutine check_bad_conversion + +!> @brief This is to check if the parser crashes correctly if user tries to get they value for a key +!! that doesn't exist +subroutine check_missing_key + integer :: yaml_file_id !< file_id for a yaml file + real :: buffer !< string bufffer + + yaml_file_id = open_and_parse_file("diag_table.yaml") + call get_value_from_key(yaml_file_id, 9, "missing", buffer) +end subroutine check_missing_key + +!> @brief This is to check if the parser crashes correctly if user sends an invalid key id to get_key_name +subroutine check_get_key_name_bad_key_id + integer :: yaml_file_id !< file_id for a yaml file + character(len=10) :: buffer !< string buffer + + yaml_file_id = open_and_parse_file("diag_table.yaml") + call get_key_name(yaml_file_id, 666, buffer) + +end subroutine check_get_key_name_bad_key_id + +!> @brief This is to check if the parser crashes correctly if user sends an invalid key id to get_key_value +subroutine check_get_key_value_bad_key_id + integer :: yaml_file_id !< file_id for a yaml file + character(len=10) :: buffer !< string buffer + + yaml_file_id = open_and_parse_file("diag_table.yaml") + call get_key_value(yaml_file_id, 666, buffer) + +end subroutine check_get_key_value_bad_key_id + +!> @brief This is to check if the parser crashes correctly if user sends an a key_id array that is that the correct +!! size to get_key_ids +subroutine check_wrong_buffer_size_key_id + integer :: yaml_file_id !< file_id for a yaml file + integer :: key_ids(1) !< array of key ids + + yaml_file_id = open_and_parse_file("diag_table.yaml") + call get_key_ids(yaml_file_id, 19, key_ids) + +end subroutine check_wrong_buffer_size_key_id + +!> @brief This is to check if the parser crashes correctly if user sends an a block_id array that is that the correct +!! size to get_block_ids +subroutine check_wrong_buffer_size_block_id + integer :: yaml_file_id !< file_id for a yaml file + integer :: block_ids(10)!< array of block ids + + yaml_file_id = open_and_parse_file("diag_table.yaml") + call get_block_ids(yaml_file_id, "diag_files", block_ids) + +end subroutine check_wrong_buffer_size_block_id +#endif +end program check_crashes diff --git a/test_fms/parser/parser_demo.F90 b/test_fms/parser/parser_demo.F90 new file mode 100644 index 0000000000..16bc1c81ac --- /dev/null +++ b/test_fms/parser/parser_demo.F90 @@ -0,0 +1,119 @@ +!*********************************************************************** +!* GNU Lesser General Public License +!* +!* This file is part of the GFDL Flexible Modeling System (FMS). +!* +!* FMS is free software: you can redistribute it and/or modify it under +!* the terms of the GNU Lesser General Public License as published by +!* the Free Software Foundation, either version 3 of the License, or (at +!* your option) any later version. +!* +!* FMS is distributed in the hope that it will be useful, but WITHOUT +!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +!* for more details. +!* +!* You should have received a copy of the GNU Lesser General Public +!* License along with FMS. If not, see . +!*********************************************************************** + +program parser_demo +!> @brief This programs demostrates how to use the parser + +#ifdef use_yaml +use FMS_mod, only: fms_init, fms_end +use yaml_parser_mod +use platform_mod + +implicit none + +integer :: diag_yaml_id !< Id for the diag_table yaml +integer :: nfiles !< Number of files in the diag_table yaml +integer, allocatable :: file_ids(:) !< Ids of the files in the diag_table yaml +integer :: nvariables !< Number of variables in the diag_table yaml +integer, allocatable :: var_ids(:) !< Ids of the variables in the diag_table yaml +integer :: i, j !< For do loops +character(len=255) :: string_buffer !< Buffer to read strings to +integer :: int_buffer !< Buffer to read integers to +real(kind=r8_kind) :: r8_buffer !< Buffer to read r8 to + +call fms_init +call fms_end + +diag_yaml_id = open_and_parse_file("diag_table.yaml") +print *, "" + +call get_value_from_key(diag_yaml_id, 0, "title", string_buffer) +print *, "title:", trim(string_buffer) + +call get_value_from_key(diag_yaml_id, 0, "baseDate", string_buffer) +print *, "baseDate:", trim(string_buffer) + +nfiles = get_num_blocks(diag_yaml_id, "diag_files") +allocate(file_ids(nfiles)) +call get_block_ids(diag_yaml_id, "diag_files", file_ids) +print *, "" + +do i = 1, nfiles + print *, "File number:", i + + call get_value_from_key(diag_yaml_id, file_ids(i), "fileName", string_buffer) + print *, "fileName:", trim(string_buffer) + + call get_value_from_key(diag_yaml_id, file_ids(i), "freq", int_buffer) + print *, "freq:", int_buffer + + call get_value_from_key(diag_yaml_id, file_ids(i), "frequnit", string_buffer) + print *, "frequnit:", trim(string_buffer) + + call get_value_from_key(diag_yaml_id, file_ids(i), "timeunit", string_buffer) + print *, "timeunit:", trim(string_buffer) + + call get_value_from_key(diag_yaml_id, file_ids(i), "unlimdim", string_buffer) + print *, "unlimdim:", trim(string_buffer) + + !< The number of variables that are part of the current file + nvariables = get_num_blocks(diag_yaml_id, "varlist", parent_block_id=file_ids(i)) + allocate(var_ids(nvariables)) + call get_block_ids(diag_yaml_id, "varlist", var_ids, parent_block_id=file_ids(i)) + + do j = 1, nvariables + print *, " Variable number:", j + + call get_value_from_key(diag_yaml_id, var_ids(j), "varName", string_buffer) + print *, " varName:", trim(string_buffer) + + string_buffer = "" + call get_value_from_key(diag_yaml_id, var_ids(j), "reduction", string_buffer) + print *, " reduction:", trim(string_buffer) + + string_buffer = "" + call get_value_from_key(diag_yaml_id, var_ids(j), "module", string_buffer) + print *, " module:", trim(string_buffer) + + r8_buffer = 0. + call get_value_from_key(diag_yaml_id, var_ids(j), "fill_value", r8_buffer, is_optional=.true.) + print *, " fill_value:", r8_buffer + + string_buffer = "" + call get_value_from_key(diag_yaml_id, var_ids(j), "outName", string_buffer, is_optional=.true.) + print *, " outName:", trim(string_buffer) + + string_buffer = "" + call get_value_from_key(diag_yaml_id, var_ids(j), "kind", string_buffer, is_optional=.true.) + print *, " kind:", trim(string_buffer) + + int_buffer = 0. + call get_value_from_key(diag_yaml_id, var_ids(j), "mullions", int_buffer, is_optional=.true.) + print *, " mullions:", int_buffer + + print *, "" + end do + deallocate(var_ids) + print *, "" +enddo +deallocate(file_ids) + +#endif + +end program parser_demo diff --git a/test_fms/parser/parser_demo2.F90 b/test_fms/parser/parser_demo2.F90 new file mode 100644 index 0000000000..c230559a4e --- /dev/null +++ b/test_fms/parser/parser_demo2.F90 @@ -0,0 +1,108 @@ +!*********************************************************************** +!* GNU Lesser General Public License +!* +!* This file is part of the GFDL Flexible Modeling System (FMS). +!* +!* FMS is free software: you can redistribute it and/or modify it under +!* the terms of the GNU Lesser General Public License as published by +!* the Free Software Foundation, either version 3 of the License, or (at +!* your option) any later version. +!* +!* FMS is distributed in the hope that it will be useful, but WITHOUT +!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +!* for more details. +!* +!* You should have received a copy of the GNU Lesser General Public +!* License along with FMS. If not, see . +!*********************************************************************** + +program parser_demo +!> @brief This programs demostrates how to use the parser + +#ifdef use_yaml +use FMS_mod, only: fms_init, fms_end +use yaml_parser_mod +use platform_mod + +implicit none + +integer :: diag_yaml_id !< Id for the diag_table yaml +integer :: nfiles !< Number of files in the diag_table yaml +integer, allocatable :: file_ids(:) !< Ids of the files in the diag_table yaml +integer :: nvariables !< Number of variables in the diag_table yaml +integer, allocatable :: var_ids(:) !< Ids of the variables in the diag_table yaml +integer :: i, j, k !< For do loops +integer :: nkeys !< Number of keys +integer, allocatable :: key_ids(:) !< Ids of keys in the diag_table_yaml +character(len=255) :: key_value !< The value of a key +character(len=255) :: key_name !< The name of a key + +call fms_init +call fms_end + +diag_yaml_id = open_and_parse_file("diag_table.yaml") +print *, "" + +nkeys = get_nkeys(diag_yaml_id, 0) +allocate(key_ids(nkeys)) +call get_key_ids(diag_yaml_id, 0, key_ids) + +do i = 1, nkeys + call get_key_name(diag_yaml_id, key_ids(i), key_name) + call get_key_value(diag_yaml_id, key_ids(i), key_value) + print *, "Key:", trim(key_name), " Value:", trim(key_value) +enddo + +deallocate(key_ids) + +nfiles = get_num_blocks(diag_yaml_id, "diag_files") +allocate(file_ids(nfiles)) +call get_block_ids(diag_yaml_id, "diag_files", file_ids) +print *, "" + +do i = 1, nfiles + print *, "File number:", i + + nkeys = get_nkeys(diag_yaml_id, file_ids(i)) + allocate(key_ids(nkeys)) + call get_key_ids(diag_yaml_id, file_ids(i), key_ids) + + do j = 1, nkeys + call get_key_name(diag_yaml_id, key_ids(j), key_name) + call get_key_value(diag_yaml_id, key_ids(j), key_value) + print *, " Key:", trim(key_name), " Value:", trim(key_value) + enddo + + deallocate(key_ids) + print *, "" + !< The number of variables that are part of the current file + nvariables = get_num_blocks(diag_yaml_id, "varlist", parent_block_id=file_ids(i)) + allocate(var_ids(nvariables)) + call get_block_ids(diag_yaml_id, "varlist", var_ids, parent_block_id=file_ids(i)) + + do j = 1, nvariables + print *, " Variable number:", j + + nkeys = get_nkeys(diag_yaml_id, var_ids(j)) + allocate(key_ids(nkeys)) + call get_key_ids(diag_yaml_id, var_ids(j), key_ids) + + do k = 1, nkeys + call get_key_name(diag_yaml_id, key_ids(k), key_name) + call get_key_value(diag_yaml_id, key_ids(k), key_value) + print *, " Key:", trim(key_name), " Value:", trim(key_value) + enddo + + deallocate(key_ids) + print *, "" + end do + + deallocate(var_ids) + print *, "" +enddo +deallocate(file_ids) + +#endif + +end program parser_demo diff --git a/test_fms/parser/test_yaml_parser.F90 b/test_fms/parser/test_yaml_parser.F90 new file mode 100644 index 0000000000..3cdc3b7fb3 --- /dev/null +++ b/test_fms/parser/test_yaml_parser.F90 @@ -0,0 +1,155 @@ +!*********************************************************************** +!* GNU Lesser General Public License +!* +!* This file is part of the GFDL Flexible Modeling System (FMS). +!* +!* FMS is free software: you can redistribute it and/or modify it under +!* the terms of the GNU Lesser General Public License as published by +!* the Free Software Foundation, either version 3 of the License, or (at +!* your option) any later version. +!* +!* FMS is distributed in the hope that it will be useful, but WITHOUT +!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +!* for more details. +!* +!* You should have received a copy of the GNU Lesser General Public +!* License along with FMS. If not, see . +!*********************************************************************** + +!> @brief This programs tests the public subroutines in parser/yaml_parser.F90 +program test_read_and_parse_file + +#ifdef use_yaml +use yaml_parser_mod +use mpp_mod +use fms_mod, only : fms_init, fms_end +use platform_mod + +implicit none + +integer :: yaml_file_id1 !< file id of a yaml file +integer :: nfiles !< number of files +integer :: nvariables !< number of variables +integer, allocatable :: file_ids(:) !< array of file ids +integer, allocatable :: variable_ids(:) !< array of variable ids +integer :: yaml_file_id2 !< file id of a yaml file +integer :: nentries !< number of entries +integer, allocatable :: entries_ids(:) !< array of entries ids +integer :: zero !< dummy integer buffer +character(len=20) :: string_buffer !< string buffer +integer(kind=i4_kind) :: i4_buffer !< i4 buffer +integer(kind=i8_kind) :: i8_buffer !< i8 buffer +real(kind=r4_kind) :: r4_buffer !< r4 buffer +real(kind=r8_kind) :: r8_buffer !< r8 buffer +integer :: nkeys !< number of keys +integer, allocatable :: key_ids(:) !< array of key ids +character(len=20) :: key_name !< the name of the key +character(len=20) :: key_value !< the value of a key + +call fms_init + +!< Test open_and_parse_file +yaml_file_id1 = open_and_parse_file("diag_table.yaml") +if (yaml_file_id1 .ne. 0) call mpp_error(FATAL, "The yaml_file_id for this file should be 0") + +!< Test if multiple files can be opened +yaml_file_id2 = open_and_parse_file("data_table.yaml") +if (yaml_file_id2 .ne. 1) call mpp_error(FATAL, "The yaml_file_id for this file should be 1") + +!< ----------------------------------- + +!< Test get_num_blocks +nfiles = get_num_blocks(yaml_file_id1, "diag_files") +if (nfiles .ne. 2) call mpp_error(FATAL, "There should be only 2 diag_files") + +!< Test if a different yaml file id will work +nentries = get_num_blocks(yaml_file_id2, "data_table") +if (nentries .ne. 2) call mpp_error(FATAL, "There should be only 2 entries") + +!< Try to look for a block that does not exist! +zero = get_num_blocks(yaml_file_id2, "diag_files") +if (zero .ne. 0) call mpp_error(FATAL, "'diag_files' should not exist in this file") + +!< Try the parent block_id optional argument +nvariables = get_num_blocks(yaml_file_id1, "varlist", parent_block_id=3) !< Number of variables that belong to the atmos_daily file in the diag_table.yaml +if (nvariables .ne. 2) call mpp_error(FATAL, "There should only be 2 variables in the atmos_daily file") + +!< ----------------------------------- + +!< Test get_block_ids +allocate(file_ids(nfiles)) +call get_block_ids(yaml_file_id1, "diag_files", file_ids) +if(file_ids(1) .ne. 3 .or. file_ids(2) .ne. 21) call mpp_error(FATAL, "The file_ids are wrong!") + +!< Test to see if a diffrent yaml file id will work +allocate(entries_ids(nentries)) +call get_block_ids(yaml_file_id2, "data_table", entries_ids) +if(entries_ids(1) .ne. 1 .or. entries_ids(2) .ne. 8) call mpp_error(FATAL, "The entry_ids are wrong!") + +!< Try the parent block id optional argument +allocate(variable_ids(nvariables)) +call get_block_ids(yaml_file_id1, "varlist", variable_ids, parent_block_id=3) +if (variable_ids(1) .ne. 9 .or. variable_ids(2) .ne. 15) call mpp_error(FATAL, "The variable_ids are wrong!") + +!< Error check: *_ids is not the correct size + +!< ----------------------------------- + +!< Test get_value_from_key +!! Try get_value_from_key using a string buffer +call get_value_from_key(yaml_file_id1, variable_ids(1), "varName", string_buffer) +if (trim(string_buffer) .ne. "tdata") call mpp_error(FATAL, "varName was not read correctly!") + +!! Try get_value_from_key using a i4 buffer +call get_value_from_key(yaml_file_id1, variable_ids(1), "mullions", i4_buffer) +if (i4_buffer .ne. int(10, kind=i4_kind)) call mpp_error(FATAL, "mullions was not read correctly as an i4!") + +!! Try get_value_from_key using a i8 buffer +call get_value_from_key(yaml_file_id1, variable_ids(1), "mullions", i8_buffer) +if (i8_buffer .ne. int(10, kind=i8_kind)) call mpp_error(FATAL, "mullions was not read correctly as an i8!") + +!! Try get_value_from_key using a r4 buffer +call get_value_from_key(yaml_file_id1, variable_ids(1), "fill_value", r4_buffer) +if (r4_buffer .ne. real(-999.9, kind=r4_kind)) call mpp_error(FATAL, "fill_value was not read correctly as an r4!") + +!! Try get_value_from_key using a r8 buffer +call get_value_from_key(yaml_file_id1, variable_ids(1), "fill_value", r8_buffer) +if (r8_buffer .ne. real(-999.9, kind=r8_kind)) call mpp_error(FATAL, "fill_value was not read correctly as an r8!") + +!! Try the is_optional argument on an key that does not exist +string_buffer = "" +call get_value_from_key(yaml_file_id1, variable_ids(1), "NANANANA", string_buffer, is_optional=.true.) +if (trim(string_buffer) .ne. "") call mpp_error(FATAL, "string_buffer was set when they key does not exist?") + +!< ----------------------------------- + +!< Test nkeys +nkeys = get_nkeys(yaml_file_id1, variable_ids(1)) +if (nkeys .ne. 5) call mpp_error(FATAL, "The number of keys was not read correctly") + +!< ----------------------------------- + +!< Test get_key_ids +allocate(key_ids(nkeys)) +call get_key_ids(yaml_file_id1, variable_ids(1), key_ids) +if (key_ids(1) .ne. 10 .or. key_ids(2) .ne. 11 .or. key_ids(3) .ne. 12 .or. key_ids(4) .ne. 13 .or. key_ids(5) .ne. 14) call mpp_error(FATAL, "The key ids obtained are wrong") + +!< ----------------------------------- + +!< Test get_key_name +call get_key_name(yaml_file_id1, key_ids(1), key_name) +if ((trim(key_name) .ne. "varName")) call mpp_error(FATAL, "get_key_name did not output the correct name") + +!< Test get_key_value +call get_key_value(yaml_file_id1, key_ids(1), key_value) +if ((trim(key_value) .ne. "tdata")) call mpp_error(FATAL, "get_key_name did not output the correct name") + +deallocate(key_ids) +deallocate(variable_ids) +deallocate(entries_ids) +deallocate(file_ids) + +call fms_end +#endif +end program diff --git a/test_fms/parser/test_yaml_parser.sh b/test_fms/parser/test_yaml_parser.sh new file mode 100755 index 0000000000..de134653d5 --- /dev/null +++ b/test_fms/parser/test_yaml_parser.sh @@ -0,0 +1,218 @@ +#!/bin/sh + +#*********************************************************************** +#* GNU Lesser General Public License +#* +#* This file is part of the GFDL Flexible Modeling System (FMS). +#* +#* FMS is free software: you can redistribute it and/or modify it under +#* the terms of the GNU Lesser General Public License as published by +#* the Free Software Foundation, either version 3 of the License, or (at +#* your option) any later version. +#* +#* FMS is distributed in the hope that it will be useful, but WITHOUT +#* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +#* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +#* for more details. +#* +#* You should have received a copy of the GNU Lesser General Public +#* License along with FMS. If not, see . +#*********************************************************************** + +# This is part of the GFDL FMS package. This is a shell script to +# execute tests in the test_fms/parser directory. + +# Set common test settings. +. ../test_common.sh + +touch input.nml + +cat <<_EOF > data_table.yaml +data_table: + - gridname : "ICE" + fieldname_code : "sic_obs" + fieldname_file : "ice" + file_name : "INPUT/hadisst_ice.data.nc" + interpol_method : "bilinear" + factor : 0.01 + - gridname : "WUT" + fieldname_code : "potato" + fieldname_file : "mullions" + file_name : "INPUT/potato.nc" + interpol_method : "bilinear" + factor : 1e-06 + region_type : "inside_region" + lat_start : -89.1 + lat_end : 89.8 + lon_start : 3.4 + lon_end : 154.4 +_EOF + +cat <<_EOF > diag_table.yaml +title: c384L49_esm5PIcontrol +baseDate: [1960 1 1 1 1 1 1] +diag_files: +- fileName: "atmos_daily" + freq: 24 + frequnit: hours + timeunit: days + unlimdim: time + varlist: + - varName: tdata + reduction: False + module: mullions + mullions: 10 + fill_value: -999.9 + - varName: pdata + outName: pressure + reduction: False + kind: double + module: "moist" +- fileName: atmos_8xdaily + freq: 3 + frequnit: hours + timeunit: days + unlimdim: time + varlist: + - varName: tdata + reduction: False + module: "moist" +_EOF + +run_test test_yaml_parser 1 $parser_skip +run_test parser_demo 1 $parser_skip +run_test parser_demo2 1 $parser_skip + +printf "&check_crashes_nml \n missing_file = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n bad_conversion = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n missing_key = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n get_block_ids_bad_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n get_num_blocks_bad_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n get_nkeys_bad_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n get_key_ids_bad_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n get_key_name_bad_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n get_key_value_bad_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n get_value_from_key_bad_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n get_key_name_bad_key_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n get_key_value_bad_key_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +### +printf "&check_crashes_nml \n get_key_ids_bad_block_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n get_nkeys_bad_block_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n get_block_ids_bad_block_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n get_num_blocks_bad_block_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n get_value_from_key_bad_block_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n wrong_buffer_size_key_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n wrong_buffer_size_block_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi