diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 09b5da7..2a78b43 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -77,6 +77,8 @@ jobs: run: nml-tools check --config examples/05_file_profiles/nml-config.toml --diff - name: Check generated optional-reader fixture files run: nml-tools check --config tests/fortran_optional_read/nml-config.toml --diff + - name: Check generated namespace fixture files + run: nml-tools check --config tests/fortran_namespaces/nml-config.toml --diff - name: Validate 03_references template run: > nml-tools validate --config examples/03_references/nml-config.toml @@ -131,6 +133,17 @@ jobs: run: > ./build/optional-generated-read/optional_generated_read tests/fortran_optional_read + - name: Configure generated namespace conformance test + run: > + cmake -S tests/fortran_namespaces -B build/generated-namespaces -G Ninja + -DCMAKE_BUILD_TYPE=Debug + -DCMAKE_Fortran_FLAGS_DEBUG="${{ matrix.debug_flags }}" + - name: Build generated namespace conformance test + run: cmake --build build/generated-namespaces --parallel + - name: Run generated namespace conformance test + run: > + ./build/generated-namespaces/generated_namespaces + tests/fortran_namespaces - name: Build 01_simple run: > cmake -S examples/01_simple -B build/01_simple -G Ninja diff --git a/README.md b/README.md index 23eb6f1..ca4e22e 100644 --- a/README.md +++ b/README.md @@ -6,6 +6,11 @@ Generate Fortran namelist modules, Markdown docs, and template namelists from a small JSON Schema-like specification with Fortran-focused extensions. +The aim is schema-guided generation and validation for a defined Fortran +namelist subset, with matching documentation and templates. This is not a +general JSON Schema engine or a Fortran compiler/name resolver. Optional f2py +and editor integrations use the same supported subset; they do not broaden it. + ## Features - Schema input in YAML or JSON. @@ -57,9 +62,56 @@ identifiers and must not contain `__`. Double underscores are reserved for generated support names such as `seed__default`, `method__enum_values`, and `period__start_year__min`. -Schema property names and runtime dimension names must also avoid generated -namelist type member names: `is_configured`, `init`, `init_type`, `set_dims`, -`from_file`, `set`, `is_set`, `is_valid`, and `filled_shape`. +Namelist group names, schema properties/components, runtime dimensions, +constants, kind aliases, and derived-type names must not be `errmsg` +(case-insensitively), because `errmsg=` is reserved as the stable error-output +keyword on generated procedures. Properties and dimensions may otherwise +match generated member names such as `set`, `is_valid`, or `is_configured`; +they occupy separate generated containers. + +Generated Fortran calls a small, documented set of intrinsics directly. To +avoid scope-dependent shadowing, the following names are unavailable +case-insensitively wherever they are emitted unqualified: namelist group names, +root properties, runtime dimensions, constants, kind aliases, and derived-type names: +`present`, `size`, `shape`, `allocated`, `associated`, `trim`, `len`, `any`, +`all`, `huge`, `reshape`, `achar`, `char`, `iachar`, `ichar`, `index`, +`len_trim`, `minval`, and `transfer`. Fortran developers should avoid intrinsic +names in these roles; the generator checks this explicit dependency list, not every +Fortran intrinsic. Qualified derived components such as `%size` and `%present` +are allowed, but still follow the identifier, `__`, and `errmsg` rules. + +The generated helper API also reserves `NML_OK`, its `NML_ERR_*` status +constants, `nml_file_t`, `nml_line_buffer`, `nml_open`, `nml_find`, and +`nml_close` in unqualified scopes. Additional conflicts depend on the schema +and configuration and are checked case-insensitively before rendering: + +- A schema-spelled root property cannot equal its namelist group name. Schema + loading enforces this for every output mode, including documentation/templates, + and after root `$ref` composition. Qualified components may match the group. +- Native setter/reader arguments cannot shadow imported constants, kind + aliases, or derived types needed in their scope, the outer object type, + or their own generated procedure name. +- Helper constants, local derived types, and kind imports must have distinct + local names; imports from different modules or of different remote entities + cannot claim the same local name. +- Generated module types/procedures cannot conflict with imported symbols. + f2py arguments are deterministically mangled where needed, but conflicting + imported types/kinds and wrapper procedures are rejected. +- An emitted module cannot `use` itself, even under a different spelling/case. + Choose distinct names for generated modules and helper/kind/application + modules they actually import. For example, a namelist named `helper` needs + a helper module name other than the default `nml_helper`. Unused configured + dependencies do not impose this restriction. + +The opaque-handle resolver imports its C-binding dependencies locally. Enabling +f2py therefore does not reserve names such as `c_intptr_t` or `c_ptr` for native +setter/reader fields or runtime dimensions. f2py mangles arguments that would +shadow its own required imports; Python-facing names remain unchanged. + +Diagnostics name the conflicting sources and generated scope. There is no +blanket ban on `nml_*` schema properties or dimensions. These rules also apply +to schemas used for documentation/templates: such schemas describe the same +Fortran-generatable subset. ### x-fortran-namelist @@ -465,9 +517,14 @@ mod_path = "out/nml_optimization.f90" ### [helper] -Controls the generated helper module. +Controls the nml-tools-generated helper module. This source is required when +generating any native Fortran module (`mod_path`) or f2py wrapper +(`f2py_path`); it is not an application-provided extension point. Application +derived types and kind modules remain supported through their schema and +`[kinds]` configuration. -- `path` (string, required to generate helper): output file for the helper module. +- `path` (string, required for `mod_path` or `f2py_path`): output file for the + generated helper module. - `module` (string, optional): Fortran module name (default: `nml_helper`). - `buffer` (int, optional): line buffer length for the helper module. - `header` (string, optional): text inserted at the top of the helper file. @@ -505,10 +562,10 @@ Named runtime array dimension defaults. - Names must be unique across `[constants]` and `[dimensions]`. - Names must not contain `__`; nml-tools reserves double underscores for generated helper identifiers. -- Names must not collide with namelist property names, because generated - Fortran stores the current runtime extent as a field with the dimension name. -- Names must not collide with generated namelist type members such as `init`, - `set_dims`, or `is_valid`. +- Names may match namelist properties and generated operation names because + dimensions are stored below a separate `dims` component. +- Used dimensions retain their `[dimensions]` configuration order in the public + `dims` type and positional Fortran `set_dims(...)` arguments. - Entries may be used in `x-fortran-shape`, but not in `x-fortran-len`. - Arrays whose shape contains a `[dimensions]` name are generated as allocatable runtime-sized arrays. @@ -613,7 +670,7 @@ cfg.set(periods=[{"start_year": 1980}, {"start_year": 2001}]) Only the internal f2py ABI is flattened: `%` paths are encoded with `__`, for example `period__start_year` and `has__period__start_year`. Generated Fortran support identifiers also use `__` as an internal separator, for example -`seed__default`, `method__enum_values`, and `n_periods__default`. Do not use +`seed__default`, `method__enum_values`, and `n_periods__dim_default`. Do not use `__` in schema property, component, derived type/module, constant, or runtime dimension names; it is reserved for generated identifiers. Python `is_set("period.start_year")` @@ -657,7 +714,8 @@ Schema entries to generate per-namelist outputs. When present, it must match the schema's `x-fortran-namelist` case-insensitively; the schema remains canonical for generated namelist names. The schema's `x-fortran-namelist` must be a valid user Fortran identifier, and - `__` is reserved for generated internal names. + follow the documented intrinsic/helper identifier reservations. `__` is + reserved for generated internal names. - `schema` (string): schema file path. - `mod_path` (string, optional): Fortran module output path. - `doc_path` (string, optional): Markdown output path. @@ -937,6 +995,40 @@ Character substring assignment, complex schema values, nested derived values, component arrays, nondefault lower bounds, and user-defined formatted I/O are currently explicit capability boundaries. +## Generated Fortran layout + +Generated schema values and runtime dimensions use separate public containers: + +```fortran +type(nml_run_t) :: config + +value = config%data%iterations +extent = config%dims%n_items +``` + +The generated module declares public `nml_run_data_t`, optional +`nml_run_dims_t`, and outer `nml_run_t` types. Schema values live below +`config%data`; configured runtime dimensions live below `config%dims`; lifecycle +state and type-bound procedures remain on `config`. Namelist files stay flat: +they continue to use `iterations` rather than `data%iterations`. + +This separates storage responsibilities; it does not encapsulate them. Both +containers remain public. Use `set_dims` to change dimensions: direct assignment +to `%dims` does not resize dependent storage or update lifecycle state. Direct +mutation of `%data` likewise does not maintain allocation/configuration +invariants; callers are responsible for keeping the documented layout valid. +Only failed `set_dims` updates promise to leave both containers unchanged, not +arbitrary failed reads or setters. + +This replaced the earlier flat native layout. Existing Fortran callers must +change `%field` to `%data%field` and `%dimension` to `%dims%dimension`. Python +wrappers retain their existing field and dimension names. + +Generated arrays have lower bound one in every dimension. Public indices use +`1:size(array, dim)`, and callers must not manually reallocate public generated +storage with non-one lower bounds. Setter inputs may have other lower bounds; +their values are copied by shape into one-based generated storage. + ## Error handling Generated type-bound procedures return integer status codes and accept an @@ -965,6 +1057,9 @@ Status codes (defined in the helper module): Notes: - `errmsg`, when present, is filled with a short message (including `iomsg` on read errors). +- The caller owns the character buffer; messages may be truncated to its length. + Capture the integer code and message together before another operation reuses + that buffer. Reader cleanup preserves the original read/find failure message. - When every field has an effective default or is otherwise optional, a readable file may omit that namelist group. `from_file` then succeeds with the same initialized defaults and optional-value sentinels as an empty group. A missing @@ -974,6 +1069,24 @@ Notes: - `NML_ERR_INVALID_HANDLE` only reports zero f2py handles. Non-zero invalid handles are outside the generated wrapper contract. +For example, handle or save the failure before making another generated call: + +```fortran +integer :: code, saved_code +character(len=1024) :: errmsg +character(len=:), allocatable :: saved_message + +code = config%from_file("run.nml", errmsg=errmsg) +if (code /= NML_OK) then + saved_code = code + saved_message = trim(errmsg) + ! saved_code and saved_message now remain available after another call. +end if +``` + +A status type owning both `code` and `msg` is a separate future API decision; +this layout change retains integer results and `errmsg=`. + ## Documentation format Generated Fortran doc-strings are currently tailored for Doxygen. Future diff --git a/examples/01_simple/main.f90 b/examples/01_simple/main.f90 index 132cde1..6724c68 100644 --- a/examples/01_simple/main.f90 +++ b/examples/01_simple/main.f90 @@ -49,23 +49,23 @@ program main write(*,*) "filled shape of mcmc_error_params: ", shp end if - allocate(try_methods(size(cfg%try_methods))) - allocate(complex_sizes(size(cfg%complex_sizes))) + allocate(try_methods(size(cfg%data%try_methods))) + allocate(complex_sizes(size(cfg%data%complex_sizes))) allocate(mcmc_error_params( & shp(1), & shp(2), & shp(3))) - name = cfg%name - method = cfg%method - try_methods = cfg%try_methods - complex_sizes = cfg%complex_sizes - niterations = cfg%niterations - tolerance = cfg%tolerance - seed = cfg%seed - dds_r = cfg%dds_r - mcmc_opti = cfg%mcmc_opti - mcmc_error_params = cfg%mcmc_error_params(1:shp(1), 1:shp(2), 1:shp(3)) - include_parameters = cfg%include_parameters + name = cfg%data%name + method = cfg%data%method + try_methods = cfg%data%try_methods + complex_sizes = cfg%data%complex_sizes + niterations = cfg%data%niterations + tolerance = cfg%data%tolerance + seed = cfg%data%seed + dds_r = cfg%data%dds_r + mcmc_opti = cfg%data%mcmc_opti + mcmc_error_params = cfg%data%mcmc_error_params(1:shp(1), 1:shp(2), 1:shp(3)) + include_parameters = cfg%data%include_parameters write(*, nml=optimization) end program main diff --git a/examples/01_simple/out/nml_helper.f90 b/examples/01_simple/out/nml_helper.f90 index fb670d2..97c0b7e 100644 --- a/examples/01_simple/out/nml_helper.f90 +++ b/examples/01_simple/out/nml_helper.f90 @@ -42,7 +42,7 @@ module nml_helper !> \brief Shared constants for generated namelist modules integer, parameter, public :: buf = 256 !< Buffer length for character strings. - integer, parameter, public :: max_iter__default = 4 !< Maximum number of iterations. + integer, parameter, public :: max_iter__dim_default = 4 !< Maximum number of iterations. !> \class nml_file_t !> \brief Type for namelist file operations @@ -58,61 +58,61 @@ module nml_helper contains !> \brief Open a namelist file - integer function nml_open(this, file, errmsg) result(status) + integer function nml_open(this, file, errmsg) result(nml__status) class(nml_file_t), intent(inout) :: this character(len=*), intent(in) :: file character(len=*), intent(out), optional :: errmsg - integer :: iostat - logical :: exists - character(len=nml_line_buffer) :: iomsg + integer :: nml__iostat + logical :: nml__exists + character(len=nml_line_buffer) :: nml__iomsg if (present(errmsg)) errmsg = "" - status = this%close() - inquire(file=file, exist=exists) - if (.not. exists) then + nml__status = this%close() + inquire(file=file, exist=nml__exists) + if (.not. nml__exists) then this%is_open = .false. this%unit = 0 - status = NML_ERR_FILE_NOT_FOUND + nml__status = NML_ERR_FILE_NOT_FOUND if (present(errmsg)) errmsg = "file not found: " // trim(file) return end if open(newunit=this%unit, file=file, status='old', action='read', & - iostat=iostat, iomsg=iomsg) - this%is_open = (iostat == 0) + iostat=nml__iostat, iomsg=nml__iomsg) + this%is_open = (nml__iostat == 0) if (.not. this%is_open) then this%unit = 0 - status = NML_ERR_OPEN - if (present(errmsg)) errmsg = trim(iomsg) + nml__status = NML_ERR_OPEN + if (present(errmsg)) errmsg = trim(nml__iomsg) return end if - status = NML_OK + nml__status = NML_OK end function nml_open !> \brief Find a namelist in the opened file - integer function nml_find(this, nml, errmsg) result(status) + integer function nml_find(this, nml, errmsg) result(nml__status) class(nml_file_t), intent(inout) :: this character(len=*), intent(in) :: nml character(len=*), intent(out), optional :: errmsg - integer :: iostat - character(len=nml_line_buffer) :: line - character(len=nml_line_buffer) :: iomsg + integer :: nml__iostat + character(len=nml_line_buffer) :: nml__line + character(len=nml_line_buffer) :: nml__iomsg if (present(errmsg)) errmsg = "" - status = NML_ERR_NML_NOT_FOUND + nml__status = NML_ERR_NML_NOT_FOUND if (.not. this%is_open) then - status = NML_ERR_NOT_OPEN + nml__status = NML_ERR_NOT_OPEN if (present(errmsg)) errmsg = "file not open" return end if rewind(unit=this%unit) do - read(this%unit, '(A)', iostat=iostat, iomsg=iomsg) line - if (iostat < 0) exit - if (iostat > 0) then - status = NML_ERR_READ - if (present(errmsg)) errmsg = trim(iomsg) + read(this%unit, '(A)', iostat=nml__iostat, iomsg=nml__iomsg) nml__line + if (nml__iostat < 0) exit + if (nml__iostat > 0) then + nml__status = NML_ERR_READ + if (present(errmsg)) errmsg = trim(nml__iomsg) return end if - if (index(to_lower(line), '&' // to_lower(trim(nml))) /= 0) then - status = NML_OK + if (index(to__lower(nml__line), '&' // to__lower(trim(nml))) /= 0) then + nml__status = NML_OK backspace(this%unit) return end if @@ -121,18 +121,18 @@ integer function nml_find(this, nml, errmsg) result(status) end function nml_find !> \brief Close the namelist file - integer function nml_close(this, errmsg) result(status) + integer function nml_close(this, errmsg) result(nml__status) class(nml_file_t), intent(inout) :: this character(len=*), intent(out), optional :: errmsg - integer :: iostat - character(len=nml_line_buffer) :: iomsg + integer :: nml__iostat + character(len=nml_line_buffer) :: nml__iomsg if (present(errmsg)) errmsg = "" - status = NML_OK + nml__status = NML_OK if (this%is_open) then - close(unit=this%unit, iostat=iostat, iomsg=iomsg) - if (iostat /= 0) then - status = NML_ERR_CLOSE - if (present(errmsg)) errmsg = trim(iomsg) + close(unit=this%unit, iostat=nml__iostat, iomsg=nml__iomsg) + if (nml__iostat /= 0) then + nml__status = NML_ERR_CLOSE + if (present(errmsg)) errmsg = trim(nml__iomsg) end if end if this%is_open = .false. @@ -140,35 +140,34 @@ integer function nml_close(this, errmsg) result(status) end function nml_close !> \brief Convert string to lower case - pure function to_lower(string) result(lower_string) - character(len=*), intent(in) :: string - character(len=len(string)) :: lower_string - integer, parameter :: shift=iachar('a')-iachar('A'), upA=iachar('A'), upZ=iachar('Z') - integer :: k, i - do i = 1, len(string) - k = ichar(string(i:i)) - if (k>=upA .and. k<=upZ) k = k + shift - lower_string(i:i) = char(k) + pure function to__lower(nml__string) result(nml__lower_string) + character(len=*), intent(in) :: nml__string + character(len=len(nml__string)) :: nml__lower_string + integer, parameter :: nml__shift=iachar('a')-iachar('A'), nml__upA=iachar('A'), nml__upZ=iachar('Z') + integer :: nml__k, nml__i + do nml__i = 1, len(nml__string) + nml__k = ichar(nml__string(nml__i:nml__i)) + if (nml__k>=nml__upA .and. nml__k<=nml__upZ) nml__k = nml__k + nml__shift + nml__lower_string(nml__i:nml__i) = char(nml__k) end do - end function to_lower + end function to__lower !> \brief Validate index bounds for array access - integer function idx_check(idx, lower, upper, field, errmsg) result(status) - integer, intent(in) :: idx(:) - integer, intent(in) :: lower(:) - integer, intent(in) :: upper(:) - character(len=*), intent(in) :: field + integer function idx__check(nml__idx, nml__extents, nml__field, errmsg) result(nml__status) + integer, intent(in) :: nml__idx(:) + integer, intent(in) :: nml__extents(:) + character(len=*), intent(in) :: nml__field character(len=*), intent(out), optional :: errmsg - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - if (size(idx) /= size(lower)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index rank mismatch for '" // trim(field) // "'" - else if (any(idx < lower) .or. any(idx > upper)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index out of bounds for '" // trim(field) // "'" + if (size(nml__idx) /= size(nml__extents)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index rank mismatch for '" // trim(nml__field) // "'" + else if (any(nml__idx < 1) .or. any(nml__idx > nml__extents)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index out of bounds for '" // trim(nml__field) // "'" end if - end function idx_check + end function idx__check end module nml_helper diff --git a/examples/01_simple/out/nml_optimization.f90 b/examples/01_simple/out/nml_optimization.f90 index fb689cf..79653b8 100644 --- a/examples/01_simple/out/nml_optimization.f90 +++ b/examples/01_simple/out/nml_optimization.f90 @@ -21,12 +21,13 @@ module nml_optimization NML_ERR_NOT_SET, & NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & - idx_check, & - to_lower, & + idx__check, & + to__lower, & buf, & - max_iter__default, & + max_iter__dim_default, & NML_ERR_PARTLY_SET - use ieee_arithmetic, only: ieee_value, ieee_quiet_nan, ieee_is_nan + use ieee_arithmetic, only: nml__ieee_value => ieee_value, & + nml__ieee_quiet_nan => ieee_quiet_nan, nml__ieee_is_nan => ieee_is_nan ! kind specifiers listed in the nml-tools configuration file use iso_fortran_env, only: & i4=>int32, & @@ -53,12 +54,11 @@ module nml_optimization real(dp), parameter, public :: dds_r__min_excl = 0.0_dp real(dp), parameter, public :: mcmc_error_params__min = 0.0_dp - !> \class nml_optimization_t - !> \brief Optimization configurations - !> \details All relevant configurations for the optimization parameters. - type, public :: nml_optimization_t - logical :: is_configured = .false. !< whether the namelist has been configured - integer :: max_iter = max_iter__default !< runtime dimension for max_iter + private :: nml_optimization_read__from_file + + !> \class nml_optimization_data_t + !> \brief Schema-backed values for optimization + type, public :: nml_optimization_data_t character(len=buf) :: name !< Optimization name character(len=buf) :: method !< Optimization method character(len=buf), dimension(3) :: try_methods !< Try alternative methods @@ -70,6 +70,21 @@ module nml_optimization logical :: mcmc_opti !< MCMC optimization real(dp), allocatable, dimension(:, :, :) :: mcmc_error_params !< MCMC error parameters per iteration logical, dimension(3) :: include_parameters !< Include parameters + end type nml_optimization_data_t + + !> \class nml_optimization_dims_t + !> \brief Runtime dimensions for optimization + type, public :: nml_optimization_dims_t + integer :: max_iter = max_iter__dim_default !< runtime dimension for max_iter + end type nml_optimization_dims_t + + !> \class nml_optimization_t + !> \brief Optimization configurations + !> \details All relevant configurations for the optimization parameters. + type, public :: nml_optimization_t + type(nml_optimization_data_t) :: data !< schema-backed namelist values + type(nml_optimization_dims_t) :: dims !< runtime array dimensions + logical :: is_configured = .false. !< whether the namelist has been configured contains procedure :: init => nml_optimization_init procedure :: set_dims => nml_optimization_set_dims @@ -83,187 +98,196 @@ module nml_optimization contains !> \brief Check whether a value is part of an enum - elemental logical function method__in_enum(val, allow_missing) result(in_enum) - character(len=*), intent(in) :: val !< value to check - logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - - if (present(allow_missing)) then - if (allow_missing) then - if (val == achar(0)) then - in_enum = .true. + elemental logical function method__in_enum(nml__val, nml__allow_missing) result(nml__in_enum) + character(len=*), intent(in) :: nml__val !< value to check + logical, intent(in), optional :: nml__allow_missing !< allow sentinel values as valid + + if (present(nml__allow_missing)) then + if (nml__allow_missing) then + if (nml__val == achar(0)) then + nml__in_enum = .true. return end if end if end if - in_enum = any(trim(val) == method__enum_values) + nml__in_enum = any(trim(nml__val) == method__enum_values) end function method__in_enum !> \brief Check whether a value is part of an enum - elemental logical function try_methods__in_enum(val, allow_missing) result(in_enum) - character(len=*), intent(in) :: val !< value to check - logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - - if (present(allow_missing)) then - if (allow_missing) then - if (val == achar(0)) then - in_enum = .true. + elemental logical function try_methods__in_enum(nml__val, nml__allow_missing) result(nml__in_enum) + character(len=*), intent(in) :: nml__val !< value to check + logical, intent(in), optional :: nml__allow_missing !< allow sentinel values as valid + + if (present(nml__allow_missing)) then + if (nml__allow_missing) then + if (nml__val == achar(0)) then + nml__in_enum = .true. return end if end if end if - in_enum = any(trim(val) == try_methods__enum_values) + nml__in_enum = any(trim(nml__val) == try_methods__enum_values) end function try_methods__in_enum !> \brief Check whether a value is part of an enum - elemental logical function complex_sizes__in_enum(val, allow_missing) result(in_enum) - integer(i4), intent(in) :: val !< value to check - logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - - if (present(allow_missing)) then - if (allow_missing) then - if (val == -huge(val)) then - in_enum = .true. + elemental logical function complex_sizes__in_enum(nml__val, nml__allow_missing) result(nml__in_enum) + integer(i4), intent(in) :: nml__val !< value to check + logical, intent(in), optional :: nml__allow_missing !< allow sentinel values as valid + + if (present(nml__allow_missing)) then + if (nml__allow_missing) then + if (nml__val == -huge(nml__val)) then + nml__in_enum = .true. return end if end if end if - in_enum = any(val == complex_sizes__enum_values) + nml__in_enum = any(nml__val == complex_sizes__enum_values) end function complex_sizes__in_enum !> \brief Check whether a value is within bounds - elemental logical function niterations__in_bounds(val, allow_missing) result(in_bounds) - integer(i4), intent(in) :: val !< value to check - logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - - if (present(allow_missing)) then - if (allow_missing) then - if (val == -huge(val)) then - in_bounds = .true. + elemental logical function niterations__in_bounds(nml__val, nml__allow_missing) result(nml__in_bounds) + integer(i4), intent(in) :: nml__val !< value to check + logical, intent(in), optional :: nml__allow_missing !< allow sentinel values as valid + + if (present(nml__allow_missing)) then + if (nml__allow_missing) then + if (nml__val == -huge(nml__val)) then + nml__in_bounds = .true. return end if end if end if - in_bounds = .true. - if (val < niterations__min) in_bounds = .false. + nml__in_bounds = .true. + if (nml__val < niterations__min) nml__in_bounds = .false. end function niterations__in_bounds !> \brief Check whether a value is within bounds - elemental logical function tolerance__in_bounds(val, allow_missing) result(in_bounds) - real(dp), intent(in) :: val !< value to check - logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - - if (present(allow_missing)) then - if (allow_missing) then - if (ieee_is_nan(val)) then - in_bounds = .true. + elemental logical function tolerance__in_bounds(nml__val, nml__allow_missing) result(nml__in_bounds) + real(dp), intent(in) :: nml__val !< value to check + logical, intent(in), optional :: nml__allow_missing !< allow sentinel values as valid + + if (present(nml__allow_missing)) then + if (nml__allow_missing) then + if (nml__ieee_is_nan(nml__val)) then + nml__in_bounds = .true. return end if end if end if - in_bounds = .true. - if (val <= tolerance__min_excl) in_bounds = .false. + nml__in_bounds = .true. + if (nml__val <= tolerance__min_excl) nml__in_bounds = .false. end function tolerance__in_bounds !> \brief Check whether a value is within bounds - elemental logical function dds_r__in_bounds(val, allow_missing) result(in_bounds) - real(dp), intent(in) :: val !< value to check - logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - - if (present(allow_missing)) then - if (allow_missing) then - if (ieee_is_nan(val)) then - in_bounds = .true. + elemental logical function dds_r__in_bounds(nml__val, nml__allow_missing) result(nml__in_bounds) + real(dp), intent(in) :: nml__val !< value to check + logical, intent(in), optional :: nml__allow_missing !< allow sentinel values as valid + + if (present(nml__allow_missing)) then + if (nml__allow_missing) then + if (nml__ieee_is_nan(nml__val)) then + nml__in_bounds = .true. return end if end if end if - in_bounds = .true. - if (val <= dds_r__min_excl) in_bounds = .false. + nml__in_bounds = .true. + if (nml__val <= dds_r__min_excl) nml__in_bounds = .false. end function dds_r__in_bounds !> \brief Check whether a value is within bounds - elemental logical function mcmc_error_params__in_bounds(val, allow_missing) result(in_bounds) - real(dp), intent(in) :: val !< value to check - logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - - if (present(allow_missing)) then - if (allow_missing) then - if (ieee_is_nan(val)) then - in_bounds = .true. + elemental logical function mcmc_error_params__in_bounds(nml__val, nml__allow_missing) result(nml__in_bounds) + real(dp), intent(in) :: nml__val !< value to check + logical, intent(in), optional :: nml__allow_missing !< allow sentinel values as valid + + if (present(nml__allow_missing)) then + if (nml__allow_missing) then + if (nml__ieee_is_nan(nml__val)) then + nml__in_bounds = .true. return end if end if end if - in_bounds = .true. - if (val < mcmc_error_params__min) in_bounds = .false. + nml__in_bounds = .true. + if (nml__val < mcmc_error_params__min) nml__in_bounds = .false. end function mcmc_error_params__in_bounds !> \brief Initialize defaults and sentinels for optimization - integer function nml_optimization_init(this, errmsg) result(status) - class(nml_optimization_t), intent(inout) :: this !< namelist instance + integer function nml_optimization_init(nml__obj, errmsg) result(nml__status) + class(nml_optimization_t), intent(inout) :: nml__obj !< namelist instance character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - this%is_configured = .false. + nml__obj%is_configured = .false. ! allocate runtime-sized fields - if (allocated(this%mcmc_error_params)) deallocate(this%mcmc_error_params) - allocate(this%mcmc_error_params(3, 2, this%max_iter)) + if (allocated(nml__obj%data%mcmc_error_params)) deallocate(nml__obj%data%mcmc_error_params) + allocate(nml__obj%data%mcmc_error_params(3, 2, nml__obj%dims%max_iter)) ! sentinel values for required/optional parameters - this%name = achar(0) ! sentinel for optional string - this%method = achar(0) ! NULL string as sentinel for required string - this%try_methods = achar(0) ! sentinel for optional string array - this%complex_sizes = -huge(this%complex_sizes) ! sentinel for optional integer array - this%niterations = -huge(this%niterations) ! sentinel for required integer - this%tolerance = ieee_value(this%tolerance, ieee_quiet_nan) ! sentinel for required real - this%mcmc_error_params = ieee_value(this%mcmc_error_params, ieee_quiet_nan) ! sentinel for required real array + nml__obj%data%name = achar(0) ! sentinel for optional string + nml__obj%data%method = achar(0) ! NULL string as sentinel for required string + nml__obj%data%try_methods = achar(0) ! sentinel for optional string array + nml__obj%data%complex_sizes = -huge(nml__obj%data%complex_sizes) ! sentinel for optional integer array + nml__obj%data%niterations = -huge(nml__obj%data%niterations) ! sentinel for required integer + nml__obj%data%tolerance = nml__ieee_value(nml__obj%data%tolerance, nml__ieee_quiet_nan) ! sentinel for required real + nml__obj%data%mcmc_error_params = nml__ieee_value(nml__obj%data%mcmc_error_params, nml__ieee_quiet_nan) ! sentinel for required real array ! default values - this%seed = seed__default - this%dds_r = dds_r__default - this%mcmc_opti = mcmc_opti__default ! bool values always need a default - this%include_parameters = include_parameters__default + nml__obj%data%seed = seed__default + nml__obj%data%dds_r = dds_r__default + nml__obj%data%mcmc_opti = mcmc_opti__default ! bool values always need a default + nml__obj%data%include_parameters = include_parameters__default end function nml_optimization_init !> \brief Reset runtime dimensions for optimization - integer function nml_optimization_set_dims(this, & + integer function nml_optimization_set_dims(nml__obj, & max_iter, & - errmsg) result(status) - class(nml_optimization_t), intent(inout) :: this !< namelist instance + errmsg) result(nml__status) + class(nml_optimization_t), intent(inout) :: nml__obj !< namelist instance integer, intent(in), optional :: max_iter !< runtime dimension override for max_iter integer :: candidate__max_iter character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" if (present(max_iter)) then candidate__max_iter = max_iter else - candidate__max_iter = max_iter__default + candidate__max_iter = max_iter__dim_default end if if (candidate__max_iter <= 0) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "dimension 'max_iter' must be positive" return end if - this%max_iter = candidate__max_iter + nml__obj%dims%max_iter = candidate__max_iter ! deallocate runtime-sized fields; init/set/from_file allocate them again - if (allocated(this%mcmc_error_params)) deallocate(this%mcmc_error_params) - this%is_configured = .false. + if (allocated(nml__obj%data%mcmc_error_params)) deallocate(nml__obj%data%mcmc_error_params) + nml__obj%is_configured = .false. end function nml_optimization_set_dims !> \brief Read optimization namelist from file - integer function nml_optimization_from_file(this, file, errmsg) result(status) - class(nml_optimization_t), intent(inout) :: this !< namelist instance + integer function nml_optimization_from_file(nml__obj, file, errmsg) result(nml__status) + class(nml_optimization_t), intent(inout) :: nml__obj !< namelist instance character(len=*), intent(in) :: file !< path to namelist file character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + + nml__status = nml_optimization_read__from_file(nml__obj, file, errmsg) + end function nml_optimization_from_file + + integer function nml_optimization_read__from_file(nml__obj, nml__file, errmsg) & + result(nml__status) + class(nml_optimization_t), intent(inout) :: nml__obj + character(len=*), intent(in) :: nml__file + character(len=*), intent(out), optional :: errmsg ! namelist variables character(len=buf) :: name character(len=buf) :: method @@ -277,10 +301,10 @@ integer function nml_optimization_from_file(this, file, errmsg) result(status) real(dp), allocatable, dimension(:, :, :) :: mcmc_error_params logical, dimension(3) :: include_parameters ! locals - type(nml_file_t) :: nml - integer :: iostat - integer :: close_status - character(len=nml_line_buffer) :: iomsg + type(nml_file_t) :: nml__reader + integer :: nml__iostat + integer :: nml__close_status + character(len=nml_line_buffer) :: nml__iomsg namelist /optimization/ & name, & @@ -295,66 +319,66 @@ integer function nml_optimization_from_file(this, file, errmsg) result(status) mcmc_error_params, & include_parameters - status = this%init(errmsg=errmsg) - if (status /= NML_OK) return + nml__status = nml__obj%init(errmsg=errmsg) + if (nml__status /= NML_OK) return ! allocate local namelist variables matching runtime-sized fields if (allocated(mcmc_error_params)) deallocate(mcmc_error_params) - allocate(mcmc_error_params(3, 2, this%max_iter)) - name = this%name - method = this%method - try_methods = this%try_methods - complex_sizes = this%complex_sizes - niterations = this%niterations - tolerance = this%tolerance - seed = this%seed - dds_r = this%dds_r - mcmc_opti = this%mcmc_opti - mcmc_error_params = this%mcmc_error_params - include_parameters = this%include_parameters - - status = nml%open(file, errmsg=errmsg) - if (status /= NML_OK) return - - status = nml%find("optimization", errmsg=errmsg) - if (status /= NML_OK) then - close_status = nml%close() + allocate(mcmc_error_params(3, 2, nml__obj%dims%max_iter)) + name = nml__obj%data%name + method = nml__obj%data%method + try_methods = nml__obj%data%try_methods + complex_sizes = nml__obj%data%complex_sizes + niterations = nml__obj%data%niterations + tolerance = nml__obj%data%tolerance + seed = nml__obj%data%seed + dds_r = nml__obj%data%dds_r + mcmc_opti = nml__obj%data%mcmc_opti + mcmc_error_params = nml__obj%data%mcmc_error_params + include_parameters = nml__obj%data%include_parameters + + nml__status = nml__reader%open(nml__file, errmsg=errmsg) + if (nml__status /= NML_OK) return + + nml__status = nml__reader%find("optimization", errmsg=errmsg) + if (nml__status /= NML_OK) then + nml__close_status = nml__reader%close() return end if ! read namelist - read(nml%unit, nml=optimization, iostat=iostat, iomsg=iomsg) - if (iostat /= 0) then - status = NML_ERR_READ - if (present(errmsg)) errmsg = trim(iomsg) - close_status = nml%close() + read(nml__reader%unit, nml=optimization, iostat=nml__iostat, iomsg=nml__iomsg) + if (nml__iostat /= 0) then + nml__status = NML_ERR_READ + if (present(errmsg)) errmsg = trim(nml__iomsg) + nml__close_status = nml__reader%close() return end if - close_status = nml%close(errmsg=errmsg) - if (close_status /= NML_OK) then - status = close_status + nml__close_status = nml__reader%close(errmsg=errmsg) + if (nml__close_status /= NML_OK) then + nml__status = nml__close_status return end if ! assign values - this%name = name - this%method = method - this%try_methods = try_methods - this%complex_sizes = complex_sizes - this%niterations = niterations - this%tolerance = tolerance - this%seed = seed - this%dds_r = dds_r - this%mcmc_opti = mcmc_opti - this%mcmc_error_params = mcmc_error_params - this%include_parameters = include_parameters + nml__obj%data%name = name + nml__obj%data%method = method + nml__obj%data%try_methods = try_methods + nml__obj%data%complex_sizes = complex_sizes + nml__obj%data%niterations = niterations + nml__obj%data%tolerance = tolerance + nml__obj%data%seed = seed + nml__obj%data%dds_r = dds_r + nml__obj%data%mcmc_opti = mcmc_opti + nml__obj%data%mcmc_error_params = mcmc_error_params + nml__obj%data%include_parameters = include_parameters ! mark as configured - this%is_configured = .true. - status = NML_OK - end function nml_optimization_from_file + nml__obj%is_configured = .true. + nml__status = NML_OK + end function nml_optimization_read__from_file !> \brief Set optimization values - integer function nml_optimization_set(this, & + integer function nml_optimization_set(nml__obj, & method, & niterations, & tolerance, & @@ -366,9 +390,9 @@ integer function nml_optimization_set(this, & dds_r, & mcmc_opti, & include_parameters, & - errmsg) result(status) + errmsg) result(nml__status) - class(nml_optimization_t), intent(inout) :: this !< namelist instance + class(nml_optimization_t), intent(inout) :: nml__obj !< namelist instance character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values character(len=*), intent(in) :: method !< Optimization method integer(i4), intent(in) :: niterations !< Number of iterations @@ -381,276 +405,249 @@ integer function nml_optimization_set(this, & real(dp), intent(in), optional :: dds_r !< DDS perturbation rate logical, intent(in), optional :: mcmc_opti !< MCMC optimization logical, dimension(:), intent(in), optional :: include_parameters !< Include parameters - integer :: & - lb__1, & - lb__2, & - lb__3, & - ub__1, & - ub__2, & - ub__3 - - status = this%init(errmsg=errmsg) - if (status /= NML_OK) return + nml__status = nml__obj%init(errmsg=errmsg) + if (nml__status /= NML_OK) return ! required parameters - this%method = method - this%niterations = niterations - this%tolerance = tolerance - if (size(mcmc_error_params, 1) > size(this%mcmc_error_params, 1)) then - status = NML_ERR_INVALID_INDEX + nml__obj%data%method = method + nml__obj%data%niterations = niterations + nml__obj%data%tolerance = tolerance + if (size(mcmc_error_params, 1) > size(nml__obj%data%mcmc_error_params, 1)) then + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'mcmc_error_params'" return end if - lb__1 = lbound(this%mcmc_error_params, 1) - ub__1 = lb__1 + size(mcmc_error_params, 1) - 1 - if (size(mcmc_error_params, 2) > size(this%mcmc_error_params, 2)) then - status = NML_ERR_INVALID_INDEX + if (size(mcmc_error_params, 2) > size(nml__obj%data%mcmc_error_params, 2)) then + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "dimension 2 exceeds bounds for 'mcmc_error_params'" return end if - lb__2 = lbound(this%mcmc_error_params, 2) - ub__2 = lb__2 + size(mcmc_error_params, 2) - 1 - if (size(mcmc_error_params, 3) > size(this%mcmc_error_params, 3)) then - status = NML_ERR_INVALID_INDEX + if (size(mcmc_error_params, 3) > size(nml__obj%data%mcmc_error_params, 3)) then + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "dimension 3 exceeds bounds for 'mcmc_error_params'" return end if - lb__3 = lbound(this%mcmc_error_params, 3) - ub__3 = lb__3 + size(mcmc_error_params, 3) - 1 - this%mcmc_error_params(lb__1:ub__1, lb__2:ub__2, lb__3:ub__3) = mcmc_error_params + nml__obj%data%mcmc_error_params( & + 1:size(mcmc_error_params, 1), & + 1:size(mcmc_error_params, 2), & + 1:size(mcmc_error_params, 3)) = mcmc_error_params ! override with provided values - if (present(name)) this%name = name + if (present(name)) nml__obj%data%name = name if (present(try_methods)) then - if (size(try_methods, 1) > size(this%try_methods, 1)) then - status = NML_ERR_INVALID_INDEX + if (size(try_methods, 1) > size(nml__obj%data%try_methods, 1)) then + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'try_methods'" return end if - lb__1 = lbound(this%try_methods, 1) - ub__1 = lb__1 + size(try_methods, 1) - 1 - this%try_methods(lb__1:ub__1) = try_methods + nml__obj%data%try_methods( & + 1:size(try_methods, 1)) = try_methods end if if (present(complex_sizes)) then - if (size(complex_sizes, 1) > size(this%complex_sizes, 1)) then - status = NML_ERR_INVALID_INDEX + if (size(complex_sizes, 1) > size(nml__obj%data%complex_sizes, 1)) then + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'complex_sizes'" return end if - lb__1 = lbound(this%complex_sizes, 1) - ub__1 = lb__1 + size(complex_sizes, 1) - 1 - this%complex_sizes(lb__1:ub__1) = complex_sizes + nml__obj%data%complex_sizes( & + 1:size(complex_sizes, 1)) = complex_sizes end if - if (present(seed)) this%seed = seed - if (present(dds_r)) this%dds_r = dds_r - if (present(mcmc_opti)) this%mcmc_opti = mcmc_opti + if (present(seed)) nml__obj%data%seed = seed + if (present(dds_r)) nml__obj%data%dds_r = dds_r + if (present(mcmc_opti)) nml__obj%data%mcmc_opti = mcmc_opti if (present(include_parameters)) then - if (size(include_parameters, 1) > size(this%include_parameters, 1)) then - status = NML_ERR_INVALID_INDEX + if (size(include_parameters, 1) > size(nml__obj%data%include_parameters, 1)) then + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'include_parameters'" return end if - lb__1 = lbound(this%include_parameters, 1) - ub__1 = lb__1 + size(include_parameters, 1) - 1 - this%include_parameters(lb__1:ub__1) = include_parameters + nml__obj%data%include_parameters( & + 1:size(include_parameters, 1)) = include_parameters end if ! mark as configured - this%is_configured = .true. - status = NML_OK + nml__obj%is_configured = .true. + nml__status = NML_OK end function nml_optimization_set !> \brief Check whether a namelist value was set - integer function nml_optimization_is_set(this, name, idx, errmsg) result(status) - class(nml_optimization_t), intent(in) :: this !< namelist instance + integer function nml_optimization_is_set(nml__obj, name, idx, errmsg) result(nml__status) + class(nml_optimization_t), intent(in) :: nml__obj !< namelist instance character(len=*), intent(in) :: name !< field name integer, intent(in), optional :: idx(:) !< optional field index values character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(trim(name))) + select case (to__lower(trim(name))) case ("name") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'name'" return end if - if (this%name == achar(0)) status = NML_ERR_NOT_SET + if (nml__obj%data%name == achar(0)) nml__status = NML_ERR_NOT_SET case ("method") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'method'" return end if - if (this%method == achar(0)) status = NML_ERR_NOT_SET + if (nml__obj%data%method == achar(0)) nml__status = NML_ERR_NOT_SET case ("try_methods") if (present(idx)) then - status = idx_check(idx, lbound(this%try_methods), ubound(this%try_methods), & + nml__status = idx__check(idx, shape(nml__obj%data%try_methods), & "try_methods", errmsg) - if (status /= NML_OK) return - if (this%try_methods(idx(1)) == achar(0)) status = NML_ERR_NOT_SET + if (nml__status /= NML_OK) return + if (nml__obj%data%try_methods(idx(1)) == achar(0)) nml__status = NML_ERR_NOT_SET else - if (all(this%try_methods == achar(0))) status = NML_ERR_NOT_SET + if (all(nml__obj%data%try_methods == achar(0))) nml__status = NML_ERR_NOT_SET end if case ("complex_sizes") if (present(idx)) then - status = idx_check(idx, lbound(this%complex_sizes), ubound(this%complex_sizes), & + nml__status = idx__check(idx, shape(nml__obj%data%complex_sizes), & "complex_sizes", errmsg) - if (status /= NML_OK) return - if (this%complex_sizes(idx(1)) == -huge(this%complex_sizes(idx(1)))) status = NML_ERR_NOT_SET + if (nml__status /= NML_OK) return + if (nml__obj%data%complex_sizes(idx(1)) == -huge(nml__obj%data%complex_sizes(idx(1)))) nml__status = NML_ERR_NOT_SET else - if (all(this%complex_sizes == -huge(this%complex_sizes))) status = NML_ERR_NOT_SET + if (all(nml__obj%data%complex_sizes == -huge(nml__obj%data%complex_sizes))) nml__status = NML_ERR_NOT_SET end if case ("niterations") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'niterations'" return end if - if (this%niterations == -huge(this%niterations)) status = NML_ERR_NOT_SET + if (nml__obj%data%niterations == -huge(nml__obj%data%niterations)) nml__status = NML_ERR_NOT_SET case ("tolerance") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'tolerance'" return end if - if (ieee_is_nan(this%tolerance)) status = NML_ERR_NOT_SET + if (nml__ieee_is_nan(nml__obj%data%tolerance)) nml__status = NML_ERR_NOT_SET case ("seed") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'seed'" return end if case ("dds_r") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'dds_r'" return end if case ("mcmc_opti") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'mcmc_opti'" return end if case ("mcmc_error_params") - if (.not. allocated(this%mcmc_error_params)) then - status = NML_ERR_NOT_SET + if (.not. allocated(nml__obj%data%mcmc_error_params)) then + nml__status = NML_ERR_NOT_SET return end if if (present(idx)) then - status = idx_check(idx, lbound(this%mcmc_error_params), ubound(this%mcmc_error_params), & + nml__status = idx__check(idx, shape(nml__obj%data%mcmc_error_params), & "mcmc_error_params", errmsg) - if (status /= NML_OK) return - if (ieee_is_nan(this%mcmc_error_params(idx(1), idx(2), idx(3)))) status = NML_ERR_NOT_SET + if (nml__status /= NML_OK) return + if (nml__ieee_is_nan(nml__obj%data%mcmc_error_params(idx(1), idx(2), idx(3)))) nml__status = NML_ERR_NOT_SET else - if (all(ieee_is_nan(this%mcmc_error_params))) status = NML_ERR_NOT_SET + if (all(nml__ieee_is_nan(nml__obj%data%mcmc_error_params))) nml__status = NML_ERR_NOT_SET end if case ("include_parameters") if (present(idx)) then - status = idx_check(idx, lbound(this%include_parameters), ubound(this%include_parameters), & + nml__status = idx__check(idx, shape(nml__obj%data%include_parameters), & "include_parameters", errmsg) - if (status /= NML_OK) return + if (nml__status /= NML_OK) return else end if case default - status = NML_ERR_INVALID_NAME + nml__status = NML_ERR_INVALID_NAME if (present(errmsg)) errmsg = "unknown field: " // trim(name) end select - if (status == NML_ERR_NOT_SET .and. present(errmsg)) then + if (nml__status == NML_ERR_NOT_SET .and. present(errmsg)) then if (len_trim(errmsg) == 0) errmsg = "field not set: " // trim(name) end if end function nml_optimization_is_set !> \brief Determine the filled shape along flexible dimensions - integer function nml_optimization_filled_shape(this, name, filled, errmsg) result(status) - class(nml_optimization_t), intent(in) :: this !< namelist instance + integer function nml_optimization_filled_shape(nml__obj, name, filled, errmsg) result(nml__status) + class(nml_optimization_t), intent(in) :: nml__obj !< namelist instance character(len=*), intent(in) :: name !< field name integer, intent(out) :: filled(:) !< filled shape of the requested field character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - integer :: idx - integer :: dim - integer :: & - lb__1, & - lb__2, & - lb__3, & - ub__1, & - ub__2, & - ub__3 - - status = NML_OK + integer :: nml__idx + integer :: nml__dim + + nml__status = NML_OK if (present(errmsg)) errmsg = "" - select case (to_lower(trim(name))) + select case (to__lower(trim(name))) case ("mcmc_error_params") if (size(filled) /= 3) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "shape rank mismatch for 'mcmc_error_params'" return end if - if (.not. allocated(this%mcmc_error_params)) then + if (.not. allocated(nml__obj%data%mcmc_error_params)) then filled = 0 return end if - do dim = 1, 3 - filled(dim) = size(this%mcmc_error_params, dim) + do nml__dim = 1, 3 + filled(nml__dim) = size(nml__obj%data%mcmc_error_params, nml__dim) end do filled(2) = 0 - do idx = ubound(this%mcmc_error_params, 2), & - lbound(this%mcmc_error_params, 2), -1 - if (.not. (all(ieee_is_nan(this%mcmc_error_params(:, idx, :))))) then - filled(2) = idx - lbound(this%mcmc_error_params, 2) + 1 + do nml__idx = size(nml__obj%data%mcmc_error_params, 2), 1, -1 + if (.not. (all(nml__ieee_is_nan(nml__obj%data%mcmc_error_params(:, nml__idx, :))))) then + filled(2) = nml__idx exit end if end do filled(3) = 0 - do idx = ubound(this%mcmc_error_params, 3), & - lbound(this%mcmc_error_params, 3), -1 - if (.not. (all(ieee_is_nan(this%mcmc_error_params(:, :, idx))))) then - filled(3) = idx - lbound(this%mcmc_error_params, 3) + 1 + do nml__idx = size(nml__obj%data%mcmc_error_params, 3), 1, -1 + if (.not. (all(nml__ieee_is_nan(nml__obj%data%mcmc_error_params(:, :, nml__idx))))) then + filled(3) = nml__idx exit end if end do if (minval(filled) > 0) then - lb__2 = lbound(this%mcmc_error_params, 2) - ub__2 = lb__2 + filled(2) - 1 - lb__3 = lbound(this%mcmc_error_params, 3) - ub__3 = lb__3 + filled(3) - 1 - if (any(ieee_is_nan(this%mcmc_error_params(:, lb__2:ub__2, lb__3:ub__3)))) then - status = NML_ERR_PARTLY_SET + if (any(nml__ieee_is_nan(nml__obj%data%mcmc_error_params(:, 1:filled(2), 1:filled(3))))) then + nml__status = NML_ERR_PARTLY_SET if (present(errmsg)) errmsg = "array partly set: mcmc_error_params" return end if end if case default - status = NML_ERR_INVALID_NAME + nml__status = NML_ERR_INVALID_NAME if (present(errmsg)) errmsg = "field is not a flexible array: " // trim(name) end select end function nml_optimization_filled_shape !> \brief Validate required values and constraints - integer function nml_optimization_is_valid(this, errmsg) result(status) - class(nml_optimization_t), intent(in) :: this !< namelist instance + integer function nml_optimization_is_valid(nml__obj, errmsg) result(nml__status) + class(nml_optimization_t), intent(in) :: nml__obj !< namelist instance character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - integer :: istat - integer, allocatable :: filled(:) + integer :: nml__istat + integer, allocatable :: nml__filled(:) - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if ! required parameters - istat = this%is_set("method", errmsg=errmsg) - if (istat == NML_ERR_NOT_SET) then - status = NML_ERR_REQUIRED + nml__istat = nml__obj%is_set("method", errmsg=errmsg) + if (nml__istat == NML_ERR_NOT_SET) then + nml__status = NML_ERR_REQUIRED if (present(errmsg)) then if (len_trim(errmsg) == 0) then errmsg = "field not set: method" @@ -659,13 +656,13 @@ integer function nml_optimization_is_valid(this, errmsg) result(status) end if return end if - if (istat /= NML_OK) then - status = istat + if (nml__istat /= NML_OK) then + nml__status = nml__istat return end if - istat = this%is_set("niterations", errmsg=errmsg) - if (istat == NML_ERR_NOT_SET) then - status = NML_ERR_REQUIRED + nml__istat = nml__obj%is_set("niterations", errmsg=errmsg) + if (nml__istat == NML_ERR_NOT_SET) then + nml__status = NML_ERR_REQUIRED if (present(errmsg)) then if (len_trim(errmsg) == 0) then errmsg = "field not set: niterations" @@ -674,13 +671,13 @@ integer function nml_optimization_is_valid(this, errmsg) result(status) end if return end if - if (istat /= NML_OK) then - status = istat + if (nml__istat /= NML_OK) then + nml__status = nml__istat return end if - istat = this%is_set("tolerance", errmsg=errmsg) - if (istat == NML_ERR_NOT_SET) then - status = NML_ERR_REQUIRED + nml__istat = nml__obj%is_set("tolerance", errmsg=errmsg) + if (nml__istat == NML_ERR_NOT_SET) then + nml__status = NML_ERR_REQUIRED if (present(errmsg)) then if (len_trim(errmsg) == 0) then errmsg = "field not set: tolerance" @@ -689,89 +686,90 @@ integer function nml_optimization_is_valid(this, errmsg) result(status) end if return end if - if (istat /= NML_OK) then - status = istat + if (nml__istat /= NML_OK) then + nml__status = nml__istat return end if ! flexible arrays - if (allocated(filled)) deallocate(filled) - allocate(filled(3)) - istat = this%filled_shape("mcmc_error_params", filled, errmsg=errmsg) - if (istat == NML_ERR_PARTLY_SET) then - status = istat + if (allocated(nml__filled)) deallocate(nml__filled) + allocate(nml__filled(3)) + nml__istat = nml__obj%filled_shape( & + "mcmc_error_params", nml__filled, errmsg=errmsg) + if (nml__istat == NML_ERR_PARTLY_SET) then + nml__status = nml__istat if (present(errmsg)) then if (len_trim(errmsg) == 0) errmsg = "array partly set: mcmc_error_params" end if return end if - if (istat /= NML_OK) then - status = istat + if (nml__istat /= NML_OK) then + nml__status = nml__istat return end if - if (minval(filled) == 0) then - status = NML_ERR_REQUIRED + if (minval(nml__filled) == 0) then + nml__status = NML_ERR_REQUIRED if (present(errmsg)) errmsg = "required field not set: mcmc_error_params" return end if ! enum constraints - istat = this%is_set("method", errmsg=errmsg) - if (istat == NML_OK) then - if (.not. method__in_enum(this%method)) then - status = NML_ERR_ENUM + nml__istat = nml__obj%is_set("method", errmsg=errmsg) + if (nml__istat == NML_OK) then + if (.not. method__in_enum(nml__obj%data%method)) then + nml__status = NML_ERR_ENUM if (present(errmsg)) errmsg = "enum constraint failed: method" return end if - else if (istat /= NML_ERR_NOT_SET) then - status = istat + else if (nml__istat /= NML_ERR_NOT_SET) then + nml__status = nml__istat return end if - if (.not. all(try_methods__in_enum(this%try_methods, allow_missing=.true.))) then - status = NML_ERR_ENUM + if (.not. all(try_methods__in_enum(nml__obj%data%try_methods, nml__allow_missing=.true.))) then + nml__status = NML_ERR_ENUM if (present(errmsg)) errmsg = "enum constraint failed: try_methods" return end if - if (.not. all(complex_sizes__in_enum(this%complex_sizes, allow_missing=.true.))) then - status = NML_ERR_ENUM + if (.not. all(complex_sizes__in_enum(nml__obj%data%complex_sizes, nml__allow_missing=.true.))) then + nml__status = NML_ERR_ENUM if (present(errmsg)) errmsg = "enum constraint failed: complex_sizes" return end if ! bounds constraints - istat = this%is_set("niterations", errmsg=errmsg) - if (istat == NML_OK) then - if (.not. niterations__in_bounds(this%niterations)) then - status = NML_ERR_BOUNDS + nml__istat = nml__obj%is_set("niterations", errmsg=errmsg) + if (nml__istat == NML_OK) then + if (.not. niterations__in_bounds(nml__obj%data%niterations)) then + nml__status = NML_ERR_BOUNDS if (present(errmsg)) errmsg = "bounds constraint failed: niterations" return end if - else if (istat /= NML_ERR_NOT_SET) then - status = istat + else if (nml__istat /= NML_ERR_NOT_SET) then + nml__status = nml__istat return end if - istat = this%is_set("tolerance", errmsg=errmsg) - if (istat == NML_OK) then - if (.not. tolerance__in_bounds(this%tolerance)) then - status = NML_ERR_BOUNDS + nml__istat = nml__obj%is_set("tolerance", errmsg=errmsg) + if (nml__istat == NML_OK) then + if (.not. tolerance__in_bounds(nml__obj%data%tolerance)) then + nml__status = NML_ERR_BOUNDS if (present(errmsg)) errmsg = "bounds constraint failed: tolerance" return end if - else if (istat /= NML_ERR_NOT_SET) then - status = istat + else if (nml__istat /= NML_ERR_NOT_SET) then + nml__status = nml__istat return end if - istat = this%is_set("dds_r", errmsg=errmsg) - if (istat == NML_OK) then - if (.not. dds_r__in_bounds(this%dds_r)) then - status = NML_ERR_BOUNDS + nml__istat = nml__obj%is_set("dds_r", errmsg=errmsg) + if (nml__istat == NML_OK) then + if (.not. dds_r__in_bounds(nml__obj%data%dds_r)) then + nml__status = NML_ERR_BOUNDS if (present(errmsg)) errmsg = "bounds constraint failed: dds_r" return end if - else if (istat /= NML_ERR_NOT_SET) then - status = istat + else if (nml__istat /= NML_ERR_NOT_SET) then + nml__status = nml__istat return end if - if (allocated(this%mcmc_error_params)) then - if (.not. all(mcmc_error_params__in_bounds(this%mcmc_error_params, allow_missing=.true.))) then - status = NML_ERR_BOUNDS + if (allocated(nml__obj%data%mcmc_error_params)) then + if (.not. all(mcmc_error_params__in_bounds(nml__obj%data%mcmc_error_params, nml__allow_missing=.true.))) then + nml__status = NML_ERR_BOUNDS if (present(errmsg)) errmsg = "bounds constraint failed: mcmc_error_params" return end if diff --git a/examples/02_pybind/f2py/generated/f2py_config.f90 b/examples/02_pybind/f2py/generated/f2py_config.f90 index 1c0cdbf..1687bb7 100644 --- a/examples/02_pybind/f2py/generated/f2py_config.f90 +++ b/examples/02_pybind/f2py/generated/f2py_config.f90 @@ -18,22 +18,22 @@ module f2py_config contains !> \brief Read the config namelist from a file - subroutine config_from_file_wrapper(handle, file, status, errmsg) - integer(c_intptr_t), intent(in) :: handle !< opaque handle to a nml_config_t instance + subroutine config_from_file_wrapper(nml__handle, file, nml__status, nml__errmsg) + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a nml_config_t instance character(len=*), intent(in) :: file !< namelist file path - integer, intent(out) :: status !< nml-tools status code - character(len=512), intent(out) :: errmsg !< error message for non-OK status values - type(nml_config_t), pointer :: this + integer, intent(out) :: nml__status !< nml-tools status code + character(len=512), intent(out) :: nml__errmsg !< error message for non-OK status values + type(nml_config_t), pointer :: nml__obj - call nml_config_resolve_handle(handle, this, status, errmsg) - if (.not. associated(this)) then + call nml_config_resolve_handle(nml__handle, nml__obj, nml__status, nml__errmsg) + if (.not. associated(nml__obj)) then return end if - status = this%from_file(file, errmsg=errmsg) + nml__status = nml__obj%from_file(file, errmsg=nml__errmsg) end subroutine config_from_file_wrapper !> \brief Set config values on the handled instance - subroutine config_set_wrapper(handle, & + subroutine config_set_wrapper(nml__handle, & name, & has__name, & iterations, & @@ -43,8 +43,8 @@ subroutine config_set_wrapper(handle, & weights__n1, & weights, & has__weights, & - status, errmsg) - integer(c_intptr_t), intent(in) :: handle !< opaque handle to a nml_config_t instance + nml__status, nml__errmsg) + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a nml_config_t instance character(len=*), intent(in) :: name !< Config name (optional) logical, intent(in) :: has__name !< whether name was provided integer(i4), intent(in) :: iterations !< Iterations (required) @@ -54,15 +54,15 @@ subroutine config_set_wrapper(handle, & integer, intent(in) :: weights__n1 !< extent for weights real(dp), dimension(weights__n1), intent(in) :: weights !< Weights (optional) logical, intent(in) :: has__weights !< whether weights was provided - integer, intent(out) :: status !< nml-tools status code - character(len=512), intent(out) :: errmsg !< error message for non-OK status values - type(nml_config_t), pointer :: this + integer, intent(out) :: nml__status !< nml-tools status code + character(len=512), intent(out) :: nml__errmsg !< error message for non-OK status values + type(nml_config_t), pointer :: nml__obj character(len=:), allocatable :: maybe__name logical, allocatable :: maybe__enabled real(dp), dimension(:), allocatable :: maybe__weights - call nml_config_resolve_handle(handle, this, status, errmsg) - if (.not. associated(this)) then + call nml_config_resolve_handle(nml__handle, nml__obj, nml__status, nml__errmsg) + if (.not. associated(nml__obj)) then return end if if (has__name) then @@ -76,77 +76,77 @@ subroutine config_set_wrapper(handle, & allocate(maybe__weights(weights__n1)) maybe__weights = weights end if - status = this%set( & + nml__status = nml__obj%set( & name=maybe__name, & iterations=iterations, & tolerance=tolerance, & enabled=maybe__enabled, & weights=maybe__weights, & - errmsg=errmsg) + errmsg=nml__errmsg) end subroutine config_set_wrapper !> \brief Set runtime dimensions on the handled config instance - subroutine config_set_dims_wrapper(handle, & + subroutine config_set_dims_wrapper(nml__handle, & n_weights, & has__n_weights, & - status, errmsg) - integer(c_intptr_t), intent(in) :: handle !< opaque handle to a nml_config_t instance + nml__status, nml__errmsg) + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a nml_config_t instance integer, intent(in) :: n_weights !< runtime dimension override for n_weights logical, intent(in) :: has__n_weights !< whether n_weights was provided - integer, intent(out) :: status !< nml-tools status code - character(len=512), intent(out) :: errmsg !< error message for non-OK status values - type(nml_config_t), pointer :: this + integer, intent(out) :: nml__status !< nml-tools status code + character(len=512), intent(out) :: nml__errmsg !< error message for non-OK status values + type(nml_config_t), pointer :: nml__obj integer, allocatable :: maybe__n_weights - call nml_config_resolve_handle(handle, this, status, errmsg) - if (.not. associated(this)) then + call nml_config_resolve_handle(nml__handle, nml__obj, nml__status, nml__errmsg) + if (.not. associated(nml__obj)) then return end if if (has__n_weights) then allocate(maybe__n_weights) maybe__n_weights = n_weights end if - status = this%set_dims( & + nml__status = nml__obj%set_dims( & n_weights=maybe__n_weights, & - errmsg=errmsg) + errmsg=nml__errmsg) end subroutine config_set_dims_wrapper !> \brief Check whether a config field is set - subroutine config_is_set_wrapper(handle, name, idx__n1, idx, has__idx, status, errmsg) - integer(c_intptr_t), intent(in) :: handle !< opaque handle to a nml_config_t instance + subroutine config_is_set_wrapper(nml__handle, name, idx__n1, idx, has__idx, nml__status, nml__errmsg) + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a nml_config_t instance character(len=*), intent(in) :: name !< field name integer, intent(in) :: idx__n1 !< extent for idx integer, dimension(idx__n1), intent(in) :: idx !< optional field index values logical, intent(in) :: has__idx !< whether idx was provided - integer, intent(out) :: status !< nml-tools status code - character(len=512), intent(out) :: errmsg !< error message for non-OK status values - type(nml_config_t), pointer :: this + integer, intent(out) :: nml__status !< nml-tools status code + character(len=512), intent(out) :: nml__errmsg !< error message for non-OK status values + type(nml_config_t), pointer :: nml__obj integer, dimension(:), allocatable :: maybe__idx - call nml_config_resolve_handle(handle, this, status, errmsg) - if (.not. associated(this)) then + call nml_config_resolve_handle(nml__handle, nml__obj, nml__status, nml__errmsg) + if (.not. associated(nml__obj)) then return end if if (has__idx) then allocate(maybe__idx(idx__n1)) maybe__idx = idx end if - status = this%is_set(name, idx=maybe__idx, errmsg=errmsg) + nml__status = nml__obj%is_set(name, idx=maybe__idx, errmsg=nml__errmsg) end subroutine config_is_set_wrapper !> \brief Validate the handled config instance - subroutine config_is_valid_wrapper(handle, status, errmsg) - integer(c_intptr_t), intent(in) :: handle !< opaque handle to a nml_config_t instance - integer, intent(out) :: status !< nml-tools status code - character(len=512), intent(out) :: errmsg !< error message for non-OK status values - type(nml_config_t), pointer :: this + subroutine config_is_valid_wrapper(nml__handle, nml__status, nml__errmsg) + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a nml_config_t instance + integer, intent(out) :: nml__status !< nml-tools status code + character(len=512), intent(out) :: nml__errmsg !< error message for non-OK status values + type(nml_config_t), pointer :: nml__obj - call nml_config_resolve_handle(handle, this, status, errmsg) - if (.not. associated(this)) then + call nml_config_resolve_handle(nml__handle, nml__obj, nml__status, nml__errmsg) + if (.not. associated(nml__obj)) then return end if - status = this%is_valid(errmsg=errmsg) + nml__status = nml__obj%is_valid(errmsg=nml__errmsg) end subroutine config_is_valid_wrapper end module f2py_config diff --git a/examples/02_pybind/fortran/config_store.f90 b/examples/02_pybind/fortran/config_store.f90 index 229be77..af30c89 100644 --- a/examples/02_pybind/fortran/config_store.f90 +++ b/examples/02_pybind/fortran/config_store.f90 @@ -47,22 +47,22 @@ end subroutine reset_config subroutine get_iterations(value) integer, intent(out) :: value !< current iteration count - value = config%iterations + value = config%data%iterations end subroutine get_iterations !> \brief Return the configured tolerance subroutine get_tolerance(value) real(dp), intent(out) :: value !< current tolerance - value = config%tolerance + value = config%data%tolerance end subroutine get_tolerance !> \brief Return the current number of configured weights subroutine get_weight_count(value) integer, intent(out) :: value !< current weight array extent - if (allocated(config%weights)) then - value = size(config%weights) + if (allocated(config%data%weights)) then + value = size(config%data%weights) else value = 0 end if @@ -73,34 +73,34 @@ subroutine get_weight(index, value) integer, intent(in) :: index !< one-based weight index real(dp), intent(out) :: value !< current weight value - value = config%weights(index) + value = config%data%weights(index) end subroutine get_weight !> \brief Return the configured enabled flag subroutine get_enabled(value) logical, intent(out) :: value !< current enabled flag - value = config%enabled + value = config%data%enabled end subroutine get_enabled !> \brief Print the persistent config instance subroutine print_config() integer :: i - write(*, '(a, i0)') 'iterations = ', config%iterations - write(*, '(a, es12.5)') 'tolerance = ', config%tolerance - write(*, '(a, l1)') 'enabled = ', config%enabled - if (.not. allocated(config%weights)) then + write(*, '(a, i0)') 'iterations = ', config%data%iterations + write(*, '(a, es12.5)') 'tolerance = ', config%data%tolerance + write(*, '(a, l1)') 'enabled = ', config%data%enabled + if (.not. allocated(config%data%weights)) then write(*, '(a)') 'weights = ' return end if - if (size(config%weights) == 0) then + if (size(config%data%weights) == 0) then write(*, '(a)') 'weights = ' return end if write(*, '(a)', advance='no') 'weights = ' - do i = 1, size(config%weights) - write(*, '(es12.5, 1x)', advance='no') config%weights(i) + do i = 1, size(config%data%weights) + write(*, '(es12.5, 1x)', advance='no') config%data%weights(i) end do write(*, *) end subroutine print_config diff --git a/examples/02_pybind/fortran/generated/nml_config.f90 b/examples/02_pybind/fortran/generated/nml_config.f90 index 4a5cd38..a502f4b 100644 --- a/examples/02_pybind/fortran/generated/nml_config.f90 +++ b/examples/02_pybind/fortran/generated/nml_config.f90 @@ -24,17 +24,17 @@ module nml_config NML_ERR_NOT_SET, & NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & - idx_check, & - to_lower, & + idx__check, & + to__lower, & NML_ERR_INVALID_HANDLE, & str_len, & - n_weights__default - use ieee_arithmetic, only: ieee_value, ieee_quiet_nan, ieee_is_nan + n_weights__dim_default + use ieee_arithmetic, only: nml__ieee_value => ieee_value, & + nml__ieee_quiet_nan => ieee_quiet_nan, nml__ieee_is_nan => ieee_is_nan ! kind specifiers listed in the nml-tools configuration file use iso_fortran_env, only: & i4=>int32, & dp=>real64 - use iso_c_binding, only: c_f_pointer, c_intptr_t, c_null_ptr, c_ptr implicit none @@ -47,6 +47,24 @@ module nml_config integer(i4), parameter, public :: iterations__min = 1_i4 real(dp), parameter, public :: tolerance__min_excl = 0.0_dp + private :: nml_config_read__from_file + + !> \class nml_config_data_t + !> \brief Schema-backed values for config + type, public :: nml_config_data_t + character(len=str_len) :: name !< Config name + integer(i4) :: iterations !< Iterations + real(dp) :: tolerance !< Tolerance + logical :: enabled !< Enabled + real(dp), allocatable, dimension(:) :: weights !< Weights + end type nml_config_data_t + + !> \class nml_config_dims_t + !> \brief Runtime dimensions for config + type, public :: nml_config_dims_t + integer :: n_weights = n_weights__dim_default !< runtime dimension for n_weights + end type nml_config_dims_t + !> \class nml_config_t !> \brief Python binding config !> \details Minimal namelist used by the pybind example. @@ -55,13 +73,9 @@ module nml_config !! through an opaque integer handle. !! type, public :: nml_config_t + type(nml_config_data_t) :: data !< schema-backed namelist values + type(nml_config_dims_t) :: dims !< runtime array dimensions logical :: is_configured = .false. !< whether the namelist has been configured - integer :: n_weights = n_weights__default !< runtime dimension for n_weights - character(len=str_len) :: name !< Config name - integer(i4) :: iterations !< Iterations - real(dp) :: tolerance !< Tolerance - logical :: enabled !< Enabled - real(dp), allocatable, dimension(:) :: weights !< Weights contains procedure :: init => nml_config_init procedure :: set_dims => nml_config_set_dims @@ -74,117 +88,127 @@ module nml_config contains !> \brief Check whether a value is within bounds - elemental logical function iterations__in_bounds(val, allow_missing) result(in_bounds) - integer(i4), intent(in) :: val !< value to check - logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - - if (present(allow_missing)) then - if (allow_missing) then - if (val == -huge(val)) then - in_bounds = .true. + elemental logical function iterations__in_bounds(nml__val, nml__allow_missing) result(nml__in_bounds) + integer(i4), intent(in) :: nml__val !< value to check + logical, intent(in), optional :: nml__allow_missing !< allow sentinel values as valid + + if (present(nml__allow_missing)) then + if (nml__allow_missing) then + if (nml__val == -huge(nml__val)) then + nml__in_bounds = .true. return end if end if end if - in_bounds = .true. - if (val < iterations__min) in_bounds = .false. + nml__in_bounds = .true. + if (nml__val < iterations__min) nml__in_bounds = .false. end function iterations__in_bounds !> \brief Check whether a value is within bounds - elemental logical function tolerance__in_bounds(val, allow_missing) result(in_bounds) - real(dp), intent(in) :: val !< value to check - logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - - if (present(allow_missing)) then - if (allow_missing) then - if (ieee_is_nan(val)) then - in_bounds = .true. + elemental logical function tolerance__in_bounds(nml__val, nml__allow_missing) result(nml__in_bounds) + real(dp), intent(in) :: nml__val !< value to check + logical, intent(in), optional :: nml__allow_missing !< allow sentinel values as valid + + if (present(nml__allow_missing)) then + if (nml__allow_missing) then + if (nml__ieee_is_nan(nml__val)) then + nml__in_bounds = .true. return end if end if end if - in_bounds = .true. - if (val <= tolerance__min_excl) in_bounds = .false. + nml__in_bounds = .true. + if (nml__val <= tolerance__min_excl) nml__in_bounds = .false. end function tolerance__in_bounds !> \brief Resolve an opaque C pointer handle to a nml_config_t pointer - subroutine nml_config_resolve_handle(handle, this, status, errmsg) - integer(c_intptr_t), intent(in) :: handle !< opaque handle to a nml_config_t instance - type(nml_config_t), pointer :: this !< resolved namelist pointer - integer, intent(out) :: status !< nml-tools status code + subroutine nml_config_resolve_handle(nml__handle, nml__obj, nml__status, errmsg) + use iso_c_binding, only: c_f_pointer, c_intptr_t, c_null_ptr, c_ptr + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a nml_config_t instance + type(nml_config_t), pointer :: nml__obj !< resolved namelist pointer + integer, intent(out) :: nml__status !< nml-tools status code character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - type(c_ptr) :: ptr + type(c_ptr) :: nml__ptr if (present(errmsg)) errmsg = "" - nullify(this) - if (handle == 0_c_intptr_t) then - status = NML_ERR_INVALID_HANDLE + nullify(nml__obj) + if (nml__handle == 0_c_intptr_t) then + nml__status = NML_ERR_INVALID_HANDLE if (present(errmsg)) errmsg = "zero handle" return end if - ptr = transfer(handle, c_null_ptr) - call c_f_pointer(ptr, this) - status = NML_OK + nml__ptr = transfer(nml__handle, c_null_ptr) + call c_f_pointer(nml__ptr, nml__obj) + nml__status = NML_OK end subroutine nml_config_resolve_handle !> \brief Initialize defaults and sentinels for config - integer function nml_config_init(this, errmsg) result(status) - class(nml_config_t), intent(inout) :: this !< namelist instance + integer function nml_config_init(nml__obj, errmsg) result(nml__status) + class(nml_config_t), intent(inout) :: nml__obj !< namelist instance character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - this%is_configured = .false. + nml__obj%is_configured = .false. ! allocate runtime-sized fields - if (allocated(this%weights)) deallocate(this%weights) - allocate(this%weights(this%n_weights)) + if (allocated(nml__obj%data%weights)) deallocate(nml__obj%data%weights) + allocate(nml__obj%data%weights(nml__obj%dims%n_weights)) ! sentinel values for required/optional parameters - this%iterations = -huge(this%iterations) ! sentinel for required integer - this%tolerance = ieee_value(this%tolerance, ieee_quiet_nan) ! sentinel for required real + nml__obj%data%iterations = -huge(nml__obj%data%iterations) ! sentinel for required integer + nml__obj%data%tolerance = nml__ieee_value(nml__obj%data%tolerance, nml__ieee_quiet_nan) ! sentinel for required real ! default values - this%name = name__default - this%enabled = enabled__default ! bool values always need a default - this%weights = weights__default + nml__obj%data%name = name__default + nml__obj%data%enabled = enabled__default ! bool values always need a default + nml__obj%data%weights = weights__default end function nml_config_init !> \brief Reset runtime dimensions for config - integer function nml_config_set_dims(this, & + integer function nml_config_set_dims(nml__obj, & n_weights, & - errmsg) result(status) - class(nml_config_t), intent(inout) :: this !< namelist instance + errmsg) result(nml__status) + class(nml_config_t), intent(inout) :: nml__obj !< namelist instance integer, intent(in), optional :: n_weights !< runtime dimension override for n_weights integer :: candidate__n_weights character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" if (present(n_weights)) then candidate__n_weights = n_weights else - candidate__n_weights = n_weights__default + candidate__n_weights = n_weights__dim_default end if if (candidate__n_weights <= 0) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "dimension 'n_weights' must be positive" return end if - this%n_weights = candidate__n_weights + nml__obj%dims%n_weights = candidate__n_weights ! deallocate runtime-sized fields; init/set/from_file allocate them again - if (allocated(this%weights)) deallocate(this%weights) - this%is_configured = .false. + if (allocated(nml__obj%data%weights)) deallocate(nml__obj%data%weights) + nml__obj%is_configured = .false. end function nml_config_set_dims !> \brief Read config namelist from file - integer function nml_config_from_file(this, file, errmsg) result(status) - class(nml_config_t), intent(inout) :: this !< namelist instance + integer function nml_config_from_file(nml__obj, file, errmsg) result(nml__status) + class(nml_config_t), intent(inout) :: nml__obj !< namelist instance character(len=*), intent(in) :: file !< path to namelist file character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + + nml__status = nml_config_read__from_file(nml__obj, file, errmsg) + end function nml_config_from_file + + integer function nml_config_read__from_file(nml__obj, nml__file, errmsg) & + result(nml__status) + class(nml_config_t), intent(inout) :: nml__obj + character(len=*), intent(in) :: nml__file + character(len=*), intent(out), optional :: errmsg ! namelist variables character(len=str_len) :: name integer(i4) :: iterations @@ -192,10 +216,10 @@ integer function nml_config_from_file(this, file, errmsg) result(status) logical :: enabled real(dp), allocatable, dimension(:) :: weights ! locals - type(nml_file_t) :: nml - integer :: iostat - integer :: close_status - character(len=nml_line_buffer) :: iomsg + type(nml_file_t) :: nml__reader + integer :: nml__iostat + integer :: nml__close_status + character(len=nml_line_buffer) :: nml__iomsg namelist /config/ & name, & @@ -204,176 +228,171 @@ integer function nml_config_from_file(this, file, errmsg) result(status) enabled, & weights - status = this%init(errmsg=errmsg) - if (status /= NML_OK) return + nml__status = nml__obj%init(errmsg=errmsg) + if (nml__status /= NML_OK) return ! allocate local namelist variables matching runtime-sized fields if (allocated(weights)) deallocate(weights) - allocate(weights(this%n_weights)) - name = this%name - iterations = this%iterations - tolerance = this%tolerance - enabled = this%enabled - weights = this%weights - - status = nml%open(file, errmsg=errmsg) - if (status /= NML_OK) return - - status = nml%find("config", errmsg=errmsg) - if (status /= NML_OK) then - close_status = nml%close() + allocate(weights(nml__obj%dims%n_weights)) + name = nml__obj%data%name + iterations = nml__obj%data%iterations + tolerance = nml__obj%data%tolerance + enabled = nml__obj%data%enabled + weights = nml__obj%data%weights + + nml__status = nml__reader%open(nml__file, errmsg=errmsg) + if (nml__status /= NML_OK) return + + nml__status = nml__reader%find("config", errmsg=errmsg) + if (nml__status /= NML_OK) then + nml__close_status = nml__reader%close() return end if ! read namelist - read(nml%unit, nml=config, iostat=iostat, iomsg=iomsg) - if (iostat /= 0) then - status = NML_ERR_READ - if (present(errmsg)) errmsg = trim(iomsg) - close_status = nml%close() + read(nml__reader%unit, nml=config, iostat=nml__iostat, iomsg=nml__iomsg) + if (nml__iostat /= 0) then + nml__status = NML_ERR_READ + if (present(errmsg)) errmsg = trim(nml__iomsg) + nml__close_status = nml__reader%close() return end if - close_status = nml%close(errmsg=errmsg) - if (close_status /= NML_OK) then - status = close_status + nml__close_status = nml__reader%close(errmsg=errmsg) + if (nml__close_status /= NML_OK) then + nml__status = nml__close_status return end if ! assign values - this%name = name - this%iterations = iterations - this%tolerance = tolerance - this%enabled = enabled - this%weights = weights + nml__obj%data%name = name + nml__obj%data%iterations = iterations + nml__obj%data%tolerance = tolerance + nml__obj%data%enabled = enabled + nml__obj%data%weights = weights ! mark as configured - this%is_configured = .true. - status = NML_OK - end function nml_config_from_file + nml__obj%is_configured = .true. + nml__status = NML_OK + end function nml_config_read__from_file !> \brief Set config values - integer function nml_config_set(this, & + integer function nml_config_set(nml__obj, & iterations, & tolerance, & name, & enabled, & weights, & - errmsg) result(status) + errmsg) result(nml__status) - class(nml_config_t), intent(inout) :: this !< namelist instance + class(nml_config_t), intent(inout) :: nml__obj !< namelist instance character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values integer(i4), intent(in) :: iterations !< Iterations real(dp), intent(in) :: tolerance !< Tolerance character(len=*), intent(in), optional :: name !< Config name logical, intent(in), optional :: enabled !< Enabled real(dp), dimension(:), intent(in), optional :: weights !< Weights - integer :: & - lb__1, & - ub__1 - - status = this%init(errmsg=errmsg) - if (status /= NML_OK) return + nml__status = nml__obj%init(errmsg=errmsg) + if (nml__status /= NML_OK) return ! required parameters - this%iterations = iterations - this%tolerance = tolerance + nml__obj%data%iterations = iterations + nml__obj%data%tolerance = tolerance ! override with provided values - if (present(name)) this%name = name - if (present(enabled)) this%enabled = enabled + if (present(name)) nml__obj%data%name = name + if (present(enabled)) nml__obj%data%enabled = enabled if (present(weights)) then - if (size(weights, 1) > size(this%weights, 1)) then - status = NML_ERR_INVALID_INDEX + if (size(weights, 1) > size(nml__obj%data%weights, 1)) then + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'weights'" return end if - lb__1 = lbound(this%weights, 1) - ub__1 = lb__1 + size(weights, 1) - 1 - this%weights(lb__1:ub__1) = weights + nml__obj%data%weights( & + 1:size(weights, 1)) = weights end if ! mark as configured - this%is_configured = .true. - status = NML_OK + nml__obj%is_configured = .true. + nml__status = NML_OK end function nml_config_set !> \brief Check whether a namelist value was set - integer function nml_config_is_set(this, name, idx, errmsg) result(status) - class(nml_config_t), intent(in) :: this !< namelist instance + integer function nml_config_is_set(nml__obj, name, idx, errmsg) result(nml__status) + class(nml_config_t), intent(in) :: nml__obj !< namelist instance character(len=*), intent(in) :: name !< field name integer, intent(in), optional :: idx(:) !< optional field index values character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(trim(name))) + select case (to__lower(trim(name))) case ("name") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'name'" return end if case ("iterations") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'iterations'" return end if - if (this%iterations == -huge(this%iterations)) status = NML_ERR_NOT_SET + if (nml__obj%data%iterations == -huge(nml__obj%data%iterations)) nml__status = NML_ERR_NOT_SET case ("tolerance") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'tolerance'" return end if - if (ieee_is_nan(this%tolerance)) status = NML_ERR_NOT_SET + if (nml__ieee_is_nan(nml__obj%data%tolerance)) nml__status = NML_ERR_NOT_SET case ("enabled") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'enabled'" return end if case ("weights") - if (.not. allocated(this%weights)) then - status = NML_ERR_NOT_SET + if (.not. allocated(nml__obj%data%weights)) then + nml__status = NML_ERR_NOT_SET return end if if (present(idx)) then - status = idx_check(idx, lbound(this%weights), ubound(this%weights), & + nml__status = idx__check(idx, shape(nml__obj%data%weights), & "weights", errmsg) - if (status /= NML_OK) return + if (nml__status /= NML_OK) return else end if case default - status = NML_ERR_INVALID_NAME + nml__status = NML_ERR_INVALID_NAME if (present(errmsg)) errmsg = "unknown field: " // trim(name) end select - if (status == NML_ERR_NOT_SET .and. present(errmsg)) then + if (nml__status == NML_ERR_NOT_SET .and. present(errmsg)) then if (len_trim(errmsg) == 0) errmsg = "field not set: " // trim(name) end if end function nml_config_is_set !> \brief Validate required values and constraints - integer function nml_config_is_valid(this, errmsg) result(status) - class(nml_config_t), intent(in) :: this !< namelist instance + integer function nml_config_is_valid(nml__obj, errmsg) result(nml__status) + class(nml_config_t), intent(in) :: nml__obj !< namelist instance character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - integer :: istat + integer :: nml__istat - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if ! required parameters - istat = this%is_set("iterations", errmsg=errmsg) - if (istat == NML_ERR_NOT_SET) then - status = NML_ERR_REQUIRED + nml__istat = nml__obj%is_set("iterations", errmsg=errmsg) + if (nml__istat == NML_ERR_NOT_SET) then + nml__status = NML_ERR_REQUIRED if (present(errmsg)) then if (len_trim(errmsg) == 0) then errmsg = "field not set: iterations" @@ -382,13 +401,13 @@ integer function nml_config_is_valid(this, errmsg) result(status) end if return end if - if (istat /= NML_OK) then - status = istat + if (nml__istat /= NML_OK) then + nml__status = nml__istat return end if - istat = this%is_set("tolerance", errmsg=errmsg) - if (istat == NML_ERR_NOT_SET) then - status = NML_ERR_REQUIRED + nml__istat = nml__obj%is_set("tolerance", errmsg=errmsg) + if (nml__istat == NML_ERR_NOT_SET) then + nml__status = NML_ERR_REQUIRED if (present(errmsg)) then if (len_trim(errmsg) == 0) then errmsg = "field not set: tolerance" @@ -397,31 +416,31 @@ integer function nml_config_is_valid(this, errmsg) result(status) end if return end if - if (istat /= NML_OK) then - status = istat + if (nml__istat /= NML_OK) then + nml__status = nml__istat return end if ! bounds constraints - istat = this%is_set("iterations", errmsg=errmsg) - if (istat == NML_OK) then - if (.not. iterations__in_bounds(this%iterations)) then - status = NML_ERR_BOUNDS + nml__istat = nml__obj%is_set("iterations", errmsg=errmsg) + if (nml__istat == NML_OK) then + if (.not. iterations__in_bounds(nml__obj%data%iterations)) then + nml__status = NML_ERR_BOUNDS if (present(errmsg)) errmsg = "bounds constraint failed: iterations" return end if - else if (istat /= NML_ERR_NOT_SET) then - status = istat + else if (nml__istat /= NML_ERR_NOT_SET) then + nml__status = nml__istat return end if - istat = this%is_set("tolerance", errmsg=errmsg) - if (istat == NML_OK) then - if (.not. tolerance__in_bounds(this%tolerance)) then - status = NML_ERR_BOUNDS + nml__istat = nml__obj%is_set("tolerance", errmsg=errmsg) + if (nml__istat == NML_OK) then + if (.not. tolerance__in_bounds(nml__obj%data%tolerance)) then + nml__status = NML_ERR_BOUNDS if (present(errmsg)) errmsg = "bounds constraint failed: tolerance" return end if - else if (istat /= NML_ERR_NOT_SET) then - status = istat + else if (nml__istat /= NML_ERR_NOT_SET) then + nml__status = nml__istat return end if end function nml_config_is_valid diff --git a/examples/02_pybind/fortran/generated/nml_helper.f90 b/examples/02_pybind/fortran/generated/nml_helper.f90 index 940f5b1..e5e90af 100644 --- a/examples/02_pybind/fortran/generated/nml_helper.f90 +++ b/examples/02_pybind/fortran/generated/nml_helper.f90 @@ -39,7 +39,7 @@ module nml_helper !> \brief Shared constants for generated namelist modules integer, parameter, public :: str_len = 128 !< String buffer length for the pybind example. - integer, parameter, public :: n_weights__default = 3 !< Default number of weights. + integer, parameter, public :: n_weights__dim_default = 3 !< Default number of weights. !> \class nml_file_t !> \brief Type for namelist file operations @@ -55,61 +55,61 @@ module nml_helper contains !> \brief Open a namelist file - integer function nml_open(this, file, errmsg) result(status) + integer function nml_open(this, file, errmsg) result(nml__status) class(nml_file_t), intent(inout) :: this character(len=*), intent(in) :: file character(len=*), intent(out), optional :: errmsg - integer :: iostat - logical :: exists - character(len=nml_line_buffer) :: iomsg + integer :: nml__iostat + logical :: nml__exists + character(len=nml_line_buffer) :: nml__iomsg if (present(errmsg)) errmsg = "" - status = this%close() - inquire(file=file, exist=exists) - if (.not. exists) then + nml__status = this%close() + inquire(file=file, exist=nml__exists) + if (.not. nml__exists) then this%is_open = .false. this%unit = 0 - status = NML_ERR_FILE_NOT_FOUND + nml__status = NML_ERR_FILE_NOT_FOUND if (present(errmsg)) errmsg = "file not found: " // trim(file) return end if open(newunit=this%unit, file=file, status='old', action='read', & - iostat=iostat, iomsg=iomsg) - this%is_open = (iostat == 0) + iostat=nml__iostat, iomsg=nml__iomsg) + this%is_open = (nml__iostat == 0) if (.not. this%is_open) then this%unit = 0 - status = NML_ERR_OPEN - if (present(errmsg)) errmsg = trim(iomsg) + nml__status = NML_ERR_OPEN + if (present(errmsg)) errmsg = trim(nml__iomsg) return end if - status = NML_OK + nml__status = NML_OK end function nml_open !> \brief Find a namelist in the opened file - integer function nml_find(this, nml, errmsg) result(status) + integer function nml_find(this, nml, errmsg) result(nml__status) class(nml_file_t), intent(inout) :: this character(len=*), intent(in) :: nml character(len=*), intent(out), optional :: errmsg - integer :: iostat - character(len=nml_line_buffer) :: line - character(len=nml_line_buffer) :: iomsg + integer :: nml__iostat + character(len=nml_line_buffer) :: nml__line + character(len=nml_line_buffer) :: nml__iomsg if (present(errmsg)) errmsg = "" - status = NML_ERR_NML_NOT_FOUND + nml__status = NML_ERR_NML_NOT_FOUND if (.not. this%is_open) then - status = NML_ERR_NOT_OPEN + nml__status = NML_ERR_NOT_OPEN if (present(errmsg)) errmsg = "file not open" return end if rewind(unit=this%unit) do - read(this%unit, '(A)', iostat=iostat, iomsg=iomsg) line - if (iostat < 0) exit - if (iostat > 0) then - status = NML_ERR_READ - if (present(errmsg)) errmsg = trim(iomsg) + read(this%unit, '(A)', iostat=nml__iostat, iomsg=nml__iomsg) nml__line + if (nml__iostat < 0) exit + if (nml__iostat > 0) then + nml__status = NML_ERR_READ + if (present(errmsg)) errmsg = trim(nml__iomsg) return end if - if (index(to_lower(line), '&' // to_lower(trim(nml))) /= 0) then - status = NML_OK + if (index(to__lower(nml__line), '&' // to__lower(trim(nml))) /= 0) then + nml__status = NML_OK backspace(this%unit) return end if @@ -118,18 +118,18 @@ integer function nml_find(this, nml, errmsg) result(status) end function nml_find !> \brief Close the namelist file - integer function nml_close(this, errmsg) result(status) + integer function nml_close(this, errmsg) result(nml__status) class(nml_file_t), intent(inout) :: this character(len=*), intent(out), optional :: errmsg - integer :: iostat - character(len=nml_line_buffer) :: iomsg + integer :: nml__iostat + character(len=nml_line_buffer) :: nml__iomsg if (present(errmsg)) errmsg = "" - status = NML_OK + nml__status = NML_OK if (this%is_open) then - close(unit=this%unit, iostat=iostat, iomsg=iomsg) - if (iostat /= 0) then - status = NML_ERR_CLOSE - if (present(errmsg)) errmsg = trim(iomsg) + close(unit=this%unit, iostat=nml__iostat, iomsg=nml__iomsg) + if (nml__iostat /= 0) then + nml__status = NML_ERR_CLOSE + if (present(errmsg)) errmsg = trim(nml__iomsg) end if end if this%is_open = .false. @@ -137,35 +137,34 @@ integer function nml_close(this, errmsg) result(status) end function nml_close !> \brief Convert string to lower case - pure function to_lower(string) result(lower_string) - character(len=*), intent(in) :: string - character(len=len(string)) :: lower_string - integer, parameter :: shift=iachar('a')-iachar('A'), upA=iachar('A'), upZ=iachar('Z') - integer :: k, i - do i = 1, len(string) - k = ichar(string(i:i)) - if (k>=upA .and. k<=upZ) k = k + shift - lower_string(i:i) = char(k) + pure function to__lower(nml__string) result(nml__lower_string) + character(len=*), intent(in) :: nml__string + character(len=len(nml__string)) :: nml__lower_string + integer, parameter :: nml__shift=iachar('a')-iachar('A'), nml__upA=iachar('A'), nml__upZ=iachar('Z') + integer :: nml__k, nml__i + do nml__i = 1, len(nml__string) + nml__k = ichar(nml__string(nml__i:nml__i)) + if (nml__k>=nml__upA .and. nml__k<=nml__upZ) nml__k = nml__k + nml__shift + nml__lower_string(nml__i:nml__i) = char(nml__k) end do - end function to_lower + end function to__lower !> \brief Validate index bounds for array access - integer function idx_check(idx, lower, upper, field, errmsg) result(status) - integer, intent(in) :: idx(:) - integer, intent(in) :: lower(:) - integer, intent(in) :: upper(:) - character(len=*), intent(in) :: field + integer function idx__check(nml__idx, nml__extents, nml__field, errmsg) result(nml__status) + integer, intent(in) :: nml__idx(:) + integer, intent(in) :: nml__extents(:) + character(len=*), intent(in) :: nml__field character(len=*), intent(out), optional :: errmsg - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - if (size(idx) /= size(lower)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index rank mismatch for '" // trim(field) // "'" - else if (any(idx < lower) .or. any(idx > upper)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index out of bounds for '" // trim(field) // "'" + if (size(nml__idx) /= size(nml__extents)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index rank mismatch for '" // trim(nml__field) // "'" + else if (any(nml__idx < 1) .or. any(nml__idx > nml__extents)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index out of bounds for '" // trim(nml__field) // "'" end if - end function idx_check + end function idx__check end module nml_helper diff --git a/examples/03_references/out/nml_helper.f90 b/examples/03_references/out/nml_helper.f90 index e9f0be8..c49c4a6 100644 --- a/examples/03_references/out/nml_helper.f90 +++ b/examples/03_references/out/nml_helper.f90 @@ -41,7 +41,7 @@ module nml_helper !> \brief Shared constants for generated namelist modules integer, parameter, public :: label_len = 32 !< Length of labels referenced from shared definitions. - integer, parameter, public :: n_stations__default = 4 !< Number of station weights in the run configuration. + integer, parameter, public :: n_stations__dim_default = 4 !< Number of station weights in the run configuration. !> \class nml_file_t !> \brief Type for namelist file operations @@ -57,61 +57,61 @@ module nml_helper contains !> \brief Open a namelist file - integer function nml_open(this, file, errmsg) result(status) + integer function nml_open(this, file, errmsg) result(nml__status) class(nml_file_t), intent(inout) :: this character(len=*), intent(in) :: file character(len=*), intent(out), optional :: errmsg - integer :: iostat - logical :: exists - character(len=nml_line_buffer) :: iomsg + integer :: nml__iostat + logical :: nml__exists + character(len=nml_line_buffer) :: nml__iomsg if (present(errmsg)) errmsg = "" - status = this%close() - inquire(file=file, exist=exists) - if (.not. exists) then + nml__status = this%close() + inquire(file=file, exist=nml__exists) + if (.not. nml__exists) then this%is_open = .false. this%unit = 0 - status = NML_ERR_FILE_NOT_FOUND + nml__status = NML_ERR_FILE_NOT_FOUND if (present(errmsg)) errmsg = "file not found: " // trim(file) return end if open(newunit=this%unit, file=file, status='old', action='read', & - iostat=iostat, iomsg=iomsg) - this%is_open = (iostat == 0) + iostat=nml__iostat, iomsg=nml__iomsg) + this%is_open = (nml__iostat == 0) if (.not. this%is_open) then this%unit = 0 - status = NML_ERR_OPEN - if (present(errmsg)) errmsg = trim(iomsg) + nml__status = NML_ERR_OPEN + if (present(errmsg)) errmsg = trim(nml__iomsg) return end if - status = NML_OK + nml__status = NML_OK end function nml_open !> \brief Find a namelist in the opened file - integer function nml_find(this, nml, errmsg) result(status) + integer function nml_find(this, nml, errmsg) result(nml__status) class(nml_file_t), intent(inout) :: this character(len=*), intent(in) :: nml character(len=*), intent(out), optional :: errmsg - integer :: iostat - character(len=nml_line_buffer) :: line - character(len=nml_line_buffer) :: iomsg + integer :: nml__iostat + character(len=nml_line_buffer) :: nml__line + character(len=nml_line_buffer) :: nml__iomsg if (present(errmsg)) errmsg = "" - status = NML_ERR_NML_NOT_FOUND + nml__status = NML_ERR_NML_NOT_FOUND if (.not. this%is_open) then - status = NML_ERR_NOT_OPEN + nml__status = NML_ERR_NOT_OPEN if (present(errmsg)) errmsg = "file not open" return end if rewind(unit=this%unit) do - read(this%unit, '(A)', iostat=iostat, iomsg=iomsg) line - if (iostat < 0) exit - if (iostat > 0) then - status = NML_ERR_READ - if (present(errmsg)) errmsg = trim(iomsg) + read(this%unit, '(A)', iostat=nml__iostat, iomsg=nml__iomsg) nml__line + if (nml__iostat < 0) exit + if (nml__iostat > 0) then + nml__status = NML_ERR_READ + if (present(errmsg)) errmsg = trim(nml__iomsg) return end if - if (index(to_lower(line), '&' // to_lower(trim(nml))) /= 0) then - status = NML_OK + if (index(to__lower(nml__line), '&' // to__lower(trim(nml))) /= 0) then + nml__status = NML_OK backspace(this%unit) return end if @@ -120,18 +120,18 @@ integer function nml_find(this, nml, errmsg) result(status) end function nml_find !> \brief Close the namelist file - integer function nml_close(this, errmsg) result(status) + integer function nml_close(this, errmsg) result(nml__status) class(nml_file_t), intent(inout) :: this character(len=*), intent(out), optional :: errmsg - integer :: iostat - character(len=nml_line_buffer) :: iomsg + integer :: nml__iostat + character(len=nml_line_buffer) :: nml__iomsg if (present(errmsg)) errmsg = "" - status = NML_OK + nml__status = NML_OK if (this%is_open) then - close(unit=this%unit, iostat=iostat, iomsg=iomsg) - if (iostat /= 0) then - status = NML_ERR_CLOSE - if (present(errmsg)) errmsg = trim(iomsg) + close(unit=this%unit, iostat=nml__iostat, iomsg=nml__iomsg) + if (nml__iostat /= 0) then + nml__status = NML_ERR_CLOSE + if (present(errmsg)) errmsg = trim(nml__iomsg) end if end if this%is_open = .false. @@ -139,35 +139,34 @@ integer function nml_close(this, errmsg) result(status) end function nml_close !> \brief Convert string to lower case - pure function to_lower(string) result(lower_string) - character(len=*), intent(in) :: string - character(len=len(string)) :: lower_string - integer, parameter :: shift=iachar('a')-iachar('A'), upA=iachar('A'), upZ=iachar('Z') - integer :: k, i - do i = 1, len(string) - k = ichar(string(i:i)) - if (k>=upA .and. k<=upZ) k = k + shift - lower_string(i:i) = char(k) + pure function to__lower(nml__string) result(nml__lower_string) + character(len=*), intent(in) :: nml__string + character(len=len(nml__string)) :: nml__lower_string + integer, parameter :: nml__shift=iachar('a')-iachar('A'), nml__upA=iachar('A'), nml__upZ=iachar('Z') + integer :: nml__k, nml__i + do nml__i = 1, len(nml__string) + nml__k = ichar(nml__string(nml__i:nml__i)) + if (nml__k>=nml__upA .and. nml__k<=nml__upZ) nml__k = nml__k + nml__shift + nml__lower_string(nml__i:nml__i) = char(nml__k) end do - end function to_lower + end function to__lower !> \brief Validate index bounds for array access - integer function idx_check(idx, lower, upper, field, errmsg) result(status) - integer, intent(in) :: idx(:) - integer, intent(in) :: lower(:) - integer, intent(in) :: upper(:) - character(len=*), intent(in) :: field + integer function idx__check(nml__idx, nml__extents, nml__field, errmsg) result(nml__status) + integer, intent(in) :: nml__idx(:) + integer, intent(in) :: nml__extents(:) + character(len=*), intent(in) :: nml__field character(len=*), intent(out), optional :: errmsg - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - if (size(idx) /= size(lower)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index rank mismatch for '" // trim(field) // "'" - else if (any(idx < lower) .or. any(idx > upper)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index out of bounds for '" // trim(field) // "'" + if (size(nml__idx) /= size(nml__extents)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index rank mismatch for '" // trim(nml__field) // "'" + else if (any(nml__idx < 1) .or. any(nml__idx > nml__extents)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index out of bounds for '" // trim(nml__field) // "'" end if - end function idx_check + end function idx__check end module nml_helper diff --git a/examples/03_references/out/nml_report.f90 b/examples/03_references/out/nml_report.f90 index bd49da7..14b1447 100644 --- a/examples/03_references/out/nml_report.f90 +++ b/examples/03_references/out/nml_report.f90 @@ -20,10 +20,11 @@ module nml_report NML_ERR_NOT_SET, & NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & - idx_check, & - to_lower, & + idx__check, & + to__lower, & label_len - use ieee_arithmetic, only: ieee_value, ieee_quiet_nan, ieee_is_nan + use ieee_arithmetic, only: nml__ieee_value => ieee_value, & + nml__ieee_quiet_nan => ieee_quiet_nan, nml__ieee_is_nan => ieee_is_nan ! kind specifiers listed in the nml-tools configuration file use iso_fortran_env, only: & i4=>int32, & @@ -43,14 +44,22 @@ module nml_report real(dp), parameter, public :: acceptance_fraction__min = 0.5_dp real(dp), parameter, public :: acceptance_fraction__max = 1.0_dp + private :: nml_report_read__from_file + + !> \class nml_report_data_t + !> \brief Schema-backed values for report + type, public :: nml_report_data_t + character(len=label_len) :: label !< Report label + integer(i4) :: level !< Reporting detail + real(dp) :: acceptance_fraction !< Acceptance fraction + end type nml_report_data_t + !> \class nml_report_t !> \brief Reference-driven report configuration !> \details A second namelist sharing the external definition library. type, public :: nml_report_t + type(nml_report_data_t) :: data !< schema-backed namelist values logical :: is_configured = .false. !< whether the namelist has been configured - character(len=label_len) :: label !< Report label - integer(i4) :: level !< Reporting detail - real(dp) :: acceptance_fraction !< Acceptance fraction contains procedure :: init => nml_report_init procedure :: from_file => nml_report_from_file @@ -62,230 +71,238 @@ module nml_report contains !> \brief Check whether a value is part of an enum - elemental logical function level__in_enum(val, allow_missing) result(in_enum) - integer(i4), intent(in) :: val !< value to check - logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - - if (present(allow_missing)) then - if (allow_missing) then - if (val == -huge(val)) then - in_enum = .true. + elemental logical function level__in_enum(nml__val, nml__allow_missing) result(nml__in_enum) + integer(i4), intent(in) :: nml__val !< value to check + logical, intent(in), optional :: nml__allow_missing !< allow sentinel values as valid + + if (present(nml__allow_missing)) then + if (nml__allow_missing) then + if (nml__val == -huge(nml__val)) then + nml__in_enum = .true. return end if end if end if - in_enum = any(val == level__enum_values) + nml__in_enum = any(nml__val == level__enum_values) end function level__in_enum !> \brief Check whether a value is within bounds - elemental logical function acceptance_fraction__in_bounds(val, allow_missing) result(in_bounds) - real(dp), intent(in) :: val !< value to check - logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - - if (present(allow_missing)) then - if (allow_missing) then - if (ieee_is_nan(val)) then - in_bounds = .true. + elemental logical function acceptance_fraction__in_bounds(nml__val, nml__allow_missing) result(nml__in_bounds) + real(dp), intent(in) :: nml__val !< value to check + logical, intent(in), optional :: nml__allow_missing !< allow sentinel values as valid + + if (present(nml__allow_missing)) then + if (nml__allow_missing) then + if (nml__ieee_is_nan(nml__val)) then + nml__in_bounds = .true. return end if end if end if - in_bounds = .true. - if (val < acceptance_fraction__min) in_bounds = .false. - if (val > acceptance_fraction__max) in_bounds = .false. + nml__in_bounds = .true. + if (nml__val < acceptance_fraction__min) nml__in_bounds = .false. + if (nml__val > acceptance_fraction__max) nml__in_bounds = .false. end function acceptance_fraction__in_bounds !> \brief Initialize defaults and sentinels for report - integer function nml_report_init(this, errmsg) result(status) - class(nml_report_t), intent(inout) :: this !< namelist instance + integer function nml_report_init(nml__obj, errmsg) result(nml__status) + class(nml_report_t), intent(inout) :: nml__obj !< namelist instance character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - this%is_configured = .false. + nml__obj%is_configured = .false. ! default values - this%label = label__default - this%level = level__default - this%acceptance_fraction = acceptance_fraction__default + nml__obj%data%label = label__default + nml__obj%data%level = level__default + nml__obj%data%acceptance_fraction = acceptance_fraction__default end function nml_report_init !> \brief Read report namelist from file - integer function nml_report_from_file(this, file, errmsg) result(status) - class(nml_report_t), intent(inout) :: this !< namelist instance + integer function nml_report_from_file(nml__obj, file, errmsg) result(nml__status) + class(nml_report_t), intent(inout) :: nml__obj !< namelist instance character(len=*), intent(in) :: file !< path to namelist file character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + + nml__status = nml_report_read__from_file(nml__obj, file, errmsg) + end function nml_report_from_file + + integer function nml_report_read__from_file(nml__obj, nml__file, errmsg) & + result(nml__status) + class(nml_report_t), intent(inout) :: nml__obj + character(len=*), intent(in) :: nml__file + character(len=*), intent(out), optional :: errmsg ! namelist variables character(len=label_len) :: label integer(i4) :: level real(dp) :: acceptance_fraction ! locals - type(nml_file_t) :: nml - integer :: iostat - integer :: close_status - character(len=nml_line_buffer) :: iomsg + type(nml_file_t) :: nml__reader + integer :: nml__iostat + integer :: nml__close_status + character(len=nml_line_buffer) :: nml__iomsg namelist /report/ & label, & level, & acceptance_fraction - status = this%init(errmsg=errmsg) - if (status /= NML_OK) return - label = this%label - level = this%level - acceptance_fraction = this%acceptance_fraction - - status = nml%open(file, errmsg=errmsg) - if (status /= NML_OK) return - - status = nml%find("report", errmsg=errmsg) - if (status /= NML_OK) then - if (status == NML_ERR_NML_NOT_FOUND) then - close_status = nml%close(errmsg=errmsg) - if (close_status /= NML_OK) then - status = close_status + nml__status = nml__obj%init(errmsg=errmsg) + if (nml__status /= NML_OK) return + label = nml__obj%data%label + level = nml__obj%data%level + acceptance_fraction = nml__obj%data%acceptance_fraction + + nml__status = nml__reader%open(nml__file, errmsg=errmsg) + if (nml__status /= NML_OK) return + + nml__status = nml__reader%find("report", errmsg=errmsg) + if (nml__status /= NML_OK) then + if (nml__status == NML_ERR_NML_NOT_FOUND) then + nml__close_status = nml__reader%close(errmsg=errmsg) + if (nml__close_status /= NML_OK) then + nml__status = nml__close_status return end if - this%is_configured = .true. - status = NML_OK + nml__obj%is_configured = .true. + nml__status = NML_OK return end if - close_status = nml%close() + nml__close_status = nml__reader%close() return end if ! read namelist - read(nml%unit, nml=report, iostat=iostat, iomsg=iomsg) - if (iostat /= 0) then - status = NML_ERR_READ - if (present(errmsg)) errmsg = trim(iomsg) - close_status = nml%close() + read(nml__reader%unit, nml=report, iostat=nml__iostat, iomsg=nml__iomsg) + if (nml__iostat /= 0) then + nml__status = NML_ERR_READ + if (present(errmsg)) errmsg = trim(nml__iomsg) + nml__close_status = nml__reader%close() return end if - close_status = nml%close(errmsg=errmsg) - if (close_status /= NML_OK) then - status = close_status + nml__close_status = nml__reader%close(errmsg=errmsg) + if (nml__close_status /= NML_OK) then + nml__status = nml__close_status return end if ! assign values - this%label = label - this%level = level - this%acceptance_fraction = acceptance_fraction + nml__obj%data%label = label + nml__obj%data%level = level + nml__obj%data%acceptance_fraction = acceptance_fraction ! mark as configured - this%is_configured = .true. - status = NML_OK - end function nml_report_from_file + nml__obj%is_configured = .true. + nml__status = NML_OK + end function nml_report_read__from_file !> \brief Set report values - integer function nml_report_set(this, & + integer function nml_report_set(nml__obj, & label, & level, & acceptance_fraction, & - errmsg) result(status) + errmsg) result(nml__status) - class(nml_report_t), intent(inout) :: this !< namelist instance + class(nml_report_t), intent(inout) :: nml__obj !< namelist instance character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values character(len=*), intent(in), optional :: label !< Report label integer(i4), intent(in), optional :: level !< Reporting detail real(dp), intent(in), optional :: acceptance_fraction !< Acceptance fraction - - status = this%init(errmsg=errmsg) - if (status /= NML_OK) return + nml__status = nml__obj%init(errmsg=errmsg) + if (nml__status /= NML_OK) return ! required parameters ! override with provided values - if (present(label)) this%label = label - if (present(level)) this%level = level - if (present(acceptance_fraction)) this%acceptance_fraction = acceptance_fraction + if (present(label)) nml__obj%data%label = label + if (present(level)) nml__obj%data%level = level + if (present(acceptance_fraction)) nml__obj%data%acceptance_fraction = acceptance_fraction ! mark as configured - this%is_configured = .true. - status = NML_OK + nml__obj%is_configured = .true. + nml__status = NML_OK end function nml_report_set !> \brief Check whether a namelist value was set - integer function nml_report_is_set(this, name, idx, errmsg) result(status) - class(nml_report_t), intent(in) :: this !< namelist instance + integer function nml_report_is_set(nml__obj, name, idx, errmsg) result(nml__status) + class(nml_report_t), intent(in) :: nml__obj !< namelist instance character(len=*), intent(in) :: name !< field name integer, intent(in), optional :: idx(:) !< optional field index values character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(trim(name))) + select case (to__lower(trim(name))) case ("label") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'label'" return end if case ("level") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'level'" return end if case ("acceptance_fraction") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'acceptance_fraction'" return end if case default - status = NML_ERR_INVALID_NAME + nml__status = NML_ERR_INVALID_NAME if (present(errmsg)) errmsg = "unknown field: " // trim(name) end select - if (status == NML_ERR_NOT_SET .and. present(errmsg)) then + if (nml__status == NML_ERR_NOT_SET .and. present(errmsg)) then if (len_trim(errmsg) == 0) errmsg = "field not set: " // trim(name) end if end function nml_report_is_set !> \brief Validate required values and constraints - integer function nml_report_is_valid(this, errmsg) result(status) - class(nml_report_t), intent(in) :: this !< namelist instance + integer function nml_report_is_valid(nml__obj, errmsg) result(nml__status) + class(nml_report_t), intent(in) :: nml__obj !< namelist instance character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - integer :: istat + integer :: nml__istat - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if ! enum constraints - istat = this%is_set("level", errmsg=errmsg) - if (istat == NML_OK) then - if (.not. level__in_enum(this%level)) then - status = NML_ERR_ENUM + nml__istat = nml__obj%is_set("level", errmsg=errmsg) + if (nml__istat == NML_OK) then + if (.not. level__in_enum(nml__obj%data%level)) then + nml__status = NML_ERR_ENUM if (present(errmsg)) errmsg = "enum constraint failed: level" return end if - else if (istat /= NML_ERR_NOT_SET) then - status = istat + else if (nml__istat /= NML_ERR_NOT_SET) then + nml__status = nml__istat return end if ! bounds constraints - istat = this%is_set("acceptance_fraction", errmsg=errmsg) - if (istat == NML_OK) then - if (.not. acceptance_fraction__in_bounds(this%acceptance_fraction)) then - status = NML_ERR_BOUNDS + nml__istat = nml__obj%is_set("acceptance_fraction", errmsg=errmsg) + if (nml__istat == NML_OK) then + if (.not. acceptance_fraction__in_bounds(nml__obj%data%acceptance_fraction)) then + nml__status = NML_ERR_BOUNDS if (present(errmsg)) errmsg = "bounds constraint failed: acceptance_fraction" return end if - else if (istat /= NML_ERR_NOT_SET) then - status = istat + else if (nml__istat /= NML_ERR_NOT_SET) then + nml__status = nml__istat return end if end function nml_report_is_valid diff --git a/examples/03_references/out/nml_run.f90 b/examples/03_references/out/nml_run.f90 index db34924..0424c5f 100644 --- a/examples/03_references/out/nml_run.f90 +++ b/examples/03_references/out/nml_run.f90 @@ -20,11 +20,12 @@ module nml_run NML_ERR_NOT_SET, & NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & - idx_check, & - to_lower, & + idx__check, & + to__lower, & label_len, & - n_stations__default - use ieee_arithmetic, only: ieee_value, ieee_quiet_nan, ieee_is_nan + n_stations__dim_default + use ieee_arithmetic, only: nml__ieee_value => ieee_value, & + nml__ieee_quiet_nan => ieee_quiet_nan, nml__ieee_is_nan => ieee_is_nan ! kind specifiers listed in the nml-tools configuration file use iso_fortran_env, only: & i4=>int32, & @@ -49,17 +50,31 @@ module nml_run real(dp), parameter, public :: relaxation__min_excl = 0.0_dp real(dp), parameter, public :: relaxation__max = 0.5_dp - !> \class nml_run_t - !> \brief Reference-driven run configuration - !> \details Configuration composed from a reusable root schema and local fields. - type, public :: nml_run_t - logical :: is_configured = .false. !< whether the namelist has been configured - integer :: n_stations = n_stations__default !< runtime dimension for n_stations + private :: nml_run_read__from_file + + !> \class nml_run_data_t + !> \brief Schema-backed values for run + type, public :: nml_run_data_t character(len=label_len) :: label !< Run label integer(i4) :: steps !< Simulation steps real(dp), allocatable, dimension(:) :: station_weights !< Station weights character(len=label_len) :: method !< Time integration method real(dp) :: relaxation !< Relaxation factor + end type nml_run_data_t + + !> \class nml_run_dims_t + !> \brief Runtime dimensions for run + type, public :: nml_run_dims_t + integer :: n_stations = n_stations__dim_default !< runtime dimension for n_stations + end type nml_run_dims_t + + !> \class nml_run_t + !> \brief Reference-driven run configuration + !> \details Configuration composed from a reusable root schema and local fields. + type, public :: nml_run_t + type(nml_run_data_t) :: data !< schema-backed namelist values + type(nml_run_dims_t) :: dims !< runtime array dimensions + logical :: is_configured = .false. !< whether the namelist has been configured contains procedure :: init => nml_run_init procedure :: set_dims => nml_run_set_dims @@ -72,141 +87,150 @@ module nml_run contains !> \brief Check whether a value is part of an enum - elemental logical function method__in_enum(val, allow_missing) result(in_enum) - character(len=*), intent(in) :: val !< value to check - logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - - if (present(allow_missing)) then - if (allow_missing) then - if (val == achar(0)) then - in_enum = .true. + elemental logical function method__in_enum(nml__val, nml__allow_missing) result(nml__in_enum) + character(len=*), intent(in) :: nml__val !< value to check + logical, intent(in), optional :: nml__allow_missing !< allow sentinel values as valid + + if (present(nml__allow_missing)) then + if (nml__allow_missing) then + if (nml__val == achar(0)) then + nml__in_enum = .true. return end if end if end if - in_enum = any(trim(val) == method__enum_values) + nml__in_enum = any(trim(nml__val) == method__enum_values) end function method__in_enum !> \brief Check whether a value is within bounds - elemental logical function steps__in_bounds(val, allow_missing) result(in_bounds) - integer(i4), intent(in) :: val !< value to check - logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - - if (present(allow_missing)) then - if (allow_missing) then - if (val == -huge(val)) then - in_bounds = .true. + elemental logical function steps__in_bounds(nml__val, nml__allow_missing) result(nml__in_bounds) + integer(i4), intent(in) :: nml__val !< value to check + logical, intent(in), optional :: nml__allow_missing !< allow sentinel values as valid + + if (present(nml__allow_missing)) then + if (nml__allow_missing) then + if (nml__val == -huge(nml__val)) then + nml__in_bounds = .true. return end if end if end if - in_bounds = .true. - if (val < steps__min) in_bounds = .false. - if (val > steps__max) in_bounds = .false. + nml__in_bounds = .true. + if (nml__val < steps__min) nml__in_bounds = .false. + if (nml__val > steps__max) nml__in_bounds = .false. end function steps__in_bounds !> \brief Check whether a value is within bounds - elemental logical function station_weights__in_bounds(val, allow_missing) result(in_bounds) - real(dp), intent(in) :: val !< value to check - logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - - if (present(allow_missing)) then - if (allow_missing) then - if (ieee_is_nan(val)) then - in_bounds = .true. + elemental logical function station_weights__in_bounds(nml__val, nml__allow_missing) result(nml__in_bounds) + real(dp), intent(in) :: nml__val !< value to check + logical, intent(in), optional :: nml__allow_missing !< allow sentinel values as valid + + if (present(nml__allow_missing)) then + if (nml__allow_missing) then + if (nml__ieee_is_nan(nml__val)) then + nml__in_bounds = .true. return end if end if end if - in_bounds = .true. - if (val < station_weights__min) in_bounds = .false. + nml__in_bounds = .true. + if (nml__val < station_weights__min) nml__in_bounds = .false. end function station_weights__in_bounds !> \brief Check whether a value is within bounds - elemental logical function relaxation__in_bounds(val, allow_missing) result(in_bounds) - real(dp), intent(in) :: val !< value to check - logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - - if (present(allow_missing)) then - if (allow_missing) then - if (ieee_is_nan(val)) then - in_bounds = .true. + elemental logical function relaxation__in_bounds(nml__val, nml__allow_missing) result(nml__in_bounds) + real(dp), intent(in) :: nml__val !< value to check + logical, intent(in), optional :: nml__allow_missing !< allow sentinel values as valid + + if (present(nml__allow_missing)) then + if (nml__allow_missing) then + if (nml__ieee_is_nan(nml__val)) then + nml__in_bounds = .true. return end if end if end if - in_bounds = .true. - if (val <= relaxation__min_excl) in_bounds = .false. - if (val > relaxation__max) in_bounds = .false. + nml__in_bounds = .true. + if (nml__val <= relaxation__min_excl) nml__in_bounds = .false. + if (nml__val > relaxation__max) nml__in_bounds = .false. end function relaxation__in_bounds !> \brief Initialize defaults and sentinels for run - integer function nml_run_init(this, errmsg) result(status) - class(nml_run_t), intent(inout) :: this !< namelist instance + integer function nml_run_init(nml__obj, errmsg) result(nml__status) + class(nml_run_t), intent(inout) :: nml__obj !< namelist instance character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - this%is_configured = .false. + nml__obj%is_configured = .false. ! allocate runtime-sized fields - if (allocated(this%station_weights)) deallocate(this%station_weights) - allocate(this%station_weights(this%n_stations)) + if (allocated(nml__obj%data%station_weights)) deallocate(nml__obj%data%station_weights) + allocate(nml__obj%data%station_weights(nml__obj%dims%n_stations)) ! sentinel values for required/optional parameters - this%steps = -huge(this%steps) ! sentinel for required integer + nml__obj%data%steps = -huge(nml__obj%data%steps) ! sentinel for required integer ! default values - this%label = label__default - this%station_weights = reshape( & + nml__obj%data%label = label__default + nml__obj%data%station_weights = reshape( & station_weights__default, & - shape=[this%n_stations], & + shape=[nml__obj%dims%n_stations], & pad=station_weights__default) - this%method = method__default - this%relaxation = relaxation__default + nml__obj%data%method = method__default + nml__obj%data%relaxation = relaxation__default end function nml_run_init !> \brief Reset runtime dimensions for run - integer function nml_run_set_dims(this, & + integer function nml_run_set_dims(nml__obj, & n_stations, & - errmsg) result(status) - class(nml_run_t), intent(inout) :: this !< namelist instance + errmsg) result(nml__status) + class(nml_run_t), intent(inout) :: nml__obj !< namelist instance integer, intent(in), optional :: n_stations !< runtime dimension override for n_stations integer :: candidate__n_stations character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" if (present(n_stations)) then candidate__n_stations = n_stations else - candidate__n_stations = n_stations__default + candidate__n_stations = n_stations__dim_default end if if (candidate__n_stations <= 0) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "dimension 'n_stations' must be positive" return end if if (candidate__n_stations < 2) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "shape constants for 'station_weights' must allow at least 2 default values" return end if - this%n_stations = candidate__n_stations + nml__obj%dims%n_stations = candidate__n_stations ! deallocate runtime-sized fields; init/set/from_file allocate them again - if (allocated(this%station_weights)) deallocate(this%station_weights) - this%is_configured = .false. + if (allocated(nml__obj%data%station_weights)) deallocate(nml__obj%data%station_weights) + nml__obj%is_configured = .false. end function nml_run_set_dims !> \brief Read run namelist from file - integer function nml_run_from_file(this, file, errmsg) result(status) - class(nml_run_t), intent(inout) :: this !< namelist instance + integer function nml_run_from_file(nml__obj, file, errmsg) result(nml__status) + class(nml_run_t), intent(inout) :: nml__obj !< namelist instance character(len=*), intent(in) :: file !< path to namelist file character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + + nml__status = nml_run_read__from_file(nml__obj, file, errmsg) + end function nml_run_from_file + + integer function nml_run_read__from_file(nml__obj, nml__file, errmsg) & + result(nml__status) + class(nml_run_t), intent(inout) :: nml__obj + character(len=*), intent(in) :: nml__file + character(len=*), intent(out), optional :: errmsg ! namelist variables character(len=label_len) :: label integer(i4) :: steps @@ -214,10 +238,10 @@ integer function nml_run_from_file(this, file, errmsg) result(status) character(len=label_len) :: method real(dp) :: relaxation ! locals - type(nml_file_t) :: nml - integer :: iostat - integer :: close_status - character(len=nml_line_buffer) :: iomsg + type(nml_file_t) :: nml__reader + integer :: nml__iostat + integer :: nml__close_status + character(len=nml_line_buffer) :: nml__iomsg namelist /run/ & label, & @@ -226,175 +250,170 @@ integer function nml_run_from_file(this, file, errmsg) result(status) method, & relaxation - status = this%init(errmsg=errmsg) - if (status /= NML_OK) return + nml__status = nml__obj%init(errmsg=errmsg) + if (nml__status /= NML_OK) return ! allocate local namelist variables matching runtime-sized fields if (allocated(station_weights)) deallocate(station_weights) - allocate(station_weights(this%n_stations)) - label = this%label - steps = this%steps - station_weights = this%station_weights - method = this%method - relaxation = this%relaxation - - status = nml%open(file, errmsg=errmsg) - if (status /= NML_OK) return - - status = nml%find("run", errmsg=errmsg) - if (status /= NML_OK) then - close_status = nml%close() + allocate(station_weights(nml__obj%dims%n_stations)) + label = nml__obj%data%label + steps = nml__obj%data%steps + station_weights = nml__obj%data%station_weights + method = nml__obj%data%method + relaxation = nml__obj%data%relaxation + + nml__status = nml__reader%open(nml__file, errmsg=errmsg) + if (nml__status /= NML_OK) return + + nml__status = nml__reader%find("run", errmsg=errmsg) + if (nml__status /= NML_OK) then + nml__close_status = nml__reader%close() return end if ! read namelist - read(nml%unit, nml=run, iostat=iostat, iomsg=iomsg) - if (iostat /= 0) then - status = NML_ERR_READ - if (present(errmsg)) errmsg = trim(iomsg) - close_status = nml%close() + read(nml__reader%unit, nml=run, iostat=nml__iostat, iomsg=nml__iomsg) + if (nml__iostat /= 0) then + nml__status = NML_ERR_READ + if (present(errmsg)) errmsg = trim(nml__iomsg) + nml__close_status = nml__reader%close() return end if - close_status = nml%close(errmsg=errmsg) - if (close_status /= NML_OK) then - status = close_status + nml__close_status = nml__reader%close(errmsg=errmsg) + if (nml__close_status /= NML_OK) then + nml__status = nml__close_status return end if ! assign values - this%label = label - this%steps = steps - this%station_weights = station_weights - this%method = method - this%relaxation = relaxation + nml__obj%data%label = label + nml__obj%data%steps = steps + nml__obj%data%station_weights = station_weights + nml__obj%data%method = method + nml__obj%data%relaxation = relaxation ! mark as configured - this%is_configured = .true. - status = NML_OK - end function nml_run_from_file + nml__obj%is_configured = .true. + nml__status = NML_OK + end function nml_run_read__from_file !> \brief Set run values - integer function nml_run_set(this, & + integer function nml_run_set(nml__obj, & steps, & label, & station_weights, & method, & relaxation, & - errmsg) result(status) + errmsg) result(nml__status) - class(nml_run_t), intent(inout) :: this !< namelist instance + class(nml_run_t), intent(inout) :: nml__obj !< namelist instance character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values integer(i4), intent(in) :: steps !< Simulation steps character(len=*), intent(in), optional :: label !< Run label real(dp), dimension(:), intent(in), optional :: station_weights !< Station weights character(len=*), intent(in), optional :: method !< Time integration method real(dp), intent(in), optional :: relaxation !< Relaxation factor - integer :: & - lb__1, & - ub__1 - - status = this%init(errmsg=errmsg) - if (status /= NML_OK) return + nml__status = nml__obj%init(errmsg=errmsg) + if (nml__status /= NML_OK) return ! required parameters - this%steps = steps + nml__obj%data%steps = steps ! override with provided values - if (present(label)) this%label = label + if (present(label)) nml__obj%data%label = label if (present(station_weights)) then - if (size(station_weights, 1) > size(this%station_weights, 1)) then - status = NML_ERR_INVALID_INDEX + if (size(station_weights, 1) > size(nml__obj%data%station_weights, 1)) then + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'station_weights'" return end if - lb__1 = lbound(this%station_weights, 1) - ub__1 = lb__1 + size(station_weights, 1) - 1 - this%station_weights(lb__1:ub__1) = station_weights + nml__obj%data%station_weights( & + 1:size(station_weights, 1)) = station_weights end if - if (present(method)) this%method = method - if (present(relaxation)) this%relaxation = relaxation + if (present(method)) nml__obj%data%method = method + if (present(relaxation)) nml__obj%data%relaxation = relaxation ! mark as configured - this%is_configured = .true. - status = NML_OK + nml__obj%is_configured = .true. + nml__status = NML_OK end function nml_run_set !> \brief Check whether a namelist value was set - integer function nml_run_is_set(this, name, idx, errmsg) result(status) - class(nml_run_t), intent(in) :: this !< namelist instance + integer function nml_run_is_set(nml__obj, name, idx, errmsg) result(nml__status) + class(nml_run_t), intent(in) :: nml__obj !< namelist instance character(len=*), intent(in) :: name !< field name integer, intent(in), optional :: idx(:) !< optional field index values character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(trim(name))) + select case (to__lower(trim(name))) case ("label") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'label'" return end if case ("steps") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'steps'" return end if - if (this%steps == -huge(this%steps)) status = NML_ERR_NOT_SET + if (nml__obj%data%steps == -huge(nml__obj%data%steps)) nml__status = NML_ERR_NOT_SET case ("station_weights") - if (.not. allocated(this%station_weights)) then - status = NML_ERR_NOT_SET + if (.not. allocated(nml__obj%data%station_weights)) then + nml__status = NML_ERR_NOT_SET return end if if (present(idx)) then - status = idx_check(idx, lbound(this%station_weights), ubound(this%station_weights), & + nml__status = idx__check(idx, shape(nml__obj%data%station_weights), & "station_weights", errmsg) - if (status /= NML_OK) return + if (nml__status /= NML_OK) return else end if case ("method") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'method'" return end if case ("relaxation") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'relaxation'" return end if case default - status = NML_ERR_INVALID_NAME + nml__status = NML_ERR_INVALID_NAME if (present(errmsg)) errmsg = "unknown field: " // trim(name) end select - if (status == NML_ERR_NOT_SET .and. present(errmsg)) then + if (nml__status == NML_ERR_NOT_SET .and. present(errmsg)) then if (len_trim(errmsg) == 0) errmsg = "field not set: " // trim(name) end if end function nml_run_is_set !> \brief Validate required values and constraints - integer function nml_run_is_valid(this, errmsg) result(status) - class(nml_run_t), intent(in) :: this !< namelist instance + integer function nml_run_is_valid(nml__obj, errmsg) result(nml__status) + class(nml_run_t), intent(in) :: nml__obj !< namelist instance character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - integer :: istat + integer :: nml__istat - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if ! required parameters - istat = this%is_set("steps", errmsg=errmsg) - if (istat == NML_ERR_NOT_SET) then - status = NML_ERR_REQUIRED + nml__istat = nml__obj%is_set("steps", errmsg=errmsg) + if (nml__istat == NML_ERR_NOT_SET) then + nml__status = NML_ERR_REQUIRED if (present(errmsg)) then if (len_trim(errmsg) == 0) then errmsg = "field not set: steps" @@ -403,50 +422,50 @@ integer function nml_run_is_valid(this, errmsg) result(status) end if return end if - if (istat /= NML_OK) then - status = istat + if (nml__istat /= NML_OK) then + nml__status = nml__istat return end if ! enum constraints - istat = this%is_set("method", errmsg=errmsg) - if (istat == NML_OK) then - if (.not. method__in_enum(this%method)) then - status = NML_ERR_ENUM + nml__istat = nml__obj%is_set("method", errmsg=errmsg) + if (nml__istat == NML_OK) then + if (.not. method__in_enum(nml__obj%data%method)) then + nml__status = NML_ERR_ENUM if (present(errmsg)) errmsg = "enum constraint failed: method" return end if - else if (istat /= NML_ERR_NOT_SET) then - status = istat + else if (nml__istat /= NML_ERR_NOT_SET) then + nml__status = nml__istat return end if ! bounds constraints - istat = this%is_set("steps", errmsg=errmsg) - if (istat == NML_OK) then - if (.not. steps__in_bounds(this%steps)) then - status = NML_ERR_BOUNDS + nml__istat = nml__obj%is_set("steps", errmsg=errmsg) + if (nml__istat == NML_OK) then + if (.not. steps__in_bounds(nml__obj%data%steps)) then + nml__status = NML_ERR_BOUNDS if (present(errmsg)) errmsg = "bounds constraint failed: steps" return end if - else if (istat /= NML_ERR_NOT_SET) then - status = istat + else if (nml__istat /= NML_ERR_NOT_SET) then + nml__status = nml__istat return end if - if (allocated(this%station_weights)) then - if (.not. all(station_weights__in_bounds(this%station_weights, allow_missing=.true.))) then - status = NML_ERR_BOUNDS + if (allocated(nml__obj%data%station_weights)) then + if (.not. all(station_weights__in_bounds(nml__obj%data%station_weights, nml__allow_missing=.true.))) then + nml__status = NML_ERR_BOUNDS if (present(errmsg)) errmsg = "bounds constraint failed: station_weights" return end if end if - istat = this%is_set("relaxation", errmsg=errmsg) - if (istat == NML_OK) then - if (.not. relaxation__in_bounds(this%relaxation)) then - status = NML_ERR_BOUNDS + nml__istat = nml__obj%is_set("relaxation", errmsg=errmsg) + if (nml__istat == NML_OK) then + if (.not. relaxation__in_bounds(nml__obj%data%relaxation)) then + nml__status = NML_ERR_BOUNDS if (present(errmsg)) errmsg = "bounds constraint failed: relaxation" return end if - else if (istat /= NML_ERR_NOT_SET) then - status = istat + else if (nml__istat /= NML_ERR_NOT_SET) then + nml__status = nml__istat return end if end function nml_run_is_valid diff --git a/examples/04_derived_types/f2py/generated/f2py_config.f90 b/examples/04_derived_types/f2py/generated/f2py_config.f90 index fbb21cf..c534d70 100644 --- a/examples/04_derived_types/f2py/generated/f2py_config.f90 +++ b/examples/04_derived_types/f2py/generated/f2py_config.f90 @@ -15,22 +15,22 @@ module f2py_run contains !> \brief Read the run namelist from a file - subroutine run_from_file_wrapper(handle, file, status, errmsg) - integer(c_intptr_t), intent(in) :: handle !< opaque handle to a nml_run_t instance + subroutine run_from_file_wrapper(nml__handle, file, nml__status, nml__errmsg) + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a nml_run_t instance character(len=*), intent(in) :: file !< namelist file path - integer, intent(out) :: status !< nml-tools status code - character(len=512), intent(out) :: errmsg !< error message for non-OK status values - type(nml_run_t), pointer :: this + integer, intent(out) :: nml__status !< nml-tools status code + character(len=512), intent(out) :: nml__errmsg !< error message for non-OK status values + type(nml_run_t), pointer :: nml__obj - call nml_run_resolve_handle(handle, this, status, errmsg) - if (.not. associated(this)) then + call nml_run_resolve_handle(nml__handle, nml__obj, nml__status, nml__errmsg) + if (.not. associated(nml__obj)) then return end if - status = this%from_file(file, errmsg=errmsg) + nml__status = nml__obj%from_file(file, errmsg=nml__errmsg) end subroutine run_from_file_wrapper !> \brief Set run values on the handled instance - subroutine run_set_wrapper(handle, & + subroutine run_set_wrapper(nml__handle, & period__start_year, & has__period__start_year, & period__end_year, & @@ -49,8 +49,8 @@ subroutine run_set_wrapper(handle, & has__station__code, & station__label, & has__station__label, & - status, errmsg) - integer(c_intptr_t), intent(in) :: handle !< opaque handle to a nml_run_t instance + nml__status, nml__errmsg) + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a nml_run_t instance integer(i4), intent(in) :: period__start_year !< period%start_year logical, intent(in) :: has__period__start_year !< whether period%start_year was provided integer(i4), intent(in) :: period__end_year !< period%end_year @@ -69,28 +69,28 @@ subroutine run_set_wrapper(handle, & logical, intent(in) :: has__station__code !< whether station%code was provided character(len=*), intent(in) :: station__label !< station%label logical, intent(in) :: has__station__label !< whether station%label was provided - integer, intent(out) :: status !< nml-tools status code - character(len=512), intent(out) :: errmsg !< error message for non-OK status values - type(nml_run_t), pointer :: this + integer, intent(out) :: nml__status !< nml-tools status code + character(len=512), intent(out) :: nml__errmsg !< error message for non-OK status values + type(nml_run_t), pointer :: nml__obj type(period_t) :: maybe__period type(period_t), dimension(:), allocatable :: maybe__periods type(station_t) :: maybe__station - call nml_run_resolve_handle(handle, this, status, errmsg) - if (.not. associated(this)) then + call nml_run_resolve_handle(nml__handle, nml__obj, nml__status, nml__errmsg) + if (.not. associated(nml__obj)) then return end if - status = this%init_type(period=maybe__period, errmsg=errmsg) - if (status /= NML_OK) return + nml__status = nml__obj%init_type(period=maybe__period, errmsg=nml__errmsg) + if (nml__status /= NML_OK) return if (has__period__start_year) maybe__period%start_year = period__start_year if (has__period__end_year) maybe__period%end_year = period__end_year if (has__period__label) maybe__period%label = period__label if (has__periods) then - status = this%init_type(periods=maybe__periods, errmsg=errmsg) - if (status /= NML_OK) return + nml__status = nml__obj%init_type(periods=maybe__periods, errmsg=nml__errmsg) + if (nml__status /= NML_OK) return if (periods__n1 > size(maybe__periods, 1)) then - status = NML_ERR_INVALID_INDEX - errmsg = "dimension 1 exceeds bounds for 'periods'" + nml__status = NML_ERR_INVALID_INDEX + nml__errmsg = "dimension 1 exceeds bounds for 'periods'" return end if where (has__periods__start_year) @@ -103,79 +103,79 @@ subroutine run_set_wrapper(handle, & maybe__periods(1:periods__n1)%label = periods__label end where end if - status = this%init_type(station=maybe__station, errmsg=errmsg) - if (status /= NML_OK) return + nml__status = nml__obj%init_type(station=maybe__station, errmsg=nml__errmsg) + if (nml__status /= NML_OK) return if (has__station__code) maybe__station%code = station__code if (has__station__label) maybe__station%label = station__label - status = this%set( & + nml__status = nml__obj%set( & period=maybe__period, & periods=maybe__periods, & station=maybe__station, & - errmsg=errmsg) + errmsg=nml__errmsg) end subroutine run_set_wrapper !> \brief Set runtime dimensions on the handled run instance - subroutine run_set_dims_wrapper(handle, & + subroutine run_set_dims_wrapper(nml__handle, & n_periods, & has__n_periods, & - status, errmsg) - integer(c_intptr_t), intent(in) :: handle !< opaque handle to a nml_run_t instance + nml__status, nml__errmsg) + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a nml_run_t instance integer, intent(in) :: n_periods !< runtime dimension override for n_periods logical, intent(in) :: has__n_periods !< whether n_periods was provided - integer, intent(out) :: status !< nml-tools status code - character(len=512), intent(out) :: errmsg !< error message for non-OK status values - type(nml_run_t), pointer :: this + integer, intent(out) :: nml__status !< nml-tools status code + character(len=512), intent(out) :: nml__errmsg !< error message for non-OK status values + type(nml_run_t), pointer :: nml__obj integer, allocatable :: maybe__n_periods - call nml_run_resolve_handle(handle, this, status, errmsg) - if (.not. associated(this)) then + call nml_run_resolve_handle(nml__handle, nml__obj, nml__status, nml__errmsg) + if (.not. associated(nml__obj)) then return end if if (has__n_periods) then allocate(maybe__n_periods) maybe__n_periods = n_periods end if - status = this%set_dims( & + nml__status = nml__obj%set_dims( & n_periods=maybe__n_periods, & - errmsg=errmsg) + errmsg=nml__errmsg) end subroutine run_set_dims_wrapper !> \brief Check whether a run field is set - subroutine run_is_set_wrapper(handle, name, idx__n1, idx, has__idx, status, errmsg) - integer(c_intptr_t), intent(in) :: handle !< opaque handle to a nml_run_t instance + subroutine run_is_set_wrapper(nml__handle, name, idx__n1, idx, has__idx, nml__status, nml__errmsg) + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a nml_run_t instance character(len=*), intent(in) :: name !< field name integer, intent(in) :: idx__n1 !< extent for idx integer, dimension(idx__n1), intent(in) :: idx !< optional field index values logical, intent(in) :: has__idx !< whether idx was provided - integer, intent(out) :: status !< nml-tools status code - character(len=512), intent(out) :: errmsg !< error message for non-OK status values - type(nml_run_t), pointer :: this + integer, intent(out) :: nml__status !< nml-tools status code + character(len=512), intent(out) :: nml__errmsg !< error message for non-OK status values + type(nml_run_t), pointer :: nml__obj integer, dimension(:), allocatable :: maybe__idx - call nml_run_resolve_handle(handle, this, status, errmsg) - if (.not. associated(this)) then + call nml_run_resolve_handle(nml__handle, nml__obj, nml__status, nml__errmsg) + if (.not. associated(nml__obj)) then return end if if (has__idx) then allocate(maybe__idx(idx__n1)) maybe__idx = idx end if - status = this%is_set(name, idx=maybe__idx, errmsg=errmsg) + nml__status = nml__obj%is_set(name, idx=maybe__idx, errmsg=nml__errmsg) end subroutine run_is_set_wrapper !> \brief Validate the handled run instance - subroutine run_is_valid_wrapper(handle, status, errmsg) - integer(c_intptr_t), intent(in) :: handle !< opaque handle to a nml_run_t instance - integer, intent(out) :: status !< nml-tools status code - character(len=512), intent(out) :: errmsg !< error message for non-OK status values - type(nml_run_t), pointer :: this + subroutine run_is_valid_wrapper(nml__handle, nml__status, nml__errmsg) + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a nml_run_t instance + integer, intent(out) :: nml__status !< nml-tools status code + character(len=512), intent(out) :: nml__errmsg !< error message for non-OK status values + type(nml_run_t), pointer :: nml__obj - call nml_run_resolve_handle(handle, this, status, errmsg) - if (.not. associated(this)) then + call nml_run_resolve_handle(nml__handle, nml__obj, nml__status, nml__errmsg) + if (.not. associated(nml__obj)) then return end if - status = this%is_valid(errmsg=errmsg) + nml__status = nml__obj%is_valid(errmsg=nml__errmsg) end subroutine run_is_valid_wrapper end module f2py_run diff --git a/examples/04_derived_types/fortran/config_store.f90 b/examples/04_derived_types/fortran/config_store.f90 index 8b2923c..299338a 100644 --- a/examples/04_derived_types/fortran/config_store.f90 +++ b/examples/04_derived_types/fortran/config_store.f90 @@ -39,26 +39,26 @@ end subroutine reset_config subroutine get_period_start(value) integer(i4), intent(out) :: value - value = config%period%start_year + value = config%data%period%start_year end subroutine get_period_start subroutine get_period_item_start(index, value) integer, intent(in) :: index integer(i4), intent(out) :: value - value = config%periods(index)%start_year + value = config%data%periods(index)%start_year end subroutine get_period_item_start subroutine get_station_code(value) integer(i4), intent(out) :: value - value = config%station%code + value = config%data%station%code end subroutine get_station_code subroutine get_station_label(value) character(len=24), intent(out) :: value - value = config%station%label + value = config%data%station%label end subroutine get_station_label end module config_store diff --git a/examples/04_derived_types/fortran/generated/nml_helper.f90 b/examples/04_derived_types/fortran/generated/nml_helper.f90 index 4aa3cf7..c807732 100644 --- a/examples/04_derived_types/fortran/generated/nml_helper.f90 +++ b/examples/04_derived_types/fortran/generated/nml_helper.f90 @@ -43,7 +43,7 @@ module nml_helper !> \brief Shared constants for generated namelist modules integer, parameter, public :: period_label_len = 12 !< Storage length of labels on locally generated periods. integer, parameter, public :: station_label_len = 8 !< Mapped station label length; imported application storage must match. - integer, parameter, public :: n_periods__default = 2 !< Default number of configured periods. + integer, parameter, public :: n_periods__dim_default = 2 !< Default number of configured periods. !> \class period_t !> \brief Simulation period @@ -68,61 +68,61 @@ module nml_helper contains !> \brief Open a namelist file - integer function nml_open(this, file, errmsg) result(status) + integer function nml_open(this, file, errmsg) result(nml__status) class(nml_file_t), intent(inout) :: this character(len=*), intent(in) :: file character(len=*), intent(out), optional :: errmsg - integer :: iostat - logical :: exists - character(len=nml_line_buffer) :: iomsg + integer :: nml__iostat + logical :: nml__exists + character(len=nml_line_buffer) :: nml__iomsg if (present(errmsg)) errmsg = "" - status = this%close() - inquire(file=file, exist=exists) - if (.not. exists) then + nml__status = this%close() + inquire(file=file, exist=nml__exists) + if (.not. nml__exists) then this%is_open = .false. this%unit = 0 - status = NML_ERR_FILE_NOT_FOUND + nml__status = NML_ERR_FILE_NOT_FOUND if (present(errmsg)) errmsg = "file not found: " // trim(file) return end if open(newunit=this%unit, file=file, status='old', action='read', & - iostat=iostat, iomsg=iomsg) - this%is_open = (iostat == 0) + iostat=nml__iostat, iomsg=nml__iomsg) + this%is_open = (nml__iostat == 0) if (.not. this%is_open) then this%unit = 0 - status = NML_ERR_OPEN - if (present(errmsg)) errmsg = trim(iomsg) + nml__status = NML_ERR_OPEN + if (present(errmsg)) errmsg = trim(nml__iomsg) return end if - status = NML_OK + nml__status = NML_OK end function nml_open !> \brief Find a namelist in the opened file - integer function nml_find(this, nml, errmsg) result(status) + integer function nml_find(this, nml, errmsg) result(nml__status) class(nml_file_t), intent(inout) :: this character(len=*), intent(in) :: nml character(len=*), intent(out), optional :: errmsg - integer :: iostat - character(len=nml_line_buffer) :: line - character(len=nml_line_buffer) :: iomsg + integer :: nml__iostat + character(len=nml_line_buffer) :: nml__line + character(len=nml_line_buffer) :: nml__iomsg if (present(errmsg)) errmsg = "" - status = NML_ERR_NML_NOT_FOUND + nml__status = NML_ERR_NML_NOT_FOUND if (.not. this%is_open) then - status = NML_ERR_NOT_OPEN + nml__status = NML_ERR_NOT_OPEN if (present(errmsg)) errmsg = "file not open" return end if rewind(unit=this%unit) do - read(this%unit, '(A)', iostat=iostat, iomsg=iomsg) line - if (iostat < 0) exit - if (iostat > 0) then - status = NML_ERR_READ - if (present(errmsg)) errmsg = trim(iomsg) + read(this%unit, '(A)', iostat=nml__iostat, iomsg=nml__iomsg) nml__line + if (nml__iostat < 0) exit + if (nml__iostat > 0) then + nml__status = NML_ERR_READ + if (present(errmsg)) errmsg = trim(nml__iomsg) return end if - if (index(to_lower(line), '&' // to_lower(trim(nml))) /= 0) then - status = NML_OK + if (index(to__lower(nml__line), '&' // to__lower(trim(nml))) /= 0) then + nml__status = NML_OK backspace(this%unit) return end if @@ -131,18 +131,18 @@ integer function nml_find(this, nml, errmsg) result(status) end function nml_find !> \brief Close the namelist file - integer function nml_close(this, errmsg) result(status) + integer function nml_close(this, errmsg) result(nml__status) class(nml_file_t), intent(inout) :: this character(len=*), intent(out), optional :: errmsg - integer :: iostat - character(len=nml_line_buffer) :: iomsg + integer :: nml__iostat + character(len=nml_line_buffer) :: nml__iomsg if (present(errmsg)) errmsg = "" - status = NML_OK + nml__status = NML_OK if (this%is_open) then - close(unit=this%unit, iostat=iostat, iomsg=iomsg) - if (iostat /= 0) then - status = NML_ERR_CLOSE - if (present(errmsg)) errmsg = trim(iomsg) + close(unit=this%unit, iostat=nml__iostat, iomsg=nml__iomsg) + if (nml__iostat /= 0) then + nml__status = NML_ERR_CLOSE + if (present(errmsg)) errmsg = trim(nml__iomsg) end if end if this%is_open = .false. @@ -150,35 +150,34 @@ integer function nml_close(this, errmsg) result(status) end function nml_close !> \brief Convert string to lower case - pure function to_lower(string) result(lower_string) - character(len=*), intent(in) :: string - character(len=len(string)) :: lower_string - integer, parameter :: shift=iachar('a')-iachar('A'), upA=iachar('A'), upZ=iachar('Z') - integer :: k, i - do i = 1, len(string) - k = ichar(string(i:i)) - if (k>=upA .and. k<=upZ) k = k + shift - lower_string(i:i) = char(k) + pure function to__lower(nml__string) result(nml__lower_string) + character(len=*), intent(in) :: nml__string + character(len=len(nml__string)) :: nml__lower_string + integer, parameter :: nml__shift=iachar('a')-iachar('A'), nml__upA=iachar('A'), nml__upZ=iachar('Z') + integer :: nml__k, nml__i + do nml__i = 1, len(nml__string) + nml__k = ichar(nml__string(nml__i:nml__i)) + if (nml__k>=nml__upA .and. nml__k<=nml__upZ) nml__k = nml__k + nml__shift + nml__lower_string(nml__i:nml__i) = char(nml__k) end do - end function to_lower + end function to__lower !> \brief Validate index bounds for array access - integer function idx_check(idx, lower, upper, field, errmsg) result(status) - integer, intent(in) :: idx(:) - integer, intent(in) :: lower(:) - integer, intent(in) :: upper(:) - character(len=*), intent(in) :: field + integer function idx__check(nml__idx, nml__extents, nml__field, errmsg) result(nml__status) + integer, intent(in) :: nml__idx(:) + integer, intent(in) :: nml__extents(:) + character(len=*), intent(in) :: nml__field character(len=*), intent(out), optional :: errmsg - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - if (size(idx) /= size(lower)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index rank mismatch for '" // trim(field) // "'" - else if (any(idx < lower) .or. any(idx > upper)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index out of bounds for '" // trim(field) // "'" + if (size(nml__idx) /= size(nml__extents)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index rank mismatch for '" // trim(nml__field) // "'" + else if (any(nml__idx < 1) .or. any(nml__idx > nml__extents)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index out of bounds for '" // trim(nml__field) // "'" end if - end function idx_check + end function idx__check end module nml_helper diff --git a/examples/04_derived_types/fortran/generated/nml_run.f90 b/examples/04_derived_types/fortran/generated/nml_run.f90 index f204da4..0afe8b2 100644 --- a/examples/04_derived_types/fortran/generated/nml_run.f90 +++ b/examples/04_derived_types/fortran/generated/nml_run.f90 @@ -20,18 +20,17 @@ module nml_run NML_ERR_NOT_SET, & NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & - idx_check, & - to_lower, & + idx__check, & + to__lower, & NML_ERR_INVALID_HANDLE, & period_t, & period_label_len, & - n_periods__default, & + n_periods__dim_default, & station_label_len ! kind specifiers listed in the nml-tools configuration file use iso_fortran_env, only: & i4=>int32 use application_types, only: station_t - use iso_c_binding, only: c_f_pointer, c_intptr_t, c_null_ptr, c_ptr implicit none @@ -42,15 +41,29 @@ module nml_run integer(i4), parameter, public :: periods__start_year__max = 2200_i4 integer(i4), parameter, public :: station__code__min = 1_i4 + private :: nml_run_read__from_file + + !> \class nml_run_data_t + !> \brief Schema-backed values for run + type, public :: nml_run_data_t + type(period_t) :: period !< Main simulation period + type(period_t), allocatable, dimension(:) :: periods !< Comparison periods + type(station_t) :: station !< Selected station + end type nml_run_data_t + + !> \class nml_run_dims_t + !> \brief Runtime dimensions for run + type, public :: nml_run_dims_t + integer :: n_periods = n_periods__dim_default !< runtime dimension for n_periods + end type nml_run_dims_t + !> \class nml_run_t !> \brief Derived-type configuration !> \details Demonstrates referenced reusable and inline imported derived types. type, public :: nml_run_t + type(nml_run_data_t) :: data !< schema-backed namelist values + type(nml_run_dims_t) :: dims !< runtime array dimensions logical :: is_configured = .false. !< whether the namelist has been configured - integer :: n_periods = n_periods__default !< runtime dimension for n_periods - type(period_t) :: period !< Main simulation period - type(period_t), allocatable, dimension(:) :: periods !< Comparison periods - type(station_t) :: station !< Selected station contains procedure :: init => nml_run_init procedure :: init_type => nml_run_init_type @@ -64,112 +77,113 @@ module nml_run contains !> \brief Check whether a value is within bounds - elemental logical function period__start_year__in_bounds(val, allow_missing) result(in_bounds) - integer(i4), intent(in) :: val !< value to check - logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - - if (present(allow_missing)) then - if (allow_missing) then - if (val == -huge(val)) then - in_bounds = .true. + elemental logical function period__start_year__in_bounds(nml__val, nml__allow_missing) result(nml__in_bounds) + integer(i4), intent(in) :: nml__val !< value to check + logical, intent(in), optional :: nml__allow_missing !< allow sentinel values as valid + + if (present(nml__allow_missing)) then + if (nml__allow_missing) then + if (nml__val == -huge(nml__val)) then + nml__in_bounds = .true. return end if end if end if - in_bounds = .true. - if (val < period__start_year__min) in_bounds = .false. - if (val > period__start_year__max) in_bounds = .false. + nml__in_bounds = .true. + if (nml__val < period__start_year__min) nml__in_bounds = .false. + if (nml__val > period__start_year__max) nml__in_bounds = .false. end function period__start_year__in_bounds !> \brief Check whether a value is within bounds - elemental logical function periods__start_year__in_bounds(val, allow_missing) result(in_bounds) - integer(i4), intent(in) :: val !< value to check - logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - - if (present(allow_missing)) then - if (allow_missing) then - if (val == -huge(val)) then - in_bounds = .true. + elemental logical function periods__start_year__in_bounds(nml__val, nml__allow_missing) result(nml__in_bounds) + integer(i4), intent(in) :: nml__val !< value to check + logical, intent(in), optional :: nml__allow_missing !< allow sentinel values as valid + + if (present(nml__allow_missing)) then + if (nml__allow_missing) then + if (nml__val == -huge(nml__val)) then + nml__in_bounds = .true. return end if end if end if - in_bounds = .true. - if (val < periods__start_year__min) in_bounds = .false. - if (val > periods__start_year__max) in_bounds = .false. + nml__in_bounds = .true. + if (nml__val < periods__start_year__min) nml__in_bounds = .false. + if (nml__val > periods__start_year__max) nml__in_bounds = .false. end function periods__start_year__in_bounds !> \brief Check whether a value is within bounds - elemental logical function station__code__in_bounds(val, allow_missing) result(in_bounds) - integer(i4), intent(in) :: val !< value to check - logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - - if (present(allow_missing)) then - if (allow_missing) then - if (val == -huge(val)) then - in_bounds = .true. + elemental logical function station__code__in_bounds(nml__val, nml__allow_missing) result(nml__in_bounds) + integer(i4), intent(in) :: nml__val !< value to check + logical, intent(in), optional :: nml__allow_missing !< allow sentinel values as valid + + if (present(nml__allow_missing)) then + if (nml__allow_missing) then + if (nml__val == -huge(nml__val)) then + nml__in_bounds = .true. return end if end if end if - in_bounds = .true. - if (val < station__code__min) in_bounds = .false. + nml__in_bounds = .true. + if (nml__val < station__code__min) nml__in_bounds = .false. end function station__code__in_bounds !> \brief Resolve an opaque C pointer handle to a nml_run_t pointer - subroutine nml_run_resolve_handle(handle, this, status, errmsg) - integer(c_intptr_t), intent(in) :: handle !< opaque handle to a nml_run_t instance - type(nml_run_t), pointer :: this !< resolved namelist pointer - integer, intent(out) :: status !< nml-tools status code + subroutine nml_run_resolve_handle(nml__handle, nml__obj, nml__status, errmsg) + use iso_c_binding, only: c_f_pointer, c_intptr_t, c_null_ptr, c_ptr + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a nml_run_t instance + type(nml_run_t), pointer :: nml__obj !< resolved namelist pointer + integer, intent(out) :: nml__status !< nml-tools status code character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - type(c_ptr) :: ptr + type(c_ptr) :: nml__ptr if (present(errmsg)) errmsg = "" - nullify(this) - if (handle == 0_c_intptr_t) then - status = NML_ERR_INVALID_HANDLE + nullify(nml__obj) + if (nml__handle == 0_c_intptr_t) then + nml__status = NML_ERR_INVALID_HANDLE if (present(errmsg)) errmsg = "zero handle" return end if - ptr = transfer(handle, c_null_ptr) - call c_f_pointer(ptr, this) - status = NML_OK + nml__ptr = transfer(nml__handle, c_null_ptr) + call c_f_pointer(nml__ptr, nml__obj) + nml__status = NML_OK end subroutine nml_run_resolve_handle !> \brief Initialize defaults and sentinels for run - integer function nml_run_init(this, errmsg) result(status) - class(nml_run_t), intent(inout) :: this !< namelist instance + integer function nml_run_init(nml__obj, errmsg) result(nml__status) + class(nml_run_t), intent(inout) :: nml__obj !< namelist instance character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - this%is_configured = .false. + nml__obj%is_configured = .false. ! derived values - status = this%init_type( & - period=this%period, & - periods=this%periods, & - station=this%station, & + nml__status = nml__obj%init_type( & + period=nml__obj%data%period, & + periods=nml__obj%data%periods, & + station=nml__obj%data%station, & errmsg=errmsg) - if (status /= NML_OK) return + if (nml__status /= NML_OK) return end function nml_run_init !> \brief Initialize derived values with their field-specific defaults - integer function nml_run_init_type(this, & + integer function nml_run_init_type(nml__obj, & period, & periods, & station, & - errmsg) result(status) - class(nml_run_t), intent(in) :: this !< parent namelist instance + errmsg) result(nml__status) + class(nml_run_t), intent(in) :: nml__obj !< parent namelist instance type(period_t), intent(inout), optional :: period !< Main simulation period type(period_t), dimension(:), allocatable, intent(inout), optional :: periods !< Comparison periods type(station_t), intent(inout), optional :: station !< Selected station character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" if (present(period)) then period%start_year = -huge(period%start_year) ! sentinel for derived component start_year @@ -179,7 +193,7 @@ integer function nml_run_init_type(this, & end if if (present(periods)) then if (allocated(periods)) deallocate(periods) - allocate(periods(this%n_periods)) + allocate(periods(nml__obj%dims%n_periods)) periods%start_year = -huge(periods%start_year) ! sentinel for derived component start_year periods%end_year = -huge(periods%end_year) ! sentinel for derived component end_year periods%label = "period" @@ -189,7 +203,7 @@ integer function nml_run_init_type(this, & if (present(station)) then station%code = -huge(station%code) ! sentinel for derived component code if (len(station%label) /= station_label_len) then - status = NML_ERR_BOUNDS + nml__status = NML_ERR_BOUNDS if (present(errmsg)) errmsg = "imported string storage length mismatch: station%label" return end if @@ -198,267 +212,271 @@ integer function nml_run_init_type(this, & end function nml_run_init_type !> \brief Reset runtime dimensions for run - integer function nml_run_set_dims(this, & + integer function nml_run_set_dims(nml__obj, & n_periods, & - errmsg) result(status) - class(nml_run_t), intent(inout) :: this !< namelist instance + errmsg) result(nml__status) + class(nml_run_t), intent(inout) :: nml__obj !< namelist instance integer, intent(in), optional :: n_periods !< runtime dimension override for n_periods integer :: candidate__n_periods character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" if (present(n_periods)) then candidate__n_periods = n_periods else - candidate__n_periods = n_periods__default + candidate__n_periods = n_periods__dim_default end if if (candidate__n_periods <= 0) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "dimension 'n_periods' must be positive" return end if - this%n_periods = candidate__n_periods + nml__obj%dims%n_periods = candidate__n_periods ! deallocate runtime-sized fields; init/set/from_file allocate them again - if (allocated(this%periods)) deallocate(this%periods) - this%is_configured = .false. + if (allocated(nml__obj%data%periods)) deallocate(nml__obj%data%periods) + nml__obj%is_configured = .false. end function nml_run_set_dims !> \brief Read run namelist from file - integer function nml_run_from_file(this, file, errmsg) result(status) - class(nml_run_t), intent(inout) :: this !< namelist instance + integer function nml_run_from_file(nml__obj, file, errmsg) result(nml__status) + class(nml_run_t), intent(inout) :: nml__obj !< namelist instance character(len=*), intent(in) :: file !< path to namelist file character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + + nml__status = nml_run_read__from_file(nml__obj, file, errmsg) + end function nml_run_from_file + + integer function nml_run_read__from_file(nml__obj, nml__file, errmsg) & + result(nml__status) + class(nml_run_t), intent(inout) :: nml__obj + character(len=*), intent(in) :: nml__file + character(len=*), intent(out), optional :: errmsg ! namelist variables type(period_t) :: period type(period_t), allocatable, dimension(:) :: periods type(station_t) :: station ! locals - type(nml_file_t) :: nml - integer :: iostat - integer :: close_status - character(len=nml_line_buffer) :: iomsg + type(nml_file_t) :: nml__reader + integer :: nml__iostat + integer :: nml__close_status + character(len=nml_line_buffer) :: nml__iomsg namelist /run/ & period, & periods, & station - status = this%init(errmsg=errmsg) - if (status /= NML_OK) return + nml__status = nml__obj%init(errmsg=errmsg) + if (nml__status /= NML_OK) return ! allocate local namelist variables matching runtime-sized fields if (allocated(periods)) deallocate(periods) - allocate(periods(this%n_periods)) - period = this%period - periods = this%periods - station = this%station + allocate(periods(nml__obj%dims%n_periods)) + period = nml__obj%data%period + periods = nml__obj%data%periods + station = nml__obj%data%station - status = nml%open(file, errmsg=errmsg) - if (status /= NML_OK) return + nml__status = nml__reader%open(nml__file, errmsg=errmsg) + if (nml__status /= NML_OK) return - status = nml%find("run", errmsg=errmsg) - if (status /= NML_OK) then - close_status = nml%close() + nml__status = nml__reader%find("run", errmsg=errmsg) + if (nml__status /= NML_OK) then + nml__close_status = nml__reader%close() return end if ! read namelist - read(nml%unit, nml=run, iostat=iostat, iomsg=iomsg) - if (iostat /= 0) then - status = NML_ERR_READ - if (present(errmsg)) errmsg = trim(iomsg) - close_status = nml%close() + read(nml__reader%unit, nml=run, iostat=nml__iostat, iomsg=nml__iomsg) + if (nml__iostat /= 0) then + nml__status = NML_ERR_READ + if (present(errmsg)) errmsg = trim(nml__iomsg) + nml__close_status = nml__reader%close() return end if - close_status = nml%close(errmsg=errmsg) - if (close_status /= NML_OK) then - status = close_status + nml__close_status = nml__reader%close(errmsg=errmsg) + if (nml__close_status /= NML_OK) then + nml__status = nml__close_status return end if ! assign values - this%period = period - this%periods = periods - this%station = station + nml__obj%data%period = period + nml__obj%data%periods = periods + nml__obj%data%station = station ! mark as configured - this%is_configured = .true. - status = NML_OK - end function nml_run_from_file + nml__obj%is_configured = .true. + nml__status = NML_OK + end function nml_run_read__from_file !> \brief Set run values - integer function nml_run_set(this, & + integer function nml_run_set(nml__obj, & period, & periods, & station, & - errmsg) result(status) + errmsg) result(nml__status) - class(nml_run_t), intent(inout) :: this !< namelist instance + class(nml_run_t), intent(inout) :: nml__obj !< namelist instance character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values type(period_t), intent(in) :: period !< Main simulation period type(station_t), intent(in) :: station !< Selected station type(period_t), dimension(:), intent(in), optional :: periods !< Comparison periods - integer :: & - lb__1, & - ub__1 - - status = this%init(errmsg=errmsg) - if (status /= NML_OK) return + nml__status = nml__obj%init(errmsg=errmsg) + if (nml__status /= NML_OK) return ! required parameters - this%period = period - this%station = station + nml__obj%data%period = period + nml__obj%data%station = station ! override with provided values if (present(periods)) then - if (size(periods, 1) > size(this%periods, 1)) then - status = NML_ERR_INVALID_INDEX + if (size(periods, 1) > size(nml__obj%data%periods, 1)) then + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'periods'" return end if - lb__1 = lbound(this%periods, 1) - ub__1 = lb__1 + size(periods, 1) - 1 - this%periods(lb__1:ub__1) = periods + nml__obj%data%periods( & + 1:size(periods, 1)) = periods end if ! mark as configured - this%is_configured = .true. - status = NML_OK + nml__obj%is_configured = .true. + nml__status = NML_OK end function nml_run_set !> \brief Check whether a namelist value was set - integer function nml_run_is_set(this, name, idx, errmsg) result(status) - class(nml_run_t), intent(in) :: this !< namelist instance + integer function nml_run_is_set(nml__obj, name, idx, errmsg) result(nml__status) + class(nml_run_t), intent(in) :: nml__obj !< namelist instance character(len=*), intent(in) :: name !< field name integer, intent(in), optional :: idx(:) !< optional field index values character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(trim(name))) + select case (to__lower(trim(name))) case ("period%start_year") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'period'" return end if case ("period%end_year") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'period'" return end if - if (this%period%end_year == -huge(this%period%end_year)) status = NML_ERR_NOT_SET + if (nml__obj%data%period%end_year == -huge(nml__obj%data%period%end_year)) nml__status = NML_ERR_NOT_SET case ("period%label") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'period'" return end if case ("period") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'period'" return end if - if (this%period%end_year == -huge(this%period%end_year)) then - status = NML_ERR_NOT_SET + if (nml__obj%data%period%end_year == -huge(nml__obj%data%period%end_year)) then + nml__status = NML_ERR_NOT_SET end if case ("periods%start_year") - if (.not. allocated(this%periods)) then - status = NML_ERR_NOT_SET + if (.not. allocated(nml__obj%data%periods)) then + nml__status = NML_ERR_NOT_SET return end if if (present(idx)) then - status = idx_check(idx, lbound(this%periods), ubound(this%periods), & + nml__status = idx__check(idx, shape(nml__obj%data%periods), & "periods", errmsg) - if (status /= NML_OK) return + if (nml__status /= NML_OK) return end if case ("periods%end_year") - if (.not. allocated(this%periods)) then - status = NML_ERR_NOT_SET + if (.not. allocated(nml__obj%data%periods)) then + nml__status = NML_ERR_NOT_SET return end if if (present(idx)) then - status = idx_check(idx, lbound(this%periods), ubound(this%periods), & + nml__status = idx__check(idx, shape(nml__obj%data%periods), & "periods", errmsg) - if (status /= NML_OK) return + if (nml__status /= NML_OK) return end if case ("periods%label") - if (.not. allocated(this%periods)) then - status = NML_ERR_NOT_SET + if (.not. allocated(nml__obj%data%periods)) then + nml__status = NML_ERR_NOT_SET return end if if (present(idx)) then - status = idx_check(idx, lbound(this%periods), ubound(this%periods), & + nml__status = idx__check(idx, shape(nml__obj%data%periods), & "periods", errmsg) - if (status /= NML_OK) return + if (nml__status /= NML_OK) return end if case ("periods") - if (.not. allocated(this%periods)) then - status = NML_ERR_NOT_SET + if (.not. allocated(nml__obj%data%periods)) then + nml__status = NML_ERR_NOT_SET return end if if (present(idx)) then - status = idx_check(idx, lbound(this%periods), ubound(this%periods), & + nml__status = idx__check(idx, shape(nml__obj%data%periods), & "periods", errmsg) - if (status /= NML_OK) return + if (nml__status /= NML_OK) return end if case ("station%code") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'station'" return end if - if (this%station%code == -huge(this%station%code)) status = NML_ERR_NOT_SET + if (nml__obj%data%station%code == -huge(nml__obj%data%station%code)) nml__status = NML_ERR_NOT_SET case ("station%label") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'station'" return end if case ("station") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'station'" return end if - if (this%station%code == -huge(this%station%code)) then - status = NML_ERR_NOT_SET + if (nml__obj%data%station%code == -huge(nml__obj%data%station%code)) then + nml__status = NML_ERR_NOT_SET end if case default - status = NML_ERR_INVALID_NAME + nml__status = NML_ERR_INVALID_NAME if (present(errmsg)) errmsg = "unknown field: " // trim(name) end select - if (status == NML_ERR_NOT_SET .and. present(errmsg)) then + if (nml__status == NML_ERR_NOT_SET .and. present(errmsg)) then if (len_trim(errmsg) == 0) errmsg = "field not set: " // trim(name) end if end function nml_run_is_set !> \brief Validate required values and constraints - integer function nml_run_is_valid(this, errmsg) result(status) - class(nml_run_t), intent(in) :: this !< namelist instance + integer function nml_run_is_valid(nml__obj, errmsg) result(nml__status) + class(nml_run_t), intent(in) :: nml__obj !< namelist instance character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - integer :: istat + integer :: nml__istat - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if ! required parameters - istat = this%is_set("period", errmsg=errmsg) - if (istat == NML_ERR_NOT_SET) then - status = NML_ERR_REQUIRED + nml__istat = nml__obj%is_set("period", errmsg=errmsg) + if (nml__istat == NML_ERR_NOT_SET) then + nml__status = NML_ERR_REQUIRED if (present(errmsg)) then if (len_trim(errmsg) == 0) then errmsg = "field not set: period" @@ -467,13 +485,13 @@ integer function nml_run_is_valid(this, errmsg) result(status) end if return end if - if (istat /= NML_OK) then - status = istat + if (nml__istat /= NML_OK) then + nml__status = nml__istat return end if - istat = this%is_set("station", errmsg=errmsg) - if (istat == NML_ERR_NOT_SET) then - status = NML_ERR_REQUIRED + nml__istat = nml__obj%is_set("station", errmsg=errmsg) + if (nml__istat == NML_ERR_NOT_SET) then + nml__status = NML_ERR_REQUIRED if (present(errmsg)) then if (len_trim(errmsg) == 0) then errmsg = "field not set: station" @@ -482,38 +500,38 @@ integer function nml_run_is_valid(this, errmsg) result(status) end if return end if - if (istat /= NML_OK) then - status = istat + if (nml__istat /= NML_OK) then + nml__status = nml__istat return end if ! bounds constraints - istat = this%is_set("period%start_year", errmsg=errmsg) - if (istat == NML_OK) then - if (.not. period__start_year__in_bounds(this%period%start_year)) then - status = NML_ERR_BOUNDS + nml__istat = nml__obj%is_set("period%start_year", errmsg=errmsg) + if (nml__istat == NML_OK) then + if (.not. period__start_year__in_bounds(nml__obj%data%period%start_year)) then + nml__status = NML_ERR_BOUNDS if (present(errmsg)) errmsg = "bounds constraint failed: period%start_year" return end if - else if (istat /= NML_ERR_NOT_SET) then - status = istat + else if (nml__istat /= NML_ERR_NOT_SET) then + nml__status = nml__istat return end if - if (allocated(this%periods)) then - if (.not. all(periods__start_year__in_bounds(this%periods%start_year, allow_missing=.true.))) then - status = NML_ERR_BOUNDS + if (allocated(nml__obj%data%periods)) then + if (.not. all(periods__start_year__in_bounds(nml__obj%data%periods%start_year, nml__allow_missing=.true.))) then + nml__status = NML_ERR_BOUNDS if (present(errmsg)) errmsg = "bounds constraint failed: periods%start_year" return end if end if - istat = this%is_set("station%code", errmsg=errmsg) - if (istat == NML_OK) then - if (.not. station__code__in_bounds(this%station%code)) then - status = NML_ERR_BOUNDS + nml__istat = nml__obj%is_set("station%code", errmsg=errmsg) + if (nml__istat == NML_OK) then + if (.not. station__code__in_bounds(nml__obj%data%station%code)) then + nml__status = NML_ERR_BOUNDS if (present(errmsg)) errmsg = "bounds constraint failed: station%code" return end if - else if (istat /= NML_ERR_NOT_SET) then - status = istat + else if (nml__istat /= NML_ERR_NOT_SET) then + nml__status = nml__istat return end if end function nml_run_is_valid diff --git a/src/nml_tools/_fortran_scope.py b/src/nml_tools/_fortran_scope.py new file mode 100644 index 0000000..b5874cf --- /dev/null +++ b/src/nml_tools/_fortran_scope.py @@ -0,0 +1,68 @@ +"""Small declaration inventories for the Fortran scopes emitted by the generators. + +This is not a Fortran name resolver: callers register declarations and the host +dependencies that their generated procedures actually need to leave unshadowed. +""" + +from __future__ import annotations + +from dataclasses import dataclass + + +@dataclass(frozen=True) +class _Symbol: + category: str + identity: tuple[str, ...] + source: str + + +class FortranScope: + """Reject conflicting entities under the same case-insensitive local name.""" + + def __init__(self, name: str, *, module_name: str | None = None) -> None: + self.name = name + self._module_name = module_name + self._symbols: dict[str, _Symbol] = {} + + @property + def names(self) -> set[str]: + """Return an independent reservation set for generated-name allocation.""" + return set(self._symbols) + + def declare(self, name: str, *, category: str, identity: tuple[str, ...], source: str) -> None: + symbol = _Symbol(category, identity, source) + key = name.lower() + previous = self._symbols.get(key) + if previous is not None and ( + previous.category != category or previous.identity != identity + ): + raise ValueError( + f"{source} conflicts with {previous.source} " + f"in Fortran scope '{self.name}' (local name '{name}')" + ) + self._symbols[key] = symbol + + def import_symbol(self, symbol: str, module: str, *, category: str = "import") -> None: + """Register a USE name, optionally written as local => remote.""" + if self._module_name is not None and module.lower() == self._module_name.lower(): + raise ValueError( + f"generated module '{self._module_name}' cannot USE itself " + f"(source module '{module}' in Fortran scope '{self.name}')" + ) + parts = symbol.split("=>", maxsplit=1) + local = parts[0].strip() + remote = parts[-1].strip() + self.declare( + local, + category=category, + identity=("import", module.lower(), remote.lower()), + source=f"imported symbol '{local}' from '{module}' ({remote})", + ) + + def child(self, name: str, *, names: set[str] | None = None) -> FortranScope: + """Copy dependencies to a procedure inventory without changing its host.""" + scope = FortranScope(name, module_name=self._module_name) + scope._symbols = { + key: symbol for key, symbol in self._symbols.items() if names is None or key in names + } + return scope diff --git a/src/nml_tools/_utils.py b/src/nml_tools/_utils.py index b9fb389..e052508 100644 --- a/src/nml_tools/_utils.py +++ b/src/nml_tools/_utils.py @@ -7,6 +7,54 @@ FORTRAN_IDENTIFIER = re.compile(r"^[A-Za-z][A-Za-z0-9_]*$") RESERVED_IDENTIFIER_SEPARATOR = "__" +RESERVED_NAMELIST_IDENTIFIERS = frozenset({"errmsg"}) +GENERATED_INTRINSIC_IDENTIFIERS = frozenset( + { + "achar", + "all", + "allocated", + "any", + "associated", + "char", + "huge", + "iachar", + "ichar", + "index", + "len", + "len_trim", + "minval", + "present", + "reshape", + "shape", + "size", + "transfer", + "trim", + } +) +GENERATED_HELPER_IDENTIFIERS = frozenset( + { + "nml_close", + "nml_file_t", + "nml_find", + "nml_line_buffer", + "nml_open", + "nml_ok", + "nml_err_file_not_found", + "nml_err_open", + "nml_err_not_open", + "nml_err_nml_not_found", + "nml_err_read", + "nml_err_close", + "nml_err_required", + "nml_err_enum", + "nml_err_not_set", + "nml_err_partly_set", + "nml_err_bounds", + "nml_err_invalid_name", + "nml_err_invalid_index", + "nml_err_invalid_handle", + } +) def is_fortran_identifier(name: str) -> bool: @@ -25,6 +73,30 @@ def validate_user_fortran_identifier(name: str, *, label: str) -> None: raise ValueError(f"{label} must not contain '{RESERVED_IDENTIFIER_SEPARATOR}'") +def validate_namelist_identifier(name: str, *, label: str) -> None: + """Validate a namelist group, root property, or runtime dimension identifier.""" + validate_user_fortran_identifier(name, label=label) + validate_generated_fortran_identifier(name, label=label) + + +def validate_derived_component_identifier(name: str, *, label: str) -> None: + """Validate a qualified component identifier without reserving direct intrinsics.""" + validate_user_fortran_identifier(name, label=label) + if name.lower() in RESERVED_NAMELIST_IDENTIFIERS: + raise ValueError(f"{label} is reserved for the generated Fortran API") + + +def validate_generated_fortran_identifier(name: str, *, label: str) -> None: + """Reject names that shadow generated Fortran dependencies.""" + canonical_name = name.lower() + if canonical_name in RESERVED_NAMELIST_IDENTIFIERS: + raise ValueError(f"{label} is reserved for the generated Fortran API") + if canonical_name in GENERATED_INTRINSIC_IDENTIFIERS: + raise ValueError(f"{label} is reserved as a Fortran intrinsic used by generated code") + if canonical_name in GENERATED_HELPER_IDENTIFIERS: + raise ValueError(f"{label} is reserved by the generated helper API") + + def strip_trailing_whitespace(text: str) -> str: """Strip trailing horizontal whitespace from each line while preserving final newline.""" cleaned = "\n".join(line.rstrip() for line in text.splitlines()) @@ -44,6 +116,7 @@ def normalize_constant_values( if not isinstance(name, str) or not name.strip(): raise ValueError("constant names must be non-empty strings") validate_user_fortran_identifier(name, label=f"constant '{name}'") + validate_generated_fortran_identifier(name, label=f"constant '{name}'") canonical_name = name.lower() if canonical_name in normalized: raise ValueError(f"constant '{name}' duplicates another constant name") @@ -63,7 +136,7 @@ def normalize_runtime_dimensions( for name, value in dimensions.items(): if not isinstance(name, str) or not name.strip(): raise ValueError("runtime dimension names must be non-empty strings") - validate_user_fortran_identifier(name, label=f"runtime dimension '{name}'") + validate_namelist_identifier(name, label=f"runtime dimension '{name}'") canonical_name = name.lower() if canonical_name in normalized: raise ValueError(f"runtime dimension '{name}' duplicates another dimension name") diff --git a/src/nml_tools/cli.py b/src/nml_tools/cli.py index 147e408..5c6df08 100644 --- a/src/nml_tools/cli.py +++ b/src/nml_tools/cli.py @@ -17,7 +17,12 @@ from ._dimensions import DimensionSource, infer_runtime_dimensions, resolve_dimension_source from ._namelist_eval import evaluate_group from ._namelist_parser import NamelistSyntaxError, ParsedFile, ParsedGroup, parse_namelist -from ._utils import constant_dimension_overlap, validate_user_fortran_identifier +from ._utils import ( + constant_dimension_overlap, + validate_generated_fortran_identifier, + validate_namelist_identifier, + validate_user_fortran_identifier, +) from ._version import __version__ from .codegen_f2py import ( F2pyCTypeMap, @@ -79,6 +84,7 @@ def convert( self.fail("must use non-empty names", param, ctx) try: validate_user_fortran_identifier(name, label=f"{self._label} '{name}'") + validate_generated_fortran_identifier(name, label=f"{self._label} '{name}'") except ValueError as exc: self.fail(str(exc), param, ctx) @@ -339,6 +345,11 @@ def _load_kind_settings(config: dict[str, Any]) -> tuple[str, dict[str, str], se for alias, target in map_raw.items(): if not isinstance(alias, str) or not isinstance(target, str): raise click.ClickException("config 'kinds.map' keys and values must be strings") + try: + validate_user_fortran_identifier(alias, label=f"config kind alias '{alias}'") + validate_generated_fortran_identifier(alias, label=f"config kind alias '{alias}'") + except ValueError as exc: + raise click.ClickException(str(exc)) from exc kind_map[alias] = target real_raw = kinds_raw.get("real", []) @@ -429,6 +440,7 @@ def _load_constants(config: dict[str, Any]) -> tuple[dict[str, int], list[Consta raise click.ClickException("config constants must have non-empty names") try: validate_user_fortran_identifier(name, label=f"config constant '{name}'") + validate_generated_fortran_identifier(name, label=f"config constant '{name}'") except ValueError as exc: raise click.ClickException(str(exc)) from exc canonical_name = name.lower() @@ -481,7 +493,7 @@ def _load_dimensions( if not name: raise click.ClickException("config dimensions must have non-empty names") try: - validate_user_fortran_identifier(name, label=f"config dimension '{name}'") + validate_namelist_identifier(name, label=f"config dimension '{name}'") except ValueError as exc: raise click.ClickException(str(exc)) from exc canonical_name = name.lower() @@ -493,7 +505,7 @@ def _load_dimensions( raise click.ClickException( f"config dimension '{name}' duplicates another dimension name" ) - default_name = f"{canonical_name}__default" + default_name = f"{canonical_name}__dim_default" if default_name in constant_names: raise click.ClickException( f"config dimension '{name}' default name duplicates a constant name" @@ -1080,6 +1092,10 @@ def _collect_generated_outputs( outputs: list[GeneratedOutput] = [] loaded_namelists = _load_namelist_registry(config, base_dir, resolver) + if helper_path is None and any( + loaded.entry["mod_path"] is not None for loaded in loaded_namelists + ): + raise click.ClickException("Fortran module generation requires [helper].path") loaded_by_key = _namelist_registry_by_key(loaded_namelists) profiles = _load_config_metadata(config, loaded_by_key).file_profiles logger.debug("Found %d schema entries", len(loaded_namelists)) @@ -1134,13 +1150,11 @@ def _collect_generated_outputs( raise click.ClickException(str(exc)) from exc try: - local_derived_types = collect_local_derived_types( - [loaded.schema for loaded in loaded_namelists], - constants=constants, - ) - if local_derived_types and helper_path is None: - raise ValueError("locally generated derived types require a configured helper output") if helper_path is not None: + local_derived_types = collect_local_derived_types( + [loaded.schema for loaded in loaded_namelists], + constants=constants, + ) logger.debug("Rendering helper module at %s", helper_path) outputs.append( GeneratedOutput( @@ -1454,6 +1468,10 @@ def gen_fortran(config_path: Path | None) -> None: resolver = SchemaResolver() loaded_namelists = _load_namelist_registry(config, base_dir, resolver) _load_config_metadata(config, _namelist_registry_by_key(loaded_namelists)) + if helper_path is None and any( + loaded.entry["mod_path"] is not None for loaded in loaded_namelists + ): + raise click.ClickException("Fortran module generation requires [helper].path") logger.info("Found %d schema entries", len(loaded_namelists)) loaded_entries: list[dict[str, Any]] = [] for loaded in loaded_namelists: @@ -1480,13 +1498,11 @@ def gen_fortran(config_path: Path | None) -> None: raise click.ClickException(str(exc)) from exc try: - local_derived_types = collect_local_derived_types( - [loaded["schema"] for loaded in loaded_entries], - constants=constants, - ) - if local_derived_types and helper_path is None: - raise ValueError("locally generated derived types require a configured helper output") if helper_path is not None: + local_derived_types = collect_local_derived_types( + [loaded["schema"] for loaded in loaded_entries], + constants=constants, + ) logger.info("Generating helper module at %s", helper_path) generate_helper( helper_path, diff --git a/src/nml_tools/codegen_f2py.py b/src/nml_tools/codegen_f2py.py index a5f2cbe..aec05ec 100644 --- a/src/nml_tools/codegen_f2py.py +++ b/src/nml_tools/codegen_f2py.py @@ -11,6 +11,7 @@ from jinja2 import Environment, FileSystemLoader, StrictUndefined +from ._fortran_scope import FortranScope from ._utils import ( normalize_constant_values, normalize_runtime_dimensions, @@ -66,6 +67,7 @@ class F2pyArgumentSpec: python_name: str | None = None derived_leaves: list[F2pyDerivedLeafSpec] | None = None derived_type_name: str | None = None + abi_name: str | None = None @dataclass @@ -390,11 +392,63 @@ def build_f2py_namelist_spec( array_dimensions: list[F2pyArrayDimensionSpec] = [] derived_type_names: list[str] = [] - field_argument_names: set[str] = {"handle", "status", "errmsg"} - field_argument_names.update(field.name.lower() for field in fields) + namelist_name = cast("str", context["namelist_name"]) + module_name = cast("str", context["module_name"]) + wrapper_module_name = f"f2py_{namelist_name}" + wrapper_scope = FortranScope(wrapper_module_name, module_name=wrapper_module_name) + wrapper_scope.import_symbol("c_intptr_t", "iso_c_binding") + for symbol in (cast("str", context["type_name"]), f"{module_name}_resolve_handle"): + wrapper_scope.import_symbol(symbol, module_name) + for kind_import in cast("list[str]", context["kind_imports"]): + wrapper_scope.import_symbol(kind_import, cast("str", context["kind_module"])) + for field in fields: + derived = _derived_schema(_normalized_properties(schema)[field.name]) + if derived is not None: + type_name = _derived_type_name(derived) + if type_name.lower() not in {name.lower() for name in derived_type_names}: + derived_type_names.append(type_name) + wrapper_scope.import_symbol(type_name, module_name) + if derived_type_names: + for symbol in ("NML_OK", "NML_ERR_INVALID_INDEX"): + wrapper_scope.import_symbol(symbol, helper_module) + wrapper_procedure_names = { + f"{namelist_name}_{suffix}".lower() + for suffix in ( + "from_file_wrapper", + "set_wrapper", + "set_dims_wrapper", + "is_set_wrapper", + "is_valid_wrapper", + ) + } + for procedure in wrapper_procedure_names: + if procedure.endswith("set_dims_wrapper") and not context["runtime_dimensions"]: + continue + wrapper_scope.declare( + procedure, category="procedure", identity=("procedure", procedure), + source=f"generated f2py wrapper procedure '{procedure}'", + ) + procedure_scope = wrapper_scope.child(f"{namelist_name}_wrapper arguments") + for symbol in ("nml__errmsg", "nml__handle", "nml__obj", "nml__status"): + procedure_scope.declare(symbol, category="state", identity=("state", symbol), + source=f"generated wrapper state '{symbol}'") + wrapper_reserved_names = procedure_scope.names | { + "associated", "errmsg", "handle", "len", "size", "status", "this", + } + field_abi_names: dict[str, str] = {} + field_names_in_use = set(wrapper_reserved_names) + for field in fields: + base_name = ( + f"{field.name}__value" + if field.name.lower() in wrapper_reserved_names + else field.name + ) + abi_name = _unique_generated_name(base_name, field_names_in_use) + field_names_in_use.add(abi_name.lower()) + field_abi_names[field.name] = abi_name - argument_names_in_use: set[str] = set(field_argument_names) - bridge_names_in_use: set[str] = set(field_argument_names) | { + argument_names_in_use: set[str] = set(field_names_in_use) + bridge_names_in_use: set[str] = set(field_names_in_use) | { "handle", "status", "errmsg", @@ -403,6 +457,7 @@ def build_f2py_namelist_spec( for field in fields: type_info = type_infos[field.name] + abi_name = field_abi_names[field.name] rank = len(type_info.dimensions) if type_info.category == "array" else 0 prop = _normalized_properties(schema)[field.name] derived = _derived_schema(prop) @@ -414,10 +469,6 @@ def build_f2py_namelist_spec( argument_names_in_use.add(generated_dim_name.lower()) dim_names.append(generated_dim_name) derived_type_name = _derived_type_name(derived) - if derived_type_name.lower() not in { - name.lower() for name in derived_type_names - }: - derived_type_names.append(derived_type_name) leaves = _f2py_derived_leaves( field.name, derived, @@ -448,6 +499,7 @@ def build_f2py_namelist_spec( has_flag=outer_has_flag, derived_leaves=leaves, derived_type_name=derived_type_name, + abi_name=abi_name, ) if field.requires_input: required_args.append(spec) @@ -538,13 +590,14 @@ def build_f2py_namelist_spec( doc_type=_python_doc_type(type_info), requirement="required" if field.requires_input else "optional", has_flag=has_flag, + abi_name=abi_name, ) if field.requires_input: required_args.append(spec) else: optional_args.append(spec) field_arguments, field_declarations = _f2py_field_arguments( - field, type_info, dim_names=dim_names + field, type_info, abi_name=abi_name, dim_names=dim_names ) argument_list.extend(field_arguments) argument_declarations.extend(field_declarations) @@ -565,16 +618,21 @@ def build_f2py_namelist_spec( _optional_bridge_declaration(field.name, type_info, maybe_name) ) bridge_assignments.append( - _optional_bridge_assignment(field.name, type_info, has_flag, maybe_name) + _optional_bridge_assignment( + field.name, + type_info, + has_flag, + maybe_name, + source_name=abi_name, + dim_names=dim_names, + ) ) set_call_arguments.append(f"{field.name}={maybe_name}") else: - set_call_arguments.append(f"{field.name}={field.name}") + set_call_arguments.append(f"{field.name}={abi_name}") runtime_dimension_args = cast("list[dict[str, str]]", context["set_dims_arguments"]) - set_dims_argument_names_in_use: set[str] = { - str(entry["name"]).lower() for entry in runtime_dimension_args - } + set_dims_argument_names_in_use: set[str] = set(wrapper_reserved_names) set_dims_bridge_names_in_use: set[str] = set(set_dims_argument_names_in_use) | { "handle", "status", @@ -585,6 +643,13 @@ def build_f2py_namelist_spec( for entry in runtime_dimension_args: const_name = entry["name"] arg_name = entry["arg_name"] + abi_name = _unique_generated_name( + f"{const_name}__value" + if const_name.lower() in wrapper_reserved_names + else const_name, + set_dims_argument_names_in_use, + ) + set_dims_argument_names_in_use.add(abi_name.lower()) python_name = _python_parameter_name(const_name) has_base = f"has__{const_name}" has_flag = _unique_generated_name(has_base, set_dims_argument_names_in_use) @@ -602,11 +667,12 @@ def build_f2py_namelist_spec( has_flag=has_flag, fixed_shape=None, python_name=python_name, + abi_name=abi_name, ) ) - set_dims_argument_list.append(const_name) + set_dims_argument_list.append(abi_name) set_dims_argument_declarations.append( - f"integer, intent(in) :: {const_name} !< runtime dimension override for {const_name}" + f"integer, intent(in) :: {abi_name} !< runtime dimension override for {const_name}" ) set_dims_argument_list.append(has_flag) set_dims_argument_declarations.append( @@ -619,7 +685,7 @@ def build_f2py_namelist_spec( set_dims_bridge_assignments.append( f"if ({has_flag}) then\n" f" allocate({maybe_name})\n" - f" {maybe_name} = {const_name}\n" + f" {maybe_name} = {abi_name}\n" "end if" ) set_dims_call_arguments.append(f"{arg_name}={maybe_name}") @@ -805,12 +871,13 @@ def _f2py_field_arguments( field: FieldSpec, type_info: FieldTypeInfo, *, + abi_name: str, dim_names: list[str] | None = None, ) -> tuple[list[str], list[str]]: requirement = "required" if field.requires_input else "optional" if type_info.category != "array": - return [field.name], [ - f"{type_info.arg_type_spec}, intent(in) :: {field.name} " + return [abi_name], [ + f"{type_info.arg_type_spec}, intent(in) :: {abi_name} " f"!< {_one_line(field.title)} ({requirement})" ] @@ -822,10 +889,10 @@ def _f2py_field_arguments( for dim_name in dim_names ] declarations.append( - f"{type_info.arg_type_spec}, dimension({dims}), intent(in) :: {field.name} " + f"{type_info.arg_type_spec}, dimension({dims}), intent(in) :: {abi_name} " f"!< {_one_line(field.title)} ({requirement})" ) - return [*dim_names, field.name], declarations + return [*dim_names, abi_name], declarations def _f2py_derived_leaves( @@ -901,16 +968,22 @@ def _derived_bridge_assignments( if rank and not init_allocates_array: dims = ", ".join(dim_names) lines.append(f"{indent}allocate({maybe_name}({dims}))") - lines.append(f"{indent}status = this%init_type({name}={maybe_name}, errmsg=errmsg)") - lines.append(f"{indent}if (status /= NML_OK) return") + lines.append( + f"{indent}nml__status = nml__obj%init_type({name}={maybe_name}, " + "errmsg=nml__errmsg)" + ) + lines.append(f"{indent}if (nml__status /= NML_OK) return") if rank: if init_allocates_array: for dim_index, dim_name in enumerate(dim_names, start=1): lines.extend( [ f"{indent}if ({dim_name} > size({maybe_name}, {dim_index})) then", - f"{indent} status = NML_ERR_INVALID_INDEX", - f'{indent} errmsg = "dimension {dim_index} exceeds bounds for \'{name}\'"', + f"{indent} nml__status = NML_ERR_INVALID_INDEX", + ( + f"{indent} nml__errmsg = \"dimension {dim_index} " + f"exceeds bounds for '{name}'\"" + ), f"{indent} return", f"{indent}end if", ] @@ -949,28 +1022,33 @@ def _optional_bridge_assignment( type_info: FieldTypeInfo, has_flag: str, maybe_name: str, + *, + source_name: str, + dim_names: list[str], ) -> str: if type_info.category == "array": - dims = ", ".join(_array_dimension_argument_names(name, len(type_info.dimensions))) + dims = ", ".join(dim_names) allocate_stmt = f"allocate({maybe_name}({dims}))" if type_info.element_category == "string": - allocate_stmt = f"allocate(character(len=len({name})) :: {maybe_name}({dims}))" + allocate_stmt = ( + f"allocate(character(len=len({source_name})) :: {maybe_name}({dims}))" + ) return ( f"if ({has_flag}) then\n" f" {allocate_stmt}\n" - f" {maybe_name} = {name}\n" + f" {maybe_name} = {source_name}\n" "end if" ) if type_info.category == "string": return ( f"if ({has_flag}) then\n" - f" {maybe_name} = {name}\n" + f" {maybe_name} = {source_name}\n" "end if" ) return ( f"if ({has_flag}) then\n" f" allocate({maybe_name})\n" - f" {maybe_name} = {name}\n" + f" {maybe_name} = {source_name}\n" "end if" ) diff --git a/src/nml_tools/codegen_fortran.py b/src/nml_tools/codegen_fortran.py index 82982e6..b437c10 100644 --- a/src/nml_tools/codegen_fortran.py +++ b/src/nml_tools/codegen_fortran.py @@ -9,12 +9,17 @@ from jinja2 import Environment, FileSystemLoader, StrictUndefined +from ._fortran_scope import FortranScope from ._utils import ( FORTRAN_IDENTIFIER, + GENERATED_HELPER_IDENTIFIERS, normalize_constant_values, normalize_runtime_dimensions, reject_constant_dimension_overlap, strip_trailing_whitespace, + validate_derived_component_identifier, + validate_generated_fortran_identifier, + validate_namelist_identifier, validate_user_fortran_identifier, ) from .schema import DERIVED_REF_ORIGIN_KEY @@ -32,19 +37,6 @@ undefined=StrictUndefined, ) -_RESERVED_NAMELIST_TYPE_MEMBERS = { - "filled_shape", - "from_file", - "init", - "init_type", - "is_configured", - "is_set", - "is_valid", - "set", - "set_dims", -} - - @dataclass class ScalarTypeInfo: """Information about a scalar Fortran type.""" @@ -237,19 +229,38 @@ def render_helper( helper_kind_ids = [ kind_id for type_spec in local_types for kind_id in type_spec.kind_ids ] + kind_imports = _resolve_kind_imports( + helper_kind_ids, kind_map=kind_map, kind_allowlist=kind_allowlist + ) + scope = FortranScope(module_name, module_name=module_name) + scope.declare(module_name, category="module", identity=("module", module_name.lower()), + source=f"helper module '{module_name}'") + for name in (*sorted(GENERATED_HELPER_IDENTIFIERS), "to__lower", "idx__check"): + scope.declare(name, category="helper", identity=("helper", name), + source=f"generated helper symbol '{name}'") + for symbol in kind_imports: + scope.import_symbol(symbol, kind_module or "iso_fortran_env", category="kind") + for constant in constants or []: + validate_generated_fortran_identifier(constant.name, label=f"constant '{constant.name}'") + scope.declare(constant.name, category="constant", + identity=("constant", constant.name.lower(), + constant.type_spec, constant.value), + source=f"helper constant '{constant.name}'") + for derived in local_types: + validate_generated_fortran_identifier(derived.type_name, label="'x-fortran-type'") + scope.declare(derived.type_name, category="type", identity=derived.identity, + source=f"local derived type '{derived.type_name}'") return _TEMPLATE_ENV.get_template("nml_helper.f90.j2").render( { "file_name": file_name, "module_name": module_name, "len_buf": len_buf, - "constants": constants or [], - "local_derived_types": local_types, + "constants": list({entry.name.lower(): entry for entry in constants or []}.values()), + "local_derived_types": list({ + entry.type_name.lower(): entry for entry in local_types + }.values()), "kind_module": kind_module or "iso_fortran_env", - "kind_imports": _resolve_kind_imports( - helper_kind_ids, - kind_map=kind_map, - kind_allowlist=kind_allowlist, - ), + "kind_imports": kind_imports, "module_doc": module_doc, "helper_header": helper_header, } @@ -317,6 +328,14 @@ def _generated_name(*parts: str) -> str: return "__".join(parts) +def _data_ref(name: str) -> str: + return f"nml__obj%data%{name}" + + +def _dims_ref(name: str) -> str: + return f"nml__obj%dims%{name}" + + def _build_context( schema: dict[str, Any], *, @@ -336,7 +355,7 @@ def _build_context( namelist_name = schema.get("x-fortran-namelist") if not isinstance(namelist_name, str) or not namelist_name.strip(): raise ValueError("schema must define 'x-fortran-namelist'") - validate_user_fortran_identifier(namelist_name, label="'x-fortran-namelist'") + validate_namelist_identifier(namelist_name, label="'x-fortran-namelist'") if schema.get("type") != "object": raise ValueError("schema root must be of type 'object'") @@ -350,12 +369,8 @@ def _build_context( for prop_name, prop in properties.items(): if not isinstance(prop_name, str) or not prop_name.strip(): raise ValueError("property names must be non-empty strings") - validate_user_fortran_identifier(prop_name, label=f"property '{prop_name}'") + validate_namelist_identifier(prop_name, label=f"property '{prop_name}'") key = prop_name.lower() - if key in _RESERVED_NAMELIST_TYPE_MEMBERS: - raise ValueError( - f"property '{prop_name}' conflicts with generated namelist type member" - ) if key in property_name_map: raise ValueError( "property names must be unique (case-insensitive): " @@ -379,6 +394,8 @@ def _build_context( required_set = set(required_fields) module_name = f"nml_{namelist_name}" type_name = f"{module_name}_t" + data_type_name = f"{module_name}_data_t" + dims_type_name = f"{module_name}_dims_t" doc_class = f"{module_name}_t" brief_text = schema.get("title", namelist_name) details_text = schema.get("description", brief_text) @@ -392,7 +409,6 @@ def _build_context( presence_cases: list[dict[str, Any]] = [] required_scalar_names: set[str] = set() required_array_by_name: dict[str, dict[str, Any]] = {} - flex_bound_vars: set[str] = set() flex_arrays: list[dict[str, Any]] = [] default_parameters: list[str] = [] enum_parameters: list[str] = [] @@ -438,8 +454,8 @@ def _build_context( "NML_ERR_NOT_SET", "NML_ERR_INVALID_NAME", "NML_ERR_INVALID_INDEX", - "idx_check", - "to_lower", + "idx__check", + "to__lower", ] if f2py_handle_helpers: helper_imports.append("NML_ERR_INVALID_HANDLE") @@ -461,17 +477,7 @@ def _unique_generated_name(base_name: str, taken_names: set[str]) -> str: def _register_runtime_dimension(dim_name: str) -> str: local_name = runtime_dimension_locals.get(dim_name) if local_name is None: - if dim_name in property_name_map: - raise ValueError( - f"runtime dimension '{dim_name}' conflicts with property " - f"'{property_name_map[dim_name]}'" - ) - if dim_name in _RESERVED_NAMELIST_TYPE_MEMBERS: - raise ValueError( - f"runtime dimension '{dim_name}' conflicts with generated " - "namelist type member" - ) - default_name = _generated_name(dim_name, "default") + default_name = _generated_name(dim_name, "dim_default") if default_name.lower() in static_constants: raise ValueError( f"runtime dimension default name '{default_name}' conflicts with a constant" @@ -519,7 +525,7 @@ def _register_runtime_dimension(dim_name: str) -> str: dim_key = dim.lower() if dim_key in runtime_dimension_values: local_dim_name = _register_runtime_dimension(dim_key) - runtime_shape[dim_index] = f"this%{local_dim_name}" + runtime_shape[dim_index] = _dims_ref(local_dim_name) dynamic_shape = True elif dim_key not in static_constants: raise ValueError(f"dimension constant '{dim}' is not defined in config") @@ -573,11 +579,11 @@ def _register_runtime_dimension(dim_name: str) -> str: name, runtime_dimensions=runtime_shape, runtime_length_expr=runtime_length_expr, - target_prefix="this%", + target_prefix="nml__obj%data%", ) ) runtime_deallocations.extend( - _render_runtime_deallocations(name, target_prefix="this%") + _render_runtime_deallocations(name, target_prefix="nml__obj%data%") ) runtime_local_allocations.extend( _render_runtime_local_allocations( @@ -637,13 +643,17 @@ def _register_runtime_dimension(dim_name: str) -> str: for child_display_name, child in components.items(): if not isinstance(child_display_name, str) or not isinstance(child, dict): raise ValueError("derived object components must be schema objects") + validate_derived_component_identifier( + child_display_name, + label=f"property '{child_display_name}'", + ) child_name = child_display_name.lower() child_info = _field_type_info(child, static_constants) if child_info.kind: kind_ids.append(child_info.kind) if child_info.length_expr and not _is_int_literal(child_info.length_expr): _add_helper_import(child_info.length_expr) - child_target = f"this%{name}%{child_name}" + child_target = f"{_data_ref(name)}%{child_name}" arg_target = f"{name}%{child_name}" if ( module is not None @@ -657,7 +667,7 @@ def _register_runtime_dimension(dim_name: str) -> str: init_lines.extend( [ f"if (len({arg_target}) /= {expected_len}) then", - " status = NML_ERR_BOUNDS", + " nml__status = NML_ERR_BOUNDS", " if (present(errmsg)) " f'errmsg = "{storage_message}"', " return", @@ -730,7 +740,7 @@ def _register_runtime_dimension(dim_name: str) -> str: } ) constraint_name = _generated_name(name, child_name) - component_ref = f"this%{name}%{child_name}" + component_ref = f"{_data_ref(name)}%{child_name}" enum_values = _enum_values(child, child_info, constants) if enum_values is not None: enum_category = _enum_category(child_info) @@ -756,8 +766,8 @@ def _register_runtime_dimension(dim_name: str) -> str: ) _, enum_missing_condition, _ = _sentinel_expressions( child_info, - var_ref="val", - len_ref="val", + var_ref="nml__val", + len_ref="nml__val", ) enum_functions.append( { @@ -777,7 +787,7 @@ def _register_runtime_dimension(dim_name: str) -> str: "is_array": type_info.category == "array", "runtime_array": dynamic_array, "array_ref": component_ref, - "allocation_ref": f"this%{name}", + "allocation_ref": _data_ref(name), "element_ref": component_ref, } ) @@ -818,8 +828,8 @@ def _register_runtime_dimension(dim_name: str) -> str: ) _, bounds_missing_condition, child_uses_ieee = _sentinel_expressions( child_info, - var_ref="val", - len_ref="val", + var_ref="nml__val", + len_ref="nml__val", ) if child_uses_ieee: requires_ieee = True @@ -845,7 +855,7 @@ def _register_runtime_dimension(dim_name: str) -> str: "is_array": type_info.category == "array", "runtime_array": dynamic_array, "array_ref": component_ref, - "allocation_ref": f"this%{name}", + "allocation_ref": _data_ref(name), "element_ref": component_ref, } ) @@ -859,36 +869,25 @@ def _register_runtime_dimension(dim_name: str) -> str: dimensions=arg_dimensions, doc=title, ) - local_init_assignments.append(f"{name} = this%{name}") - derived_partial_bounds: list[dict[str, Any]] = [] + local_init_assignments.append(f"{name} = {_data_ref(name)}") set_present_assignment: str | None = None - if type_info.category == "array": - for array_dim_index in range(1, len(type_info.dimensions) + 1): - lb_var, ub_var = _flex_bound_vars(array_dim_index) - derived_partial_bounds.append( - {"dim": array_dim_index, "lb_var": lb_var, "ub_var": ub_var} - ) - flex_bound_vars.add(lb_var) - flex_bound_vars.add(ub_var) if requires_input: if type_info.category == "array": set_required_assignments.append( - _render_partial_set_block( - name, len(type_info.dimensions), derived_partial_bounds - ) + _render_partial_set_block(name, len(type_info.dimensions)) ) else: - set_required_assignments.append(f"this%{name} = {name}") + set_required_assignments.append(f"{_data_ref(name)} = {name}") elif type_info.category == "array": - block = _render_partial_set_block( - name, len(type_info.dimensions), derived_partial_bounds - ) + block = _render_partial_set_block(name, len(type_info.dimensions)) indented_block = "\n".join(f" {line}" for line in block.splitlines()) set_present_assignment = ( f"if (present({name})) then\n{indented_block}\nend if" ) else: - set_present_assignment = f"if (present({name})) this%{name} = {name}" + set_present_assignment = ( + f"if (present({name})) {_data_ref(name)} = {name}" + ) init_argument_declaration = _render_argument_declaration( name=name, @@ -904,7 +903,9 @@ def _register_runtime_dimension(dim_name: str) -> str: ", intent(in), optional", ", allocatable, intent(inout), optional", ) - allocation_lines.append(f"if (allocated({name})) deallocate({name})") + allocation_lines.append( + f"if (allocated({name})) deallocate({name})" + ) dims = ", ".join(runtime_shape) allocation_lines.append(f"allocate({name}({dims}))") else: @@ -1001,7 +1002,7 @@ def _register_runtime_dimension(dim_name: str) -> str: dimensions=arg_dimensions, doc=title, ) - local_init_assignments.append(f"{name} = this%{name}") + local_init_assignments.append(f"{name} = {_data_ref(name)}") sentinel_assignment: str | None = None sentinel_condition: str | None = None @@ -1013,11 +1014,11 @@ def _register_runtime_dimension(dim_name: str) -> str: raise ValueError("boolean arrays must define a default") value_expr, condition_expr, uses_ieee = _sentinel_expressions( type_info, - var_ref=f"this%{name}", + var_ref=_data_ref(name), ) sentinel_assignment = _render_sentinel_assignment( type_info, - target_ref=f"this%{name}", + target_ref=_data_ref(name), value_expr=value_expr, comment=_sentinel_comment(type_info, required=requires_input), ) @@ -1028,7 +1029,7 @@ def _register_runtime_dimension(dim_name: str) -> str: if not has_default and type_info.category != "boolean": set_value_expr, set_condition_expr, set_uses_ieee = _sentinel_expressions( type_info, - var_ref=f"this%{name}", + var_ref=_data_ref(name), ) if set_uses_ieee: requires_ieee = True @@ -1038,7 +1039,7 @@ def _register_runtime_dimension(dim_name: str) -> str: set_optional_defaults.append( _render_sentinel_assignment( type_info, - target_ref=f"this%{name}", + target_ref=_data_ref(name), value_expr=set_value_expr, comment=sent_com, ) @@ -1053,8 +1054,8 @@ def _register_runtime_dimension(dim_name: str) -> str: raise ValueError("array field missing element category") all_missing, any_missing, uses_ieee = _array_missing_conditions( element_category, - var_ref=_array_section_ref(f"this%{name}", len(type_info.dimensions)), - len_ref=f"this%{name}", + var_ref=_array_section_ref(_data_ref(name), len(type_info.dimensions)), + len_ref=_data_ref(name), ) required_array_by_name[name] = { "name": display_name, @@ -1067,18 +1068,6 @@ def _register_runtime_dimension(dim_name: str) -> str: if uses_ieee: requires_ieee = True - partial_bounds: list[dict[str, Any]] | None = None - if type_info.category == "array": - rank = len(type_info.dimensions) - all_bounds = [] - for array_dim_index in range(1, rank + 1): - lb_var, ub_var = _flex_bound_vars(array_dim_index) - all_bounds.append( - {"dim": array_dim_index, "lb_var": lb_var, "ub_var": ub_var} - ) - flex_bound_vars.add(lb_var) - flex_bound_vars.add(ub_var) - partial_bounds = all_bounds if flex_dim > 0: rank = len(type_info.dimensions) element_category = type_info.element_category @@ -1087,33 +1076,24 @@ def _register_runtime_dimension(dim_name: str) -> str: flex_dims: list[int] = list(range(rank - flex_dim + 1, rank + 1)) slice_missing_conditions: list[str] = [] slice_uses_ieee = False - flex_dim_bounds: list[dict[str, Any]] = [] - lb_vars: dict[int, str] = {} - ub_vars: dict[int, str] = {} for flex_dim_index in flex_dims: - lb_var, ub_var = _flex_bound_vars(flex_dim_index) - lb_vars[flex_dim_index] = lb_var - ub_vars[flex_dim_index] = ub_var - flex_dim_bounds.append( - {"dim": flex_dim_index, "lb_var": lb_var, "ub_var": ub_var} - ) - flex_bound_vars.add(lb_var) - flex_bound_vars.add(ub_var) - slice_ref = _slice_ref(name, rank, flex_dim_index, "idx") + slice_ref = _slice_ref(name, rank, flex_dim_index, "nml__idx") slice_missing_expr, uses_ieee = _element_missing_expression( element_category, var_ref=slice_ref, - len_ref=f"this%{name}", + len_ref=_data_ref(name), ) slice_missing_conditions.append( - f"all({slice_missing_expr})" if rank > 1 else slice_missing_expr + f"all({slice_missing_expr})" + if rank > 1 + else slice_missing_expr ) slice_uses_ieee = slice_uses_ieee or uses_ieee - prefix_ref = _slice_ref_bounds(name, rank, flex_dims, lb_vars, ub_vars) + prefix_ref = _slice_ref_filled(name, rank, flex_dims) prefix_missing_expr, uses_ieee_prefix = _element_missing_expression( element_category, var_ref=prefix_ref, - len_ref=f"this%{name}", + len_ref=_data_ref(name), ) prefix_any_missing_condition = f"any({prefix_missing_expr})" flex_arrays.append( @@ -1124,7 +1104,6 @@ def _register_runtime_dimension(dim_name: str) -> str: "flex_dims": flex_dims, "required": requires_input, "runtime_array": dynamic_array, - "bounds": flex_dim_bounds, "slice_missing_conditions": slice_missing_conditions, "prefix_any_missing_condition": prefix_any_missing_condition, } @@ -1214,14 +1193,14 @@ def _register_runtime_dimension(dim_name: str) -> str: ) if default_from_items: - default_assignment = f"this%{name} = {default_const_name}" + default_assignment = f"{_data_ref(name)} = {default_const_name}" elif ( len(type_info.dimensions) == 1 and array_default_spec is not None and array_default_spec.order_values is None and array_default_spec.pad_values is None ): - default_assignment = f"this%{name} = {default_const_name}" + default_assignment = f"{_data_ref(name)} = {default_const_name}" else: source_expr = default_const_name shape_expr = ", ".join(runtime_shape) @@ -1256,12 +1235,12 @@ def _register_runtime_dimension(dim_name: str) -> str: ) if type_info.category == "boolean": default_assignment = ( - f"this%{name} = {default_const_name} " + f"{_data_ref(name)} = {default_const_name} " "! bool values always need a default" ) else: - default_assignment = f"this%{name} = {default_const_name}" - set_default_assignment = f"this%{name} = {default_const_name}" + default_assignment = f"{_data_ref(name)} = {default_const_name}" + set_default_assignment = f"{_data_ref(name)} = {default_const_name}" if default_assignment is None or set_default_assignment is None: raise ValueError(f"missing default assignment for '{display_name}'") @@ -1321,8 +1300,8 @@ def _register_runtime_dimension(dim_name: str) -> str: ) _, missing_condition, _ = _sentinel_expressions( enum_type_info, - var_ref="val", - len_ref="val", + var_ref="nml__val", + len_ref="nml__val", ) enum_functions.append( { @@ -1342,8 +1321,8 @@ def _register_runtime_dimension(dim_name: str) -> str: "func_name": _generated_name(name, "in_enum"), "is_array": True, "runtime_array": dynamic_array, - "array_ref": f"this%{name}", - "allocation_ref": f"this%{name}", + "array_ref": _data_ref(name), + "allocation_ref": _data_ref(name), } ) else: @@ -1353,7 +1332,7 @@ def _register_runtime_dimension(dim_name: str) -> str: "display_name": display_name, "func_name": _generated_name(name, "in_enum"), "is_array": False, - "element_ref": f"this%{name}", + "element_ref": _data_ref(name), } ) @@ -1397,8 +1376,8 @@ def _register_runtime_dimension(dim_name: str) -> str: ) _, missing_condition, uses_ieee = _sentinel_expressions( bounds_type_info, - var_ref="val", - len_ref="val", + var_ref="nml__val", + len_ref="nml__val", ) if uses_ieee: requires_ieee = True @@ -1424,8 +1403,8 @@ def _register_runtime_dimension(dim_name: str) -> str: "func_name": _generated_name(name, "in_bounds"), "is_array": True, "runtime_array": dynamic_array, - "array_ref": f"this%{name}", - "allocation_ref": f"this%{name}", + "array_ref": _data_ref(name), + "allocation_ref": _data_ref(name), } ) else: @@ -1435,7 +1414,7 @@ def _register_runtime_dimension(dim_name: str) -> str: "display_name": display_name, "func_name": _generated_name(name, "in_bounds"), "is_array": False, - "element_ref": f"this%{name}", + "element_ref": _data_ref(name), } ) @@ -1448,11 +1427,10 @@ def _register_runtime_dimension(dim_name: str) -> str: _render_partial_set_block( name, len(type_info.dimensions), - partial_bounds or [], ) ) else: - set_required_assignments.append(f"this%{name} = {name}") + set_required_assignments.append(f"{_data_ref(name)} = {name}") if not requires_input: if is_array: @@ -1461,14 +1439,15 @@ def _register_runtime_dimension(dim_name: str) -> str: block = _render_partial_set_block( name, len(type_info.dimensions), - partial_bounds or [], ) indented_block = "\n".join(f" {line}" for line in block.splitlines()) set_present_assignment = ( f"if (present({name})) then\n{indented_block}\nend if" ) else: - set_present_assignment = f"if (present({name})) this%{name} = {name}" + set_present_assignment = ( + f"if (present({name})) {_data_ref(name)} = {name}" + ) else: set_present_assignment = None @@ -1478,11 +1457,11 @@ def _register_runtime_dimension(dim_name: str) -> str: if is_array and not has_default: element_type = _element_type_info(type_info) index_args = ", ".join(f"idx({idx})" for idx in range(1, array_rank + 1)) - element_ref = f"this%{name}({index_args})" + element_ref = f"{_data_ref(name)}({index_args})" _, element_condition, element_uses_ieee = _sentinel_expressions( element_type, var_ref=element_ref, - len_ref=f"this%{name}", + len_ref=_data_ref(name), ) if element_uses_ieee: requires_ieee = True @@ -1552,6 +1531,12 @@ def _register_runtime_dimension(dim_name: str) -> str: raise ValueError(f"property '{current_property}': {msg}") from exc if uses_partly_set and "NML_ERR_PARTLY_SET" not in helper_imports: helper_imports.append("NML_ERR_PARTLY_SET") + runtime_dimension_order = { + name: index for index, name in enumerate(runtime_dimension_values) + } + runtime_dimensions.sort( + key=lambda entry: runtime_dimension_order[str(entry["name"])] + ) required_flex_names = {entry["name"] for entry in flex_arrays if entry["required"]} required_input_names = [field.name for field in fields if field.requires_input] required_scalar_validations: list[str] = [] @@ -1635,6 +1620,125 @@ def _register_runtime_dimension(dim_name: str) -> str: seen_extent_checks.add(extent_key) set_dims_extent_checks.append({"condition": condition, "message": extent_message}) + resolved_kind_imports = _resolve_kind_imports( + kind_ids, + kind_map=kind_map, + kind_allowlist=kind_allowlist, + ) + module_scope = FortranScope(module_name, module_name=module_name) + for symbol in helper_imports: + module_scope.import_symbol(symbol, helper_module) + for symbol in resolved_kind_imports: + module_scope.import_symbol(symbol, resolved_kind_module) + if requires_ieee: + for symbol in ("ieee_value", "ieee_quiet_nan", "ieee_is_nan"): + module_scope.import_symbol(f"nml__{symbol} => {symbol}", "ieee_arithmetic") + for entry in derived_type_imports: + module_scope.import_symbol(str(entry["type_name"]), str(entry["module"])) + dependencies = module_scope.child(module_name) + module_scope.declare(module_name, category="module", identity=("module", module_name.lower()), + source=f"generated module '{module_name}'") + generated_module_symbols = [ + type_name, + data_type_name, + f"{module_name}_init", + f"{module_name}_from_file", + f"{module_name}_set", + f"{module_name}_is_set", + f"{module_name}_is_valid", + f"{module_name}_read__from_file", + ] + if runtime_dimensions: + generated_module_symbols.extend([dims_type_name, f"{module_name}_set_dims"]) + if derived_init_type_fields: + generated_module_symbols.append(f"{module_name}_init_type") + if flex_arrays: + generated_module_symbols.append(f"{module_name}_filled_shape") + if f2py_handle_helpers: + generated_module_symbols.append(f"{module_name}_resolve_handle") + for symbol_name in generated_module_symbols: + module_scope.declare( + symbol_name, category="generated", identity=("generated", symbol_name), + source=f"generated module symbol '{symbol_name}'", + ) + for constraint in enum_functions + bounds_functions: + symbol_name = str(constraint["func_name"]) + module_scope.declare( + symbol_name, category="procedure", identity=("constraint", symbol_name), + source=f"generated constraint procedure '{symbol_name}'", + ) + for declaration in default_parameters + enum_parameters + bounds_parameters: + # These declarations are produced by this generator, not parsed user source. + symbol_name = declaration.split("::", maxsplit=1)[1].strip().split("=", 1)[0] + symbol_name = symbol_name.split("(", 1)[0].strip() + module_scope.declare( + symbol_name, category="parameter", identity=("parameter", symbol_name), + source=f"generated parameter '{symbol_name}'", + ) + + # A procedure may shadow unrelated host procedures, but not the imports/type + # its declarations use or its own name. Schema-spelled reader locals also + # share a scope with the flat namelist group. + dependencies.declare(type_name, category="type", identity=("generated", type_name), + source=f"generated outer type '{type_name}'") + + def validate_procedure( + suffix: str, arguments: list[tuple[str, str]], *, reader: bool = False + ) -> None: + procedure = f"{module_name}_{suffix}" + if suffix == "resolve_handle": + scope = dependencies.child( + procedure, names={type_name.lower(), "nml_ok", "nml_err_invalid_handle"} + ) + for symbol in ("c_f_pointer", "c_intptr_t", "c_null_ptr", "c_ptr"): + scope.import_symbol(symbol, "iso_c_binding") + else: + names: set[str] | None = None + if suffix == "from_file": + names = {type_name.lower()} + elif suffix in {"set_dims", "is_set", "filled_shape"}: + # These operations do not declare schema-typed variables. + names = {type_name.lower()} | ( + dependencies.names & GENERATED_HELPER_IDENTIFIERS + ) | {name for name in dependencies.names if "__" in name} + if suffix == "set_dims": + names.update(static_constants) + scope = dependencies.child(procedure, names=names) + scope.declare(procedure, category="procedure", identity=("procedure", procedure), + source=f"generated {suffix} procedure '{procedure}'") + for state_name in ("nml__obj", "nml__status", "errmsg"): + scope.declare( + state_name, category="state", identity=("state", state_name), + source=f"generated procedure state '{state_name}'", + ) + if reader: + scope.declare(str(namelist_name), category="namelist", + identity=("group", str(namelist_name)), + source=f"namelist group '{namelist_name}'") + for name, source in arguments: + scope.declare(name, category="argument", identity=("argument", name.lower()), + source=source) + + properties_in_scope = [ + (name, f"property '{display_name}'") for name, display_name in property_name_map.items() + ] + validate_procedure("set", properties_in_scope) + validate_procedure("read__from_file", properties_in_scope, reader=True) + validate_procedure("from_file", [("file", "public dummy 'file'")]) + if f2py_handle_helpers: + validate_procedure("resolve_handle", []) + validate_procedure("is_set", [("name", "public dummy 'name'"), ("idx", "public dummy 'idx'")]) + if flex_arrays: + validate_procedure("filled_shape", [(name, f"public dummy '{name}'") + for name in ("name", "filled")]) + if derived_init_type_fields: + validate_procedure("init_type", [(entry["name"], f"property '{entry['name']}'") + for entry in derived_init_type_fields]) + if runtime_dimensions: + validate_procedure("set_dims", [(str(entry["name"]), + f"runtime dimension '{entry['name']}'") + for entry in runtime_dimensions]) + context = { "module_name": module_name, "type_name": type_name, @@ -1660,7 +1764,7 @@ def _register_runtime_dimension(dim_name: str) -> str: "required_scalar_validations": required_scalar_validations, "required_array_validations": required_array_validations, "flex_arrays": flex_arrays, - "assignments": [f"this%{field.name} = {field.name}" for field in fields], + "assignments": [f"{_data_ref(field.name)} = {field.name}" for field in fields], "argument_list": [ field.name for field in declared_required_specs + declared_optional_specs ], @@ -1687,16 +1791,13 @@ def _register_runtime_dimension(dim_name: str) -> str: "derived_init_type_fields": derived_init_type_fields, "derived_presence_blocks": derived_presence_blocks, "kind_module": resolved_kind_module, - "kind_imports": _resolve_kind_imports( - kind_ids, - kind_map=kind_map, - kind_allowlist=kind_allowlist, - ), + "kind_imports": resolved_kind_imports, "use_ieee": requires_ieee, "helper_module": helper_module, "helper_imports": helper_imports, "presence_cases": presence_cases, - "flex_bound_vars": _sort_bound_vars(flex_bound_vars), + "data_type_name": data_type_name, + "dims_type_name": dims_type_name, "f2py_handle_helpers": f2py_handle_helpers, } @@ -1739,8 +1840,8 @@ def array_prefix(lines: list[str]) -> None: if runtime_array: lines.extend( [ - f" if (.not. allocated(this%{name})) then", - " status = NML_ERR_NOT_SET", + f" if (.not. allocated({_data_ref(name)})) then", + " nml__status = NML_ERR_NOT_SET", " return", " end if", ] @@ -1754,26 +1855,28 @@ def array_prefix(lines: list[str]) -> None: lines.extend( [ " if (present(idx)) then", - f" status = idx_check(idx, lbound(this%{name}), ubound(this%{name}), &", + f" nml__status = idx__check(idx, shape({_data_ref(name)}), &", f' "{display_name}", errmsg)', - " if (status /= NML_OK) return", + " if (nml__status /= NML_OK) return", ] ) if condition is not None: indexed = str(condition).replace( - f"this%{name}%{leaf['name']}", - f"this%{name}({idx_args})%{leaf['name']}", + f"{_data_ref(name)}%{leaf['name']}", + f"{_data_ref(name)}({idx_args})%{leaf['name']}", ) - lines.append(f" if ({indexed}) status = NML_ERR_NOT_SET") + lines.append(f" if ({indexed}) nml__status = NML_ERR_NOT_SET") if condition is not None: lines.append(" else") - lines.append(f" if (all({condition})) status = NML_ERR_NOT_SET") + lines.append( + f" if (all({condition})) nml__status = NML_ERR_NOT_SET" + ) lines.append(" end if") else: lines.extend( [ " if (present(idx)) then", - " status = NML_ERR_INVALID_INDEX", + " nml__status = NML_ERR_INVALID_INDEX", " if (present(errmsg)) " f'errmsg = "index not supported for \'{display_name}\'"', " return", @@ -1781,7 +1884,7 @@ def array_prefix(lines: list[str]) -> None: ] ) if condition is not None: - lines.append(f" if ({condition}) status = NML_ERR_NOT_SET") + lines.append(f" if ({condition}) nml__status = NML_ERR_NOT_SET") blocks.append("\n".join(lines)) required_conditions = [ @@ -1796,13 +1899,13 @@ def array_prefix(lines: list[str]) -> None: lines.extend( [ " if (present(idx)) then", - f" status = idx_check(idx, lbound(this%{name}), ubound(this%{name}), &", + f" nml__status = idx__check(idx, shape({_data_ref(name)}), &", f' "{display_name}", errmsg)', - " if (status /= NML_OK) return", + " if (nml__status /= NML_OK) return", ] ) indexed_conditions = [ - condition.replace(f"this%{name}%", f"this%{name}({idx_args})%") + condition.replace(f"{_data_ref(name)}%", f"{_data_ref(name)}({idx_args})%") for condition in aggregate_conditions ] if indexed_conditions: @@ -1813,7 +1916,7 @@ def array_prefix(lines: list[str]) -> None: operator=".and.", suffix=") then", ) - lines.append(" status = NML_ERR_NOT_SET") + lines.append(" nml__status = NML_ERR_NOT_SET") if required_conditions and len(indexed_conditions) > 1: append_condition( lines, @@ -1822,7 +1925,7 @@ def array_prefix(lines: list[str]) -> None: operator=".or.", suffix=") then", ) - lines.append(" status = NML_ERR_PARTLY_SET") + lines.append(" nml__status = NML_ERR_PARTLY_SET") lines.append(" end if") if aggregate_conditions: lines.append(" else") @@ -1833,7 +1936,7 @@ def array_prefix(lines: list[str]) -> None: operator=".and.", suffix=")) then", ) - lines.append(" status = NML_ERR_NOT_SET") + lines.append(" nml__status = NML_ERR_NOT_SET") if required_conditions and (len(aggregate_conditions) > 1 or is_array): append_condition( lines, @@ -1842,15 +1945,16 @@ def array_prefix(lines: list[str]) -> None: operator=".or.", suffix=")) then", ) - lines.append(" status = NML_ERR_PARTLY_SET") + lines.append(" nml__status = NML_ERR_PARTLY_SET") lines.append(" end if") lines.append(" end if") else: lines.extend( [ " if (present(idx)) then", - " status = NML_ERR_INVALID_INDEX", - f' if (present(errmsg)) errmsg = "index not supported for \'{display_name}\'"', + " nml__status = NML_ERR_INVALID_INDEX", + " if (present(errmsg)) " + f'errmsg = "index not supported for \'{display_name}\'"', " return", " end if", ] @@ -1863,7 +1967,7 @@ def array_prefix(lines: list[str]) -> None: operator=".and.", suffix=") then", ) - lines.append(" status = NML_ERR_NOT_SET") + lines.append(" nml__status = NML_ERR_NOT_SET") if len(aggregate_conditions) > 1 and required_conditions: append_condition( lines, @@ -1872,7 +1976,7 @@ def array_prefix(lines: list[str]) -> None: operator=".or.", suffix=") then", ) - lines.append(" status = NML_ERR_PARTLY_SET") + lines.append(" nml__status = NML_ERR_PARTLY_SET") lines.append(" end if") blocks.append("\n".join(lines)) return blocks @@ -1914,6 +2018,8 @@ def _resolve_kind_imports( imports: list[str] = [] target_aliases: dict[str, str] = {} for kind_id in _ordered_unique(kind_ids): + validate_user_fortran_identifier(kind_id, label=f"kind alias '{kind_id}'") + validate_generated_fortran_identifier(kind_id, label=f"kind alias '{kind_id}'") target = kind_id if kind_map is not None and kind_id in kind_map: mapped = kind_map[kind_id] @@ -2015,6 +2121,7 @@ def _derived_type_name(schema: dict[str, Any]) -> str: raise ValueError("derived object must define non-empty 'x-fortran-type'") stripped = type_name.strip() validate_user_fortran_identifier(stripped, label="'x-fortran-type'") + validate_generated_fortran_identifier(stripped, label="'x-fortran-type'") return stripped @@ -2441,11 +2548,15 @@ def _sentinel_expressions( if element == "string": return "achar(0)", f"all({var_ref} == achar(0))", False if element == "integer": - return f"-huge({var_ref})", f"all({var_ref} == -huge({var_ref}))", False + return ( + f"-huge({var_ref})", + f"all({var_ref} == -huge({var_ref}))", + False, + ) if element == "real": return ( - f"ieee_value({var_ref}, ieee_quiet_nan)", - f"all(ieee_is_nan({var_ref}))", + f"nml__ieee_value({var_ref}, nml__ieee_quiet_nan)", + f"all(nml__ieee_is_nan({var_ref}))", True, ) if element == "boolean": @@ -2457,8 +2568,8 @@ def _sentinel_expressions( return f"-huge({var_ref})", f"{var_ref} == -huge({var_ref})", False if category == "real": return ( - f"ieee_value({var_ref}, ieee_quiet_nan)", - f"ieee_is_nan({var_ref})", + f"nml__ieee_value({var_ref}, nml__ieee_quiet_nan)", + f"nml__ieee_is_nan({var_ref})", True, ) if category == "boolean": @@ -2477,7 +2588,7 @@ def _element_missing_expression( if category == "integer": return f"{var_ref} == -huge({var_ref})", False if category == "real": - return f"ieee_is_nan({var_ref})", True + return f"nml__ieee_is_nan({var_ref})", True raise ValueError(f"unsupported missing category '{category}'") @@ -2496,69 +2607,41 @@ def _array_missing_conditions( def _slice_ref(name: str, rank: int, dim: int, index_var: str) -> str: dims = [":" for _ in range(rank)] dims[dim - 1] = index_var - return f"this%{name}({', '.join(dims)})" + return f"{_data_ref(name)}({', '.join(dims)})" -def _flex_bound_vars(dim: int) -> tuple[str, str]: - return _generated_name("lb", str(dim)), _generated_name("ub", str(dim)) - - -def _slice_ref_bounds( - name: str, - rank: int, - flex_dims: list[int], - lb_vars: dict[int, str], - ub_vars: dict[int, str], -) -> str: +def _slice_ref_filled(name: str, rank: int, flex_dims: list[int]) -> str: dims: list[str] = [] for dim in range(1, rank + 1): if dim in flex_dims: - dims.append(f"{lb_vars[dim]}:{ub_vars[dim]}") + dims.append(f"1:filled({dim})") else: dims.append(":") - return f"this%{name}({', '.join(dims)})" + return f"{_data_ref(name)}({', '.join(dims)})" -def _render_partial_set_block( - name: str, - rank: int, - bounds: list[dict[str, Any]], -) -> str: - lb_vars = {entry["dim"]: entry["lb_var"] for entry in bounds} - ub_vars = {entry["dim"]: entry["ub_var"] for entry in bounds} - dims_all = [entry["dim"] for entry in bounds] +def _render_partial_set_block(name: str, rank: int) -> str: lines: list[str] = [] - for entry in bounds: - dim = entry["dim"] - lb_var = entry["lb_var"] - ub_var = entry["ub_var"] - lines.append(f"if (size({name}, {dim}) > size(this%{name}, {dim})) then") - lines.append(" status = NML_ERR_INVALID_INDEX") + for dim in range(1, rank + 1): + lines.append( + f"if (size({name}, {dim}) > size({_data_ref(name)}, {dim})) then" + ) + lines.append(" nml__status = NML_ERR_INVALID_INDEX") lines.append( - f" if (present(errmsg)) errmsg = \"dimension {dim} exceeds bounds for '{name}'\"" + f" if (present(errmsg)) " + f"errmsg = \"dimension {dim} exceeds bounds for '{name}'\"" ) lines.append(" return") lines.append("end if") - lines.append(f"{lb_var} = lbound(this%{name}, {dim})") - lines.append(f"{ub_var} = {lb_var} + size({name}, {dim}) - 1") - target_ref = _slice_ref_bounds(name, rank, dims_all, lb_vars, ub_vars) - lines.append(f"{target_ref} = {name}") + lines.append(f"{_data_ref(name)}( &") + for dim in range(1, rank + 1): + suffix = ", &" if dim < rank else f") = {name}" + lines.append(f" 1:size({name}, {dim}){suffix}") return "\n".join(lines) -def _sort_bound_vars(values: set[str]) -> list[str]: - def sort_key(name: str) -> tuple[str, int]: - prefix, _, suffix = name.partition("__") - try: - return prefix, int(suffix) - except ValueError: - return prefix, 0 - - return sorted(values, key=sort_key) - - def _format_reshape_assignment(name: str, arguments: list[str]) -> str: - lines = [f"this%{name} = reshape( &"] + lines = [f"{_data_ref(name)} = reshape( &"] for index, arg in enumerate(arguments): suffix = ", &" if index < len(arguments) - 1 else ")" lines.append(f" {arg}{suffix}") diff --git a/src/nml_tools/schema.py b/src/nml_tools/schema.py index e01f337..42454d4 100644 --- a/src/nml_tools/schema.py +++ b/src/nml_tools/schema.py @@ -14,7 +14,12 @@ import yaml -from ._utils import validate_user_fortran_identifier +from ._utils import ( + validate_derived_component_identifier, + validate_generated_fortran_identifier, + validate_namelist_identifier, + validate_user_fortran_identifier, +) _DRAFT_2020_12 = "https://json-schema.org/draft/2020-12/schema" _DOCUMENT_SUFFIXES = {".json", ".yml", ".yaml"} @@ -237,6 +242,9 @@ def _resolve_node( "define 'x-fortran-type' inline or use '$ref'" ) _validate_effective_node(result, position=position) + if position == "root": + # Root references can supply the group and properties separately. + _validate_user_identifiers(result, document, pointer) return result def _resolve_plain( @@ -257,7 +265,13 @@ def _resolve_plain( if not isinstance(properties, Mapping): raise ValueError(f"{_location(document, pointer)}: 'properties' must be an object") resolved["properties"] = { - name: self._resolve_property_value(value, document, pointer, name) + name: self._resolve_property_value( + value, + document, + pointer, + name, + root_property=position == "root", + ) for name, value in properties.items() } if "items" in raw: @@ -278,11 +292,16 @@ def _resolve_property_value( document: _Document, pointer: str, name: Any, + *, + root_property: bool, ) -> dict[str, Any]: if not isinstance(name, str): raise ValueError(f"{_location(document, pointer)}: property names must be strings") try: - validate_user_fortran_identifier(name, label=f"property '{name}'") + if root_property: + validate_namelist_identifier(name, label=f"property '{name}'") + else: + validate_derived_component_identifier(name, label=f"property '{name}'") except ValueError as exc: raise ValueError(f"{_location(document, pointer)}: {exc}") from exc if not isinstance(value, Mapping): @@ -451,7 +470,7 @@ def _validate_user_identifiers(raw: Any, document: _Document, pointer: str) -> N "Fortran identifier" ) try: - validate_user_fortran_identifier(namelist_name, label="'x-fortran-namelist'") + validate_namelist_identifier(namelist_name, label="'x-fortran-namelist'") except ValueError as exc: raise ValueError(f"{_location(document, pointer)}: {exc}") from exc type_name = raw.get("x-fortran-type") @@ -463,6 +482,9 @@ def _validate_user_identifiers(raw: Any, document: _Document, pointer: str) -> N ) try: validate_user_fortran_identifier(type_name.strip(), label="'x-fortran-type'") + validate_generated_fortran_identifier( + type_name.strip(), label="'x-fortran-type'" + ) except ValueError as exc: raise ValueError(f"{_location(document, pointer)}: {exc}") from exc module_name = raw.get("x-fortran-module") @@ -491,7 +513,17 @@ def _validate_user_identifiers(raw: Any, document: _Document, pointer: str) -> N "property names must be strings" ) try: - validate_user_fortran_identifier(name, label=f"property '{name}'") + if namelist_name is not None: + validate_namelist_identifier(name, label=f"property '{name}'") + if name.lower() == namelist_name.lower(): + raise ValueError( + f"property '{name}' conflicts with " + f"namelist group '{namelist_name}'" + ) + else: + validate_derived_component_identifier( + name, label=f"property '{name}'" + ) except ValueError as exc: raise ValueError( f"{_location(document, child_pointer)}: {exc}" @@ -820,6 +852,7 @@ def _validate_derived_object(schema: Mapping[str, Any]) -> None: if not isinstance(type_name, str) or not type_name.strip(): raise ValueError("derived-type object must define non-empty 'x-fortran-type'") validate_user_fortran_identifier(type_name.strip(), label="'x-fortran-type'") + validate_generated_fortran_identifier(type_name.strip(), label="'x-fortran-type'") module_name = schema.get("x-fortran-module") if module_name is not None: if not isinstance(module_name, str): @@ -832,7 +865,7 @@ def _validate_derived_object(schema: Mapping[str, Any]) -> None: for name, prop in properties.items(): if not isinstance(name, str): raise ValueError("derived-type component names must be strings") - validate_user_fortran_identifier(name, label=f"derived-type component '{name}'") + validate_derived_component_identifier(name, label=f"derived-type component '{name}'") key = name.lower() if key in canonical: raise ValueError(f"derived-type object defines duplicate component '{name}'") diff --git a/src/nml_tools/templates/f2py_wrappers.f90.j2 b/src/nml_tools/templates/f2py_wrappers.f90.j2 index 6cd7e67..95a06c8 100644 --- a/src/nml_tools/templates/f2py_wrappers.f90.j2 +++ b/src/nml_tools/templates/f2py_wrappers.f90.j2 @@ -26,122 +26,122 @@ module {{ spec.f2py_module_name }} contains !> \brief Read the {{ spec.namelist_name }} namelist from a file - subroutine {{ spec.namelist_name }}_from_file_wrapper(handle, file, status, errmsg) - integer(c_intptr_t), intent(in) :: handle !< opaque handle to a {{ spec.type_name }} instance + subroutine {{ spec.namelist_name }}_from_file_wrapper(nml__handle, file, nml__status, nml__errmsg) + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a {{ spec.type_name }} instance character(len=*), intent(in) :: file !< namelist file path - integer, intent(out) :: status !< nml-tools status code - character(len={{ spec.errmsg_len }}), intent(out) :: errmsg !< error message for non-OK status values - type({{ spec.type_name }}), pointer :: this + integer, intent(out) :: nml__status !< nml-tools status code + character(len={{ spec.errmsg_len }}), intent(out) :: nml__errmsg !< error message for non-OK status values + type({{ spec.type_name }}), pointer :: nml__obj - call {{ spec.resolve_handle_name }}(handle, this, status, errmsg) - if (.not. associated(this)) then + call {{ spec.resolve_handle_name }}(nml__handle, nml__obj, nml__status, nml__errmsg) + if (.not. associated(nml__obj)) then return end if - status = this%from_file(file, errmsg=errmsg) + nml__status = nml__obj%from_file(file, errmsg=nml__errmsg) end subroutine {{ spec.namelist_name }}_from_file_wrapper !> \brief Set {{ spec.namelist_name }} values on the handled instance - subroutine {{ spec.namelist_name }}_set_wrapper(handle, & + subroutine {{ spec.namelist_name }}_set_wrapper(nml__handle, & {% if spec.argument_list %} {{ spec.argument_list | join(', &\n ') }}, & {% endif %} - status, errmsg) - integer(c_intptr_t), intent(in) :: handle !< opaque handle to a {{ spec.type_name }} instance + nml__status, nml__errmsg) + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a {{ spec.type_name }} instance {% for decl in spec.argument_declarations %} {{ decl | indent(4, True) }} {% endfor %} - integer, intent(out) :: status !< nml-tools status code - character(len={{ spec.errmsg_len }}), intent(out) :: errmsg !< error message for non-OK status values - type({{ spec.type_name }}), pointer :: this + integer, intent(out) :: nml__status !< nml-tools status code + character(len={{ spec.errmsg_len }}), intent(out) :: nml__errmsg !< error message for non-OK status values + type({{ spec.type_name }}), pointer :: nml__obj {% for decl in spec.bridge_declarations %} {{ decl | indent(4, True) }} {% endfor %} - call {{ spec.resolve_handle_name }}(handle, this, status, errmsg) - if (.not. associated(this)) then + call {{ spec.resolve_handle_name }}(nml__handle, nml__obj, nml__status, nml__errmsg) + if (.not. associated(nml__obj)) then return end if {% for stmt in spec.bridge_assignments %} {{ stmt | indent(4, True) }} {% endfor %} {% if spec.argument_list %} - status = this%set( & + nml__status = nml__obj%set( & {% for arg in spec.set_call_arguments %} {{ arg }}, & {% endfor %} - errmsg=errmsg) + errmsg=nml__errmsg) {% else %} - status = this%set(errmsg=errmsg) + nml__status = nml__obj%set(errmsg=nml__errmsg) {% endif %} end subroutine {{ spec.namelist_name }}_set_wrapper {% if spec.set_dims_argument_list %} !> \brief Set runtime dimensions on the handled {{ spec.namelist_name }} instance - subroutine {{ spec.namelist_name }}_set_dims_wrapper(handle, & + subroutine {{ spec.namelist_name }}_set_dims_wrapper(nml__handle, & {{ spec.set_dims_argument_list | join(', &\n ') }}, & - status, errmsg) - integer(c_intptr_t), intent(in) :: handle !< opaque handle to a {{ spec.type_name }} instance + nml__status, nml__errmsg) + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a {{ spec.type_name }} instance {% for decl in spec.set_dims_argument_declarations %} {{ decl | indent(4, True) }} {% endfor %} - integer, intent(out) :: status !< nml-tools status code - character(len={{ spec.errmsg_len }}), intent(out) :: errmsg !< error message for non-OK status values - type({{ spec.type_name }}), pointer :: this + integer, intent(out) :: nml__status !< nml-tools status code + character(len={{ spec.errmsg_len }}), intent(out) :: nml__errmsg !< error message for non-OK status values + type({{ spec.type_name }}), pointer :: nml__obj {% for decl in spec.set_dims_bridge_declarations %} {{ decl | indent(4, True) }} {% endfor %} - call {{ spec.resolve_handle_name }}(handle, this, status, errmsg) - if (.not. associated(this)) then + call {{ spec.resolve_handle_name }}(nml__handle, nml__obj, nml__status, nml__errmsg) + if (.not. associated(nml__obj)) then return end if {% for stmt in spec.set_dims_bridge_assignments %} {{ stmt | indent(4, True) }} {% endfor %} - status = this%set_dims( & + nml__status = nml__obj%set_dims( & {% for arg in spec.set_dims_call_arguments %} {{ arg }}, & {% endfor %} - errmsg=errmsg) + errmsg=nml__errmsg) end subroutine {{ spec.namelist_name }}_set_dims_wrapper {% endif %} !> \brief Check whether a {{ spec.namelist_name }} field is set - subroutine {{ spec.namelist_name }}_is_set_wrapper(handle, name, idx__n1, idx, has__idx, status, errmsg) - integer(c_intptr_t), intent(in) :: handle !< opaque handle to a {{ spec.type_name }} instance + subroutine {{ spec.namelist_name }}_is_set_wrapper(nml__handle, name, idx__n1, idx, has__idx, nml__status, nml__errmsg) + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a {{ spec.type_name }} instance character(len=*), intent(in) :: name !< field name integer, intent(in) :: idx__n1 !< extent for idx integer, dimension(idx__n1), intent(in) :: idx !< optional field index values logical, intent(in) :: has__idx !< whether idx was provided - integer, intent(out) :: status !< nml-tools status code - character(len={{ spec.errmsg_len }}), intent(out) :: errmsg !< error message for non-OK status values - type({{ spec.type_name }}), pointer :: this + integer, intent(out) :: nml__status !< nml-tools status code + character(len={{ spec.errmsg_len }}), intent(out) :: nml__errmsg !< error message for non-OK status values + type({{ spec.type_name }}), pointer :: nml__obj integer, dimension(:), allocatable :: maybe__idx - call {{ spec.resolve_handle_name }}(handle, this, status, errmsg) - if (.not. associated(this)) then + call {{ spec.resolve_handle_name }}(nml__handle, nml__obj, nml__status, nml__errmsg) + if (.not. associated(nml__obj)) then return end if if (has__idx) then allocate(maybe__idx(idx__n1)) maybe__idx = idx end if - status = this%is_set(name, idx=maybe__idx, errmsg=errmsg) + nml__status = nml__obj%is_set(name, idx=maybe__idx, errmsg=nml__errmsg) end subroutine {{ spec.namelist_name }}_is_set_wrapper !> \brief Validate the handled {{ spec.namelist_name }} instance - subroutine {{ spec.namelist_name }}_is_valid_wrapper(handle, status, errmsg) - integer(c_intptr_t), intent(in) :: handle !< opaque handle to a {{ spec.type_name }} instance - integer, intent(out) :: status !< nml-tools status code - character(len={{ spec.errmsg_len }}), intent(out) :: errmsg !< error message for non-OK status values - type({{ spec.type_name }}), pointer :: this - - call {{ spec.resolve_handle_name }}(handle, this, status, errmsg) - if (.not. associated(this)) then + subroutine {{ spec.namelist_name }}_is_valid_wrapper(nml__handle, nml__status, nml__errmsg) + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a {{ spec.type_name }} instance + integer, intent(out) :: nml__status !< nml-tools status code + character(len={{ spec.errmsg_len }}), intent(out) :: nml__errmsg !< error message for non-OK status values + type({{ spec.type_name }}), pointer :: nml__obj + + call {{ spec.resolve_handle_name }}(nml__handle, nml__obj, nml__status, nml__errmsg) + if (.not. associated(nml__obj)) then return end if - status = this%is_valid(errmsg=errmsg) + nml__status = nml__obj%is_valid(errmsg=nml__errmsg) end subroutine {{ spec.namelist_name }}_is_valid_wrapper end module {{ spec.f2py_module_name }} diff --git a/src/nml_tools/templates/fortran_module.f90.j2 b/src/nml_tools/templates/fortran_module.f90.j2 index 7a83f64..24980de 100644 --- a/src/nml_tools/templates/fortran_module.f90.j2 +++ b/src/nml_tools/templates/fortran_module.f90.j2 @@ -10,7 +10,8 @@ module {{ module_name }} use {{ helper_module }}, only: & {{ helper_imports | join(', &\n ') }} {% if use_ieee %} - use ieee_arithmetic, only: ieee_value, ieee_quiet_nan, ieee_is_nan + use ieee_arithmetic, only: nml__ieee_value => ieee_value, & + nml__ieee_quiet_nan => ieee_quiet_nan, nml__ieee_is_nan => ieee_is_nan {% endif %} {% if kind_imports %} ! kind specifiers listed in the nml-tools configuration file @@ -20,9 +21,6 @@ module {{ module_name }} {% for imported in derived_type_imports %} use {{ imported.module }}, only: {{ imported.type_name }} {% endfor %} -{% if f2py_handle_helpers %} - use iso_c_binding, only: c_f_pointer, c_intptr_t, c_null_ptr, c_ptr -{% endif %} implicit none @@ -46,20 +44,36 @@ module {{ module_name }} {{ stmt }} {% endfor %} +{% endif %} + private :: {{ type_prefix }}_read__from_file + + !> \class {{ data_type_name }} + !> \brief Schema-backed values for {{ namelist_name }} + type, public :: {{ data_type_name }} +{% for field in fields %} +{{ field.declaration | indent(4, True) }} +{% endfor %} + end type {{ data_type_name }} + +{% if runtime_dimensions %} + !> \class {{ dims_type_name }} + !> \brief Runtime dimensions for {{ namelist_name }} + type, public :: {{ dims_type_name }} +{% for entry in runtime_dimensions %} + integer :: {{ entry.local_name }} = {{ entry.default_name }} !< runtime dimension for {{ entry.name }} +{% endfor %} + end type {{ dims_type_name }} + {% endif %} !> \class {{ doc_class }} !> \brief {{ brief_text }} !> \details {{ details_text | replace('\n', '\n !! ') }} type, public :: {{ type_name }} - logical :: is_configured = .false. !< whether the namelist has been configured + type({{ data_type_name }}) :: data !< schema-backed namelist values {% if runtime_dimensions %} -{% for entry in runtime_dimensions %} - integer :: {{ entry.local_name }} = {{ entry.default_name }} !< runtime dimension for {{ entry.name }} -{% endfor %} + type({{ dims_type_name }}) :: dims !< runtime array dimensions {% endif %} -{% for field in fields %} -{{ field.declaration | indent(4, True) }} -{% endfor %} + logical :: is_configured = .false. !< whether the namelist has been configured contains procedure :: init => {{ type_prefix }}_init {% if derived_init_type_fields %} @@ -82,22 +96,22 @@ contains {% if enum_functions %} {% for enum in enum_functions %} !> \brief Check whether a value is part of an enum - elemental logical function {{ enum.func_name }}(val, allow_missing) result(in_enum) - {{ enum.arg_type_spec }}, intent(in) :: val !< value to check - logical, intent(in), optional :: allow_missing !< allow sentinel values as valid + elemental logical function {{ enum.func_name }}(nml__val, nml__allow_missing) result(nml__in_enum) + {{ enum.arg_type_spec }}, intent(in) :: nml__val !< value to check + logical, intent(in), optional :: nml__allow_missing !< allow sentinel values as valid - if (present(allow_missing)) then - if (allow_missing) then + if (present(nml__allow_missing)) then + if (nml__allow_missing) then if ({{ enum.missing_condition }}) then - in_enum = .true. + nml__in_enum = .true. return end if end if end if {% if enum.use_trim %} - in_enum = any(trim(val) == {{ enum.enum_values_name }}) + nml__in_enum = any(trim(nml__val) == {{ enum.enum_values_name }}) {% else %} - in_enum = any(val == {{ enum.enum_values_name }}) + nml__in_enum = any(nml__val == {{ enum.enum_values_name }}) {% endif %} end function {{ enum.func_name }} @@ -106,25 +120,25 @@ contains {% if bounds_functions %} {% for bounds in bounds_functions %} !> \brief Check whether a value is within bounds - elemental logical function {{ bounds.func_name }}(val, allow_missing) result(in_bounds) - {{ bounds.arg_type_spec }}, intent(in) :: val !< value to check - logical, intent(in), optional :: allow_missing !< allow sentinel values as valid + elemental logical function {{ bounds.func_name }}(nml__val, nml__allow_missing) result(nml__in_bounds) + {{ bounds.arg_type_spec }}, intent(in) :: nml__val !< value to check + logical, intent(in), optional :: nml__allow_missing !< allow sentinel values as valid - if (present(allow_missing)) then - if (allow_missing) then + if (present(nml__allow_missing)) then + if (nml__allow_missing) then if ({{ bounds.missing_condition }}) then - in_bounds = .true. + nml__in_bounds = .true. return end if end if end if - in_bounds = .true. + nml__in_bounds = .true. {% if bounds.has_min %} - if (val {% if bounds.min_exclusive %}<={% else %}<{% endif %} {{ bounds.min_name }}) in_bounds = .false. + if (nml__val {% if bounds.min_exclusive %}<={% else %}<{% endif %} {{ bounds.min_name }}) nml__in_bounds = .false. {% endif %} {% if bounds.has_max %} - if (val {% if bounds.max_exclusive %}>={% else %}>{% endif %} {{ bounds.max_name }}) in_bounds = .false. + if (nml__val {% if bounds.max_exclusive %}>={% else %}>{% endif %} {{ bounds.max_name }}) nml__in_bounds = .false. {% endif %} end function {{ bounds.func_name }} @@ -132,34 +146,35 @@ contains {% endif %} {% if f2py_handle_helpers %} !> \brief Resolve an opaque C pointer handle to a {{ type_name }} pointer - subroutine {{ type_prefix }}_resolve_handle(handle, this, status, errmsg) - integer(c_intptr_t), intent(in) :: handle !< opaque handle to a {{ type_name }} instance - type({{ type_name }}), pointer :: this !< resolved namelist pointer - integer, intent(out) :: status !< nml-tools status code + subroutine {{ type_prefix }}_resolve_handle(nml__handle, nml__obj, nml__status, errmsg) + use iso_c_binding, only: c_f_pointer, c_intptr_t, c_null_ptr, c_ptr + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a {{ type_name }} instance + type({{ type_name }}), pointer :: nml__obj !< resolved namelist pointer + integer, intent(out) :: nml__status !< nml-tools status code character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - type(c_ptr) :: ptr + type(c_ptr) :: nml__ptr if (present(errmsg)) errmsg = "" - nullify(this) - if (handle == 0_c_intptr_t) then - status = NML_ERR_INVALID_HANDLE + nullify(nml__obj) + if (nml__handle == 0_c_intptr_t) then + nml__status = NML_ERR_INVALID_HANDLE if (present(errmsg)) errmsg = "zero handle" return end if - ptr = transfer(handle, c_null_ptr) - call c_f_pointer(ptr, this) - status = NML_OK + nml__ptr = transfer(nml__handle, c_null_ptr) + call c_f_pointer(nml__ptr, nml__obj) + nml__status = NML_OK end subroutine {{ type_prefix }}_resolve_handle {% endif %} !> \brief Initialize defaults and sentinels for {{ namelist_name }} - integer function {{ type_prefix }}_init(this, errmsg) result(status) - class({{ type_name }}), intent(inout) :: this !< namelist instance + integer function {{ type_prefix }}_init(nml__obj, errmsg) result(nml__status) + class({{ type_name }}), intent(inout) :: nml__obj !< namelist instance character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - this%is_configured = .false. + nml__obj%is_configured = .false. {% if runtime_allocations %} ! allocate runtime-sized fields @@ -188,27 +203,27 @@ contains {% endif %} ! derived values - status = this%init_type( & + nml__status = nml__obj%init_type( & {% for field in derived_init_type_fields %} - {{ field.name }}=this%{{ field.name }}, & + {{ field.name }}=nml__obj%data%{{ field.name }}, & {% endfor %} errmsg=errmsg) - if (status /= NML_OK) return + if (nml__status /= NML_OK) return {% endif %} end function {{ type_prefix }}_init {% if derived_init_type_fields %} !> \brief Initialize derived values with their field-specific defaults - integer function {{ type_prefix }}_init_type(this, & + integer function {{ type_prefix }}_init_type(nml__obj, & {{ derived_init_type_fields | map(attribute='name') | join(', &\n ') }}, & - errmsg) result(status) - class({{ type_name }}), intent(in) :: this !< parent namelist instance + errmsg) result(nml__status) + class({{ type_name }}), intent(in) :: nml__obj !< parent namelist instance {% for field in derived_init_type_fields %} {{ field.declaration | indent(4, True) }} {% endfor %} character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" {% for field in derived_init_type_fields %} if (present({{ field.name }})) then @@ -226,13 +241,13 @@ contains {% if runtime_dimensions %} !> \brief Reset runtime dimensions for {{ namelist_name }} {% if set_dims_arguments %} - integer function {{ type_prefix }}_set_dims(this, & + integer function {{ type_prefix }}_set_dims(nml__obj, & {{ set_dims_arguments | map(attribute='arg_name') | join(', &\n ') }}, & - errmsg) result(status) + errmsg) result(nml__status) {% else %} - integer function {{ type_prefix }}_set_dims(this, errmsg) result(status) + integer function {{ type_prefix }}_set_dims(nml__obj, errmsg) result(nml__status) {% endif %} - class({{ type_name }}), intent(inout) :: this !< namelist instance + class({{ type_name }}), intent(inout) :: nml__obj !< namelist instance {% for entry in set_dims_arguments %} integer, intent(in), optional :: {{ entry.arg_name }} !< runtime dimension override for {{ entry.name }} {% endfor %} @@ -241,7 +256,7 @@ contains {% endfor %} character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" {% for entry in set_dims_arguments %} if (present({{ entry.arg_name }})) then @@ -250,13 +265,13 @@ contains {{ entry.candidate_name }} = {{ entry.default_name }} end if if ({{ entry.candidate_name }} <= 0) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "dimension '{{ entry.name }}' must be positive" return end if {% if entry.min_required > 1 %} if ({{ entry.candidate_name }} < {{ entry.min_required }}) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "dimension '{{ entry.name }}' must be >= {{ entry.min_required }}" return end if @@ -264,13 +279,13 @@ contains {% endfor %} {% for check in set_dims_extent_checks %} if ({{ check.condition }}) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "{{ check.message }}" return end if {% endfor %} {% for entry in set_dims_arguments %} - this%{{ entry.local_name }} = {{ entry.candidate_name }} + nml__obj%dims%{{ entry.local_name }} = {{ entry.candidate_name }} {% endfor %} {% if runtime_deallocations %} @@ -279,31 +294,40 @@ contains {{ stmt | indent(4, True) }} {% endfor %} {% endif %} - this%is_configured = .false. + nml__obj%is_configured = .false. end function {{ type_prefix }}_set_dims {% endif %} !> \brief Read {{ namelist_name }} namelist from file - integer function {{ type_prefix }}_from_file(this, file, errmsg) result(status) - class({{ type_name }}), intent(inout) :: this !< namelist instance + integer function {{ type_prefix }}_from_file(nml__obj, file, errmsg) result(nml__status) + class({{ type_name }}), intent(inout) :: nml__obj !< namelist instance character(len=*), intent(in) :: file !< path to namelist file character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + + nml__status = {{ type_prefix }}_read__from_file(nml__obj, file, errmsg) + end function {{ type_prefix }}_from_file + + integer function {{ type_prefix }}_read__from_file(nml__obj, nml__file, errmsg) & + result(nml__status) + class({{ type_name }}), intent(inout) :: nml__obj + character(len=*), intent(in) :: nml__file + character(len=*), intent(out), optional :: errmsg ! namelist variables {% for field in fields %} {{ field.local_declaration | indent(4, True) }} {% endfor %} ! locals - type(nml_file_t) :: nml - integer :: iostat - integer :: close_status - character(len=nml_line_buffer) :: iomsg + type(nml_file_t) :: nml__reader + integer :: nml__iostat + integer :: nml__close_status + character(len=nml_line_buffer) :: nml__iomsg namelist /{{ namelist_name }}/ & {{ namelist_vars | join(', &\n ') }} - status = this%init(errmsg=errmsg) - if (status /= NML_OK) return + nml__status = nml__obj%init(errmsg=errmsg) + if (nml__status /= NML_OK) return {% if runtime_local_allocations %} ! allocate local namelist variables matching runtime-sized fields {% for stmt in runtime_local_allocations %} @@ -314,38 +338,38 @@ contains {{ stmt | indent(4, True) }} {% endfor %} - status = nml%open(file, errmsg=errmsg) - if (status /= NML_OK) return + nml__status = nml__reader%open(nml__file, errmsg=errmsg) + if (nml__status /= NML_OK) return - status = nml%find("{{ namelist_name }}", errmsg=errmsg) - if (status /= NML_OK) then + nml__status = nml__reader%find("{{ namelist_name }}", errmsg=errmsg) + if (nml__status /= NML_OK) then {% if allow_missing_namelist %} - if (status == NML_ERR_NML_NOT_FOUND) then - close_status = nml%close(errmsg=errmsg) - if (close_status /= NML_OK) then - status = close_status + if (nml__status == NML_ERR_NML_NOT_FOUND) then + nml__close_status = nml__reader%close(errmsg=errmsg) + if (nml__close_status /= NML_OK) then + nml__status = nml__close_status return end if - this%is_configured = .true. - status = NML_OK + nml__obj%is_configured = .true. + nml__status = NML_OK return end if {% endif %} - close_status = nml%close() + nml__close_status = nml__reader%close() return end if ! read namelist - read(nml%unit, nml={{ namelist_name }}, iostat=iostat, iomsg=iomsg) - if (iostat /= 0) then - status = NML_ERR_READ - if (present(errmsg)) errmsg = trim(iomsg) - close_status = nml%close() + read(nml__reader%unit, nml={{ namelist_name }}, iostat=nml__iostat, iomsg=nml__iomsg) + if (nml__iostat /= 0) then + nml__status = NML_ERR_READ + if (present(errmsg)) errmsg = trim(nml__iomsg) + nml__close_status = nml__reader%close() return end if - close_status = nml%close(errmsg=errmsg) - if (close_status /= NML_OK) then - status = close_status + nml__close_status = nml__reader%close(errmsg=errmsg) + if (nml__close_status /= NML_OK) then + nml__status = nml__close_status return end if @@ -355,20 +379,20 @@ contains {% endfor %} ! mark as configured - this%is_configured = .true. - status = NML_OK - end function {{ type_prefix }}_from_file + nml__obj%is_configured = .true. + nml__status = NML_OK + end function {{ type_prefix }}_read__from_file !> \brief Set {{ namelist_name }} values {% if argument_list %} - integer function {{ type_prefix }}_set(this, & + integer function {{ type_prefix }}_set(nml__obj, & {{ argument_list | join(', &\n ') }}, & - errmsg) result(status) + errmsg) result(nml__status) {% else %} - integer function {{ type_prefix }}_set(this, errmsg) result(status) + integer function {{ type_prefix }}_set(nml__obj, errmsg) result(nml__status) {% endif %} - class({{ type_name }}), intent(inout) :: this !< namelist instance + class({{ type_name }}), intent(inout) :: nml__obj !< namelist instance character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values {% for decl in required_argument_declarations %} {{ decl | indent(4, True) }} @@ -376,13 +400,8 @@ contains {% for decl in optional_argument_declarations %} {{ decl | indent(4, True) }} {% endfor %} -{% if flex_bound_vars %} - integer :: & - {{ flex_bound_vars | join(', &\n ') }} -{% endif %} - - status = this%init(errmsg=errmsg) - if (status /= NML_OK) return + nml__status = nml__obj%init(errmsg=errmsg) + if (nml__status /= NML_OK) return ! required parameters {% for stmt in set_required_assignments %} @@ -396,54 +415,54 @@ contains {% endif %} ! mark as configured - this%is_configured = .true. - status = NML_OK + nml__obj%is_configured = .true. + nml__status = NML_OK end function {{ type_prefix }}_set !> \brief Check whether a namelist value was set - integer function {{ type_prefix }}_is_set(this, name, idx, errmsg) result(status) - class({{ type_name }}), intent(in) :: this !< namelist instance + integer function {{ type_prefix }}_is_set(nml__obj, name, idx, errmsg) result(nml__status) + class({{ type_name }}), intent(in) :: nml__obj !< namelist instance character(len=*), intent(in) :: name !< field name integer, intent(in), optional :: idx(:) !< optional field index values character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(trim(name))) + select case (to__lower(trim(name))) {% for case in presence_cases %} case ("{{ case.name }}") {% if case.is_array %} {% if case.runtime_array %} - if (.not. allocated(this%{{ case.name }})) then - status = NML_ERR_NOT_SET + if (.not. allocated(nml__obj%data%{{ case.name }})) then + nml__status = NML_ERR_NOT_SET return end if {% endif %} if (present(idx)) then - status = idx_check(idx, lbound(this%{{ case.name }}), ubound(this%{{ case.name }}), & + nml__status = idx__check(idx, shape(nml__obj%data%{{ case.name }}), & "{{ case.display_name }}", errmsg) - if (status /= NML_OK) return + if (nml__status /= NML_OK) return {% if not case.always_true %} - if ({{ case.element_condition }}) status = NML_ERR_NOT_SET + if ({{ case.element_condition }}) nml__status = NML_ERR_NOT_SET {% endif %} else {% if not case.always_true %} - if ({{ case.sentinel_condition }}) status = NML_ERR_NOT_SET + if ({{ case.sentinel_condition }}) nml__status = NML_ERR_NOT_SET {% endif %} end if {% else %} if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for '{{ case.display_name }}'" return end if {% if not case.always_true %} - if ({{ case.sentinel_condition }}) status = NML_ERR_NOT_SET + if ({{ case.sentinel_condition }}) nml__status = NML_ERR_NOT_SET {% endif %} {% endif %} {% endfor %} @@ -451,89 +470,80 @@ contains {{ block | indent(4, True) }} {% endfor %} case default - status = NML_ERR_INVALID_NAME + nml__status = NML_ERR_INVALID_NAME if (present(errmsg)) errmsg = "unknown field: " // trim(name) end select - if (status == NML_ERR_NOT_SET .and. present(errmsg)) then + if (nml__status == NML_ERR_NOT_SET .and. present(errmsg)) then if (len_trim(errmsg) == 0) errmsg = "field not set: " // trim(name) end if end function {{ type_prefix }}_is_set {% if flex_arrays %} !> \brief Determine the filled shape along flexible dimensions - integer function {{ type_prefix }}_filled_shape(this, name, filled, errmsg) result(status) - class({{ type_name }}), intent(in) :: this !< namelist instance + integer function {{ type_prefix }}_filled_shape(nml__obj, name, filled, errmsg) result(nml__status) + class({{ type_name }}), intent(in) :: nml__obj !< namelist instance character(len=*), intent(in) :: name !< field name integer, intent(out) :: filled(:) !< filled shape of the requested field character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - integer :: idx - integer :: dim -{% if flex_bound_vars %} - integer :: & - {{ flex_bound_vars | join(', &\n ') }} -{% endif %} + integer :: nml__idx + integer :: nml__dim - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - select case (to_lower(trim(name))) + select case (to__lower(trim(name))) {% for flex in flex_arrays %} case ("{{ flex.name }}") if (size(filled) /= {{ flex.rank }}) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "shape rank mismatch for '{{ flex.display_name }}'" return end if {% if flex.runtime_array %} - if (.not. allocated(this%{{ flex.name }})) then + if (.not. allocated(nml__obj%data%{{ flex.name }})) then filled = 0 return end if {% endif %} - do dim = 1, {{ flex.rank }} - filled(dim) = size(this%{{ flex.name }}, dim) + do nml__dim = 1, {{ flex.rank }} + filled(nml__dim) = size(nml__obj%data%{{ flex.name }}, nml__dim) end do {% for dim in flex.flex_dims %} filled({{ dim }}) = 0 - do idx = ubound(this%{{ flex.name }}, {{ dim }}), & - lbound(this%{{ flex.name }}, {{ dim }}), -1 + do nml__idx = size(nml__obj%data%{{ flex.name }}, {{ dim }}), 1, -1 if (.not. ({{ flex.slice_missing_conditions[loop.index0] }})) then - filled({{ dim }}) = idx - lbound(this%{{ flex.name }}, {{ dim }}) + 1 + filled({{ dim }}) = nml__idx exit end if end do {% endfor %} if (minval(filled) > 0) then -{% for bound in flex.bounds %} - {{ bound.lb_var }} = lbound(this%{{ flex.name }}, {{ bound.dim }}) - {{ bound.ub_var }} = {{ bound.lb_var }} + filled({{ bound.dim }}) - 1 -{% endfor %} if ({{ flex.prefix_any_missing_condition }}) then - status = NML_ERR_PARTLY_SET + nml__status = NML_ERR_PARTLY_SET if (present(errmsg)) errmsg = "array partly set: {{ flex.display_name }}" return end if end if {% endfor %} case default - status = NML_ERR_INVALID_NAME + nml__status = NML_ERR_INVALID_NAME if (present(errmsg)) errmsg = "field is not a flexible array: " // trim(name) end select end function {{ type_prefix }}_filled_shape {% endif %} !> \brief Validate required values and constraints - integer function {{ type_prefix }}_is_valid(this, errmsg) result(status) - class({{ type_name }}), intent(in) :: this !< namelist instance + integer function {{ type_prefix }}_is_valid(nml__obj, errmsg) result(nml__status) + class({{ type_name }}), intent(in) :: nml__obj !< namelist instance character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - integer :: istat + integer :: nml__istat {% if flex_arrays %} - integer, allocatable :: filled(:) + integer, allocatable :: nml__filled(:) {% endif %} - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if @@ -541,9 +551,9 @@ contains {% if required_scalar_validations %} ! required parameters {% for name in required_scalar_validations %} - istat = this%is_set("{{ name }}", errmsg=errmsg) - if (istat == NML_ERR_NOT_SET) then - status = NML_ERR_REQUIRED + nml__istat = nml__obj%is_set("{{ name }}", errmsg=errmsg) + if (nml__istat == NML_ERR_NOT_SET) then + nml__status = NML_ERR_REQUIRED if (present(errmsg)) then if (len_trim(errmsg) == 0) then errmsg = "field not set: {{ name }}" @@ -552,8 +562,8 @@ contains end if return end if - if (istat /= NML_OK) then - status = istat + if (nml__istat /= NML_OK) then + nml__status = nml__istat return end if {% endfor %} @@ -562,19 +572,19 @@ contains ! required arrays {% for entry in required_array_validations %} {% if entry.runtime_array %} - if (.not. allocated(this%{{ entry.attr_name }})) then - status = NML_ERR_REQUIRED + if (.not. allocated(nml__obj%data%{{ entry.attr_name }})) then + nml__status = NML_ERR_REQUIRED if (present(errmsg)) errmsg = "required field not set: {{ entry.name }}" return end if {% endif %} if ({{ entry.all_missing_condition }}) then - status = NML_ERR_REQUIRED + nml__status = NML_ERR_REQUIRED if (present(errmsg)) errmsg = "required field not set: {{ entry.name }}" return end if if ({{ entry.any_missing_condition }}) then - status = NML_ERR_PARTLY_SET + nml__status = NML_ERR_PARTLY_SET if (present(errmsg)) errmsg = "array partly set: {{ entry.name }}" return end if @@ -583,23 +593,24 @@ contains {% if flex_arrays %} ! flexible arrays {% for entry in flex_arrays %} - if (allocated(filled)) deallocate(filled) - allocate(filled({{ entry.rank }})) - istat = this%filled_shape("{{ entry.display_name }}", filled, errmsg=errmsg) - if (istat == NML_ERR_PARTLY_SET) then - status = istat + if (allocated(nml__filled)) deallocate(nml__filled) + allocate(nml__filled({{ entry.rank }})) + nml__istat = nml__obj%filled_shape( & + "{{ entry.display_name }}", nml__filled, errmsg=errmsg) + if (nml__istat == NML_ERR_PARTLY_SET) then + nml__status = nml__istat if (present(errmsg)) then if (len_trim(errmsg) == 0) errmsg = "array partly set: {{ entry.display_name }}" end if return end if - if (istat /= NML_OK) then - status = istat + if (nml__istat /= NML_OK) then + nml__status = nml__istat return end if {% if entry.required %} - if (minval(filled) == 0) then - status = NML_ERR_REQUIRED + if (minval(nml__filled) == 0) then + nml__status = NML_ERR_REQUIRED if (present(errmsg)) errmsg = "required field not set: {{ entry.display_name }}" return end if @@ -613,8 +624,8 @@ contains {% if check.runtime_array %} if (allocated({{ check.allocation_ref }})) then {% endif %} - if (.not. all({{ check.func_name }}({{ check.array_ref }}, allow_missing=.true.))) then - status = NML_ERR_ENUM + if (.not. all({{ check.func_name }}({{ check.array_ref }}, nml__allow_missing=.true.))) then + nml__status = NML_ERR_ENUM if (present(errmsg)) errmsg = "enum constraint failed: {{ check.display_name }}" return end if @@ -622,15 +633,15 @@ contains end if {% endif %} {% else %} - istat = this%is_set("{{ check.display_name }}", errmsg=errmsg) - if (istat == NML_OK) then + nml__istat = nml__obj%is_set("{{ check.display_name }}", errmsg=errmsg) + if (nml__istat == NML_OK) then if (.not. {{ check.func_name }}({{ check.element_ref }})) then - status = NML_ERR_ENUM + nml__status = NML_ERR_ENUM if (present(errmsg)) errmsg = "enum constraint failed: {{ check.display_name }}" return end if - else if (istat /= NML_ERR_NOT_SET) then - status = istat + else if (nml__istat /= NML_ERR_NOT_SET) then + nml__status = nml__istat return end if {% endif %} @@ -643,8 +654,8 @@ contains {% if check.runtime_array %} if (allocated({{ check.allocation_ref }})) then {% endif %} - if (.not. all({{ check.func_name }}({{ check.array_ref }}, allow_missing=.true.))) then - status = NML_ERR_BOUNDS + if (.not. all({{ check.func_name }}({{ check.array_ref }}, nml__allow_missing=.true.))) then + nml__status = NML_ERR_BOUNDS if (present(errmsg)) errmsg = "bounds constraint failed: {{ check.display_name }}" return end if @@ -652,15 +663,15 @@ contains end if {% endif %} {% else %} - istat = this%is_set("{{ check.display_name }}", errmsg=errmsg) - if (istat == NML_OK) then + nml__istat = nml__obj%is_set("{{ check.display_name }}", errmsg=errmsg) + if (nml__istat == NML_OK) then if (.not. {{ check.func_name }}({{ check.element_ref }})) then - status = NML_ERR_BOUNDS + nml__status = NML_ERR_BOUNDS if (present(errmsg)) errmsg = "bounds constraint failed: {{ check.display_name }}" return end if - else if (istat /= NML_ERR_NOT_SET) then - status = istat + else if (nml__istat /= NML_ERR_NOT_SET) then + nml__status = nml__istat return end if {% endif %} diff --git a/src/nml_tools/templates/nml_helper.f90.j2 b/src/nml_tools/templates/nml_helper.f90.j2 index ecdc15e..19629b2 100644 --- a/src/nml_tools/templates/nml_helper.f90.j2 +++ b/src/nml_tools/templates/nml_helper.f90.j2 @@ -84,61 +84,61 @@ module {{ module_name }} contains !> \brief Open a namelist file - integer function nml_open(this, file, errmsg) result(status) + integer function nml_open(this, file, errmsg) result(nml__status) class(nml_file_t), intent(inout) :: this character(len=*), intent(in) :: file character(len=*), intent(out), optional :: errmsg - integer :: iostat - logical :: exists - character(len=nml_line_buffer) :: iomsg + integer :: nml__iostat + logical :: nml__exists + character(len=nml_line_buffer) :: nml__iomsg if (present(errmsg)) errmsg = "" - status = this%close() - inquire(file=file, exist=exists) - if (.not. exists) then + nml__status = this%close() + inquire(file=file, exist=nml__exists) + if (.not. nml__exists) then this%is_open = .false. this%unit = 0 - status = NML_ERR_FILE_NOT_FOUND + nml__status = NML_ERR_FILE_NOT_FOUND if (present(errmsg)) errmsg = "file not found: " // trim(file) return end if open(newunit=this%unit, file=file, status='old', action='read', & - iostat=iostat, iomsg=iomsg) - this%is_open = (iostat == 0) + iostat=nml__iostat, iomsg=nml__iomsg) + this%is_open = (nml__iostat == 0) if (.not. this%is_open) then this%unit = 0 - status = NML_ERR_OPEN - if (present(errmsg)) errmsg = trim(iomsg) + nml__status = NML_ERR_OPEN + if (present(errmsg)) errmsg = trim(nml__iomsg) return end if - status = NML_OK + nml__status = NML_OK end function nml_open !> \brief Find a namelist in the opened file - integer function nml_find(this, nml, errmsg) result(status) + integer function nml_find(this, nml, errmsg) result(nml__status) class(nml_file_t), intent(inout) :: this character(len=*), intent(in) :: nml character(len=*), intent(out), optional :: errmsg - integer :: iostat - character(len=nml_line_buffer) :: line - character(len=nml_line_buffer) :: iomsg + integer :: nml__iostat + character(len=nml_line_buffer) :: nml__line + character(len=nml_line_buffer) :: nml__iomsg if (present(errmsg)) errmsg = "" - status = NML_ERR_NML_NOT_FOUND + nml__status = NML_ERR_NML_NOT_FOUND if (.not. this%is_open) then - status = NML_ERR_NOT_OPEN + nml__status = NML_ERR_NOT_OPEN if (present(errmsg)) errmsg = "file not open" return end if rewind(unit=this%unit) do - read(this%unit, '(A)', iostat=iostat, iomsg=iomsg) line - if (iostat < 0) exit - if (iostat > 0) then - status = NML_ERR_READ - if (present(errmsg)) errmsg = trim(iomsg) + read(this%unit, '(A)', iostat=nml__iostat, iomsg=nml__iomsg) nml__line + if (nml__iostat < 0) exit + if (nml__iostat > 0) then + nml__status = NML_ERR_READ + if (present(errmsg)) errmsg = trim(nml__iomsg) return end if - if (index(to_lower(line), '&' // to_lower(trim(nml))) /= 0) then - status = NML_OK + if (index(to__lower(nml__line), '&' // to__lower(trim(nml))) /= 0) then + nml__status = NML_OK backspace(this%unit) return end if @@ -147,18 +147,18 @@ contains end function nml_find !> \brief Close the namelist file - integer function nml_close(this, errmsg) result(status) + integer function nml_close(this, errmsg) result(nml__status) class(nml_file_t), intent(inout) :: this character(len=*), intent(out), optional :: errmsg - integer :: iostat - character(len=nml_line_buffer) :: iomsg + integer :: nml__iostat + character(len=nml_line_buffer) :: nml__iomsg if (present(errmsg)) errmsg = "" - status = NML_OK + nml__status = NML_OK if (this%is_open) then - close(unit=this%unit, iostat=iostat, iomsg=iomsg) - if (iostat /= 0) then - status = NML_ERR_CLOSE - if (present(errmsg)) errmsg = trim(iomsg) + close(unit=this%unit, iostat=nml__iostat, iomsg=nml__iomsg) + if (nml__iostat /= 0) then + nml__status = NML_ERR_CLOSE + if (present(errmsg)) errmsg = trim(nml__iomsg) end if end if this%is_open = .false. @@ -166,35 +166,34 @@ contains end function nml_close !> \brief Convert string to lower case - pure function to_lower(string) result(lower_string) - character(len=*), intent(in) :: string - character(len=len(string)) :: lower_string - integer, parameter :: shift=iachar('a')-iachar('A'), upA=iachar('A'), upZ=iachar('Z') - integer :: k, i - do i = 1, len(string) - k = ichar(string(i:i)) - if (k>=upA .and. k<=upZ) k = k + shift - lower_string(i:i) = char(k) + pure function to__lower(nml__string) result(nml__lower_string) + character(len=*), intent(in) :: nml__string + character(len=len(nml__string)) :: nml__lower_string + integer, parameter :: nml__shift=iachar('a')-iachar('A'), nml__upA=iachar('A'), nml__upZ=iachar('Z') + integer :: nml__k, nml__i + do nml__i = 1, len(nml__string) + nml__k = ichar(nml__string(nml__i:nml__i)) + if (nml__k>=nml__upA .and. nml__k<=nml__upZ) nml__k = nml__k + nml__shift + nml__lower_string(nml__i:nml__i) = char(nml__k) end do - end function to_lower + end function to__lower !> \brief Validate index bounds for array access - integer function idx_check(idx, lower, upper, field, errmsg) result(status) - integer, intent(in) :: idx(:) - integer, intent(in) :: lower(:) - integer, intent(in) :: upper(:) - character(len=*), intent(in) :: field + integer function idx__check(nml__idx, nml__extents, nml__field, errmsg) result(nml__status) + integer, intent(in) :: nml__idx(:) + integer, intent(in) :: nml__extents(:) + character(len=*), intent(in) :: nml__field character(len=*), intent(out), optional :: errmsg - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - if (size(idx) /= size(lower)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index rank mismatch for '" // trim(field) // "'" - else if (any(idx < lower) .or. any(idx > upper)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index out of bounds for '" // trim(field) // "'" + if (size(nml__idx) /= size(nml__extents)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index rank mismatch for '" // trim(nml__field) // "'" + else if (any(nml__idx < 1) .or. any(nml__idx > nml__extents)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index out of bounds for '" // trim(nml__field) // "'" end if - end function idx_check + end function idx__check end module {{ module_name }} diff --git a/src/nml_tools/templates/python_wrappers.py.j2 b/src/nml_tools/templates/python_wrappers.py.j2 index 2801701..821a5c5 100644 --- a/src/nml_tools/templates/python_wrappers.py.j2 +++ b/src/nml_tools/templates/python_wrappers.py.j2 @@ -292,10 +292,11 @@ class {{ cls.class_name }}: kwargs: dict[str, Any] = {} {% for arg in cls.set_dims_args %} {% set py_name = arg.python_name if arg.python_name is not none else arg.name %} +{% set abi_name = arg.abi_name if arg.abi_name is not none else arg.name %} if {{ py_name }} is not None: - kwargs["{{ arg.name }}"] = {{ py_name }} + kwargs["{{ abi_name }}"] = {{ py_name }} else: - kwargs["{{ arg.name }}"] = {{ arg.dummy_value }} + kwargs["{{ abi_name }}"] = {{ arg.dummy_value }} {% if arg.has_flag is not none %} kwargs["{{ arg.has_flag }}"] = {{ py_name }} is not None {% endif %} @@ -415,9 +416,10 @@ class {{ cls.class_name }}: kwargs["{{ arg.has_flag }}"] = {{ arg.name }} is not None {% endif %} {% else %} +{% set abi_name = arg.abi_name if arg.abi_name is not none else arg.name %} {% if arg.rank > 0 %} if {{ arg.name }} is not None: - kwargs["{{ arg.name }}"] = _normalize_array( + kwargs["{{ abi_name }}"] = _normalize_array( {{ arg.name }}, {{ arg.rank }}, "{{ arg.name }}", @@ -425,7 +427,7 @@ class {{ cls.class_name }}: expected_shape={% if arg.fixed_shape is none %}None{% else %}({{ arg.fixed_shape | join(", ") }}{% if arg.fixed_shape | length == 1 %},{% endif %}){% endif %}, ) else: - kwargs["{{ arg.name }}"] = _dummy_array( + kwargs["{{ abi_name }}"] = _dummy_array( {{ arg.rank }}, dtype={% if arg.numpy_dtype is none %}None{% else %}"{{ arg.numpy_dtype }}"{% endif %}, ) @@ -434,9 +436,9 @@ class {{ cls.class_name }}: {% endif %} {% else %} if {{ arg.name }} is not None: - kwargs["{{ arg.name }}"] = {{ arg.name }} + kwargs["{{ abi_name }}"] = {{ arg.name }} else: - kwargs["{{ arg.name }}"] = {{ arg.dummy_value }} + kwargs["{{ abi_name }}"] = {{ arg.dummy_value }} {% if arg.has_flag is not none %} kwargs["{{ arg.has_flag }}"] = {{ arg.name }} is not None {% endif %} diff --git a/tests/fixtures/01_simple/out/nml_helper.f90 b/tests/fixtures/01_simple/out/nml_helper.f90 index fb670d2..97c0b7e 100644 --- a/tests/fixtures/01_simple/out/nml_helper.f90 +++ b/tests/fixtures/01_simple/out/nml_helper.f90 @@ -42,7 +42,7 @@ module nml_helper !> \brief Shared constants for generated namelist modules integer, parameter, public :: buf = 256 !< Buffer length for character strings. - integer, parameter, public :: max_iter__default = 4 !< Maximum number of iterations. + integer, parameter, public :: max_iter__dim_default = 4 !< Maximum number of iterations. !> \class nml_file_t !> \brief Type for namelist file operations @@ -58,61 +58,61 @@ module nml_helper contains !> \brief Open a namelist file - integer function nml_open(this, file, errmsg) result(status) + integer function nml_open(this, file, errmsg) result(nml__status) class(nml_file_t), intent(inout) :: this character(len=*), intent(in) :: file character(len=*), intent(out), optional :: errmsg - integer :: iostat - logical :: exists - character(len=nml_line_buffer) :: iomsg + integer :: nml__iostat + logical :: nml__exists + character(len=nml_line_buffer) :: nml__iomsg if (present(errmsg)) errmsg = "" - status = this%close() - inquire(file=file, exist=exists) - if (.not. exists) then + nml__status = this%close() + inquire(file=file, exist=nml__exists) + if (.not. nml__exists) then this%is_open = .false. this%unit = 0 - status = NML_ERR_FILE_NOT_FOUND + nml__status = NML_ERR_FILE_NOT_FOUND if (present(errmsg)) errmsg = "file not found: " // trim(file) return end if open(newunit=this%unit, file=file, status='old', action='read', & - iostat=iostat, iomsg=iomsg) - this%is_open = (iostat == 0) + iostat=nml__iostat, iomsg=nml__iomsg) + this%is_open = (nml__iostat == 0) if (.not. this%is_open) then this%unit = 0 - status = NML_ERR_OPEN - if (present(errmsg)) errmsg = trim(iomsg) + nml__status = NML_ERR_OPEN + if (present(errmsg)) errmsg = trim(nml__iomsg) return end if - status = NML_OK + nml__status = NML_OK end function nml_open !> \brief Find a namelist in the opened file - integer function nml_find(this, nml, errmsg) result(status) + integer function nml_find(this, nml, errmsg) result(nml__status) class(nml_file_t), intent(inout) :: this character(len=*), intent(in) :: nml character(len=*), intent(out), optional :: errmsg - integer :: iostat - character(len=nml_line_buffer) :: line - character(len=nml_line_buffer) :: iomsg + integer :: nml__iostat + character(len=nml_line_buffer) :: nml__line + character(len=nml_line_buffer) :: nml__iomsg if (present(errmsg)) errmsg = "" - status = NML_ERR_NML_NOT_FOUND + nml__status = NML_ERR_NML_NOT_FOUND if (.not. this%is_open) then - status = NML_ERR_NOT_OPEN + nml__status = NML_ERR_NOT_OPEN if (present(errmsg)) errmsg = "file not open" return end if rewind(unit=this%unit) do - read(this%unit, '(A)', iostat=iostat, iomsg=iomsg) line - if (iostat < 0) exit - if (iostat > 0) then - status = NML_ERR_READ - if (present(errmsg)) errmsg = trim(iomsg) + read(this%unit, '(A)', iostat=nml__iostat, iomsg=nml__iomsg) nml__line + if (nml__iostat < 0) exit + if (nml__iostat > 0) then + nml__status = NML_ERR_READ + if (present(errmsg)) errmsg = trim(nml__iomsg) return end if - if (index(to_lower(line), '&' // to_lower(trim(nml))) /= 0) then - status = NML_OK + if (index(to__lower(nml__line), '&' // to__lower(trim(nml))) /= 0) then + nml__status = NML_OK backspace(this%unit) return end if @@ -121,18 +121,18 @@ integer function nml_find(this, nml, errmsg) result(status) end function nml_find !> \brief Close the namelist file - integer function nml_close(this, errmsg) result(status) + integer function nml_close(this, errmsg) result(nml__status) class(nml_file_t), intent(inout) :: this character(len=*), intent(out), optional :: errmsg - integer :: iostat - character(len=nml_line_buffer) :: iomsg + integer :: nml__iostat + character(len=nml_line_buffer) :: nml__iomsg if (present(errmsg)) errmsg = "" - status = NML_OK + nml__status = NML_OK if (this%is_open) then - close(unit=this%unit, iostat=iostat, iomsg=iomsg) - if (iostat /= 0) then - status = NML_ERR_CLOSE - if (present(errmsg)) errmsg = trim(iomsg) + close(unit=this%unit, iostat=nml__iostat, iomsg=nml__iomsg) + if (nml__iostat /= 0) then + nml__status = NML_ERR_CLOSE + if (present(errmsg)) errmsg = trim(nml__iomsg) end if end if this%is_open = .false. @@ -140,35 +140,34 @@ integer function nml_close(this, errmsg) result(status) end function nml_close !> \brief Convert string to lower case - pure function to_lower(string) result(lower_string) - character(len=*), intent(in) :: string - character(len=len(string)) :: lower_string - integer, parameter :: shift=iachar('a')-iachar('A'), upA=iachar('A'), upZ=iachar('Z') - integer :: k, i - do i = 1, len(string) - k = ichar(string(i:i)) - if (k>=upA .and. k<=upZ) k = k + shift - lower_string(i:i) = char(k) + pure function to__lower(nml__string) result(nml__lower_string) + character(len=*), intent(in) :: nml__string + character(len=len(nml__string)) :: nml__lower_string + integer, parameter :: nml__shift=iachar('a')-iachar('A'), nml__upA=iachar('A'), nml__upZ=iachar('Z') + integer :: nml__k, nml__i + do nml__i = 1, len(nml__string) + nml__k = ichar(nml__string(nml__i:nml__i)) + if (nml__k>=nml__upA .and. nml__k<=nml__upZ) nml__k = nml__k + nml__shift + nml__lower_string(nml__i:nml__i) = char(nml__k) end do - end function to_lower + end function to__lower !> \brief Validate index bounds for array access - integer function idx_check(idx, lower, upper, field, errmsg) result(status) - integer, intent(in) :: idx(:) - integer, intent(in) :: lower(:) - integer, intent(in) :: upper(:) - character(len=*), intent(in) :: field + integer function idx__check(nml__idx, nml__extents, nml__field, errmsg) result(nml__status) + integer, intent(in) :: nml__idx(:) + integer, intent(in) :: nml__extents(:) + character(len=*), intent(in) :: nml__field character(len=*), intent(out), optional :: errmsg - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - if (size(idx) /= size(lower)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index rank mismatch for '" // trim(field) // "'" - else if (any(idx < lower) .or. any(idx > upper)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index out of bounds for '" // trim(field) // "'" + if (size(nml__idx) /= size(nml__extents)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index rank mismatch for '" // trim(nml__field) // "'" + else if (any(nml__idx < 1) .or. any(nml__idx > nml__extents)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index out of bounds for '" // trim(nml__field) // "'" end if - end function idx_check + end function idx__check end module nml_helper diff --git a/tests/fixtures/01_simple/out/nml_optimization.f90 b/tests/fixtures/01_simple/out/nml_optimization.f90 index efe475f..4f72920 100644 --- a/tests/fixtures/01_simple/out/nml_optimization.f90 +++ b/tests/fixtures/01_simple/out/nml_optimization.f90 @@ -22,11 +22,12 @@ module nml_optimization NML_ERR_NOT_SET, & NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & - idx_check, & - to_lower, & + idx__check, & + to__lower, & buf, & - max_iter__default - use ieee_arithmetic, only: ieee_value, ieee_quiet_nan, ieee_is_nan + max_iter__dim_default + use ieee_arithmetic, only: nml__ieee_value => ieee_value, & + nml__ieee_quiet_nan => ieee_quiet_nan, nml__ieee_is_nan => ieee_is_nan ! kind specifiers listed in the nml-tools configuration file use iso_fortran_env, only: & i4=>int32, & @@ -40,13 +41,11 @@ module nml_optimization logical, parameter, public :: mcmc_opti__default = .true. real(dp), parameter, public :: mcmc_error_params__default(4) = [0.01_dp, 0.6_dp, 0.2_dp, 0.3_dp] - !> \class nml_optimization_t - !> \brief MHM optimization namelist - !> \details All relevant configurations for the optimization parameters of MHM. - !! This namelist corresponds to the `optimization` section in the MHM configuration. - type, public :: nml_optimization_t - logical :: is_configured = .false. !< whether the namelist has been configured - integer :: max_iter = max_iter__default !< runtime dimension for max_iter + private :: nml_optimization_read__from_file + + !> \class nml_optimization_data_t + !> \brief Schema-backed values for optimization + type, public :: nml_optimization_data_t character(len=buf) :: name !< Optimization name integer :: niterations !< Number of iterations real :: tolerance !< Convergence tolerance @@ -54,6 +53,22 @@ module nml_optimization real(dp) :: dds_r !< DDS perturbation rate logical :: mcmc_opti !< MCMC optimization real(dp), allocatable, dimension(:, :, :) :: mcmc_error_params !< MCMC error parameters per domain + end type nml_optimization_data_t + + !> \class nml_optimization_dims_t + !> \brief Runtime dimensions for optimization + type, public :: nml_optimization_dims_t + integer :: max_iter = max_iter__dim_default !< runtime dimension for max_iter + end type nml_optimization_dims_t + + !> \class nml_optimization_t + !> \brief MHM optimization namelist + !> \details All relevant configurations for the optimization parameters of MHM. + !! This namelist corresponds to the `optimization` section in the MHM configuration. + type, public :: nml_optimization_t + type(nml_optimization_data_t) :: data !< schema-backed namelist values + type(nml_optimization_dims_t) :: dims !< runtime array dimensions + logical :: is_configured = .false. !< whether the namelist has been configured contains procedure :: init => nml_optimization_init procedure :: set_dims => nml_optimization_set_dims @@ -66,72 +81,81 @@ module nml_optimization contains !> \brief Initialize defaults and sentinels for optimization - integer function nml_optimization_init(this, errmsg) result(status) - class(nml_optimization_t), intent(inout) :: this !< namelist instance + integer function nml_optimization_init(nml__obj, errmsg) result(nml__status) + class(nml_optimization_t), intent(inout) :: nml__obj !< namelist instance character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - this%is_configured = .false. + nml__obj%is_configured = .false. ! allocate runtime-sized fields - if (allocated(this%mcmc_error_params)) deallocate(this%mcmc_error_params) - allocate(this%mcmc_error_params(3, 2, this%max_iter)) + if (allocated(nml__obj%data%mcmc_error_params)) deallocate(nml__obj%data%mcmc_error_params) + allocate(nml__obj%data%mcmc_error_params(3, 2, nml__obj%dims%max_iter)) ! sentinel values for required/optional parameters - this%name = achar(0) ! sentinel for optional string - this%niterations = -huge(this%niterations) ! sentinel for required integer - this%tolerance = ieee_value(this%tolerance, ieee_quiet_nan) ! sentinel for required real + nml__obj%data%name = achar(0) ! sentinel for optional string + nml__obj%data%niterations = -huge(nml__obj%data%niterations) ! sentinel for required integer + nml__obj%data%tolerance = nml__ieee_value(nml__obj%data%tolerance, nml__ieee_quiet_nan) ! sentinel for required real ! default values - this%seed = seed__default - this%dds_r = dds_r__default - this%mcmc_opti = mcmc_opti__default ! bool values always need a default - this%mcmc_error_params = reshape( & + nml__obj%data%seed = seed__default + nml__obj%data%dds_r = dds_r__default + nml__obj%data%mcmc_opti = mcmc_opti__default ! bool values always need a default + nml__obj%data%mcmc_error_params = reshape( & mcmc_error_params__default, & - shape=[3, 2, this%max_iter], & + shape=[3, 2, nml__obj%dims%max_iter], & order=[3, 2, 1], & pad=mcmc_error_params__default) end function nml_optimization_init !> \brief Reset runtime dimensions for optimization - integer function nml_optimization_set_dims(this, & + integer function nml_optimization_set_dims(nml__obj, & max_iter, & - errmsg) result(status) - class(nml_optimization_t), intent(inout) :: this !< namelist instance + errmsg) result(nml__status) + class(nml_optimization_t), intent(inout) :: nml__obj !< namelist instance integer, intent(in), optional :: max_iter !< runtime dimension override for max_iter integer :: candidate__max_iter character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" if (present(max_iter)) then candidate__max_iter = max_iter else - candidate__max_iter = max_iter__default + candidate__max_iter = max_iter__dim_default end if if (candidate__max_iter <= 0) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "dimension 'max_iter' must be positive" return end if if ((3 * 2 * candidate__max_iter) < 4) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "shape constants for 'mcmc_error_params' must allow at least 4 default values" return end if - this%max_iter = candidate__max_iter + nml__obj%dims%max_iter = candidate__max_iter ! deallocate runtime-sized fields; init/set/from_file allocate them again - if (allocated(this%mcmc_error_params)) deallocate(this%mcmc_error_params) - this%is_configured = .false. + if (allocated(nml__obj%data%mcmc_error_params)) deallocate(nml__obj%data%mcmc_error_params) + nml__obj%is_configured = .false. end function nml_optimization_set_dims !> \brief Read optimization namelist from file - integer function nml_optimization_from_file(this, file, errmsg) result(status) - class(nml_optimization_t), intent(inout) :: this !< namelist instance + integer function nml_optimization_from_file(nml__obj, file, errmsg) result(nml__status) + class(nml_optimization_t), intent(inout) :: nml__obj !< namelist instance character(len=*), intent(in) :: file !< path to namelist file character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + + nml__status = nml_optimization_read__from_file(nml__obj, file, errmsg) + end function nml_optimization_from_file + + integer function nml_optimization_read__from_file(nml__obj, nml__file, errmsg) & + result(nml__status) + class(nml_optimization_t), intent(inout) :: nml__obj + character(len=*), intent(in) :: nml__file + character(len=*), intent(out), optional :: errmsg ! namelist variables character(len=buf) :: name integer :: niterations @@ -141,10 +165,10 @@ integer function nml_optimization_from_file(this, file, errmsg) result(status) logical :: mcmc_opti real(dp), allocatable, dimension(:, :, :) :: mcmc_error_params ! locals - type(nml_file_t) :: nml - integer :: iostat - integer :: close_status - character(len=nml_line_buffer) :: iomsg + type(nml_file_t) :: nml__reader + integer :: nml__iostat + integer :: nml__close_status + character(len=nml_line_buffer) :: nml__iomsg namelist /optimization/ & name, & @@ -155,58 +179,58 @@ integer function nml_optimization_from_file(this, file, errmsg) result(status) mcmc_opti, & mcmc_error_params - status = this%init(errmsg=errmsg) - if (status /= NML_OK) return + nml__status = nml__obj%init(errmsg=errmsg) + if (nml__status /= NML_OK) return ! allocate local namelist variables matching runtime-sized fields if (allocated(mcmc_error_params)) deallocate(mcmc_error_params) - allocate(mcmc_error_params(3, 2, this%max_iter)) - name = this%name - niterations = this%niterations - tolerance = this%tolerance - seed = this%seed - dds_r = this%dds_r - mcmc_opti = this%mcmc_opti - mcmc_error_params = this%mcmc_error_params - - status = nml%open(file, errmsg=errmsg) - if (status /= NML_OK) return - - status = nml%find("optimization", errmsg=errmsg) - if (status /= NML_OK) then - close_status = nml%close() + allocate(mcmc_error_params(3, 2, nml__obj%dims%max_iter)) + name = nml__obj%data%name + niterations = nml__obj%data%niterations + tolerance = nml__obj%data%tolerance + seed = nml__obj%data%seed + dds_r = nml__obj%data%dds_r + mcmc_opti = nml__obj%data%mcmc_opti + mcmc_error_params = nml__obj%data%mcmc_error_params + + nml__status = nml__reader%open(nml__file, errmsg=errmsg) + if (nml__status /= NML_OK) return + + nml__status = nml__reader%find("optimization", errmsg=errmsg) + if (nml__status /= NML_OK) then + nml__close_status = nml__reader%close() return end if ! read namelist - read(nml%unit, nml=optimization, iostat=iostat, iomsg=iomsg) - if (iostat /= 0) then - status = NML_ERR_READ - if (present(errmsg)) errmsg = trim(iomsg) - close_status = nml%close() + read(nml__reader%unit, nml=optimization, iostat=nml__iostat, iomsg=nml__iomsg) + if (nml__iostat /= 0) then + nml__status = NML_ERR_READ + if (present(errmsg)) errmsg = trim(nml__iomsg) + nml__close_status = nml__reader%close() return end if - close_status = nml%close(errmsg=errmsg) - if (close_status /= NML_OK) then - status = close_status + nml__close_status = nml__reader%close(errmsg=errmsg) + if (nml__close_status /= NML_OK) then + nml__status = nml__close_status return end if ! assign values - this%name = name - this%niterations = niterations - this%tolerance = tolerance - this%seed = seed - this%dds_r = dds_r - this%mcmc_opti = mcmc_opti - this%mcmc_error_params = mcmc_error_params + nml__obj%data%name = name + nml__obj%data%niterations = niterations + nml__obj%data%tolerance = tolerance + nml__obj%data%seed = seed + nml__obj%data%dds_r = dds_r + nml__obj%data%mcmc_opti = mcmc_opti + nml__obj%data%mcmc_error_params = mcmc_error_params ! mark as configured - this%is_configured = .true. - status = NML_OK - end function nml_optimization_from_file + nml__obj%is_configured = .true. + nml__status = NML_OK + end function nml_optimization_read__from_file !> \brief Set optimization values - integer function nml_optimization_set(this, & + integer function nml_optimization_set(nml__obj, & niterations, & tolerance, & name, & @@ -214,9 +238,9 @@ integer function nml_optimization_set(this, & dds_r, & mcmc_opti, & mcmc_error_params, & - errmsg) result(status) + errmsg) result(nml__status) - class(nml_optimization_t), intent(inout) :: this !< namelist instance + class(nml_optimization_t), intent(inout) :: nml__obj !< namelist instance character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values integer, intent(in) :: niterations !< Number of iterations real, intent(in) :: tolerance !< Convergence tolerance @@ -225,147 +249,136 @@ integer function nml_optimization_set(this, & real(dp), intent(in), optional :: dds_r !< DDS perturbation rate logical, intent(in), optional :: mcmc_opti !< MCMC optimization real(dp), dimension(:, :, :), intent(in), optional :: mcmc_error_params !< MCMC error parameters per domain - integer :: & - lb__1, & - lb__2, & - lb__3, & - ub__1, & - ub__2, & - ub__3 - - status = this%init(errmsg=errmsg) - if (status /= NML_OK) return + nml__status = nml__obj%init(errmsg=errmsg) + if (nml__status /= NML_OK) return ! required parameters - this%niterations = niterations - this%tolerance = tolerance + nml__obj%data%niterations = niterations + nml__obj%data%tolerance = tolerance ! override with provided values - if (present(name)) this%name = name - if (present(seed)) this%seed = seed - if (present(dds_r)) this%dds_r = dds_r - if (present(mcmc_opti)) this%mcmc_opti = mcmc_opti + if (present(name)) nml__obj%data%name = name + if (present(seed)) nml__obj%data%seed = seed + if (present(dds_r)) nml__obj%data%dds_r = dds_r + if (present(mcmc_opti)) nml__obj%data%mcmc_opti = mcmc_opti if (present(mcmc_error_params)) then - if (size(mcmc_error_params, 1) > size(this%mcmc_error_params, 1)) then - status = NML_ERR_INVALID_INDEX + if (size(mcmc_error_params, 1) > size(nml__obj%data%mcmc_error_params, 1)) then + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'mcmc_error_params'" return end if - lb__1 = lbound(this%mcmc_error_params, 1) - ub__1 = lb__1 + size(mcmc_error_params, 1) - 1 - if (size(mcmc_error_params, 2) > size(this%mcmc_error_params, 2)) then - status = NML_ERR_INVALID_INDEX + if (size(mcmc_error_params, 2) > size(nml__obj%data%mcmc_error_params, 2)) then + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "dimension 2 exceeds bounds for 'mcmc_error_params'" return end if - lb__2 = lbound(this%mcmc_error_params, 2) - ub__2 = lb__2 + size(mcmc_error_params, 2) - 1 - if (size(mcmc_error_params, 3) > size(this%mcmc_error_params, 3)) then - status = NML_ERR_INVALID_INDEX + if (size(mcmc_error_params, 3) > size(nml__obj%data%mcmc_error_params, 3)) then + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "dimension 3 exceeds bounds for 'mcmc_error_params'" return end if - lb__3 = lbound(this%mcmc_error_params, 3) - ub__3 = lb__3 + size(mcmc_error_params, 3) - 1 - this%mcmc_error_params(lb__1:ub__1, lb__2:ub__2, lb__3:ub__3) = mcmc_error_params + nml__obj%data%mcmc_error_params( & + 1:size(mcmc_error_params, 1), & + 1:size(mcmc_error_params, 2), & + 1:size(mcmc_error_params, 3)) = mcmc_error_params end if ! mark as configured - this%is_configured = .true. - status = NML_OK + nml__obj%is_configured = .true. + nml__status = NML_OK end function nml_optimization_set !> \brief Check whether a namelist value was set - integer function nml_optimization_is_set(this, name, idx, errmsg) result(status) - class(nml_optimization_t), intent(in) :: this !< namelist instance + integer function nml_optimization_is_set(nml__obj, name, idx, errmsg) result(nml__status) + class(nml_optimization_t), intent(in) :: nml__obj !< namelist instance character(len=*), intent(in) :: name !< field name integer, intent(in), optional :: idx(:) !< optional field index values character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(trim(name))) + select case (to__lower(trim(name))) case ("name") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'name'" return end if - if (this%name == achar(0)) status = NML_ERR_NOT_SET + if (nml__obj%data%name == achar(0)) nml__status = NML_ERR_NOT_SET case ("niterations") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'niterations'" return end if - if (this%niterations == -huge(this%niterations)) status = NML_ERR_NOT_SET + if (nml__obj%data%niterations == -huge(nml__obj%data%niterations)) nml__status = NML_ERR_NOT_SET case ("tolerance") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'tolerance'" return end if - if (ieee_is_nan(this%tolerance)) status = NML_ERR_NOT_SET + if (nml__ieee_is_nan(nml__obj%data%tolerance)) nml__status = NML_ERR_NOT_SET case ("seed") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'seed'" return end if case ("dds_r") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'dds_r'" return end if case ("mcmc_opti") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'mcmc_opti'" return end if case ("mcmc_error_params") - if (.not. allocated(this%mcmc_error_params)) then - status = NML_ERR_NOT_SET + if (.not. allocated(nml__obj%data%mcmc_error_params)) then + nml__status = NML_ERR_NOT_SET return end if if (present(idx)) then - status = idx_check(idx, lbound(this%mcmc_error_params), ubound(this%mcmc_error_params), & + nml__status = idx__check(idx, shape(nml__obj%data%mcmc_error_params), & "mcmc_error_params", errmsg) - if (status /= NML_OK) return + if (nml__status /= NML_OK) return else end if case default - status = NML_ERR_INVALID_NAME + nml__status = NML_ERR_INVALID_NAME if (present(errmsg)) errmsg = "unknown field: " // trim(name) end select - if (status == NML_ERR_NOT_SET .and. present(errmsg)) then + if (nml__status == NML_ERR_NOT_SET .and. present(errmsg)) then if (len_trim(errmsg) == 0) errmsg = "field not set: " // trim(name) end if end function nml_optimization_is_set !> \brief Validate required values and constraints - integer function nml_optimization_is_valid(this, errmsg) result(status) - class(nml_optimization_t), intent(in) :: this !< namelist instance + integer function nml_optimization_is_valid(nml__obj, errmsg) result(nml__status) + class(nml_optimization_t), intent(in) :: nml__obj !< namelist instance character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - integer :: istat + integer :: nml__istat - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if ! required parameters - istat = this%is_set("niterations", errmsg=errmsg) - if (istat == NML_ERR_NOT_SET) then - status = NML_ERR_REQUIRED + nml__istat = nml__obj%is_set("niterations", errmsg=errmsg) + if (nml__istat == NML_ERR_NOT_SET) then + nml__status = NML_ERR_REQUIRED if (present(errmsg)) then if (len_trim(errmsg) == 0) then errmsg = "field not set: niterations" @@ -374,13 +387,13 @@ integer function nml_optimization_is_valid(this, errmsg) result(status) end if return end if - if (istat /= NML_OK) then - status = istat + if (nml__istat /= NML_OK) then + nml__status = nml__istat return end if - istat = this%is_set("tolerance", errmsg=errmsg) - if (istat == NML_ERR_NOT_SET) then - status = NML_ERR_REQUIRED + nml__istat = nml__obj%is_set("tolerance", errmsg=errmsg) + if (nml__istat == NML_ERR_NOT_SET) then + nml__status = NML_ERR_REQUIRED if (present(errmsg)) then if (len_trim(errmsg) == 0) then errmsg = "field not set: tolerance" @@ -389,8 +402,8 @@ integer function nml_optimization_is_valid(this, errmsg) result(status) end if return end if - if (istat /= NML_OK) then - status = istat + if (nml__istat /= NML_OK) then + nml__status = nml__istat return end if end function nml_optimization_is_valid diff --git a/tests/fixtures/01_simple/out/nml_optimization.md b/tests/fixtures/01_simple/out/nml_optimization.md index 4a0e5e2..97ef7fa 100644 --- a/tests/fixtures/01_simple/out/nml_optimization.md +++ b/tests/fixtures/01_simple/out/nml_optimization.md @@ -9,15 +9,15 @@ This namelist corresponds to the `optimization` section in the MHM configuration ## Fields -| Name | Type | Required | Info | -| --- | --- | --- | --- | -| [name](#name) | string | no | Optimization name | -| [niterations](#niterations) | integer | yes | Number of iterations | -| [tolerance](#tolerance) | real | yes | Convergence tolerance | -| [seed](#seed) | integer | no | Random seed | -| [dds_r](#dds_r) | real | no | DDS perturbation rate | -| [mcmc_opti](#mcmc_opti) | logical | no | MCMC optimization | -| [mcmc_error_params](#mcmc_error_params) | real array | no | MCMC error parameters per domain | +| Name | Type | Declared required | Input required | Info | +| --- | --- | --- | --- | --- | +| [name](#name) | string | no | no | Optimization name | +| [niterations](#niterations) | integer | yes | yes | Number of iterations | +| [tolerance](#tolerance) | real | yes | yes | Convergence tolerance | +| [seed](#seed) | integer | no | no | Random seed | +| [dds_r](#dds_r) | real | no | no | DDS perturbation rate | +| [mcmc_opti](#mcmc_opti) | logical | no | no | MCMC optimization | +| [mcmc_error_params](#mcmc_error_params) | real array | no | no | MCMC error parameters per domain | ## Field details @@ -29,7 +29,8 @@ Name for the optimization run. Summary: - Type: `character(len=buf)` -- Required: no +- Declared required: no +- Input required: no - Examples: `"test_optimization"` ### niterations @@ -40,7 +41,8 @@ Number of iterations for the optimization algorithm Summary: - Type: `integer` -- Required: yes +- Declared required: yes +- Input required: yes - Examples: `100` ### tolerance @@ -51,7 +53,8 @@ Tolerance for convergence of the optimization algorithm. Summary: - Type: `real` -- Required: yes +- Declared required: yes +- Input required: yes ### seed @@ -61,7 +64,8 @@ Random seed for reproducibility. Use -9 for random seed. Summary: - Type: `integer(i4)` -- Required: no +- Declared required: no +- Input required: no - Default: `-9` ### dds_r @@ -72,7 +76,8 @@ Parameter for the DDS algorithm controlling the perturbation rate. Summary: - Type: `real(dp)` -- Required: no +- Declared required: no +- Input required: no - Default: `0.2` ### mcmc_opti @@ -83,7 +88,8 @@ Whether to perform MCMC optimization. Summary: - Type: `logical` -- Required: no +- Declared required: no +- Input required: no - Default: `.true.` ### mcmc_error_params @@ -94,7 +100,8 @@ Parameters for the MCMC error model: err = a + b+Q Summary: - Type: `real(dp), dimension(3, 2, max_iter)` -- Required: no +- Declared required: no +- Input required: no - Default: `[0.01, 0.6, 0.2, 0.3]` (repeated, order: C) ## Example diff --git a/tests/fortran_namespaces/CMakeLists.txt b/tests/fortran_namespaces/CMakeLists.txt new file mode 100644 index 0000000..ac5f35f --- /dev/null +++ b/tests/fortran_namespaces/CMakeLists.txt @@ -0,0 +1,17 @@ +cmake_minimum_required(VERSION 3.20) +project(generated_namespaces LANGUAGES Fortran) + +set(CMAKE_Fortran_STANDARD 2008) +set(CMAKE_Fortran_STANDARD_REQUIRED ON) + +add_executable(generated_namespaces + application_types.f90 + conformance.f90 + out/nml_helper.f90 + out/nml_namespaces.f90 + out/nml_wrapper_status.f90 + out/f2py_wrapper_status.f90 + out/nml_constraints.f90 + out/nml_c_bindings.f90 + out/f2py_c_bindings.f90 +) diff --git a/tests/fortran_namespaces/application_types.f90 b/tests/fortran_namespaces/application_types.f90 new file mode 100644 index 0000000..4f62a91 --- /dev/null +++ b/tests/fortran_namespaces/application_types.f90 @@ -0,0 +1,11 @@ +module application_types + implicit none + + type :: status + integer :: code + end type status + + type :: c_ptr + integer :: code + end type c_ptr +end module application_types diff --git a/tests/fortran_namespaces/c_bindings.nml b/tests/fortran_namespaces/c_bindings.nml new file mode 100644 index 0000000..53b5c59 --- /dev/null +++ b/tests/fortran_namespaces/c_bindings.nml @@ -0,0 +1,7 @@ +&c_bindings + c_intptr_t = 17 + c_ptr = 18 + c_null_ptr = 19 + c_f_pointer = 20 + values = 7, 8, 9 +/ diff --git a/tests/fortran_namespaces/c_bindings.yml b/tests/fortran_namespaces/c_bindings.yml new file mode 100644 index 0000000..86b8a42 --- /dev/null +++ b/tests/fortran_namespaces/c_bindings.yml @@ -0,0 +1,22 @@ +title: Resolver dependency isolation +x-fortran-namelist: c_bindings +type: object +properties: + c_intptr_t: + type: integer + default: 0 + c_ptr: + type: integer + default: 0 + c_null_ptr: + type: integer + default: 0 + c_f_pointer: + type: integer + default: 0 + values: + type: array + x-fortran-shape: c_intptr_t + items: + type: integer + default: 0 diff --git a/tests/fortran_namespaces/conformance.f90 b/tests/fortran_namespaces/conformance.f90 new file mode 100644 index 0000000..7fdd1ac --- /dev/null +++ b/tests/fortran_namespaces/conformance.f90 @@ -0,0 +1,127 @@ +program conformance + use iso_c_binding, only: c_intptr_t, c_loc + use iso_fortran_env, only: int16, int64 + use nml_helper, only: NML_ERR_BOUNDS, NML_ERR_ENUM, NML_ERR_INVALID_INDEX, NML_OK + use nml_namespaces, only: nml_namespaces_t + use nml_constraints, only: nml_constraints_t + use nml_wrapper_status, only: nml_wrapper_status_t + use f2py_wrapper_status, only: wrapper_status_set_wrapper, wrapper_status_is_valid_wrapper + use nml_c_bindings, only: nml_c_bindings_t + use f2py_c_bindings, only: c_bindings_from_file_wrapper, c_bindings_set_dims_wrapper + + implicit none + + type(nml_namespaces_t) :: config + type(nml_constraints_t) :: constraints + type(nml_wrapper_status_t), target :: wrapped + type(nml_c_bindings_t), target :: c_config + integer(c_intptr_t) :: handle + character(len=256) :: root + character(len=1024) :: errmsg + integer :: source(0:1) + integer :: status + + call get_command_argument(1, root) + if (len_trim(root) == 0) error stop "fixture directory argument is required" + + status = config%set_dims(status=3, set_dims=2, errmsg=errmsg) + call expect_status(status, NML_OK, "set dimensions") + if (config%dims%status /= 3) error stop "dimension was not stored below dims" + if (config%dims%set_dims /= 2) error stop "operation-named dimension mismatch" + + source = [7, 8] + status = config%set(status=42, set_dims=6, values=source, errmsg=errmsg) + call expect_status(status, NML_OK, "set values") + if (config%data%status /= 42) error stop "status property mismatch" + if (config%data%set_dims /= 6) error stop "set_dims property mismatch" + if (any(config%data%values /= [7, 8, 0])) error stop "partial array assignment mismatch" + if (lbound(config%data%values, 1) /= 1) error stop "generated storage is not one-based" + + status = config%set_dims(status=0, errmsg=errmsg) + call expect_status(status, NML_ERR_INVALID_INDEX, "invalid dimensions") + if (config%dims%status /= 3) error stop "failed dimension update mutated dimensions" + if (.not. allocated(config%data%values)) error stop "failed dimension update deallocated data" + if (any(config%data%values /= [7, 8, 0])) error stop "failed dimension update mutated data" + + status = config%from_file(trim(root) // "/input.nml", errmsg=errmsg) + call expect_status(status, NML_OK, "read flat namelist") + if (config%data%file /= 19) error stop "file property mismatch" + if (config%data%nml /= 20) error stop "nml property mismatch" + if (config%data%iostat /= 21) error stop "iostat property mismatch" + if (config%data%close_status /= 22) error stop "close_status property mismatch" + if (config%data%data /= 23 .or. config%data%dims /= 24) then + error stop "data/dims property mismatch" + end if + if (config%data%set /= 25 .or. config%data%init /= 26) then + error stop "operation-named property mismatch" + end if + if (config%data%init_type /= 34) error stop "init_type property mismatch" + if (config%data%set_dims /= 29) error stop "set_dims input property mismatch" + if (config%data%from_file /= 30 .or. config%data%is_set /= 31) then + error stop "reader/query-named property mismatch" + end if + if (config%data%is_valid /= 32 .or. config%data%filled_shape /= 33) then + error stop "validation/shape-named property mismatch" + end if + if (config%data%is_configured /= 27) error stop "lifecycle-named property mismatch" + status = config%is_valid(errmsg=errmsg) + call expect_status(status, NML_OK, "validate") + + handle = transfer(c_loc(wrapped), handle) + call wrapper_status_set_wrapper(handle, has__state=.true., state__code=42, & + has__state__code=.true., has__pointer_state=.false., pointer_state__code=0, & + has__pointer_state__code=.false., nml__status=status, nml__errmsg=errmsg) + call expect_status(status, NML_OK, "call wrapper with imported type(status)") + if (wrapped%data%state%code /= 42) error stop "wrapper did not set derived leaf" + call wrapper_status_is_valid_wrapper(handle, status, errmsg) + call expect_status(status, NML_OK, "validate wrapped derived value") + if (wrapped%data%pointer_state%code /= 0) error stop "application c_ptr default mismatch" + + status = c_config%set(c_intptr_t=1, c_ptr=2, c_null_ptr=3, c_f_pointer=4, & + values=[5, 6], errmsg=errmsg) + call expect_status(status, NML_OK, "native C-binding-named fields") + if (c_config%data%c_intptr_t /= 1 .or. c_config%data%c_ptr /= 2) then + error stop "native C-binding fields mismatch" + end if + handle = transfer(c_loc(c_config), handle) + call c_bindings_set_dims_wrapper(handle, 3, .true., status, errmsg) + call expect_status(status, NML_OK, "C-binding-named wrapper dimension") + call c_bindings_from_file_wrapper(handle, trim(root) // "/c_bindings.nml", status, errmsg) + call expect_status(status, NML_OK, "read C-binding-named fields through wrapper") + if (c_config%dims%c_intptr_t /= 3 .or. c_config%data%c_intptr_t /= 17) then + error stop "C-binding property/dimension overlap mismatch" + end if + if (c_config%data%c_ptr /= 18 .or. c_config%data%c_null_ptr /= 19 & + .or. c_config%data%c_f_pointer /= 20) error stop "C-binding namelist fields mismatch" + if (any(c_config%data%values /= [7, 8, 9])) error stop "C-binding dimension allocation mismatch" + status = c_config%is_valid(errmsg=errmsg) + call expect_status(status, NML_OK, "validate C-binding-named configuration") + + status = constraints%set(choice=2, limit=0_int16, upper=4_int64, errmsg=errmsg) + call expect_status(status, NML_OK, "constraint setter") + status = constraints%is_valid(errmsg=errmsg) + call expect_status(status, NML_OK, "validate kind aliases matching old constraint locals") + constraints%data%choice = 3 + status = constraints%is_valid(errmsg=errmsg) + call expect_status(status, NML_ERR_ENUM, "enum error") + if (index(errmsg, "choice") == 0) error stop "enum error message lost field name" + constraints%data%choice = 1 + constraints%data%limit = -1 + status = constraints%is_valid(errmsg=errmsg) + call expect_status(status, NML_ERR_BOUNDS, "bounds error") + if (index(errmsg, "limit") == 0) error stop "bounds error message lost field name" + +contains + + subroutine expect_status(actual, expected, label) + integer, intent(in) :: actual + integer, intent(in) :: expected + character(len=*), intent(in) :: label + + if (actual /= expected) then + write(*, '(a,1x,i0,1x,i0)') trim(label), actual, expected + error stop "unexpected status" + end if + end subroutine expect_status + +end program conformance diff --git a/tests/fortran_namespaces/constraints.yml b/tests/fortran_namespaces/constraints.yml new file mode 100644 index 0000000..46de6cf --- /dev/null +++ b/tests/fortran_namespaces/constraints.yml @@ -0,0 +1,18 @@ +title: Constraint internal state +x-fortran-namelist: constraints +type: object +properties: + choice: + type: integer + x-fortran-kind: val + enum: [1, 2] + minimum: 1 + maximum: 2 + limit: + type: integer + x-fortran-kind: allow_missing + minimum: 0 + upper: + type: integer + x-fortran-kind: in_bounds + maximum: 4 diff --git a/tests/fortran_namespaces/input.nml b/tests/fortran_namespaces/input.nml new file mode 100644 index 0000000..12a0e2e --- /dev/null +++ b/tests/fortran_namespaces/input.nml @@ -0,0 +1,20 @@ +&namespaces + status = 17 + file = 19 + nml = 20 + iostat = 21 + close_status = 22 + data = 23 + dims = 24 + set = 25 + set_dims = 29 + init = 26 + init_type = 34 + from_file = 30 + is_set = 31 + is_valid = 32 + filled_shape = 33 + is_configured = 27 + values = 3, 4, 5 + more_values = 6, 7 +/ diff --git a/tests/fortran_namespaces/namespaces.yml b/tests/fortran_namespaces/namespaces.yml new file mode 100644 index 0000000..0ab814e --- /dev/null +++ b/tests/fortran_namespaces/namespaces.yml @@ -0,0 +1,64 @@ +title: Namespace conformance +x-fortran-namelist: namespaces +type: object +properties: + status: + type: integer + default: 0 + file: + type: integer + default: 0 + nml: + type: integer + default: 0 + iostat: + type: integer + default: 0 + close_status: + type: integer + default: 0 + data: + type: integer + default: 0 + dims: + type: integer + default: 0 + set: + type: integer + default: 0 + set_dims: + type: integer + default: 0 + init: + type: integer + default: 0 + init_type: + type: integer + default: 0 + from_file: + type: integer + default: 0 + is_set: + type: integer + default: 0 + is_valid: + type: integer + default: 0 + filled_shape: + type: integer + default: 0 + is_configured: + type: integer + default: 0 + values: + type: array + x-fortran-shape: status + items: + type: integer + default: 0 + more_values: + type: array + x-fortran-shape: set_dims + items: + type: integer + default: 0 diff --git a/tests/fortran_namespaces/nml-config.toml b/tests/fortran_namespaces/nml-config.toml new file mode 100644 index 0000000..10ab263 --- /dev/null +++ b/tests/fortran_namespaces/nml-config.toml @@ -0,0 +1,38 @@ +[helper] +path = "out/nml_helper.f90" + +[kinds] +module = "iso_fortran_env" +integer = ["int16", "int32", "int64"] +map = { i4 = "int32", val = "int32", allow_missing = "int16", in_bounds = "int64" } + +[dimensions.status] +default = 3 + +[dimensions.set_dims] +default = 2 + +[dimensions.c_intptr_t] +default = 2 + +[[namelists]] +name = "namespaces" +schema = "namespaces.yml" +mod_path = "out/nml_namespaces.f90" + +[[namelists]] +name = "wrapper_status" +schema = "wrapper_status.yml" +mod_path = "out/nml_wrapper_status.f90" +f2py_path = "out/f2py_wrapper_status.f90" + +[[namelists]] +name = "constraints" +schema = "constraints.yml" +mod_path = "out/nml_constraints.f90" + +[[namelists]] +name = "c_bindings" +schema = "c_bindings.yml" +mod_path = "out/nml_c_bindings.f90" +f2py_path = "out/f2py_c_bindings.f90" diff --git a/tests/fortran_namespaces/out/f2py_c_bindings.f90 b/tests/fortran_namespaces/out/f2py_c_bindings.f90 new file mode 100644 index 0000000..48eadb2 --- /dev/null +++ b/tests/fortran_namespaces/out/f2py_c_bindings.f90 @@ -0,0 +1,162 @@ +! This file was generated by nml-tools. +!> \file f2py_c_bindings.f90 +!> \copydoc f2py_c_bindings + +!> \brief Resolver dependency isolation +!> \details Resolver dependency isolation +module f2py_c_bindings + use iso_c_binding, only: c_intptr_t + use nml_c_bindings, only: nml_c_bindings_t, nml_c_bindings_resolve_handle + implicit none + +contains + + !> \brief Read the c_bindings namelist from a file + subroutine c_bindings_from_file_wrapper(nml__handle, file, nml__status, nml__errmsg) + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a nml_c_bindings_t instance + character(len=*), intent(in) :: file !< namelist file path + integer, intent(out) :: nml__status !< nml-tools status code + character(len=1024), intent(out) :: nml__errmsg !< error message for non-OK status values + type(nml_c_bindings_t), pointer :: nml__obj + + call nml_c_bindings_resolve_handle(nml__handle, nml__obj, nml__status, nml__errmsg) + if (.not. associated(nml__obj)) then + return + end if + nml__status = nml__obj%from_file(file, errmsg=nml__errmsg) + end subroutine c_bindings_from_file_wrapper + + !> \brief Set c_bindings values on the handled instance + subroutine c_bindings_set_wrapper(nml__handle, & + c_intptr_t__value, & + has__c_intptr_t, & + c_ptr, & + has__c_ptr, & + c_null_ptr, & + has__c_null_ptr, & + c_f_pointer, & + has__c_f_pointer, & + values__n1, & + values, & + has__values, & + nml__status, nml__errmsg) + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a nml_c_bindings_t instance + integer, intent(in) :: c_intptr_t__value !< c_intptr_t (optional) + logical, intent(in) :: has__c_intptr_t !< whether c_intptr_t was provided + integer, intent(in) :: c_ptr !< c_ptr (optional) + logical, intent(in) :: has__c_ptr !< whether c_ptr was provided + integer, intent(in) :: c_null_ptr !< c_null_ptr (optional) + logical, intent(in) :: has__c_null_ptr !< whether c_null_ptr was provided + integer, intent(in) :: c_f_pointer !< c_f_pointer (optional) + logical, intent(in) :: has__c_f_pointer !< whether c_f_pointer was provided + integer, intent(in) :: values__n1 !< extent for values + integer, dimension(values__n1), intent(in) :: values !< values (optional) + logical, intent(in) :: has__values !< whether values was provided + integer, intent(out) :: nml__status !< nml-tools status code + character(len=1024), intent(out) :: nml__errmsg !< error message for non-OK status values + type(nml_c_bindings_t), pointer :: nml__obj + integer, allocatable :: maybe__c_intptr_t + integer, allocatable :: maybe__c_ptr + integer, allocatable :: maybe__c_null_ptr + integer, allocatable :: maybe__c_f_pointer + integer, dimension(:), allocatable :: maybe__values + + call nml_c_bindings_resolve_handle(nml__handle, nml__obj, nml__status, nml__errmsg) + if (.not. associated(nml__obj)) then + return + end if + if (has__c_intptr_t) then + allocate(maybe__c_intptr_t) + maybe__c_intptr_t = c_intptr_t__value + end if + if (has__c_ptr) then + allocate(maybe__c_ptr) + maybe__c_ptr = c_ptr + end if + if (has__c_null_ptr) then + allocate(maybe__c_null_ptr) + maybe__c_null_ptr = c_null_ptr + end if + if (has__c_f_pointer) then + allocate(maybe__c_f_pointer) + maybe__c_f_pointer = c_f_pointer + end if + if (has__values) then + allocate(maybe__values(values__n1)) + maybe__values = values + end if + nml__status = nml__obj%set( & + c_intptr_t=maybe__c_intptr_t, & + c_ptr=maybe__c_ptr, & + c_null_ptr=maybe__c_null_ptr, & + c_f_pointer=maybe__c_f_pointer, & + values=maybe__values, & + errmsg=nml__errmsg) + end subroutine c_bindings_set_wrapper + + !> \brief Set runtime dimensions on the handled c_bindings instance + subroutine c_bindings_set_dims_wrapper(nml__handle, & + c_intptr_t__value, & + has__c_intptr_t, & + nml__status, nml__errmsg) + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a nml_c_bindings_t instance + integer, intent(in) :: c_intptr_t__value !< runtime dimension override for c_intptr_t + logical, intent(in) :: has__c_intptr_t !< whether c_intptr_t was provided + integer, intent(out) :: nml__status !< nml-tools status code + character(len=1024), intent(out) :: nml__errmsg !< error message for non-OK status values + type(nml_c_bindings_t), pointer :: nml__obj + integer, allocatable :: maybe__c_intptr_t + + call nml_c_bindings_resolve_handle(nml__handle, nml__obj, nml__status, nml__errmsg) + if (.not. associated(nml__obj)) then + return + end if + if (has__c_intptr_t) then + allocate(maybe__c_intptr_t) + maybe__c_intptr_t = c_intptr_t__value + end if + nml__status = nml__obj%set_dims( & + c_intptr_t=maybe__c_intptr_t, & + errmsg=nml__errmsg) + end subroutine c_bindings_set_dims_wrapper + + + !> \brief Check whether a c_bindings field is set + subroutine c_bindings_is_set_wrapper(nml__handle, name, idx__n1, idx, has__idx, nml__status, nml__errmsg) + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a nml_c_bindings_t instance + character(len=*), intent(in) :: name !< field name + integer, intent(in) :: idx__n1 !< extent for idx + integer, dimension(idx__n1), intent(in) :: idx !< optional field index values + logical, intent(in) :: has__idx !< whether idx was provided + integer, intent(out) :: nml__status !< nml-tools status code + character(len=1024), intent(out) :: nml__errmsg !< error message for non-OK status values + type(nml_c_bindings_t), pointer :: nml__obj + integer, dimension(:), allocatable :: maybe__idx + + call nml_c_bindings_resolve_handle(nml__handle, nml__obj, nml__status, nml__errmsg) + if (.not. associated(nml__obj)) then + return + end if + if (has__idx) then + allocate(maybe__idx(idx__n1)) + maybe__idx = idx + end if + nml__status = nml__obj%is_set(name, idx=maybe__idx, errmsg=nml__errmsg) + end subroutine c_bindings_is_set_wrapper + + !> \brief Validate the handled c_bindings instance + subroutine c_bindings_is_valid_wrapper(nml__handle, nml__status, nml__errmsg) + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a nml_c_bindings_t instance + integer, intent(out) :: nml__status !< nml-tools status code + character(len=1024), intent(out) :: nml__errmsg !< error message for non-OK status values + type(nml_c_bindings_t), pointer :: nml__obj + + call nml_c_bindings_resolve_handle(nml__handle, nml__obj, nml__status, nml__errmsg) + if (.not. associated(nml__obj)) then + return + end if + nml__status = nml__obj%is_valid(errmsg=nml__errmsg) + end subroutine c_bindings_is_valid_wrapper + +end module f2py_c_bindings + diff --git a/tests/fortran_namespaces/out/f2py_wrapper_status.f90 b/tests/fortran_namespaces/out/f2py_wrapper_status.f90 new file mode 100644 index 0000000..0f405f1 --- /dev/null +++ b/tests/fortran_namespaces/out/f2py_wrapper_status.f90 @@ -0,0 +1,113 @@ +! This file was generated by nml-tools. +!> \file f2py_wrapper_status.f90 +!> \copydoc f2py_wrapper_status + +!> \brief Wrapper status type +!> \details Wrapper status type +module f2py_wrapper_status + use iso_c_binding, only: c_intptr_t + use nml_helper, only: NML_OK, NML_ERR_INVALID_INDEX + use nml_wrapper_status, only: nml_wrapper_status_t, nml_wrapper_status_resolve_handle, status, c_ptr + implicit none + +contains + + !> \brief Read the wrapper_status namelist from a file + subroutine wrapper_status_from_file_wrapper(nml__handle, file, nml__status, nml__errmsg) + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a nml_wrapper_status_t instance + character(len=*), intent(in) :: file !< namelist file path + integer, intent(out) :: nml__status !< nml-tools status code + character(len=1024), intent(out) :: nml__errmsg !< error message for non-OK status values + type(nml_wrapper_status_t), pointer :: nml__obj + + call nml_wrapper_status_resolve_handle(nml__handle, nml__obj, nml__status, nml__errmsg) + if (.not. associated(nml__obj)) then + return + end if + nml__status = nml__obj%from_file(file, errmsg=nml__errmsg) + end subroutine wrapper_status_from_file_wrapper + + !> \brief Set wrapper_status values on the handled instance + subroutine wrapper_status_set_wrapper(nml__handle, & + has__state, & + state__code, & + has__state__code, & + has__pointer_state, & + pointer_state__code, & + has__pointer_state__code, & + nml__status, nml__errmsg) + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a nml_wrapper_status_t instance + logical, intent(in) :: has__state !< whether state was provided + integer, intent(in) :: state__code !< state%code + logical, intent(in) :: has__state__code !< whether state%code was provided + logical, intent(in) :: has__pointer_state !< whether pointer_state was provided + integer, intent(in) :: pointer_state__code !< pointer_state%code + logical, intent(in) :: has__pointer_state__code !< whether pointer_state%code was provided + integer, intent(out) :: nml__status !< nml-tools status code + character(len=1024), intent(out) :: nml__errmsg !< error message for non-OK status values + type(nml_wrapper_status_t), pointer :: nml__obj + type(status), allocatable :: maybe__state + type(c_ptr), allocatable :: maybe__pointer_state + + call nml_wrapper_status_resolve_handle(nml__handle, nml__obj, nml__status, nml__errmsg) + if (.not. associated(nml__obj)) then + return + end if + if (has__state) then + allocate(maybe__state) + nml__status = nml__obj%init_type(state=maybe__state, errmsg=nml__errmsg) + if (nml__status /= NML_OK) return + if (has__state__code) maybe__state%code = state__code + end if + if (has__pointer_state) then + allocate(maybe__pointer_state) + nml__status = nml__obj%init_type(pointer_state=maybe__pointer_state, errmsg=nml__errmsg) + if (nml__status /= NML_OK) return + if (has__pointer_state__code) maybe__pointer_state%code = pointer_state__code + end if + nml__status = nml__obj%set( & + state=maybe__state, & + pointer_state=maybe__pointer_state, & + errmsg=nml__errmsg) + end subroutine wrapper_status_set_wrapper + + + !> \brief Check whether a wrapper_status field is set + subroutine wrapper_status_is_set_wrapper(nml__handle, name, idx__n1, idx, has__idx, nml__status, nml__errmsg) + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a nml_wrapper_status_t instance + character(len=*), intent(in) :: name !< field name + integer, intent(in) :: idx__n1 !< extent for idx + integer, dimension(idx__n1), intent(in) :: idx !< optional field index values + logical, intent(in) :: has__idx !< whether idx was provided + integer, intent(out) :: nml__status !< nml-tools status code + character(len=1024), intent(out) :: nml__errmsg !< error message for non-OK status values + type(nml_wrapper_status_t), pointer :: nml__obj + integer, dimension(:), allocatable :: maybe__idx + + call nml_wrapper_status_resolve_handle(nml__handle, nml__obj, nml__status, nml__errmsg) + if (.not. associated(nml__obj)) then + return + end if + if (has__idx) then + allocate(maybe__idx(idx__n1)) + maybe__idx = idx + end if + nml__status = nml__obj%is_set(name, idx=maybe__idx, errmsg=nml__errmsg) + end subroutine wrapper_status_is_set_wrapper + + !> \brief Validate the handled wrapper_status instance + subroutine wrapper_status_is_valid_wrapper(nml__handle, nml__status, nml__errmsg) + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a nml_wrapper_status_t instance + integer, intent(out) :: nml__status !< nml-tools status code + character(len=1024), intent(out) :: nml__errmsg !< error message for non-OK status values + type(nml_wrapper_status_t), pointer :: nml__obj + + call nml_wrapper_status_resolve_handle(nml__handle, nml__obj, nml__status, nml__errmsg) + if (.not. associated(nml__obj)) then + return + end if + nml__status = nml__obj%is_valid(errmsg=nml__errmsg) + end subroutine wrapper_status_is_valid_wrapper + +end module f2py_wrapper_status + diff --git a/tests/fortran_namespaces/out/nml_c_bindings.f90 b/tests/fortran_namespaces/out/nml_c_bindings.f90 new file mode 100644 index 0000000..a2f75e2 --- /dev/null +++ b/tests/fortran_namespaces/out/nml_c_bindings.f90 @@ -0,0 +1,348 @@ +!> \file nml_c_bindings.f90 +!> \copydoc nml_c_bindings + +!> \brief Resolver dependency isolation +!> \details Resolver dependency isolation +module nml_c_bindings + use nml_helper, only: & + nml_file_t, & + nml_line_buffer, & + NML_OK, & + NML_ERR_FILE_NOT_FOUND, & + NML_ERR_OPEN, & + NML_ERR_NOT_OPEN, & + NML_ERR_NML_NOT_FOUND, & + NML_ERR_READ, & + NML_ERR_CLOSE, & + NML_ERR_REQUIRED, & + NML_ERR_ENUM, & + NML_ERR_BOUNDS, & + NML_ERR_NOT_SET, & + NML_ERR_INVALID_NAME, & + NML_ERR_INVALID_INDEX, & + idx__check, & + to__lower, & + NML_ERR_INVALID_HANDLE, & + c_intptr_t__dim_default + + implicit none + + ! default values + integer, parameter, public :: c_intptr_t__default = 0 + integer, parameter, public :: c_ptr__default = 0 + integer, parameter, public :: c_null_ptr__default = 0 + integer, parameter, public :: c_f_pointer__default = 0 + integer, parameter, public :: values__default = 0 + + private :: nml_c_bindings_read__from_file + + !> \class nml_c_bindings_data_t + !> \brief Schema-backed values for c_bindings + type, public :: nml_c_bindings_data_t + integer :: c_intptr_t !< c_intptr_t + integer :: c_ptr !< c_ptr + integer :: c_null_ptr !< c_null_ptr + integer :: c_f_pointer !< c_f_pointer + integer, allocatable, dimension(:) :: values !< values + end type nml_c_bindings_data_t + + !> \class nml_c_bindings_dims_t + !> \brief Runtime dimensions for c_bindings + type, public :: nml_c_bindings_dims_t + integer :: c_intptr_t = c_intptr_t__dim_default !< runtime dimension for c_intptr_t + end type nml_c_bindings_dims_t + + !> \class nml_c_bindings_t + !> \brief Resolver dependency isolation + !> \details Resolver dependency isolation + type, public :: nml_c_bindings_t + type(nml_c_bindings_data_t) :: data !< schema-backed namelist values + type(nml_c_bindings_dims_t) :: dims !< runtime array dimensions + logical :: is_configured = .false. !< whether the namelist has been configured + contains + procedure :: init => nml_c_bindings_init + procedure :: set_dims => nml_c_bindings_set_dims + procedure :: from_file => nml_c_bindings_from_file + procedure :: set => nml_c_bindings_set + procedure :: is_set => nml_c_bindings_is_set + procedure :: is_valid => nml_c_bindings_is_valid + end type nml_c_bindings_t + +contains + + !> \brief Resolve an opaque C pointer handle to a nml_c_bindings_t pointer + subroutine nml_c_bindings_resolve_handle(nml__handle, nml__obj, nml__status, errmsg) + use iso_c_binding, only: c_f_pointer, c_intptr_t, c_null_ptr, c_ptr + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a nml_c_bindings_t instance + type(nml_c_bindings_t), pointer :: nml__obj !< resolved namelist pointer + integer, intent(out) :: nml__status !< nml-tools status code + character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + type(c_ptr) :: nml__ptr + + if (present(errmsg)) errmsg = "" + nullify(nml__obj) + if (nml__handle == 0_c_intptr_t) then + nml__status = NML_ERR_INVALID_HANDLE + if (present(errmsg)) errmsg = "zero handle" + return + end if + nml__ptr = transfer(nml__handle, c_null_ptr) + call c_f_pointer(nml__ptr, nml__obj) + nml__status = NML_OK + end subroutine nml_c_bindings_resolve_handle + + !> \brief Initialize defaults and sentinels for c_bindings + integer function nml_c_bindings_init(nml__obj, errmsg) result(nml__status) + class(nml_c_bindings_t), intent(inout) :: nml__obj !< namelist instance + character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + + nml__status = NML_OK + if (present(errmsg)) errmsg = "" + nml__obj%is_configured = .false. + + ! allocate runtime-sized fields + if (allocated(nml__obj%data%values)) deallocate(nml__obj%data%values) + allocate(nml__obj%data%values(nml__obj%dims%c_intptr_t)) + + ! default values + nml__obj%data%c_intptr_t = c_intptr_t__default + nml__obj%data%c_ptr = c_ptr__default + nml__obj%data%c_null_ptr = c_null_ptr__default + nml__obj%data%c_f_pointer = c_f_pointer__default + nml__obj%data%values = values__default + end function nml_c_bindings_init + + !> \brief Reset runtime dimensions for c_bindings + integer function nml_c_bindings_set_dims(nml__obj, & + c_intptr_t, & + errmsg) result(nml__status) + class(nml_c_bindings_t), intent(inout) :: nml__obj !< namelist instance + integer, intent(in), optional :: c_intptr_t !< runtime dimension override for c_intptr_t + integer :: candidate__c_intptr_t + character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + + nml__status = NML_OK + if (present(errmsg)) errmsg = "" + if (present(c_intptr_t)) then + candidate__c_intptr_t = c_intptr_t + else + candidate__c_intptr_t = c_intptr_t__dim_default + end if + if (candidate__c_intptr_t <= 0) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "dimension 'c_intptr_t' must be positive" + return + end if + nml__obj%dims%c_intptr_t = candidate__c_intptr_t + + ! deallocate runtime-sized fields; init/set/from_file allocate them again + if (allocated(nml__obj%data%values)) deallocate(nml__obj%data%values) + nml__obj%is_configured = .false. + end function nml_c_bindings_set_dims + + + !> \brief Read c_bindings namelist from file + integer function nml_c_bindings_from_file(nml__obj, file, errmsg) result(nml__status) + class(nml_c_bindings_t), intent(inout) :: nml__obj !< namelist instance + character(len=*), intent(in) :: file !< path to namelist file + character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + + nml__status = nml_c_bindings_read__from_file(nml__obj, file, errmsg) + end function nml_c_bindings_from_file + + integer function nml_c_bindings_read__from_file(nml__obj, nml__file, errmsg) & + result(nml__status) + class(nml_c_bindings_t), intent(inout) :: nml__obj + character(len=*), intent(in) :: nml__file + character(len=*), intent(out), optional :: errmsg + ! namelist variables + integer :: c_intptr_t + integer :: c_ptr + integer :: c_null_ptr + integer :: c_f_pointer + integer, allocatable, dimension(:) :: values + ! locals + type(nml_file_t) :: nml__reader + integer :: nml__iostat + integer :: nml__close_status + character(len=nml_line_buffer) :: nml__iomsg + + namelist /c_bindings/ & + c_intptr_t, & + c_ptr, & + c_null_ptr, & + c_f_pointer, & + values + + nml__status = nml__obj%init(errmsg=errmsg) + if (nml__status /= NML_OK) return + ! allocate local namelist variables matching runtime-sized fields + if (allocated(values)) deallocate(values) + allocate(values(nml__obj%dims%c_intptr_t)) + c_intptr_t = nml__obj%data%c_intptr_t + c_ptr = nml__obj%data%c_ptr + c_null_ptr = nml__obj%data%c_null_ptr + c_f_pointer = nml__obj%data%c_f_pointer + values = nml__obj%data%values + + nml__status = nml__reader%open(nml__file, errmsg=errmsg) + if (nml__status /= NML_OK) return + + nml__status = nml__reader%find("c_bindings", errmsg=errmsg) + if (nml__status /= NML_OK) then + if (nml__status == NML_ERR_NML_NOT_FOUND) then + nml__close_status = nml__reader%close(errmsg=errmsg) + if (nml__close_status /= NML_OK) then + nml__status = nml__close_status + return + end if + nml__obj%is_configured = .true. + nml__status = NML_OK + return + end if + nml__close_status = nml__reader%close() + return + end if + + ! read namelist + read(nml__reader%unit, nml=c_bindings, iostat=nml__iostat, iomsg=nml__iomsg) + if (nml__iostat /= 0) then + nml__status = NML_ERR_READ + if (present(errmsg)) errmsg = trim(nml__iomsg) + nml__close_status = nml__reader%close() + return + end if + nml__close_status = nml__reader%close(errmsg=errmsg) + if (nml__close_status /= NML_OK) then + nml__status = nml__close_status + return + end if + + ! assign values + nml__obj%data%c_intptr_t = c_intptr_t + nml__obj%data%c_ptr = c_ptr + nml__obj%data%c_null_ptr = c_null_ptr + nml__obj%data%c_f_pointer = c_f_pointer + nml__obj%data%values = values + + ! mark as configured + nml__obj%is_configured = .true. + nml__status = NML_OK + end function nml_c_bindings_read__from_file + + !> \brief Set c_bindings values + integer function nml_c_bindings_set(nml__obj, & + c_intptr_t, & + c_ptr, & + c_null_ptr, & + c_f_pointer, & + values, & + errmsg) result(nml__status) + + class(nml_c_bindings_t), intent(inout) :: nml__obj !< namelist instance + character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + integer, intent(in), optional :: c_intptr_t !< c_intptr_t + integer, intent(in), optional :: c_ptr !< c_ptr + integer, intent(in), optional :: c_null_ptr !< c_null_ptr + integer, intent(in), optional :: c_f_pointer !< c_f_pointer + integer, dimension(:), intent(in), optional :: values !< values + nml__status = nml__obj%init(errmsg=errmsg) + if (nml__status /= NML_OK) return + + ! required parameters + ! override with provided values + if (present(c_intptr_t)) nml__obj%data%c_intptr_t = c_intptr_t + if (present(c_ptr)) nml__obj%data%c_ptr = c_ptr + if (present(c_null_ptr)) nml__obj%data%c_null_ptr = c_null_ptr + if (present(c_f_pointer)) nml__obj%data%c_f_pointer = c_f_pointer + if (present(values)) then + if (size(values, 1) > size(nml__obj%data%values, 1)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'values'" + return + end if + nml__obj%data%values( & + 1:size(values, 1)) = values + end if + + ! mark as configured + nml__obj%is_configured = .true. + nml__status = NML_OK + end function nml_c_bindings_set + + !> \brief Check whether a namelist value was set + integer function nml_c_bindings_is_set(nml__obj, name, idx, errmsg) result(nml__status) + class(nml_c_bindings_t), intent(in) :: nml__obj !< namelist instance + character(len=*), intent(in) :: name !< field name + integer, intent(in), optional :: idx(:) !< optional field index values + character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + + nml__status = NML_OK + if (present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" + return + end if + select case (to__lower(trim(name))) + case ("c_intptr_t") + if (present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index not supported for 'c_intptr_t'" + return + end if + case ("c_ptr") + if (present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index not supported for 'c_ptr'" + return + end if + case ("c_null_ptr") + if (present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index not supported for 'c_null_ptr'" + return + end if + case ("c_f_pointer") + if (present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index not supported for 'c_f_pointer'" + return + end if + case ("values") + if (.not. allocated(nml__obj%data%values)) then + nml__status = NML_ERR_NOT_SET + return + end if + if (present(idx)) then + nml__status = idx__check(idx, shape(nml__obj%data%values), & + "values", errmsg) + if (nml__status /= NML_OK) return + else + end if + case default + nml__status = NML_ERR_INVALID_NAME + if (present(errmsg)) errmsg = "unknown field: " // trim(name) + end select + if (nml__status == NML_ERR_NOT_SET .and. present(errmsg)) then + if (len_trim(errmsg) == 0) errmsg = "field not set: " // trim(name) + end if + end function nml_c_bindings_is_set + + !> \brief Validate required values and constraints + integer function nml_c_bindings_is_valid(nml__obj, errmsg) result(nml__status) + class(nml_c_bindings_t), intent(in) :: nml__obj !< namelist instance + character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + integer :: nml__istat + + nml__status = NML_OK + if (present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" + return + end if + + end function nml_c_bindings_is_valid + +end module nml_c_bindings diff --git a/tests/fortran_namespaces/out/nml_constraints.f90 b/tests/fortran_namespaces/out/nml_constraints.f90 new file mode 100644 index 0000000..e5654a7 --- /dev/null +++ b/tests/fortran_namespaces/out/nml_constraints.f90 @@ -0,0 +1,366 @@ +!> \file nml_constraints.f90 +!> \copydoc nml_constraints + +!> \brief Constraint internal state +!> \details Constraint internal state +module nml_constraints + use nml_helper, only: & + nml_file_t, & + nml_line_buffer, & + NML_OK, & + NML_ERR_FILE_NOT_FOUND, & + NML_ERR_OPEN, & + NML_ERR_NOT_OPEN, & + NML_ERR_NML_NOT_FOUND, & + NML_ERR_READ, & + NML_ERR_CLOSE, & + NML_ERR_REQUIRED, & + NML_ERR_ENUM, & + NML_ERR_BOUNDS, & + NML_ERR_NOT_SET, & + NML_ERR_INVALID_NAME, & + NML_ERR_INVALID_INDEX, & + idx__check, & + to__lower + ! kind specifiers listed in the nml-tools configuration file + use iso_fortran_env, only: & + val=>int32, & + allow_missing=>int16, & + in_bounds=>int64 + + implicit none + + ! enum values + integer(val), parameter, public :: choice__enum_values(2) = [1_val, 2_val] + + ! bounds values + integer(val), parameter, public :: choice__min = 1_val + integer(val), parameter, public :: choice__max = 2_val + integer(allow_missing), parameter, public :: limit__min = 0_allow_missing + integer(in_bounds), parameter, public :: upper__max = 4_in_bounds + + private :: nml_constraints_read__from_file + + !> \class nml_constraints_data_t + !> \brief Schema-backed values for constraints + type, public :: nml_constraints_data_t + integer(val) :: choice !< choice + integer(allow_missing) :: limit !< limit + integer(in_bounds) :: upper !< upper + end type nml_constraints_data_t + + !> \class nml_constraints_t + !> \brief Constraint internal state + !> \details Constraint internal state + type, public :: nml_constraints_t + type(nml_constraints_data_t) :: data !< schema-backed namelist values + logical :: is_configured = .false. !< whether the namelist has been configured + contains + procedure :: init => nml_constraints_init + procedure :: from_file => nml_constraints_from_file + procedure :: set => nml_constraints_set + procedure :: is_set => nml_constraints_is_set + procedure :: is_valid => nml_constraints_is_valid + end type nml_constraints_t + +contains + + !> \brief Check whether a value is part of an enum + elemental logical function choice__in_enum(nml__val, nml__allow_missing) result(nml__in_enum) + integer(val), intent(in) :: nml__val !< value to check + logical, intent(in), optional :: nml__allow_missing !< allow sentinel values as valid + + if (present(nml__allow_missing)) then + if (nml__allow_missing) then + if (nml__val == -huge(nml__val)) then + nml__in_enum = .true. + return + end if + end if + end if + nml__in_enum = any(nml__val == choice__enum_values) + end function choice__in_enum + + !> \brief Check whether a value is within bounds + elemental logical function choice__in_bounds(nml__val, nml__allow_missing) result(nml__in_bounds) + integer(val), intent(in) :: nml__val !< value to check + logical, intent(in), optional :: nml__allow_missing !< allow sentinel values as valid + + if (present(nml__allow_missing)) then + if (nml__allow_missing) then + if (nml__val == -huge(nml__val)) then + nml__in_bounds = .true. + return + end if + end if + end if + + nml__in_bounds = .true. + if (nml__val < choice__min) nml__in_bounds = .false. + if (nml__val > choice__max) nml__in_bounds = .false. + end function choice__in_bounds + + !> \brief Check whether a value is within bounds + elemental logical function limit__in_bounds(nml__val, nml__allow_missing) result(nml__in_bounds) + integer(allow_missing), intent(in) :: nml__val !< value to check + logical, intent(in), optional :: nml__allow_missing !< allow sentinel values as valid + + if (present(nml__allow_missing)) then + if (nml__allow_missing) then + if (nml__val == -huge(nml__val)) then + nml__in_bounds = .true. + return + end if + end if + end if + + nml__in_bounds = .true. + if (nml__val < limit__min) nml__in_bounds = .false. + end function limit__in_bounds + + !> \brief Check whether a value is within bounds + elemental logical function upper__in_bounds(nml__val, nml__allow_missing) result(nml__in_bounds) + integer(in_bounds), intent(in) :: nml__val !< value to check + logical, intent(in), optional :: nml__allow_missing !< allow sentinel values as valid + + if (present(nml__allow_missing)) then + if (nml__allow_missing) then + if (nml__val == -huge(nml__val)) then + nml__in_bounds = .true. + return + end if + end if + end if + + nml__in_bounds = .true. + if (nml__val > upper__max) nml__in_bounds = .false. + end function upper__in_bounds + + !> \brief Initialize defaults and sentinels for constraints + integer function nml_constraints_init(nml__obj, errmsg) result(nml__status) + class(nml_constraints_t), intent(inout) :: nml__obj !< namelist instance + character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + + nml__status = NML_OK + if (present(errmsg)) errmsg = "" + nml__obj%is_configured = .false. + + ! sentinel values for required/optional parameters + nml__obj%data%choice = -huge(nml__obj%data%choice) ! sentinel for optional integer + nml__obj%data%limit = -huge(nml__obj%data%limit) ! sentinel for optional integer + nml__obj%data%upper = -huge(nml__obj%data%upper) ! sentinel for optional integer + end function nml_constraints_init + + + !> \brief Read constraints namelist from file + integer function nml_constraints_from_file(nml__obj, file, errmsg) result(nml__status) + class(nml_constraints_t), intent(inout) :: nml__obj !< namelist instance + character(len=*), intent(in) :: file !< path to namelist file + character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + + nml__status = nml_constraints_read__from_file(nml__obj, file, errmsg) + end function nml_constraints_from_file + + integer function nml_constraints_read__from_file(nml__obj, nml__file, errmsg) & + result(nml__status) + class(nml_constraints_t), intent(inout) :: nml__obj + character(len=*), intent(in) :: nml__file + character(len=*), intent(out), optional :: errmsg + ! namelist variables + integer(val) :: choice + integer(allow_missing) :: limit + integer(in_bounds) :: upper + ! locals + type(nml_file_t) :: nml__reader + integer :: nml__iostat + integer :: nml__close_status + character(len=nml_line_buffer) :: nml__iomsg + + namelist /constraints/ & + choice, & + limit, & + upper + + nml__status = nml__obj%init(errmsg=errmsg) + if (nml__status /= NML_OK) return + choice = nml__obj%data%choice + limit = nml__obj%data%limit + upper = nml__obj%data%upper + + nml__status = nml__reader%open(nml__file, errmsg=errmsg) + if (nml__status /= NML_OK) return + + nml__status = nml__reader%find("constraints", errmsg=errmsg) + if (nml__status /= NML_OK) then + if (nml__status == NML_ERR_NML_NOT_FOUND) then + nml__close_status = nml__reader%close(errmsg=errmsg) + if (nml__close_status /= NML_OK) then + nml__status = nml__close_status + return + end if + nml__obj%is_configured = .true. + nml__status = NML_OK + return + end if + nml__close_status = nml__reader%close() + return + end if + + ! read namelist + read(nml__reader%unit, nml=constraints, iostat=nml__iostat, iomsg=nml__iomsg) + if (nml__iostat /= 0) then + nml__status = NML_ERR_READ + if (present(errmsg)) errmsg = trim(nml__iomsg) + nml__close_status = nml__reader%close() + return + end if + nml__close_status = nml__reader%close(errmsg=errmsg) + if (nml__close_status /= NML_OK) then + nml__status = nml__close_status + return + end if + + ! assign values + nml__obj%data%choice = choice + nml__obj%data%limit = limit + nml__obj%data%upper = upper + + ! mark as configured + nml__obj%is_configured = .true. + nml__status = NML_OK + end function nml_constraints_read__from_file + + !> \brief Set constraints values + integer function nml_constraints_set(nml__obj, & + choice, & + limit, & + upper, & + errmsg) result(nml__status) + + class(nml_constraints_t), intent(inout) :: nml__obj !< namelist instance + character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + integer(val), intent(in), optional :: choice !< choice + integer(allow_missing), intent(in), optional :: limit !< limit + integer(in_bounds), intent(in), optional :: upper !< upper + nml__status = nml__obj%init(errmsg=errmsg) + if (nml__status /= NML_OK) return + + ! required parameters + ! override with provided values + if (present(choice)) nml__obj%data%choice = choice + if (present(limit)) nml__obj%data%limit = limit + if (present(upper)) nml__obj%data%upper = upper + + ! mark as configured + nml__obj%is_configured = .true. + nml__status = NML_OK + end function nml_constraints_set + + !> \brief Check whether a namelist value was set + integer function nml_constraints_is_set(nml__obj, name, idx, errmsg) result(nml__status) + class(nml_constraints_t), intent(in) :: nml__obj !< namelist instance + character(len=*), intent(in) :: name !< field name + integer, intent(in), optional :: idx(:) !< optional field index values + character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + + nml__status = NML_OK + if (present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" + return + end if + select case (to__lower(trim(name))) + case ("choice") + if (present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index not supported for 'choice'" + return + end if + if (nml__obj%data%choice == -huge(nml__obj%data%choice)) nml__status = NML_ERR_NOT_SET + case ("limit") + if (present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index not supported for 'limit'" + return + end if + if (nml__obj%data%limit == -huge(nml__obj%data%limit)) nml__status = NML_ERR_NOT_SET + case ("upper") + if (present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index not supported for 'upper'" + return + end if + if (nml__obj%data%upper == -huge(nml__obj%data%upper)) nml__status = NML_ERR_NOT_SET + case default + nml__status = NML_ERR_INVALID_NAME + if (present(errmsg)) errmsg = "unknown field: " // trim(name) + end select + if (nml__status == NML_ERR_NOT_SET .and. present(errmsg)) then + if (len_trim(errmsg) == 0) errmsg = "field not set: " // trim(name) + end if + end function nml_constraints_is_set + + !> \brief Validate required values and constraints + integer function nml_constraints_is_valid(nml__obj, errmsg) result(nml__status) + class(nml_constraints_t), intent(in) :: nml__obj !< namelist instance + character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + integer :: nml__istat + + nml__status = NML_OK + if (present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" + return + end if + + ! enum constraints + nml__istat = nml__obj%is_set("choice", errmsg=errmsg) + if (nml__istat == NML_OK) then + if (.not. choice__in_enum(nml__obj%data%choice)) then + nml__status = NML_ERR_ENUM + if (present(errmsg)) errmsg = "enum constraint failed: choice" + return + end if + else if (nml__istat /= NML_ERR_NOT_SET) then + nml__status = nml__istat + return + end if + ! bounds constraints + nml__istat = nml__obj%is_set("choice", errmsg=errmsg) + if (nml__istat == NML_OK) then + if (.not. choice__in_bounds(nml__obj%data%choice)) then + nml__status = NML_ERR_BOUNDS + if (present(errmsg)) errmsg = "bounds constraint failed: choice" + return + end if + else if (nml__istat /= NML_ERR_NOT_SET) then + nml__status = nml__istat + return + end if + nml__istat = nml__obj%is_set("limit", errmsg=errmsg) + if (nml__istat == NML_OK) then + if (.not. limit__in_bounds(nml__obj%data%limit)) then + nml__status = NML_ERR_BOUNDS + if (present(errmsg)) errmsg = "bounds constraint failed: limit" + return + end if + else if (nml__istat /= NML_ERR_NOT_SET) then + nml__status = nml__istat + return + end if + nml__istat = nml__obj%is_set("upper", errmsg=errmsg) + if (nml__istat == NML_OK) then + if (.not. upper__in_bounds(nml__obj%data%upper)) then + nml__status = NML_ERR_BOUNDS + if (present(errmsg)) errmsg = "bounds constraint failed: upper" + return + end if + else if (nml__istat /= NML_ERR_NOT_SET) then + nml__status = nml__istat + return + end if + end function nml_constraints_is_valid + +end module nml_constraints diff --git a/tests/fortran_namespaces/out/nml_helper.f90 b/tests/fortran_namespaces/out/nml_helper.f90 new file mode 100644 index 0000000..c52a825 --- /dev/null +++ b/tests/fortran_namespaces/out/nml_helper.f90 @@ -0,0 +1,171 @@ +!> \file nml_helper.f90 +!> \copydoc nml_helper + +!> \brief Helper module for namelist file operations +module nml_helper + + !> \brief Buffer length for reading lines + integer, public :: nml_line_buffer = 1024 + !> \brief Status code: success + integer, parameter, public :: NML_OK = 0 + !> \brief Status code: file not found + integer, parameter, public :: NML_ERR_FILE_NOT_FOUND = 1 + !> \brief Status code: failed to open file + integer, parameter, public :: NML_ERR_OPEN = 2 + !> \brief Status code: file not open + integer, parameter, public :: NML_ERR_NOT_OPEN = 3 + !> \brief Status code: namelist not found + integer, parameter, public :: NML_ERR_NML_NOT_FOUND = 4 + !> \brief Status code: read error + integer, parameter, public :: NML_ERR_READ = 5 + !> \brief Status code: close error + integer, parameter, public :: NML_ERR_CLOSE = 6 + !> \brief Status code: required value missing + integer, parameter, public :: NML_ERR_REQUIRED = 10 + !> \brief Status code: enum validation failed + integer, parameter, public :: NML_ERR_ENUM = 11 + !> \brief Status code: value not set + integer, parameter, public :: NML_ERR_NOT_SET = 12 + !> \brief Status code: array partially set + integer, parameter, public :: NML_ERR_PARTLY_SET = 13 + !> \brief Status code: bounds validation failed + integer, parameter, public :: NML_ERR_BOUNDS = 14 + !> \brief Status code: invalid field name + integer, parameter, public :: NML_ERR_INVALID_NAME = 20 + !> \brief Status code: invalid index + integer, parameter, public :: NML_ERR_INVALID_INDEX = 21 + !> \brief Status code: zero opaque handle + integer, parameter, public :: NML_ERR_INVALID_HANDLE = 22 + + !> \brief Shared constants for generated namelist modules + integer, parameter, public :: status__dim_default = 3 + integer, parameter, public :: set_dims__dim_default = 2 + integer, parameter, public :: c_intptr_t__dim_default = 2 + + !> \class nml_file_t + !> \brief Type for namelist file operations + type, public :: nml_file_t + integer :: unit = 0 + logical :: is_open = .false. + contains + procedure :: open => nml_open + procedure :: find => nml_find + procedure :: close => nml_close + end type nml_file_t + +contains + + !> \brief Open a namelist file + integer function nml_open(this, file, errmsg) result(nml__status) + class(nml_file_t), intent(inout) :: this + character(len=*), intent(in) :: file + character(len=*), intent(out), optional :: errmsg + integer :: nml__iostat + logical :: nml__exists + character(len=nml_line_buffer) :: nml__iomsg + if (present(errmsg)) errmsg = "" + nml__status = this%close() + inquire(file=file, exist=nml__exists) + if (.not. nml__exists) then + this%is_open = .false. + this%unit = 0 + nml__status = NML_ERR_FILE_NOT_FOUND + if (present(errmsg)) errmsg = "file not found: " // trim(file) + return + end if + open(newunit=this%unit, file=file, status='old', action='read', & + iostat=nml__iostat, iomsg=nml__iomsg) + this%is_open = (nml__iostat == 0) + if (.not. this%is_open) then + this%unit = 0 + nml__status = NML_ERR_OPEN + if (present(errmsg)) errmsg = trim(nml__iomsg) + return + end if + nml__status = NML_OK + end function nml_open + + !> \brief Find a namelist in the opened file + integer function nml_find(this, nml, errmsg) result(nml__status) + class(nml_file_t), intent(inout) :: this + character(len=*), intent(in) :: nml + character(len=*), intent(out), optional :: errmsg + integer :: nml__iostat + character(len=nml_line_buffer) :: nml__line + character(len=nml_line_buffer) :: nml__iomsg + if (present(errmsg)) errmsg = "" + nml__status = NML_ERR_NML_NOT_FOUND + if (.not. this%is_open) then + nml__status = NML_ERR_NOT_OPEN + if (present(errmsg)) errmsg = "file not open" + return + end if + rewind(unit=this%unit) + do + read(this%unit, '(A)', iostat=nml__iostat, iomsg=nml__iomsg) nml__line + if (nml__iostat < 0) exit + if (nml__iostat > 0) then + nml__status = NML_ERR_READ + if (present(errmsg)) errmsg = trim(nml__iomsg) + return + end if + if (index(to__lower(nml__line), '&' // to__lower(trim(nml))) /= 0) then + nml__status = NML_OK + backspace(this%unit) + return + end if + end do + if (present(errmsg)) errmsg = "namelist not found: " // trim(nml) + end function nml_find + + !> \brief Close the namelist file + integer function nml_close(this, errmsg) result(nml__status) + class(nml_file_t), intent(inout) :: this + character(len=*), intent(out), optional :: errmsg + integer :: nml__iostat + character(len=nml_line_buffer) :: nml__iomsg + if (present(errmsg)) errmsg = "" + nml__status = NML_OK + if (this%is_open) then + close(unit=this%unit, iostat=nml__iostat, iomsg=nml__iomsg) + if (nml__iostat /= 0) then + nml__status = NML_ERR_CLOSE + if (present(errmsg)) errmsg = trim(nml__iomsg) + end if + end if + this%is_open = .false. + this%unit = 0 + end function nml_close + + !> \brief Convert string to lower case + pure function to__lower(nml__string) result(nml__lower_string) + character(len=*), intent(in) :: nml__string + character(len=len(nml__string)) :: nml__lower_string + integer, parameter :: nml__shift=iachar('a')-iachar('A'), nml__upA=iachar('A'), nml__upZ=iachar('Z') + integer :: nml__k, nml__i + do nml__i = 1, len(nml__string) + nml__k = ichar(nml__string(nml__i:nml__i)) + if (nml__k>=nml__upA .and. nml__k<=nml__upZ) nml__k = nml__k + nml__shift + nml__lower_string(nml__i:nml__i) = char(nml__k) + end do + end function to__lower + + !> \brief Validate index bounds for array access + integer function idx__check(nml__idx, nml__extents, nml__field, errmsg) result(nml__status) + integer, intent(in) :: nml__idx(:) + integer, intent(in) :: nml__extents(:) + character(len=*), intent(in) :: nml__field + character(len=*), intent(out), optional :: errmsg + + nml__status = NML_OK + if (present(errmsg)) errmsg = "" + if (size(nml__idx) /= size(nml__extents)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index rank mismatch for '" // trim(nml__field) // "'" + else if (any(nml__idx < 1) .or. any(nml__idx > nml__extents)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index out of bounds for '" // trim(nml__field) // "'" + end if + end function idx__check + +end module nml_helper diff --git a/tests/fortran_namespaces/out/nml_namespaces.f90 b/tests/fortran_namespaces/out/nml_namespaces.f90 new file mode 100644 index 0000000..bd5745c --- /dev/null +++ b/tests/fortran_namespaces/out/nml_namespaces.f90 @@ -0,0 +1,568 @@ +!> \file nml_namespaces.f90 +!> \copydoc nml_namespaces + +!> \brief Namespace conformance +!> \details Namespace conformance +module nml_namespaces + use nml_helper, only: & + nml_file_t, & + nml_line_buffer, & + NML_OK, & + NML_ERR_FILE_NOT_FOUND, & + NML_ERR_OPEN, & + NML_ERR_NOT_OPEN, & + NML_ERR_NML_NOT_FOUND, & + NML_ERR_READ, & + NML_ERR_CLOSE, & + NML_ERR_REQUIRED, & + NML_ERR_ENUM, & + NML_ERR_BOUNDS, & + NML_ERR_NOT_SET, & + NML_ERR_INVALID_NAME, & + NML_ERR_INVALID_INDEX, & + idx__check, & + to__lower, & + status__dim_default, & + set_dims__dim_default + + implicit none + + ! default values + integer, parameter, public :: status__default = 0 + integer, parameter, public :: file__default = 0 + integer, parameter, public :: nml__default = 0 + integer, parameter, public :: iostat__default = 0 + integer, parameter, public :: close_status__default = 0 + integer, parameter, public :: data__default = 0 + integer, parameter, public :: dims__default = 0 + integer, parameter, public :: set__default = 0 + integer, parameter, public :: set_dims__default = 0 + integer, parameter, public :: init__default = 0 + integer, parameter, public :: init_type__default = 0 + integer, parameter, public :: from_file__default = 0 + integer, parameter, public :: is_set__default = 0 + integer, parameter, public :: is_valid__default = 0 + integer, parameter, public :: filled_shape__default = 0 + integer, parameter, public :: is_configured__default = 0 + integer, parameter, public :: values__default = 0 + integer, parameter, public :: more_values__default = 0 + + private :: nml_namespaces_read__from_file + + !> \class nml_namespaces_data_t + !> \brief Schema-backed values for namespaces + type, public :: nml_namespaces_data_t + integer :: status !< status + integer :: file !< file + integer :: nml !< nml + integer :: iostat !< iostat + integer :: close_status !< close_status + integer :: data !< data + integer :: dims !< dims + integer :: set !< set + integer :: set_dims !< set_dims + integer :: init !< init + integer :: init_type !< init_type + integer :: from_file !< from_file + integer :: is_set !< is_set + integer :: is_valid !< is_valid + integer :: filled_shape !< filled_shape + integer :: is_configured !< is_configured + integer, allocatable, dimension(:) :: values !< values + integer, allocatable, dimension(:) :: more_values !< more_values + end type nml_namespaces_data_t + + !> \class nml_namespaces_dims_t + !> \brief Runtime dimensions for namespaces + type, public :: nml_namespaces_dims_t + integer :: status = status__dim_default !< runtime dimension for status + integer :: set_dims = set_dims__dim_default !< runtime dimension for set_dims + end type nml_namespaces_dims_t + + !> \class nml_namespaces_t + !> \brief Namespace conformance + !> \details Namespace conformance + type, public :: nml_namespaces_t + type(nml_namespaces_data_t) :: data !< schema-backed namelist values + type(nml_namespaces_dims_t) :: dims !< runtime array dimensions + logical :: is_configured = .false. !< whether the namelist has been configured + contains + procedure :: init => nml_namespaces_init + procedure :: set_dims => nml_namespaces_set_dims + procedure :: from_file => nml_namespaces_from_file + procedure :: set => nml_namespaces_set + procedure :: is_set => nml_namespaces_is_set + procedure :: is_valid => nml_namespaces_is_valid + end type nml_namespaces_t + +contains + + !> \brief Initialize defaults and sentinels for namespaces + integer function nml_namespaces_init(nml__obj, errmsg) result(nml__status) + class(nml_namespaces_t), intent(inout) :: nml__obj !< namelist instance + character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + + nml__status = NML_OK + if (present(errmsg)) errmsg = "" + nml__obj%is_configured = .false. + + ! allocate runtime-sized fields + if (allocated(nml__obj%data%values)) deallocate(nml__obj%data%values) + allocate(nml__obj%data%values(nml__obj%dims%status)) + if (allocated(nml__obj%data%more_values)) deallocate(nml__obj%data%more_values) + allocate(nml__obj%data%more_values(nml__obj%dims%set_dims)) + + ! default values + nml__obj%data%status = status__default + nml__obj%data%file = file__default + nml__obj%data%nml = nml__default + nml__obj%data%iostat = iostat__default + nml__obj%data%close_status = close_status__default + nml__obj%data%data = data__default + nml__obj%data%dims = dims__default + nml__obj%data%set = set__default + nml__obj%data%set_dims = set_dims__default + nml__obj%data%init = init__default + nml__obj%data%init_type = init_type__default + nml__obj%data%from_file = from_file__default + nml__obj%data%is_set = is_set__default + nml__obj%data%is_valid = is_valid__default + nml__obj%data%filled_shape = filled_shape__default + nml__obj%data%is_configured = is_configured__default + nml__obj%data%values = values__default + nml__obj%data%more_values = more_values__default + end function nml_namespaces_init + + !> \brief Reset runtime dimensions for namespaces + integer function nml_namespaces_set_dims(nml__obj, & + status, & + set_dims, & + errmsg) result(nml__status) + class(nml_namespaces_t), intent(inout) :: nml__obj !< namelist instance + integer, intent(in), optional :: status !< runtime dimension override for status + integer, intent(in), optional :: set_dims !< runtime dimension override for set_dims + integer :: candidate__status + integer :: candidate__set_dims + character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + + nml__status = NML_OK + if (present(errmsg)) errmsg = "" + if (present(status)) then + candidate__status = status + else + candidate__status = status__dim_default + end if + if (candidate__status <= 0) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "dimension 'status' must be positive" + return + end if + if (present(set_dims)) then + candidate__set_dims = set_dims + else + candidate__set_dims = set_dims__dim_default + end if + if (candidate__set_dims <= 0) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "dimension 'set_dims' must be positive" + return + end if + nml__obj%dims%status = candidate__status + nml__obj%dims%set_dims = candidate__set_dims + + ! deallocate runtime-sized fields; init/set/from_file allocate them again + if (allocated(nml__obj%data%values)) deallocate(nml__obj%data%values) + if (allocated(nml__obj%data%more_values)) deallocate(nml__obj%data%more_values) + nml__obj%is_configured = .false. + end function nml_namespaces_set_dims + + + !> \brief Read namespaces namelist from file + integer function nml_namespaces_from_file(nml__obj, file, errmsg) result(nml__status) + class(nml_namespaces_t), intent(inout) :: nml__obj !< namelist instance + character(len=*), intent(in) :: file !< path to namelist file + character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + + nml__status = nml_namespaces_read__from_file(nml__obj, file, errmsg) + end function nml_namespaces_from_file + + integer function nml_namespaces_read__from_file(nml__obj, nml__file, errmsg) & + result(nml__status) + class(nml_namespaces_t), intent(inout) :: nml__obj + character(len=*), intent(in) :: nml__file + character(len=*), intent(out), optional :: errmsg + ! namelist variables + integer :: status + integer :: file + integer :: nml + integer :: iostat + integer :: close_status + integer :: data + integer :: dims + integer :: set + integer :: set_dims + integer :: init + integer :: init_type + integer :: from_file + integer :: is_set + integer :: is_valid + integer :: filled_shape + integer :: is_configured + integer, allocatable, dimension(:) :: values + integer, allocatable, dimension(:) :: more_values + ! locals + type(nml_file_t) :: nml__reader + integer :: nml__iostat + integer :: nml__close_status + character(len=nml_line_buffer) :: nml__iomsg + + namelist /namespaces/ & + status, & + file, & + nml, & + iostat, & + close_status, & + data, & + dims, & + set, & + set_dims, & + init, & + init_type, & + from_file, & + is_set, & + is_valid, & + filled_shape, & + is_configured, & + values, & + more_values + + nml__status = nml__obj%init(errmsg=errmsg) + if (nml__status /= NML_OK) return + ! allocate local namelist variables matching runtime-sized fields + if (allocated(values)) deallocate(values) + allocate(values(nml__obj%dims%status)) + if (allocated(more_values)) deallocate(more_values) + allocate(more_values(nml__obj%dims%set_dims)) + status = nml__obj%data%status + file = nml__obj%data%file + nml = nml__obj%data%nml + iostat = nml__obj%data%iostat + close_status = nml__obj%data%close_status + data = nml__obj%data%data + dims = nml__obj%data%dims + set = nml__obj%data%set + set_dims = nml__obj%data%set_dims + init = nml__obj%data%init + init_type = nml__obj%data%init_type + from_file = nml__obj%data%from_file + is_set = nml__obj%data%is_set + is_valid = nml__obj%data%is_valid + filled_shape = nml__obj%data%filled_shape + is_configured = nml__obj%data%is_configured + values = nml__obj%data%values + more_values = nml__obj%data%more_values + + nml__status = nml__reader%open(nml__file, errmsg=errmsg) + if (nml__status /= NML_OK) return + + nml__status = nml__reader%find("namespaces", errmsg=errmsg) + if (nml__status /= NML_OK) then + if (nml__status == NML_ERR_NML_NOT_FOUND) then + nml__close_status = nml__reader%close(errmsg=errmsg) + if (nml__close_status /= NML_OK) then + nml__status = nml__close_status + return + end if + nml__obj%is_configured = .true. + nml__status = NML_OK + return + end if + nml__close_status = nml__reader%close() + return + end if + + ! read namelist + read(nml__reader%unit, nml=namespaces, iostat=nml__iostat, iomsg=nml__iomsg) + if (nml__iostat /= 0) then + nml__status = NML_ERR_READ + if (present(errmsg)) errmsg = trim(nml__iomsg) + nml__close_status = nml__reader%close() + return + end if + nml__close_status = nml__reader%close(errmsg=errmsg) + if (nml__close_status /= NML_OK) then + nml__status = nml__close_status + return + end if + + ! assign values + nml__obj%data%status = status + nml__obj%data%file = file + nml__obj%data%nml = nml + nml__obj%data%iostat = iostat + nml__obj%data%close_status = close_status + nml__obj%data%data = data + nml__obj%data%dims = dims + nml__obj%data%set = set + nml__obj%data%set_dims = set_dims + nml__obj%data%init = init + nml__obj%data%init_type = init_type + nml__obj%data%from_file = from_file + nml__obj%data%is_set = is_set + nml__obj%data%is_valid = is_valid + nml__obj%data%filled_shape = filled_shape + nml__obj%data%is_configured = is_configured + nml__obj%data%values = values + nml__obj%data%more_values = more_values + + ! mark as configured + nml__obj%is_configured = .true. + nml__status = NML_OK + end function nml_namespaces_read__from_file + + !> \brief Set namespaces values + integer function nml_namespaces_set(nml__obj, & + status, & + file, & + nml, & + iostat, & + close_status, & + data, & + dims, & + set, & + set_dims, & + init, & + init_type, & + from_file, & + is_set, & + is_valid, & + filled_shape, & + is_configured, & + values, & + more_values, & + errmsg) result(nml__status) + + class(nml_namespaces_t), intent(inout) :: nml__obj !< namelist instance + character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + integer, intent(in), optional :: status !< status + integer, intent(in), optional :: file !< file + integer, intent(in), optional :: nml !< nml + integer, intent(in), optional :: iostat !< iostat + integer, intent(in), optional :: close_status !< close_status + integer, intent(in), optional :: data !< data + integer, intent(in), optional :: dims !< dims + integer, intent(in), optional :: set !< set + integer, intent(in), optional :: set_dims !< set_dims + integer, intent(in), optional :: init !< init + integer, intent(in), optional :: init_type !< init_type + integer, intent(in), optional :: from_file !< from_file + integer, intent(in), optional :: is_set !< is_set + integer, intent(in), optional :: is_valid !< is_valid + integer, intent(in), optional :: filled_shape !< filled_shape + integer, intent(in), optional :: is_configured !< is_configured + integer, dimension(:), intent(in), optional :: values !< values + integer, dimension(:), intent(in), optional :: more_values !< more_values + nml__status = nml__obj%init(errmsg=errmsg) + if (nml__status /= NML_OK) return + + ! required parameters + ! override with provided values + if (present(status)) nml__obj%data%status = status + if (present(file)) nml__obj%data%file = file + if (present(nml)) nml__obj%data%nml = nml + if (present(iostat)) nml__obj%data%iostat = iostat + if (present(close_status)) nml__obj%data%close_status = close_status + if (present(data)) nml__obj%data%data = data + if (present(dims)) nml__obj%data%dims = dims + if (present(set)) nml__obj%data%set = set + if (present(set_dims)) nml__obj%data%set_dims = set_dims + if (present(init)) nml__obj%data%init = init + if (present(init_type)) nml__obj%data%init_type = init_type + if (present(from_file)) nml__obj%data%from_file = from_file + if (present(is_set)) nml__obj%data%is_set = is_set + if (present(is_valid)) nml__obj%data%is_valid = is_valid + if (present(filled_shape)) nml__obj%data%filled_shape = filled_shape + if (present(is_configured)) nml__obj%data%is_configured = is_configured + if (present(values)) then + if (size(values, 1) > size(nml__obj%data%values, 1)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'values'" + return + end if + nml__obj%data%values( & + 1:size(values, 1)) = values + end if + if (present(more_values)) then + if (size(more_values, 1) > size(nml__obj%data%more_values, 1)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'more_values'" + return + end if + nml__obj%data%more_values( & + 1:size(more_values, 1)) = more_values + end if + + ! mark as configured + nml__obj%is_configured = .true. + nml__status = NML_OK + end function nml_namespaces_set + + !> \brief Check whether a namelist value was set + integer function nml_namespaces_is_set(nml__obj, name, idx, errmsg) result(nml__status) + class(nml_namespaces_t), intent(in) :: nml__obj !< namelist instance + character(len=*), intent(in) :: name !< field name + integer, intent(in), optional :: idx(:) !< optional field index values + character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + + nml__status = NML_OK + if (present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" + return + end if + select case (to__lower(trim(name))) + case ("status") + if (present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index not supported for 'status'" + return + end if + case ("file") + if (present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index not supported for 'file'" + return + end if + case ("nml") + if (present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index not supported for 'nml'" + return + end if + case ("iostat") + if (present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index not supported for 'iostat'" + return + end if + case ("close_status") + if (present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index not supported for 'close_status'" + return + end if + case ("data") + if (present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index not supported for 'data'" + return + end if + case ("dims") + if (present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index not supported for 'dims'" + return + end if + case ("set") + if (present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index not supported for 'set'" + return + end if + case ("set_dims") + if (present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index not supported for 'set_dims'" + return + end if + case ("init") + if (present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index not supported for 'init'" + return + end if + case ("init_type") + if (present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index not supported for 'init_type'" + return + end if + case ("from_file") + if (present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index not supported for 'from_file'" + return + end if + case ("is_set") + if (present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index not supported for 'is_set'" + return + end if + case ("is_valid") + if (present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index not supported for 'is_valid'" + return + end if + case ("filled_shape") + if (present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index not supported for 'filled_shape'" + return + end if + case ("is_configured") + if (present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index not supported for 'is_configured'" + return + end if + case ("values") + if (.not. allocated(nml__obj%data%values)) then + nml__status = NML_ERR_NOT_SET + return + end if + if (present(idx)) then + nml__status = idx__check(idx, shape(nml__obj%data%values), & + "values", errmsg) + if (nml__status /= NML_OK) return + else + end if + case ("more_values") + if (.not. allocated(nml__obj%data%more_values)) then + nml__status = NML_ERR_NOT_SET + return + end if + if (present(idx)) then + nml__status = idx__check(idx, shape(nml__obj%data%more_values), & + "more_values", errmsg) + if (nml__status /= NML_OK) return + else + end if + case default + nml__status = NML_ERR_INVALID_NAME + if (present(errmsg)) errmsg = "unknown field: " // trim(name) + end select + if (nml__status == NML_ERR_NOT_SET .and. present(errmsg)) then + if (len_trim(errmsg) == 0) errmsg = "field not set: " // trim(name) + end if + end function nml_namespaces_is_set + + !> \brief Validate required values and constraints + integer function nml_namespaces_is_valid(nml__obj, errmsg) result(nml__status) + class(nml_namespaces_t), intent(in) :: nml__obj !< namelist instance + character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + integer :: nml__istat + + nml__status = NML_OK + if (present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" + return + end if + + end function nml_namespaces_is_valid + +end module nml_namespaces diff --git a/tests/fortran_namespaces/out/nml_wrapper_status.f90 b/tests/fortran_namespaces/out/nml_wrapper_status.f90 new file mode 100644 index 0000000..c4154b9 --- /dev/null +++ b/tests/fortran_namespaces/out/nml_wrapper_status.f90 @@ -0,0 +1,278 @@ +!> \file nml_wrapper_status.f90 +!> \copydoc nml_wrapper_status + +!> \brief Wrapper status type +!> \details Wrapper status type +module nml_wrapper_status + use nml_helper, only: & + nml_file_t, & + nml_line_buffer, & + NML_OK, & + NML_ERR_FILE_NOT_FOUND, & + NML_ERR_OPEN, & + NML_ERR_NOT_OPEN, & + NML_ERR_NML_NOT_FOUND, & + NML_ERR_READ, & + NML_ERR_CLOSE, & + NML_ERR_REQUIRED, & + NML_ERR_ENUM, & + NML_ERR_BOUNDS, & + NML_ERR_NOT_SET, & + NML_ERR_INVALID_NAME, & + NML_ERR_INVALID_INDEX, & + idx__check, & + to__lower, & + NML_ERR_INVALID_HANDLE + use application_types, only: status + use application_types, only: c_ptr + + implicit none + + private :: nml_wrapper_status_read__from_file + + !> \class nml_wrapper_status_data_t + !> \brief Schema-backed values for wrapper_status + type, public :: nml_wrapper_status_data_t + type(status) :: state !< state + type(c_ptr) :: pointer_state !< pointer_state + end type nml_wrapper_status_data_t + + !> \class nml_wrapper_status_t + !> \brief Wrapper status type + !> \details Wrapper status type + type, public :: nml_wrapper_status_t + type(nml_wrapper_status_data_t) :: data !< schema-backed namelist values + logical :: is_configured = .false. !< whether the namelist has been configured + contains + procedure :: init => nml_wrapper_status_init + procedure :: init_type => nml_wrapper_status_init_type + procedure :: from_file => nml_wrapper_status_from_file + procedure :: set => nml_wrapper_status_set + procedure :: is_set => nml_wrapper_status_is_set + procedure :: is_valid => nml_wrapper_status_is_valid + end type nml_wrapper_status_t + +contains + + !> \brief Resolve an opaque C pointer handle to a nml_wrapper_status_t pointer + subroutine nml_wrapper_status_resolve_handle(nml__handle, nml__obj, nml__status, errmsg) + use iso_c_binding, only: c_f_pointer, c_intptr_t, c_null_ptr, c_ptr + integer(c_intptr_t), intent(in) :: nml__handle !< opaque handle to a nml_wrapper_status_t instance + type(nml_wrapper_status_t), pointer :: nml__obj !< resolved namelist pointer + integer, intent(out) :: nml__status !< nml-tools status code + character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + type(c_ptr) :: nml__ptr + + if (present(errmsg)) errmsg = "" + nullify(nml__obj) + if (nml__handle == 0_c_intptr_t) then + nml__status = NML_ERR_INVALID_HANDLE + if (present(errmsg)) errmsg = "zero handle" + return + end if + nml__ptr = transfer(nml__handle, c_null_ptr) + call c_f_pointer(nml__ptr, nml__obj) + nml__status = NML_OK + end subroutine nml_wrapper_status_resolve_handle + + !> \brief Initialize defaults and sentinels for wrapper_status + integer function nml_wrapper_status_init(nml__obj, errmsg) result(nml__status) + class(nml_wrapper_status_t), intent(inout) :: nml__obj !< namelist instance + character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + + nml__status = NML_OK + if (present(errmsg)) errmsg = "" + nml__obj%is_configured = .false. + + ! derived values + nml__status = nml__obj%init_type( & + state=nml__obj%data%state, & + pointer_state=nml__obj%data%pointer_state, & + errmsg=errmsg) + if (nml__status /= NML_OK) return + end function nml_wrapper_status_init + + !> \brief Initialize derived values with their field-specific defaults + integer function nml_wrapper_status_init_type(nml__obj, & + state, & + pointer_state, & + errmsg) result(nml__status) + class(nml_wrapper_status_t), intent(in) :: nml__obj !< parent namelist instance + type(status), intent(inout), optional :: state !< state + type(c_ptr), intent(inout), optional :: pointer_state !< pointer_state + character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + + nml__status = NML_OK + if (present(errmsg)) errmsg = "" + if (present(state)) then + state%code = -huge(state%code) ! sentinel for derived component code + end if + if (present(pointer_state)) then + pointer_state%code = 0 + end if + end function nml_wrapper_status_init_type + + + !> \brief Read wrapper_status namelist from file + integer function nml_wrapper_status_from_file(nml__obj, file, errmsg) result(nml__status) + class(nml_wrapper_status_t), intent(inout) :: nml__obj !< namelist instance + character(len=*), intent(in) :: file !< path to namelist file + character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + + nml__status = nml_wrapper_status_read__from_file(nml__obj, file, errmsg) + end function nml_wrapper_status_from_file + + integer function nml_wrapper_status_read__from_file(nml__obj, nml__file, errmsg) & + result(nml__status) + class(nml_wrapper_status_t), intent(inout) :: nml__obj + character(len=*), intent(in) :: nml__file + character(len=*), intent(out), optional :: errmsg + ! namelist variables + type(status) :: state + type(c_ptr) :: pointer_state + ! locals + type(nml_file_t) :: nml__reader + integer :: nml__iostat + integer :: nml__close_status + character(len=nml_line_buffer) :: nml__iomsg + + namelist /wrapper_status/ & + state, & + pointer_state + + nml__status = nml__obj%init(errmsg=errmsg) + if (nml__status /= NML_OK) return + state = nml__obj%data%state + pointer_state = nml__obj%data%pointer_state + + nml__status = nml__reader%open(nml__file, errmsg=errmsg) + if (nml__status /= NML_OK) return + + nml__status = nml__reader%find("wrapper_status", errmsg=errmsg) + if (nml__status /= NML_OK) then + if (nml__status == NML_ERR_NML_NOT_FOUND) then + nml__close_status = nml__reader%close(errmsg=errmsg) + if (nml__close_status /= NML_OK) then + nml__status = nml__close_status + return + end if + nml__obj%is_configured = .true. + nml__status = NML_OK + return + end if + nml__close_status = nml__reader%close() + return + end if + + ! read namelist + read(nml__reader%unit, nml=wrapper_status, iostat=nml__iostat, iomsg=nml__iomsg) + if (nml__iostat /= 0) then + nml__status = NML_ERR_READ + if (present(errmsg)) errmsg = trim(nml__iomsg) + nml__close_status = nml__reader%close() + return + end if + nml__close_status = nml__reader%close(errmsg=errmsg) + if (nml__close_status /= NML_OK) then + nml__status = nml__close_status + return + end if + + ! assign values + nml__obj%data%state = state + nml__obj%data%pointer_state = pointer_state + + ! mark as configured + nml__obj%is_configured = .true. + nml__status = NML_OK + end function nml_wrapper_status_read__from_file + + !> \brief Set wrapper_status values + integer function nml_wrapper_status_set(nml__obj, & + state, & + pointer_state, & + errmsg) result(nml__status) + + class(nml_wrapper_status_t), intent(inout) :: nml__obj !< namelist instance + character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + type(status), intent(in), optional :: state !< state + type(c_ptr), intent(in), optional :: pointer_state !< pointer_state + nml__status = nml__obj%init(errmsg=errmsg) + if (nml__status /= NML_OK) return + + ! required parameters + ! override with provided values + if (present(state)) nml__obj%data%state = state + if (present(pointer_state)) nml__obj%data%pointer_state = pointer_state + + ! mark as configured + nml__obj%is_configured = .true. + nml__status = NML_OK + end function nml_wrapper_status_set + + !> \brief Check whether a namelist value was set + integer function nml_wrapper_status_is_set(nml__obj, name, idx, errmsg) result(nml__status) + class(nml_wrapper_status_t), intent(in) :: nml__obj !< namelist instance + character(len=*), intent(in) :: name !< field name + integer, intent(in), optional :: idx(:) !< optional field index values + character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + + nml__status = NML_OK + if (present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" + return + end if + select case (to__lower(trim(name))) + case ("state%code") + if (present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index not supported for 'state'" + return + end if + if (nml__obj%data%state%code == -huge(nml__obj%data%state%code)) nml__status = NML_ERR_NOT_SET + case ("state") + if (present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index not supported for 'state'" + return + end if + case ("pointer_state%code") + if (present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index not supported for 'pointer_state'" + return + end if + case ("pointer_state") + if (present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index not supported for 'pointer_state'" + return + end if + case default + nml__status = NML_ERR_INVALID_NAME + if (present(errmsg)) errmsg = "unknown field: " // trim(name) + end select + if (nml__status == NML_ERR_NOT_SET .and. present(errmsg)) then + if (len_trim(errmsg) == 0) errmsg = "field not set: " // trim(name) + end if + end function nml_wrapper_status_is_set + + !> \brief Validate required values and constraints + integer function nml_wrapper_status_is_valid(nml__obj, errmsg) result(nml__status) + class(nml_wrapper_status_t), intent(in) :: nml__obj !< namelist instance + character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + integer :: nml__istat + + nml__status = NML_OK + if (present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" + return + end if + + end function nml_wrapper_status_is_valid + +end module nml_wrapper_status diff --git a/tests/fortran_namespaces/wrapper_status.yml b/tests/fortran_namespaces/wrapper_status.yml new file mode 100644 index 0000000..148b2be --- /dev/null +++ b/tests/fortran_namespaces/wrapper_status.yml @@ -0,0 +1,20 @@ +title: Wrapper status type +x-fortran-namelist: wrapper_status +type: object +required: [state] +properties: + state: + type: object + x-fortran-type: status + x-fortran-module: application_types + properties: + code: + type: integer + pointer_state: + type: object + x-fortran-type: c_ptr + x-fortran-module: application_types + properties: + code: + type: integer + default: 0 diff --git a/tests/fortran_optional_read/conformance.f90 b/tests/fortran_optional_read/conformance.f90 index 2384b3d..1541618 100644 --- a/tests/fortran_optional_read/conformance.f90 +++ b/tests/fortran_optional_read/conformance.f90 @@ -18,7 +18,7 @@ program conformance status = optional%from_file(join_path(root, "other.nml"), errmsg) call expect_status(status, NML_OK, "optional missing group") if (.not. optional%is_configured) error stop "optional missing group was not configured" - if (optional%count /= 7) error stop "optional default was not retained" + if (optional%data%count /= 7) error stop "optional default was not retained" if (len_trim(errmsg) /= 0) error stop "optional missing group did not clear errmsg" status = optional%is_valid(errmsg=errmsg) @@ -28,12 +28,14 @@ program conformance status = required%from_file(join_path(root, "other.nml"), errmsg) call expect_status(status, NML_ERR_NML_NOT_FOUND, "required missing group") + if (index(errmsg, "namelist not found:") == 0) error stop "cleanup lost missing-group message" status = optional%from_file(join_path(root, "does-not-exist.nml"), errmsg) call expect_status(status, NML_ERR_FILE_NOT_FOUND, "missing file") status = optional%from_file(join_path(root, "malformed.nml"), errmsg) call expect_status(status, NML_ERR_READ, "malformed group") + if (len_trim(errmsg) == 0) error stop "cleanup lost read error message" contains diff --git a/tests/fortran_optional_read/out/nml_helper.f90 b/tests/fortran_optional_read/out/nml_helper.f90 index 0606531..2acb816 100644 --- a/tests/fortran_optional_read/out/nml_helper.f90 +++ b/tests/fortran_optional_read/out/nml_helper.f90 @@ -52,61 +52,61 @@ module nml_helper contains !> \brief Open a namelist file - integer function nml_open(this, file, errmsg) result(status) + integer function nml_open(this, file, errmsg) result(nml__status) class(nml_file_t), intent(inout) :: this character(len=*), intent(in) :: file character(len=*), intent(out), optional :: errmsg - integer :: iostat - logical :: exists - character(len=nml_line_buffer) :: iomsg + integer :: nml__iostat + logical :: nml__exists + character(len=nml_line_buffer) :: nml__iomsg if (present(errmsg)) errmsg = "" - status = this%close() - inquire(file=file, exist=exists) - if (.not. exists) then + nml__status = this%close() + inquire(file=file, exist=nml__exists) + if (.not. nml__exists) then this%is_open = .false. this%unit = 0 - status = NML_ERR_FILE_NOT_FOUND + nml__status = NML_ERR_FILE_NOT_FOUND if (present(errmsg)) errmsg = "file not found: " // trim(file) return end if open(newunit=this%unit, file=file, status='old', action='read', & - iostat=iostat, iomsg=iomsg) - this%is_open = (iostat == 0) + iostat=nml__iostat, iomsg=nml__iomsg) + this%is_open = (nml__iostat == 0) if (.not. this%is_open) then this%unit = 0 - status = NML_ERR_OPEN - if (present(errmsg)) errmsg = trim(iomsg) + nml__status = NML_ERR_OPEN + if (present(errmsg)) errmsg = trim(nml__iomsg) return end if - status = NML_OK + nml__status = NML_OK end function nml_open !> \brief Find a namelist in the opened file - integer function nml_find(this, nml, errmsg) result(status) + integer function nml_find(this, nml, errmsg) result(nml__status) class(nml_file_t), intent(inout) :: this character(len=*), intent(in) :: nml character(len=*), intent(out), optional :: errmsg - integer :: iostat - character(len=nml_line_buffer) :: line - character(len=nml_line_buffer) :: iomsg + integer :: nml__iostat + character(len=nml_line_buffer) :: nml__line + character(len=nml_line_buffer) :: nml__iomsg if (present(errmsg)) errmsg = "" - status = NML_ERR_NML_NOT_FOUND + nml__status = NML_ERR_NML_NOT_FOUND if (.not. this%is_open) then - status = NML_ERR_NOT_OPEN + nml__status = NML_ERR_NOT_OPEN if (present(errmsg)) errmsg = "file not open" return end if rewind(unit=this%unit) do - read(this%unit, '(A)', iostat=iostat, iomsg=iomsg) line - if (iostat < 0) exit - if (iostat > 0) then - status = NML_ERR_READ - if (present(errmsg)) errmsg = trim(iomsg) + read(this%unit, '(A)', iostat=nml__iostat, iomsg=nml__iomsg) nml__line + if (nml__iostat < 0) exit + if (nml__iostat > 0) then + nml__status = NML_ERR_READ + if (present(errmsg)) errmsg = trim(nml__iomsg) return end if - if (index(to_lower(line), '&' // to_lower(trim(nml))) /= 0) then - status = NML_OK + if (index(to__lower(nml__line), '&' // to__lower(trim(nml))) /= 0) then + nml__status = NML_OK backspace(this%unit) return end if @@ -115,18 +115,18 @@ integer function nml_find(this, nml, errmsg) result(status) end function nml_find !> \brief Close the namelist file - integer function nml_close(this, errmsg) result(status) + integer function nml_close(this, errmsg) result(nml__status) class(nml_file_t), intent(inout) :: this character(len=*), intent(out), optional :: errmsg - integer :: iostat - character(len=nml_line_buffer) :: iomsg + integer :: nml__iostat + character(len=nml_line_buffer) :: nml__iomsg if (present(errmsg)) errmsg = "" - status = NML_OK + nml__status = NML_OK if (this%is_open) then - close(unit=this%unit, iostat=iostat, iomsg=iomsg) - if (iostat /= 0) then - status = NML_ERR_CLOSE - if (present(errmsg)) errmsg = trim(iomsg) + close(unit=this%unit, iostat=nml__iostat, iomsg=nml__iomsg) + if (nml__iostat /= 0) then + nml__status = NML_ERR_CLOSE + if (present(errmsg)) errmsg = trim(nml__iomsg) end if end if this%is_open = .false. @@ -134,35 +134,34 @@ integer function nml_close(this, errmsg) result(status) end function nml_close !> \brief Convert string to lower case - pure function to_lower(string) result(lower_string) - character(len=*), intent(in) :: string - character(len=len(string)) :: lower_string - integer, parameter :: shift=iachar('a')-iachar('A'), upA=iachar('A'), upZ=iachar('Z') - integer :: k, i - do i = 1, len(string) - k = ichar(string(i:i)) - if (k>=upA .and. k<=upZ) k = k + shift - lower_string(i:i) = char(k) + pure function to__lower(nml__string) result(nml__lower_string) + character(len=*), intent(in) :: nml__string + character(len=len(nml__string)) :: nml__lower_string + integer, parameter :: nml__shift=iachar('a')-iachar('A'), nml__upA=iachar('A'), nml__upZ=iachar('Z') + integer :: nml__k, nml__i + do nml__i = 1, len(nml__string) + nml__k = ichar(nml__string(nml__i:nml__i)) + if (nml__k>=nml__upA .and. nml__k<=nml__upZ) nml__k = nml__k + nml__shift + nml__lower_string(nml__i:nml__i) = char(nml__k) end do - end function to_lower + end function to__lower !> \brief Validate index bounds for array access - integer function idx_check(idx, lower, upper, field, errmsg) result(status) - integer, intent(in) :: idx(:) - integer, intent(in) :: lower(:) - integer, intent(in) :: upper(:) - character(len=*), intent(in) :: field + integer function idx__check(nml__idx, nml__extents, nml__field, errmsg) result(nml__status) + integer, intent(in) :: nml__idx(:) + integer, intent(in) :: nml__extents(:) + character(len=*), intent(in) :: nml__field character(len=*), intent(out), optional :: errmsg - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - if (size(idx) /= size(lower)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index rank mismatch for '" // trim(field) // "'" - else if (any(idx < lower) .or. any(idx > upper)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index out of bounds for '" // trim(field) // "'" + if (size(nml__idx) /= size(nml__extents)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index rank mismatch for '" // trim(nml__field) // "'" + else if (any(nml__idx < 1) .or. any(nml__idx > nml__extents)) then + nml__status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index out of bounds for '" // trim(nml__field) // "'" end if - end function idx_check + end function idx__check end module nml_helper diff --git a/tests/fortran_optional_read/out/nml_optional.f90 b/tests/fortran_optional_read/out/nml_optional.f90 index c8724cd..a483eda 100644 --- a/tests/fortran_optional_read/out/nml_optional.f90 +++ b/tests/fortran_optional_read/out/nml_optional.f90 @@ -20,8 +20,8 @@ module nml_optional NML_ERR_NOT_SET, & NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & - idx_check, & - to_lower + idx__check, & + to__lower ! kind specifiers listed in the nml-tools configuration file use iso_fortran_env, only: & i4=>int32 @@ -31,13 +31,21 @@ module nml_optional ! default values integer(i4), parameter, public :: count__default = 7_i4 + private :: nml_optional_read__from_file + + !> \class nml_optional_data_t + !> \brief Schema-backed values for optional + type, public :: nml_optional_data_t + integer(i4) :: count !< count + character(len=16) :: label !< label + end type nml_optional_data_t + !> \class nml_optional_t !> \brief Optional generated reader !> \details Optional generated reader type, public :: nml_optional_t + type(nml_optional_data_t) :: data !< schema-backed namelist values logical :: is_configured = .false. !< whether the namelist has been configured - integer(i4) :: count !< count - character(len=16) :: label !< label contains procedure :: init => nml_optional_init procedure :: from_file => nml_optional_from_file @@ -49,157 +57,165 @@ module nml_optional contains !> \brief Initialize defaults and sentinels for optional - integer function nml_optional_init(this, errmsg) result(status) - class(nml_optional_t), intent(inout) :: this !< namelist instance + integer function nml_optional_init(nml__obj, errmsg) result(nml__status) + class(nml_optional_t), intent(inout) :: nml__obj !< namelist instance character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - this%is_configured = .false. + nml__obj%is_configured = .false. ! sentinel values for required/optional parameters - this%label = achar(0) ! sentinel for optional string + nml__obj%data%label = achar(0) ! sentinel for optional string ! default values - this%count = count__default + nml__obj%data%count = count__default end function nml_optional_init !> \brief Read optional namelist from file - integer function nml_optional_from_file(this, file, errmsg) result(status) - class(nml_optional_t), intent(inout) :: this !< namelist instance + integer function nml_optional_from_file(nml__obj, file, errmsg) result(nml__status) + class(nml_optional_t), intent(inout) :: nml__obj !< namelist instance character(len=*), intent(in) :: file !< path to namelist file character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + + nml__status = nml_optional_read__from_file(nml__obj, file, errmsg) + end function nml_optional_from_file + + integer function nml_optional_read__from_file(nml__obj, nml__file, errmsg) & + result(nml__status) + class(nml_optional_t), intent(inout) :: nml__obj + character(len=*), intent(in) :: nml__file + character(len=*), intent(out), optional :: errmsg ! namelist variables integer(i4) :: count character(len=16) :: label ! locals - type(nml_file_t) :: nml - integer :: iostat - integer :: close_status - character(len=nml_line_buffer) :: iomsg + type(nml_file_t) :: nml__reader + integer :: nml__iostat + integer :: nml__close_status + character(len=nml_line_buffer) :: nml__iomsg namelist /optional/ & count, & label - status = this%init(errmsg=errmsg) - if (status /= NML_OK) return - count = this%count - label = this%label + nml__status = nml__obj%init(errmsg=errmsg) + if (nml__status /= NML_OK) return + count = nml__obj%data%count + label = nml__obj%data%label - status = nml%open(file, errmsg=errmsg) - if (status /= NML_OK) return + nml__status = nml__reader%open(nml__file, errmsg=errmsg) + if (nml__status /= NML_OK) return - status = nml%find("optional", errmsg=errmsg) - if (status /= NML_OK) then - if (status == NML_ERR_NML_NOT_FOUND) then - close_status = nml%close(errmsg=errmsg) - if (close_status /= NML_OK) then - status = close_status + nml__status = nml__reader%find("optional", errmsg=errmsg) + if (nml__status /= NML_OK) then + if (nml__status == NML_ERR_NML_NOT_FOUND) then + nml__close_status = nml__reader%close(errmsg=errmsg) + if (nml__close_status /= NML_OK) then + nml__status = nml__close_status return end if - this%is_configured = .true. - status = NML_OK + nml__obj%is_configured = .true. + nml__status = NML_OK return end if - close_status = nml%close() + nml__close_status = nml__reader%close() return end if ! read namelist - read(nml%unit, nml=optional, iostat=iostat, iomsg=iomsg) - if (iostat /= 0) then - status = NML_ERR_READ - if (present(errmsg)) errmsg = trim(iomsg) - close_status = nml%close() + read(nml__reader%unit, nml=optional, iostat=nml__iostat, iomsg=nml__iomsg) + if (nml__iostat /= 0) then + nml__status = NML_ERR_READ + if (present(errmsg)) errmsg = trim(nml__iomsg) + nml__close_status = nml__reader%close() return end if - close_status = nml%close(errmsg=errmsg) - if (close_status /= NML_OK) then - status = close_status + nml__close_status = nml__reader%close(errmsg=errmsg) + if (nml__close_status /= NML_OK) then + nml__status = nml__close_status return end if ! assign values - this%count = count - this%label = label + nml__obj%data%count = count + nml__obj%data%label = label ! mark as configured - this%is_configured = .true. - status = NML_OK - end function nml_optional_from_file + nml__obj%is_configured = .true. + nml__status = NML_OK + end function nml_optional_read__from_file !> \brief Set optional values - integer function nml_optional_set(this, & + integer function nml_optional_set(nml__obj, & count, & label, & - errmsg) result(status) + errmsg) result(nml__status) - class(nml_optional_t), intent(inout) :: this !< namelist instance + class(nml_optional_t), intent(inout) :: nml__obj !< namelist instance character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values integer(i4), intent(in), optional :: count !< count character(len=*), intent(in), optional :: label !< label - - status = this%init(errmsg=errmsg) - if (status /= NML_OK) return + nml__status = nml__obj%init(errmsg=errmsg) + if (nml__status /= NML_OK) return ! required parameters ! override with provided values - if (present(count)) this%count = count - if (present(label)) this%label = label + if (present(count)) nml__obj%data%count = count + if (present(label)) nml__obj%data%label = label ! mark as configured - this%is_configured = .true. - status = NML_OK + nml__obj%is_configured = .true. + nml__status = NML_OK end function nml_optional_set !> \brief Check whether a namelist value was set - integer function nml_optional_is_set(this, name, idx, errmsg) result(status) - class(nml_optional_t), intent(in) :: this !< namelist instance + integer function nml_optional_is_set(nml__obj, name, idx, errmsg) result(nml__status) + class(nml_optional_t), intent(in) :: nml__obj !< namelist instance character(len=*), intent(in) :: name !< field name integer, intent(in), optional :: idx(:) !< optional field index values character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(trim(name))) + select case (to__lower(trim(name))) case ("count") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'count'" return end if case ("label") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'label'" return end if - if (this%label == achar(0)) status = NML_ERR_NOT_SET + if (nml__obj%data%label == achar(0)) nml__status = NML_ERR_NOT_SET case default - status = NML_ERR_INVALID_NAME + nml__status = NML_ERR_INVALID_NAME if (present(errmsg)) errmsg = "unknown field: " // trim(name) end select - if (status == NML_ERR_NOT_SET .and. present(errmsg)) then + if (nml__status == NML_ERR_NOT_SET .and. present(errmsg)) then if (len_trim(errmsg) == 0) errmsg = "field not set: " // trim(name) end if end function nml_optional_is_set !> \brief Validate required values and constraints - integer function nml_optional_is_valid(this, errmsg) result(status) - class(nml_optional_t), intent(in) :: this !< namelist instance + integer function nml_optional_is_valid(nml__obj, errmsg) result(nml__status) + class(nml_optional_t), intent(in) :: nml__obj !< namelist instance character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - integer :: istat + integer :: nml__istat - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if diff --git a/tests/fortran_optional_read/out/nml_required.f90 b/tests/fortran_optional_read/out/nml_required.f90 index 8b0daeb..662a03c 100644 --- a/tests/fortran_optional_read/out/nml_required.f90 +++ b/tests/fortran_optional_read/out/nml_required.f90 @@ -20,20 +20,28 @@ module nml_required NML_ERR_NOT_SET, & NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & - idx_check, & - to_lower + idx__check, & + to__lower ! kind specifiers listed in the nml-tools configuration file use iso_fortran_env, only: & i4=>int32 implicit none + private :: nml_required_read__from_file + + !> \class nml_required_data_t + !> \brief Schema-backed values for required + type, public :: nml_required_data_t + integer(i4) :: count !< count + end type nml_required_data_t + !> \class nml_required_t !> \brief Required generated reader !> \details Required generated reader type, public :: nml_required_t + type(nml_required_data_t) :: data !< schema-backed namelist values logical :: is_configured = .false. !< whether the namelist has been configured - integer(i4) :: count !< count contains procedure :: init => nml_required_init procedure :: from_file => nml_required_from_file @@ -45,139 +53,147 @@ module nml_required contains !> \brief Initialize defaults and sentinels for required - integer function nml_required_init(this, errmsg) result(status) - class(nml_required_t), intent(inout) :: this !< namelist instance + integer function nml_required_init(nml__obj, errmsg) result(nml__status) + class(nml_required_t), intent(inout) :: nml__obj !< namelist instance character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - this%is_configured = .false. + nml__obj%is_configured = .false. ! sentinel values for required/optional parameters - this%count = -huge(this%count) ! sentinel for required integer + nml__obj%data%count = -huge(nml__obj%data%count) ! sentinel for required integer end function nml_required_init !> \brief Read required namelist from file - integer function nml_required_from_file(this, file, errmsg) result(status) - class(nml_required_t), intent(inout) :: this !< namelist instance + integer function nml_required_from_file(nml__obj, file, errmsg) result(nml__status) + class(nml_required_t), intent(inout) :: nml__obj !< namelist instance character(len=*), intent(in) :: file !< path to namelist file character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values + + nml__status = nml_required_read__from_file(nml__obj, file, errmsg) + end function nml_required_from_file + + integer function nml_required_read__from_file(nml__obj, nml__file, errmsg) & + result(nml__status) + class(nml_required_t), intent(inout) :: nml__obj + character(len=*), intent(in) :: nml__file + character(len=*), intent(out), optional :: errmsg ! namelist variables integer(i4) :: count ! locals - type(nml_file_t) :: nml - integer :: iostat - integer :: close_status - character(len=nml_line_buffer) :: iomsg + type(nml_file_t) :: nml__reader + integer :: nml__iostat + integer :: nml__close_status + character(len=nml_line_buffer) :: nml__iomsg namelist /required/ & count - status = this%init(errmsg=errmsg) - if (status /= NML_OK) return - count = this%count + nml__status = nml__obj%init(errmsg=errmsg) + if (nml__status /= NML_OK) return + count = nml__obj%data%count - status = nml%open(file, errmsg=errmsg) - if (status /= NML_OK) return + nml__status = nml__reader%open(nml__file, errmsg=errmsg) + if (nml__status /= NML_OK) return - status = nml%find("required", errmsg=errmsg) - if (status /= NML_OK) then - close_status = nml%close() + nml__status = nml__reader%find("required", errmsg=errmsg) + if (nml__status /= NML_OK) then + nml__close_status = nml__reader%close() return end if ! read namelist - read(nml%unit, nml=required, iostat=iostat, iomsg=iomsg) - if (iostat /= 0) then - status = NML_ERR_READ - if (present(errmsg)) errmsg = trim(iomsg) - close_status = nml%close() + read(nml__reader%unit, nml=required, iostat=nml__iostat, iomsg=nml__iomsg) + if (nml__iostat /= 0) then + nml__status = NML_ERR_READ + if (present(errmsg)) errmsg = trim(nml__iomsg) + nml__close_status = nml__reader%close() return end if - close_status = nml%close(errmsg=errmsg) - if (close_status /= NML_OK) then - status = close_status + nml__close_status = nml__reader%close(errmsg=errmsg) + if (nml__close_status /= NML_OK) then + nml__status = nml__close_status return end if ! assign values - this%count = count + nml__obj%data%count = count ! mark as configured - this%is_configured = .true. - status = NML_OK - end function nml_required_from_file + nml__obj%is_configured = .true. + nml__status = NML_OK + end function nml_required_read__from_file !> \brief Set required values - integer function nml_required_set(this, & + integer function nml_required_set(nml__obj, & count, & - errmsg) result(status) + errmsg) result(nml__status) - class(nml_required_t), intent(inout) :: this !< namelist instance + class(nml_required_t), intent(inout) :: nml__obj !< namelist instance character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values integer(i4), intent(in) :: count !< count - - status = this%init(errmsg=errmsg) - if (status /= NML_OK) return + nml__status = nml__obj%init(errmsg=errmsg) + if (nml__status /= NML_OK) return ! required parameters - this%count = count + nml__obj%data%count = count ! mark as configured - this%is_configured = .true. - status = NML_OK + nml__obj%is_configured = .true. + nml__status = NML_OK end function nml_required_set !> \brief Check whether a namelist value was set - integer function nml_required_is_set(this, name, idx, errmsg) result(status) - class(nml_required_t), intent(in) :: this !< namelist instance + integer function nml_required_is_set(nml__obj, name, idx, errmsg) result(nml__status) + class(nml_required_t), intent(in) :: nml__obj !< namelist instance character(len=*), intent(in) :: name !< field name integer, intent(in), optional :: idx(:) !< optional field index values character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(trim(name))) + select case (to__lower(trim(name))) case ("count") if (present(idx)) then - status = NML_ERR_INVALID_INDEX + nml__status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index not supported for 'count'" return end if - if (this%count == -huge(this%count)) status = NML_ERR_NOT_SET + if (nml__obj%data%count == -huge(nml__obj%data%count)) nml__status = NML_ERR_NOT_SET case default - status = NML_ERR_INVALID_NAME + nml__status = NML_ERR_INVALID_NAME if (present(errmsg)) errmsg = "unknown field: " // trim(name) end select - if (status == NML_ERR_NOT_SET .and. present(errmsg)) then + if (nml__status == NML_ERR_NOT_SET .and. present(errmsg)) then if (len_trim(errmsg) == 0) errmsg = "field not set: " // trim(name) end if end function nml_required_is_set !> \brief Validate required values and constraints - integer function nml_required_is_valid(this, errmsg) result(status) - class(nml_required_t), intent(in) :: this !< namelist instance + integer function nml_required_is_valid(nml__obj, errmsg) result(nml__status) + class(nml_required_t), intent(in) :: nml__obj !< namelist instance character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - integer :: istat + integer :: nml__istat - status = NML_OK + nml__status = NML_OK if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if ! required parameters - istat = this%is_set("count", errmsg=errmsg) - if (istat == NML_ERR_NOT_SET) then - status = NML_ERR_REQUIRED + nml__istat = nml__obj%is_set("count", errmsg=errmsg) + if (nml__istat == NML_ERR_NOT_SET) then + nml__status = NML_ERR_REQUIRED if (present(errmsg)) then if (len_trim(errmsg) == 0) then errmsg = "field not set: count" @@ -186,8 +202,8 @@ integer function nml_required_is_valid(this, errmsg) result(status) end if return end if - if (istat /= NML_OK) then - status = istat + if (nml__istat /= NML_OK) then + nml__status = nml__istat return end if end function nml_required_is_valid diff --git a/tests/test_cli_config.py b/tests/test_cli_config.py index 3a14954..7c53b76 100644 --- a/tests/test_cli_config.py +++ b/tests/test_cli_config.py @@ -193,7 +193,7 @@ def test_load_dimensions_validates_values_and_duplicate_names() -> None: ) assert dimensions == {"n_cells": 3} - assert specs[0].name == "n_cells__default" + assert specs[0].name == "n_cells__dim_default" assert specs[0].value == "3" assert specs[0].doc == "Number of cells." @@ -203,7 +203,7 @@ def test_load_dimensions_validates_values_and_duplicate_names() -> None: with pytest.raises(click.ClickException, match="default name duplicates a constant"): cli_module._load_dimensions( {"dimensions": {"n_cells": {"default": 3}}}, - {"n_cells__default": 3}, + {"n_cells__dim_default": 3}, ) with pytest.raises(click.ClickException, match="duplicates another dimension"): @@ -1353,6 +1353,9 @@ def test_generate_command_uses_pyproject_config_in_process(tmp_path: Path) -> No [tool.nml-tools] minimum-version = "0" + [tool.nml-tools.helper] + path = "out/nml_helper.f90" + [tool.nml-tools.kinds] module = "iso_fortran_env" real = ["real64"] @@ -1372,6 +1375,131 @@ def test_generate_command_uses_pyproject_config_in_process(tmp_path: Path) -> No assert Path("out/nml_demo.f90").exists() +def test_generate_command_requires_helper_path_for_fortran_output(tmp_path: Path) -> None: + runner = CliRunner() + with runner.isolated_filesystem(temp_dir=tmp_path): + Path("schema.yml").write_text( + "x-fortran-namelist: demo\ntype: object\nproperties:\n value:\n type: integer\n", + encoding="utf-8", + ) + Path("nml-config.toml").write_text( + "[kinds]\nmodule = 'iso_fortran_env'\n\n[[namelists]]\n" + "schema = 'schema.yml'\nmod_path = 'out/nml_demo.f90'\n", + encoding="utf-8", + ) + + result = runner.invoke(cli_module.cli, ["generate"]) + + assert result.exit_code != 0 + assert "Fortran module generation requires [helper].path" in result.output + + +def test_generate_command_allows_missing_helper_path_without_fortran_output( + tmp_path: Path, +) -> None: + runner = CliRunner() + with runner.isolated_filesystem(temp_dir=tmp_path): + Path("schema.yml").write_text( + "x-fortran-namelist: demo\ntype: object\nproperties:\n value:\n type: integer\n", + encoding="utf-8", + ) + Path("nml-config.toml").write_text( + "[kinds]\nmodule = 'iso_fortran_env'\n\n[[namelists]]\n" + "schema = 'schema.yml'\ndoc_path = 'out/nml_demo.md'\n", + encoding="utf-8", + ) + + result = runner.invoke(cli_module.cli, ["generate"]) + + assert result.exit_code == 0, result.output + assert Path("out/nml_demo.md").exists() + assert not Path("nml_helper.f90").exists() + + +@pytest.mark.parametrize("command", ["generate", "gen-fortran"]) +def test_commands_allow_helper_free_local_derived_types_without_fortran_output( + tmp_path: Path, + command: str, +) -> None: + runner = CliRunner() + with runner.isolated_filesystem(temp_dir=tmp_path): + Path("schema.yml").write_text( + dedent( + """ + x-fortran-namelist: demo + type: object + properties: + value: + type: object + x-fortran-type: value_t + properties: + count: + type: integer + """ + ), + encoding="utf-8", + ) + Path("nml-config.toml").write_text( + "[kinds]\nmodule = 'iso_fortran_env'\n\n[[namelists]]\n" + "schema = 'schema.yml'\ndoc_path = 'out/nml_demo.md'\n", + encoding="utf-8", + ) + + result = runner.invoke(cli_module.cli, [command]) + + assert result.exit_code == 0, result.output + assert not Path("nml_helper.f90").exists() + + +def test_load_kind_settings_rejects_generated_dependency_alias() -> None: + with pytest.raises(click.ClickException, match="reserved"): + cli_module._load_kind_settings( + { + "kinds": { + "module": "iso_fortran_env", + "map": {"present": "int32"}, + "integer": ["int32"], + } + } + ) + + +@pytest.mark.parametrize( + ("command", "output_kind"), + [ + ("generate", "docs"), + ("gen-markdown", "docs"), + ("check", "docs"), + ("generate", "templates"), + ("gen-template", "templates"), + ("check", "templates"), + ], +) +def test_helper_free_outputs_reject_property_matching_namelist_group( + tmp_path: Path, command: str, output_kind: str +) -> None: + runner = CliRunner() + with runner.isolated_filesystem(temp_dir=tmp_path): + Path("schema.yml").write_text( + "x-fortran-namelist: Run\ntype: object\nproperties:\n rUN:\n type: integer\n", + encoding="utf-8", + ) + outputs = ( + "doc_path = 'out/run.md'\n" + if output_kind == "docs" + else "\n[[templates]]\npath = 'out/run.nml'\nnamelists = ['Run']\n" + ) + Path("nml-config.toml").write_text( + "[kinds]\nmodule = 'iso_fortran_env'\n\n[[namelists]]\n" + "schema = 'schema.yml'\n" + outputs, + encoding="utf-8", + ) + result = runner.invoke(cli_module.cli, [command]) + assert result.exit_code != 0 + assert "property 'rUN' conflicts with namelist group 'Run'" in result.output + assert not Path("out").exists() + + def test_generate_command_resolves_definitions_for_all_outputs(tmp_path: Path) -> None: runner = CliRunner() with runner.isolated_filesystem(temp_dir=tmp_path): @@ -1411,6 +1539,9 @@ def test_generate_command_resolves_definitions_for_all_outputs(tmp_path: Path) - integer = ["int32"] map = { i4 = "int32" } + [helper] + path = "out/nml_helper.f90" + [[namelists]] schema = "schema.yml" mod_path = "out/nml_demo.f90" @@ -1630,6 +1761,9 @@ def test_generation_subcommands_use_discovered_pyproject_config( [tool.nml-tools] minimum-version = "0" + [tool.nml-tools.helper] + path = "out/nml_helper.f90" + [tool.nml-tools.kinds] module = "iso_fortran_env" real = ["real64"] @@ -1847,6 +1981,9 @@ def test_check_command_passes_and_reports_differences(tmp_path: Path) -> None: [tool.nml-tools] minimum-version = "0" + [tool.nml-tools.helper] + path = "out/nml_helper.f90" + [tool.nml-tools.kinds] module = "iso_fortran_env" real = ["real64"] @@ -1909,6 +2046,9 @@ def test_check_command_reports_missing_files(tmp_path: Path) -> None: real = ["real64"] integer = ["int32"] + [helper] + path = "out/nml_helper.f90" + [[namelists]] schema = "schema.yml" mod_path = "out/nml_demo.f90" diff --git a/tests/test_cli_smoke.py b/tests/test_cli_smoke.py index bee19a6..753721b 100644 --- a/tests/test_cli_smoke.py +++ b/tests/test_cli_smoke.py @@ -222,6 +222,9 @@ def test_cli_generate_discovers_pyproject_tool_config(tmp_path: Path) -> None: [tool.nml-tools] minimum-version = "0" + [tool.nml-tools.helper] + path = "out/nml_helper.f90" + [tool.nml-tools.kinds] module = "iso_fortran_env" real = ["real64"] @@ -273,6 +276,9 @@ def test_cli_default_prefers_nml_config_over_pyproject(tmp_path: Path) -> None: real = ["real64"] integer = ["int32"] + [helper] + path = "out/nml_helper.f90" + [[namelists]] schema = "schema.yml" mod_path = "out/from_nml_config.f90" diff --git a/tests/test_codegen_f2py.py b/tests/test_codegen_f2py.py index aac44e8..926df65 100644 --- a/tests/test_codegen_f2py.py +++ b/tests/test_codegen_f2py.py @@ -114,7 +114,7 @@ def test_generate_f2py_wrappers_respects_kind_map(tmp_path: Path) -> None: assert "!> \\brief Optimization" in generated assert "!> \\brief Set optimization values on the handled instance" in generated assert ( - "integer(c_intptr_t), intent(in) :: handle " + "integer(c_intptr_t), intent(in) :: nml__handle " "!< opaque handle to a nml_optimization_t instance" ) in generated assert "integer, intent(in) :: values__n1 !< extent for values" in generated @@ -123,7 +123,7 @@ def test_generate_f2py_wrappers_respects_kind_map(tmp_path: Path) -> None: "!< values (required)" ) in generated assert ( - "character(len=1024), intent(out) :: errmsg " + "character(len=1024), intent(out) :: nml__errmsg " "!< error message for non-OK status values" ) in generated assert "use iso_fortran_env, only:" in generated @@ -141,18 +141,24 @@ def test_generate_f2py_wrappers_respects_kind_map(tmp_path: Path) -> None: assert "integer(i4), dimension(:), allocatable :: maybe__weights" in generated assert "if (has__seed) then" in generated assert "if (has__weights) then" in generated - assert "status = this%set(" in generated + assert "nml__status = nml__obj%set(" in generated assert "seed=maybe__seed" in generated assert "weights=maybe__weights" in generated assert "optional ::" not in generated assert "dimension(:), intent(in)" not in generated assert "function optimization_handle" not in generated assert "nml_optimization_resolve_handle" in generated - assert "call nml_optimization_resolve_handle(handle, this, status, errmsg)" in generated + assert ( + "call nml_optimization_resolve_handle(" + "nml__handle, nml__obj, nml__status, nml__errmsg)" in generated + ) assert "c_associated" not in generated assert "c_f_pointer" not in generated assert "status = NML_OK" not in generated - assert "type(nml_optimization_t), pointer :: this" in generated + assert "type(nml_optimization_t), pointer :: nml__obj" in generated + assert "integer(c_intptr_t), intent(in) :: nml__handle" in generated + assert "integer, intent(out) :: nml__status" in generated + assert "character(len=1024), intent(out) :: nml__errmsg" in generated assert "subroutine optimization_set_wrapper" in generated assert "subroutine optimization_from_file_wrapper" in generated assert "subroutine optimization_is_set_wrapper" in generated @@ -250,7 +256,7 @@ def test_generate_f2py_wrappers_exposes_set_dims_wrapper(tmp_path: Path) -> None ) assert "integer, allocatable :: maybe__n_weights" in generated assert "if (has__n_weights) then" in generated - assert "status = this%set_dims(" in generated + assert "nml__status = nml__obj%set_dims(" in generated assert "n_weights=maybe__n_weights" in generated @@ -272,14 +278,17 @@ def test_generate_f2py_wrappers_flattens_derived_values_to_intrinsic_arguments() assert "logical, dimension(periods__n1), intent(in) :: has__periods__start_year" in generated assert "type(period_t) :: maybe__period" in generated assert "type(period_t), dimension(:), allocatable :: maybe__periods" in generated - assert "status = this%init_type(period=maybe__period, errmsg=errmsg)" in generated + assert ( + "nml__status = nml__obj%init_type(" + "period=maybe__period, errmsg=nml__errmsg)" in generated + ) assert "if (periods__n1 > size(maybe__periods, 1)) then" in generated - assert 'errmsg = "dimension 1 exceeds bounds for \'periods\'"' in generated + assert 'nml__errmsg = "dimension 1 exceeds bounds for \'periods\'"' in generated assert "where (has__periods__start_year)" in generated assert generated.index("if (periods__n1 > size(maybe__periods, 1)) then") < ( generated.index("where (has__periods__start_year)") ) - assert "status = this%set(" in generated + assert "nml__status = nml__obj%set(" in generated assert "period=maybe__period" in generated assert "periods=maybe__periods" in generated @@ -388,7 +397,10 @@ def test_f2py_regroups_required_defaults_as_optional_with_presence_flags() -> No assert "logical, intent(in) :: has__count" in generated assert "logical, intent(in) :: has__setting" in generated assert "if (has__setting) then" in generated - assert "status = this%init_type(setting=maybe__setting, errmsg=errmsg)" in generated + assert ( + "nml__status = nml__obj%init_type(" + "setting=maybe__setting, errmsg=nml__errmsg)" in generated + ) def test_generate_f2cmap_requires_explicit_kind_mappings(tmp_path: Path) -> None: @@ -497,6 +509,10 @@ class FakeExtension: with pytest.raises(module.NmlError) as exc: cfg.is_valid() assert exc.value.status == 11 + assert exc.value.errmsg == "enum constraint failed" + assert module._split_result(("other output", 11, b"original message")) == ( + 11, "original message" + ) with pytest.raises(ValueError, match="required argument 'method'"): cfg.set(method=None, values=[1.0]) @@ -739,3 +755,158 @@ def test_generate_python_wrapper_rejects_unknown_docstring_style(tmp_path: Path) tmp_path / "config_wrappers.py", py_style="google", ) + + +def test_f2py_mangles_internal_status_names_but_preserves_python_names() -> None: + codegen = _import_codegen_f2py() + schema = { + "x-fortran-namelist": "run", + "type": "object", + "properties": { + "status": {"type": "integer"}, + "values": { + "type": "array", + "x-fortran-shape": "status", + "items": {"type": "integer"}, + }, + }, + } + + spec = codegen.build_f2py_namelist_spec(schema, dimensions={"status": 2}) + fortran = codegen.render_f2py_wrappers( + [schema], + file_name="f2py_run.f90", + dimensions={"status": 2}, + ) + python = codegen.render_python_wrappers([(spec, "f2py_run")]) + + assert "status__value" in spec.argument_list + assert "status__value" in spec.set_dims_argument_list + assert "status=maybe__status" in spec.set_call_arguments + assert "integer, intent(in) :: status__value" in fortran + assert "status: Any = None" in python + assert 'kwargs["status__value"] = status' in python + + +def test_f2py_wrapper_uses_internal_status_for_imported_status_type() -> None: + codegen = _import_codegen_f2py() + schema = resolve_schema( + { + "x-fortran-namelist": "run", + "type": "object", + "properties": { + "state": { + "type": "object", + "x-fortran-type": "status", + "x-fortran-module": "application_types", + "properties": {"code": {"type": "integer"}}, + } + }, + } + ) + + generated = codegen.render_f2py_wrappers([schema], file_name="f2py_run.f90") + + assert "type(status), allocatable :: maybe__state" in generated + assert "integer, intent(out) :: nml__status" in generated + assert "type(status) :: nml__status" not in generated + + +def test_f2py_derived_leaf_names_avoid_internal_wrapper_state() -> None: + codegen = _import_codegen_f2py() + schema = resolve_schema( + { + "x-fortran-namelist": "run", + "type": "object", + "properties": { + "nml": { + "type": "object", + "x-fortran-type": "state_t", + "properties": { + "status": {"type": "integer"}, + "handle": {"type": "integer"}, + "obj": {"type": "integer"}, + }, + } + }, + } + ) + + generated = codegen.render_f2py_wrappers([schema], file_name="f2py_run.f90") + + assert "integer, intent(in) :: nml__status_1 !< nml%status" in generated + assert "integer, intent(in) :: nml__handle_1 !< nml%handle" in generated + assert "integer, intent(in) :: nml__obj_1 !< nml%obj" in generated + assert "integer, intent(out) :: nml__status !< nml-tools status code" in generated + + +@pytest.mark.parametrize("namelist_name", ["run", "Run"]) +def test_f2py_mangles_schema_arguments_matching_wrapper_procedures( + namelist_name: str, +) -> None: + codegen = _import_codegen_f2py() + schema = { + "x-fortran-namelist": namelist_name, + "type": "object", + "properties": {"run_set_wrapper": {"type": "integer"}}, + } + + generated = codegen.render_f2py_wrappers([schema], file_name="f2py_run.f90") + + assert ( + f"subroutine {namelist_name}_set_wrapper(nml__handle, &\n" + " run_set_wrapper__value," + ) in generated + assert "integer, intent(in) :: run_set_wrapper__value" in generated + + +def test_f2py_rejects_kind_import_matching_wrapper_procedure() -> None: + codegen = _import_codegen_f2py() + schema = { + "x-fortran-namelist": "run", + "type": "object", + "properties": { + "value": {"type": "integer", "x-fortran-kind": "run_set_wrapper"} + }, + } + + with pytest.raises(ValueError, match="wrapper procedure 'run_set_wrapper' conflicts.*int32"): + codegen.build_f2py_namelist_spec( + schema, + kind_map={"run_set_wrapper": "int32"}, + kind_allowlist={"int32"}, + ) + + +def test_f2py_rejects_derived_type_matching_wrapper_procedure() -> None: + codegen = _import_codegen_f2py() + schema = { + "x-fortran-namelist": "run", + "type": "object", + "properties": { + "value": { + "type": "object", + "x-fortran-type": "run_set_wrapper", + "properties": {"code": {"type": "integer"}}, + } + }, + } + + with pytest.raises(ValueError, match="wrapper procedure 'run_set_wrapper' conflicts.*nml_run"): + codegen.build_f2py_namelist_spec(schema) + + +@pytest.mark.parametrize("field_name", ["c_intptr_t", "nml_run_resolve_handle"]) +def test_f2py_mangles_schema_arguments_matching_imported_wrapper_symbols( + field_name: str, +) -> None: + codegen = _import_codegen_f2py() + schema = { + "x-fortran-namelist": "run", + "type": "object", + "properties": {field_name: {"type": "integer"}}, + } + + generated = codegen.render_f2py_wrappers([schema], file_name="f2py_run.f90") + + assert f"integer, intent(in) :: {field_name}__value" in generated diff --git a/tests/test_codegen_fortran.py b/tests/test_codegen_fortran.py index ea275a7..db0b10e 100644 --- a/tests/test_codegen_fortran.py +++ b/tests/test_codegen_fortran.py @@ -183,8 +183,9 @@ def test_generate_fortran_handle_helper_uses_explicit_transfer_mold(tmp_path: Pa generated = output.read_text() assert "use iso_c_binding, only: c_f_pointer, c_intptr_t, c_null_ptr, c_ptr" in generated - assert "ptr = transfer(handle, c_null_ptr)" in generated - assert "ptr = transfer(handle, ptr)" not in generated + assert "nml__ptr = transfer(nml__handle, c_null_ptr)" in generated + assert "integer(c_intptr_t), intent(in) :: nml__handle" in generated + assert "type(c_ptr) :: nml__ptr" in generated def test_generate_fortran_allows_items_default(tmp_path: Path) -> None: @@ -207,7 +208,7 @@ def test_generate_fortran_allows_items_default(tmp_path: Path) -> None: generated = output.read_text() assert "integer(i4), parameter, public :: values__default = 2_i4" in generated - assert "this%values = values__default" in generated + assert "nml__obj%data%values = values__default" in generated def test_generate_fortran_accepts_static_shape_constants(tmp_path: Path) -> None: @@ -237,11 +238,11 @@ def test_generate_fortran_accepts_static_shape_constants(tmp_path: Path) -> None assert "integer :: dim__max_layers" not in generated assert "integer(i4), dimension(max_layers) :: values" in generated assert "procedure :: set_dims" not in generated - assert "allocate(this%values" not in generated + assert "allocate(nml__obj%data%values" not in generated assert "use nml_helper, only:" in generated assert "max_layers" in generated assert "integer(i4), parameter, public :: values__default = 1_i4" in generated - assert "this%values = values__default" in generated + assert "nml__obj%data%values = values__default" in generated def test_generate_fortran_matches_constants_case_insensitively(tmp_path: Path) -> None: @@ -324,16 +325,39 @@ def test_generate_fortran_accepts_runtime_dimensions(tmp_path: Path) -> None: ) generated = output.read_text() - assert "integer :: max_layers = max_layers__default" in generated + assert "type, public :: nml_test_nml_data_t" in generated + assert "type, public :: nml_test_nml_dims_t" in generated + assert "type(nml_test_nml_data_t) :: data" in generated + assert "type(nml_test_nml_dims_t) :: dims" in generated + assert "integer :: max_layers = max_layers__dim_default" in generated assert "integer(i4), allocatable, dimension(:) :: values" in generated assert "procedure :: set_dims => nml_test_nml_set_dims" in generated - assert "allocate(this%values(this%max_layers))" in generated + assert "allocate(nml__obj%data%values(nml__obj%dims%max_layers))" in generated assert "use nml_helper, only:" in generated helper_symbols = _extract_use_only_symbols(generated, "nml_helper") - assert "max_layers__default" in helper_symbols - assert "max_layers__default=>" not in generated + assert "max_layers__dim_default" in helper_symbols + assert "max_layers__dim_default=>" not in generated assert "integer(i4), parameter, public :: values__default = 1_i4" in generated - assert "this%values = values__default" in generated + assert "nml__obj%data%values = values__default" in generated + + +def test_generate_fortran_omits_dimensions_companion_without_runtime_dimensions() -> None: + codegen = _import_codegen_module() + schema = { + "x-fortran-namelist": "run", + "type": "object", + "properties": {"data": {"type": "integer"}, "dims": {"type": "integer"}}, + } + + generated = codegen.render_fortran(schema, file_name="nml_run.f90") + + assert "type, public :: nml_run_data_t" in generated + assert "type(nml_run_data_t) :: data" in generated + assert "nml_run_dims_t" not in generated + assert "integer :: data" in generated + assert "integer :: dims" in generated + assert "nml__obj%data%data" in generated + assert "nml__obj%data%dims" in generated def test_generate_fortran_normalizes_runtime_dimension_names(tmp_path: Path) -> None: @@ -360,13 +384,13 @@ def test_generate_fortran_normalizes_runtime_dimension_names(tmp_path: Path) -> ) generated = output.read_text() - assert "integer :: max_layers = max_layers__default" in generated + assert "integer :: max_layers = max_layers__dim_default" in generated helper_symbols = _extract_use_only_symbols(generated, "nml_helper") - assert "max_layers__default" in helper_symbols - assert "max_layers__default=>" not in generated + assert "max_layers__dim_default" in helper_symbols + assert "max_layers__dim_default=>" not in generated -def test_generate_fortran_rejects_runtime_dimension_property_collisions( +def test_generate_fortran_allows_runtime_dimension_property_collisions( tmp_path: Path, ) -> None: schema = { @@ -385,13 +409,17 @@ def test_generate_fortran_rejects_runtime_dimension_property_collisions( output = tmp_path / "nml_test.f90" generate_fortran = _import_generate_fortran() - with pytest.raises(ValueError, match="runtime dimension 'max_layers' conflicts"): - generate_fortran( - schema, - output, - kind_module="mo_kind", - dimensions={"max_layers": 3}, - ) + generate_fortran( + schema, + output, + kind_module="mo_kind", + dimensions={"max_layers": 3}, + ) + generated = output.read_text() + assert "integer(i4) :: max_layers" in generated + assert "integer :: max_layers = max_layers__dim_default" in generated + assert "nml__obj%data%max_layers" in generated + assert "nml__obj%dims%max_layers" in generated def test_generate_fortran_rejects_runtime_dimension_default_constant_collisions( @@ -404,7 +432,7 @@ def test_generate_fortran_rejects_runtime_dimension_default_constant_collisions( "properties": { "name": { "type": "string", - "x-fortran-len": "max_layers__default", + "x-fortran-len": "max_layers__dim_default", }, "values": { "type": "array", @@ -416,17 +444,17 @@ def test_generate_fortran_rejects_runtime_dimension_default_constant_collisions( output = tmp_path / "nml_test.f90" generate_fortran = _import_generate_fortran() - with pytest.raises(ValueError, match="constant 'max_layers__default' must not contain"): + with pytest.raises(ValueError, match="constant 'max_layers__dim_default' must not contain"): generate_fortran( schema, output, kind_module="mo_kind", - constants={"max_layers__default": 32}, + constants={"max_layers__dim_default": 32}, dimensions={"max_layers": 3}, ) -def test_generate_fortran_rejects_runtime_dimension_name_when_property_default_exists( +def test_generate_fortran_allows_runtime_dimension_name_when_property_default_exists( tmp_path: Path, ) -> None: schema = { @@ -449,13 +477,15 @@ def test_generate_fortran_rejects_runtime_dimension_name_when_property_default_e output = tmp_path / "nml_test.f90" generate_fortran = _import_generate_fortran() - with pytest.raises(ValueError, match="runtime dimension 'max_layers' conflicts"): - generate_fortran( - schema, - output, - kind_module="mo_kind", - dimensions={"max_layers": 3}, - ) + generate_fortran( + schema, + output, + kind_module="mo_kind", + dimensions={"max_layers": 3}, + ) + generated = output.read_text() + assert "nml__obj%data%max_layers = max_layers__default" in generated + assert "nml__obj%dims%max_layers" in generated def test_generate_fortran_does_not_alias_runtime_dimension_names_in_type_specs( @@ -668,7 +698,10 @@ def test_generate_fortran_emits_bounds_helpers(tmp_path: Path) -> None: assert "integer(i4), parameter, public :: counts__min = 1_i4" in generated assert "elemental logical function tolerance__in_bounds" in generated assert "elemental logical function counts__in_bounds" in generated - assert "all(counts__in_bounds(this%counts, allow_missing=.true.))" in generated + assert ( + "all(counts__in_bounds(nml__obj%data%counts, nml__allow_missing=.true.))" + in generated + ) def test_generate_fortran_rejects_flex_dim_boolean_array(tmp_path: Path) -> None: @@ -730,8 +763,21 @@ def test_generate_fortran_rejects_case_insensitive_duplicates(tmp_path: Path) -> generate_fortran(schema, tmp_path / "nml_test.f90", kind_module="mo_kind") -@pytest.mark.parametrize("name", ["is_configured", "init", "set", "from_file", "is_valid"]) -def test_generate_fortran_rejects_property_names_conflicting_with_type_members( +@pytest.mark.parametrize( + "name", + [ + "is_configured", + "init", + "init_type", + "set", + "set_dims", + "from_file", + "is_set", + "is_valid", + "filled_shape", + ], +) +def test_generate_fortran_allows_property_names_matching_type_members( tmp_path: Path, name: str, ) -> None: @@ -745,12 +791,13 @@ def test_generate_fortran_rejects_property_names_conflicting_with_type_members( } generate_fortran = _import_generate_fortran() - with pytest.raises(ValueError, match="conflicts with generated namelist type member"): - generate_fortran(schema, tmp_path / "nml_test.f90", kind_module="mo_kind") + output = tmp_path / "nml_test.f90" + generate_fortran(schema, output, kind_module="mo_kind") + assert f"integer :: {name}" in output.read_text() @pytest.mark.parametrize("name", ["is_configured", "init", "set_dims", "filled_shape"]) -def test_generate_fortran_rejects_runtime_dimensions_conflicting_with_type_members( +def test_generate_fortran_allows_runtime_dimensions_matching_type_members( tmp_path: Path, name: str, ) -> None: @@ -768,15 +815,399 @@ def test_generate_fortran_rejects_runtime_dimensions_conflicting_with_type_membe } generate_fortran = _import_generate_fortran() - with pytest.raises(ValueError, match="conflicts with generated namelist type member"): - generate_fortran( + output = tmp_path / "nml_test.f90" + generate_fortran( + schema, + output, + kind_module="mo_kind", + dimensions={name: 2}, + ) + assert f"integer :: {name} = {name}__dim_default" in output.read_text() + + +@pytest.mark.parametrize("name", ["errmsg", "ErrMsg"]) +def test_generate_fortran_rejects_reserved_errmsg_property(name: str) -> None: + codegen = _import_codegen_module() + schema = { + "x-fortran-namelist": "run", + "type": "object", + "properties": {name: {"type": "integer"}}, + } + + with pytest.raises(ValueError, match="reserved for the generated Fortran API"): + codegen.render_fortran(schema, file_name="nml_run.f90") + + +def test_generate_fortran_rejects_reserved_errmsg_dimension() -> None: + codegen = _import_codegen_module() + schema = { + "x-fortran-namelist": "run", + "type": "object", + "properties": { + "values": { + "type": "array", + "items": {"type": "integer"}, + "x-fortran-shape": "errmsg", + } + }, + } + + with pytest.raises(ValueError, match="reserved for the generated Fortran API"): + codegen.render_fortran( schema, - tmp_path / "nml_test.f90", - kind_module="mo_kind", - dimensions={name: 2}, + file_name="nml_run.f90", + dimensions={"ErrMsg": 2}, + ) + + +@pytest.mark.parametrize("type_name", ["nml_run_t", "nml_run_data_t", "nml_run_set"]) +def test_generate_fortran_rejects_generated_module_symbol_import_collision(type_name: str) -> None: + codegen = _import_codegen_module() + schema = { + "x-fortran-namelist": "run", + "type": "object", + "properties": { + "value": { + "type": "object", + "x-fortran-type": type_name, + "x-fortran-module": "application_types", + "properties": {"count": {"type": "integer"}}, + } + }, + } + + with pytest.raises(ValueError, match=f"generated module symbol '{type_name}'"): + codegen.render_fortran(schema, file_name="nml_run.f90") + + +def test_generate_fortran_rejects_f2py_handle_helper_import_collision() -> None: + codegen = _import_codegen_module() + schema = { + "x-fortran-namelist": "run", + "type": "object", + "properties": { + "value": { + "type": "object", + "x-fortran-type": "nml_run_resolve_handle", + "x-fortran-module": "application_types", + "properties": {"count": {"type": "integer"}}, + } + }, + } + + with pytest.raises(ValueError, match="generated module symbol 'nml_run_resolve_handle'"): + codegen.render_fortran( + schema, + file_name="nml_run.f90", + f2py_handle_helpers=True, ) +def test_generate_fortran_rejects_ambiguous_imported_type_names() -> None: + codegen = _import_codegen_module() + schema = { + "x-fortran-namelist": "run", + "type": "object", + "properties": { + "first": { + "type": "object", + "x-fortran-type": "status", + "x-fortran-module": "application_a", + "properties": {"code": {"type": "integer"}}, + }, + "second": { + "type": "object", + "x-fortran-type": "status", + "x-fortran-module": "application_b", + "properties": {"code": {"type": "integer"}}, + }, + }, + } + + with pytest.raises( + ValueError, match="application_b.*conflicts.*application_a.*scope 'nml_run'" + ): + codegen.render_fortran(schema, file_name="nml_run.f90") + + +def test_generate_fortran_rejects_local_and_imported_type_name_collision() -> None: + codegen = _import_codegen_module() + schema = { + "x-fortran-namelist": "run", + "type": "object", + "properties": { + "local": { + "type": "object", + "x-fortran-type": "status", + "properties": {"code": {"type": "integer"}}, + }, + "imported": { + "type": "object", + "x-fortran-type": "status", + "x-fortran-module": "application_types", + "properties": {"code": {"type": "integer"}}, + }, + }, + } + + with pytest.raises(ValueError, match="application_types.*conflicts.*nml_helper"): + codegen.render_fortran(schema, file_name="nml_run.f90") + + +@pytest.mark.parametrize( + ("schema", "kwargs"), + [ + ( + { + "x-fortran-namelist": "run", + "type": "object", + "properties": {"value": {"type": "string", "x-fortran-len": "errmsg"}}, + }, + {"constants": {"errmsg": 8}}, + ), + ( + { + "x-fortran-namelist": "run", + "type": "object", + "properties": { + "value": {"type": "integer", "x-fortran-kind": "errmsg"} + }, + }, + {"kind_map": {"errmsg": "int32"}, "kind_allowlist": {"int32"}}, + ), + ( + { + "x-fortran-namelist": "run", + "type": "object", + "properties": { + "value": { + "type": "object", + "x-fortran-type": "errmsg", + "properties": {"code": {"type": "integer"}}, + } + }, + }, + {}, + ), + ], +) +def test_generate_fortran_rejects_errmsg_in_generated_scope( + schema: dict[str, object], kwargs: dict[str, object] +) -> None: + codegen = _import_codegen_module() + + with pytest.raises(ValueError, match="reserved for the generated Fortran API"): + codegen.render_fortran(schema, file_name="nml_run.f90", **kwargs) + + +def test_generate_fortran_rejects_generated_procedure_dummy_collisions() -> None: + codegen = _import_codegen_module() + + with pytest.raises(ValueError, match="generated set procedure 'nml_run_set'"): + codegen.render_fortran( + { + "x-fortran-namelist": "run", + "type": "object", + "properties": {"nml_run_set": {"type": "integer"}}, + }, + file_name="nml_run.f90", + ) + + with pytest.raises(ValueError, match="generated init_type procedure 'nml_run_init_type'"): + codegen.render_fortran( + { + "x-fortran-namelist": "run", + "type": "object", + "properties": { + "nml_run_init_type": { + "type": "object", + "x-fortran-type": "period_t", + "properties": {"year": {"type": "integer"}}, + } + }, + }, + file_name="nml_run.f90", + ) + + with pytest.raises(ValueError, match="generated set_dims procedure 'nml_run_set_dims'"): + codegen.render_fortran( + { + "x-fortran-namelist": "run", + "type": "object", + "properties": { + "values": { + "type": "array", + "x-fortran-shape": "nml_run_set_dims", + "items": {"type": "integer"}, + } + }, + }, + file_name="nml_run.f90", + dimensions={"nml_run_set_dims": 2}, + ) + + +def test_generate_fortran_rejects_outer_type_procedure_scope_collisions() -> None: + codegen = _import_codegen_module() + + with pytest.raises(ValueError, match="generated outer type 'nml_run_t'"): + codegen.render_fortran( + { + "x-fortran-namelist": "run", + "type": "object", + "properties": {"nml_run_t": {"type": "integer"}}, + }, + file_name="nml_run.f90", + ) + + with pytest.raises(ValueError, match="generated outer type 'nml_run_t'"): + codegen.render_fortran( + { + "x-fortran-namelist": "run", + "type": "object", + "properties": { + "values": { + "type": "array", + "x-fortran-shape": "nml_run_t", + "items": {"type": "integer"}, + } + }, + }, + file_name="nml_run.f90", + dimensions={"nml_run_t": 2}, + ) + + +def test_generate_fortran_rejects_property_colliding_with_configured_import() -> None: + codegen = _import_codegen_module() + + with pytest.raises(ValueError, match="property 'n' conflicts with imported symbol"): + codegen.render_fortran( + { + "x-fortran-namelist": "run", + "type": "object", + "properties": { + "n": {"type": "integer"}, + "values": { + "type": "array", + "x-fortran-shape": "n", + "items": {"type": "integer"}, + }, + }, + }, + file_name="nml_run.f90", + constants={"n": 2}, + ) + + with pytest.raises( + ValueError, match="property 'i4' conflicts with imported symbol" + ): + codegen.render_fortran( + { + "x-fortran-namelist": "run", + "type": "object", + "properties": {"i4": {"type": "integer", "x-fortran-kind": "i4"}}, + }, + file_name="nml_run.f90", + kind_map={"i4": "int32"}, + kind_allowlist={"int32"}, + ) + + +def test_generate_fortran_isolates_resolver_imports_from_application_types() -> None: + codegen = _import_codegen_module() + schema = { + "x-fortran-namelist": "run", + "type": "object", + "properties": { + "value": { + "type": "object", + "x-fortran-type": "c_ptr", + "x-fortran-module": "application_types", + "properties": {"code": {"type": "integer"}}, + } + }, + } + + generated = codegen.render_fortran( + schema, file_name="nml_run.f90", f2py_handle_helpers=True, + ) + assert "use application_types, only: c_ptr" in generated + assert "use iso_c_binding" not in generated.split("contains", maxsplit=1)[0] + resolver = generated.split("subroutine nml_run_resolve_handle", maxsplit=1)[1] + assert "use iso_c_binding, only: c_f_pointer, c_intptr_t, c_null_ptr, c_ptr" in resolver + + +@pytest.mark.parametrize("name", ["present", "Present", "size", "NML_OK"]) +def test_generate_fortran_rejects_generated_dependency_names(name: str) -> None: + codegen = _import_codegen_module() + schema = { + "x-fortran-namelist": "run", + "type": "object", + "properties": {name: {"type": "integer"}}, + } + + with pytest.raises(ValueError, match="reserved"): + codegen.render_fortran(schema, file_name="nml_run.f90") + + +def test_generate_fortran_uses_direct_intrinsics_and_internal_helper_procedures() -> None: + codegen = _import_codegen_module() + schema = { + "x-fortran-namelist": "run", + "type": "object", + "properties": {"value": {"type": "integer"}}, + } + + generated = codegen.render_fortran(schema, file_name="nml_run.f90") + helper = codegen.render_helper(file_name="nml_helper.f90") + + assert "nml_helper_intrinsics" not in generated + assert "nml_helper_intrinsics" not in helper + assert "if (present(errmsg))" in generated + assert "idx__check" in generated + assert "to__lower" in generated + assert "function to__lower" in helper + assert "function idx__check" in helper + + +def test_generate_fortran_keeps_renamed_ieee_helpers_out_of_private_list() -> None: + codegen = _import_codegen_module() + generated = codegen.render_fortran( + { + "x-fortran-namelist": "run", + "type": "object", + "required": ["value"], + "properties": {"value": {"type": "number"}}, + }, + file_name="nml_run.f90", + ) + + assert "use ieee_arithmetic, only: nml__ieee_value => ieee_value" in generated + assert "private :: nml__ieee_value" not in generated + + +def test_generate_fortran_rejects_derived_type_root_symbol_collision() -> None: + codegen = _import_codegen_module() + schema = { + "x-fortran-namelist": "run", + "type": "object", + "properties": { + "period": {"type": "integer"}, + "value": { + "type": "object", + "x-fortran-type": "period", + "properties": {"year": {"type": "integer"}}, + }, + }, + } + + with pytest.raises( + ValueError, match="property 'period' conflicts with imported symbol 'period'" + ): + codegen.render_fortran(schema, file_name="nml_run.f90") + + def test_generate_fortran_accepts_required_case_insensitive(tmp_path: Path) -> None: schema = { "title": "Required case", @@ -830,7 +1261,7 @@ def test_generate_fortran_emits_filled_shape_for_flex_arrays(tmp_path: Path) -> generated = output.read_text() assert "procedure :: filled_shape" in generated - assert "_filled_shape(this, name, filled, errmsg)" in generated + assert "_filled_shape(nml__obj, name, filled, errmsg)" in generated assert "NML_ERR_PARTLY_SET" in generated @@ -943,11 +1374,11 @@ def test_generate_fortran_set_dims_validates_before_assignment(tmp_path: Path) - is_set_idx = generated.index("integer function nml_test_nml_is_set") is_valid_idx = generated.index("integer function nml_test_nml_is_valid") - generated.index("if (.not. this%is_configured) then", is_set_idx) - generated.index("if (.not. this%is_configured) then", is_valid_idx) + generated.index("if (.not. nml__obj%is_configured) then", is_set_idx) + generated.index("if (.not. nml__obj%is_configured) then", is_valid_idx) validate_idx = generated.index("if (candidate__max_layers <= 0) then") - assign_idx = generated.index("this%max_layers = candidate__max_layers") + assign_idx = generated.index("nml__obj%dims%max_layers = candidate__max_layers") assert assign_idx > validate_idx @@ -976,11 +1407,51 @@ def test_generate_fortran_runtime_sized_array_with_default_uses_partial_set(tmp_ ) generated = output.read_text() - assert "if (size(values, 1) > size(this%values, 1)) then" in generated - assert "this%values(lb__1:ub__1) = values" in generated + assert ( + "if (size(values, 1) > size(nml__obj%data%values, 1)) then" + in generated + ) + assert "nml__obj%data%values( &\n 1:size(values, 1)) = values" in generated + assert "lbound(" not in generated + assert "ubound(" not in generated assert "dimension 1 mismatch for 'values'" not in generated +def test_generate_fortran_orders_used_runtime_dimensions_by_configuration() -> None: + codegen = _import_codegen_module() + schema = { + "x-fortran-namelist": "run", + "type": "object", + "properties": { + "first": { + "type": "array", + "x-fortran-shape": "a", + "items": {"type": "integer"}, + }, + "second": { + "type": "array", + "x-fortran-shape": "b", + "items": {"type": "integer"}, + }, + }, + } + + generated = codegen.render_fortran( + schema, + file_name="nml_run.f90", + dimensions={"b": 3, "a": 2}, + ) + + dims_type = generated.index("type, public :: nml_run_dims_t") + b_component = generated.index("integer :: b = b__dim_default", dims_type) + a_component = generated.index("integer :: a = a__dim_default", dims_type) + set_dims = generated.index("integer function nml_run_set_dims") + b_argument = generated.index(" b, &", set_dims) + a_argument = generated.index(" a, &", set_dims) + assert b_component < a_component + assert b_argument < a_argument + + def test_generate_fortran_required_defaults_make_setter_arguments_optional() -> None: codegen = _import_codegen_module() schema = { @@ -997,15 +1468,15 @@ def test_generate_fortran_required_defaults_make_setter_arguments_optional() -> generated = codegen.render_fortran(schema, file_name="nml_run.f90") assert ( - "integer function nml_run_set(this, &\n count, &\n mode, &\n flag, &" + "integer function nml_run_set(nml__obj, &\n count, &\n mode, &\n flag, &" in generated ) assert "character(len=*), intent(in) :: mode" in generated assert "integer, intent(in), optional :: count" in generated assert "logical, intent(in), optional :: flag" in generated - assert 'istat = this%is_set("mode", errmsg=errmsg)' in generated - assert 'istat = this%is_set("count", errmsg=errmsg)' not in generated - assert 'istat = this%is_set("flag", errmsg=errmsg)' not in generated + assert 'nml__istat = nml__obj%is_set("mode", errmsg=errmsg)' in generated + assert 'nml__istat = nml__obj%is_set("count", errmsg=errmsg)' not in generated + assert 'nml__istat = nml__obj%is_set("flag", errmsg=errmsg)' not in generated def test_generate_fortran_allows_missing_group_without_input_required_fields() -> None: @@ -1022,18 +1493,18 @@ def test_generate_fortran_allows_missing_group_without_input_required_fields() - generated = codegen.render_fortran(schema, file_name="nml_run.f90") - missing_group_branch = """ if (status /= NML_OK) then - if (status == NML_ERR_NML_NOT_FOUND) then - close_status = nml%close(errmsg=errmsg) - if (close_status /= NML_OK) then - status = close_status + missing_group_branch = """ if (nml__status /= NML_OK) then + if (nml__status == NML_ERR_NML_NOT_FOUND) then + nml__close_status = nml__reader%close(errmsg=errmsg) + if (nml__close_status /= NML_OK) then + nml__status = nml__close_status return end if - this%is_configured = .true. - status = NML_OK + nml__obj%is_configured = .true. + nml__status = NML_OK return end if - close_status = nml%close() + nml__close_status = nml__reader%close() return end if""" assert missing_group_branch in generated @@ -1050,11 +1521,13 @@ def test_generate_fortran_rejects_missing_group_with_input_required_fields() -> generated = codegen.render_fortran(schema, file_name="nml_run.f90") - find_start = generated.index('status = nml%find("run", errmsg=errmsg)') + find_start = generated.index( + 'nml__status = nml__reader%find("run", errmsg=errmsg)' + ) find_end = generated.index(" ! read namelist") find_block = generated[find_start:find_end] - assert "close_status = nml%close(errmsg=errmsg)" not in find_block - assert "this%is_configured = .true." not in find_block + assert "nml__close_status = nml__reader%close(errmsg=errmsg)" not in find_block + assert "nml__obj%is_configured = .true." not in find_block def test_generate_fortran_runtime_repeat_and_item_defaults_use_extent_policy() -> None: @@ -1174,8 +1647,11 @@ def test_generate_fortran_fixed_array_setters_use_assumed_shape( generated = output.read_text() assert "integer(i4), dimension(:), intent(in), optional :: values" in generated - assert "if (size(values, 1) > size(this%values, 1)) then" in generated - assert "this%values(lb__1:ub__1) = values" in generated + assert ( + "if (size(values, 1) > size(nml__obj%data%values, 1)) then" + in generated + ) + assert "nml__obj%data%values( &\n 1:size(values, 1)) = values" in generated assert "dimension(3), intent(in), optional :: values" not in generated @@ -1207,9 +1683,12 @@ def test_generate_fortran_runtime_sized_string_array_uses_static_length( generated = output.read_text() assert "character(len=name_len), allocatable, dimension(:) :: names" in generated - assert "allocate(character(len=name_len) :: this%names(this%max_names))" in generated + assert ( + "allocate(character(len=name_len) :: " + "nml__obj%data%names(nml__obj%dims%max_names))" in generated + ) assert "character(len=:), allocatable" not in generated - assert "this%names = names" in generated + assert "nml__obj%data%names = names" in generated def test_generate_fortran_multidimensional_string_array_sentinels( @@ -1238,8 +1717,8 @@ def test_generate_fortran_multidimensional_string_array_sentinels( ) generated = output.read_text() - assert "this%names = achar(0)" in generated - assert "all(this%names == achar(0))" in generated + assert "nml__obj%data%names = achar(0)" in generated + assert "all(nml__obj%data%names == achar(0))" in generated def test_generate_fortran_array_default_pad_order(tmp_path: Path) -> None: @@ -1365,29 +1844,29 @@ def test_generate_fortran_emits_local_derived_types_and_typed_fields() -> None: assert "type(period_t) :: period" in generated assert "type(period_t), allocatable, dimension(:) :: periods" in generated assert "procedure :: init_type => nml_run_init_type" in generated - assert "status = this%init_type( &" in generated - assert "period=this%period" in generated - assert "periods=this%periods" in generated + assert "nml__status = nml__obj%init_type( &" in generated + assert "period=nml__obj%data%period" in generated + assert "periods=nml__obj%data%periods" in generated assert "init_type requires exactly one" not in generated assert "init_type requires at least one" not in generated assert "integer :: selected" not in generated assert "selected = selected + 1" not in generated - assert "this%period%start_year" in generated + assert "nml__obj%data%period%start_year" in generated assert 'case ("period%start_year")' in generated assert 'case ("periods%start_year")' in generated assert "! required parameters" in generated assert "! required derived values" not in generated - assert 'istat = this%is_set("period", errmsg=errmsg)' in generated - assert 'istat = this%is_set("periods", errmsg=errmsg)' in generated - assert generated.count('istat = this%is_set("period", errmsg=errmsg)') == 1 - assert generated.count('istat = this%is_set("periods", errmsg=errmsg)') == 1 + assert 'nml__istat = nml__obj%is_set("period", errmsg=errmsg)' in generated + assert 'nml__istat = nml__obj%is_set("periods", errmsg=errmsg)' in generated + assert generated.count('nml__istat = nml__obj%is_set("period", errmsg=errmsg)') == 1 + assert generated.count('nml__istat = nml__obj%is_set("periods", errmsg=errmsg)') == 1 assert " .and. &" in generated assert " .or. &" in generated assert "integer(i4), parameter, public :: period__start_year__min = 1900_i4" in generated assert "elemental logical function period__start_year__in_bounds" in generated - assert "period__label__in_enum(this%period%label)" in generated - assert "periods__start_year__in_bounds(this%periods%start_year" in generated - assert "if (allocated(this%periods)) then" in generated + assert "period__label__in_enum(nml__obj%data%period%label)" in generated + assert "periods__start_year__in_bounds(nml__obj%data%periods%start_year" in generated + assert "if (allocated(nml__obj%data%periods)) then" in generated def test_generate_fortran_init_type_accepts_fixed_derived_arrays() -> None: @@ -1422,7 +1901,7 @@ def test_generate_fortran_init_type_accepts_fixed_derived_arrays() -> None: assert "type(period_t), dimension(2) :: periods" in generated assert "type(period_t), dimension(:), intent(inout), optional :: periods" in generated assert "allocatable, intent(inout), optional :: periods" not in generated - assert "periods=this%periods" in generated + assert "periods=nml__obj%data%periods" in generated assert "periods%year = 2001" in generated @@ -1474,8 +1953,8 @@ def test_generate_fortran_imports_application_owned_derived_type() -> None: assert "type(location_t) :: location" in generated assert "type(location_t), intent(in), optional :: location" in generated assert "type(location_t), dimension(:), intent(in), optional :: locations" in generated - assert 'istat = this%is_set("location", errmsg=errmsg)' not in generated - assert 'istat = this%is_set("locations", errmsg=errmsg)' not in generated + assert 'nml__istat = nml__obj%is_set("location", errmsg=errmsg)' not in generated + assert 'nml__istat = nml__obj%is_set("locations", errmsg=errmsg)' not in generated assert "if (len(location%name) /= 8) then" in generated assert "if (len(locations%name) /= 8) then" in generated assert "imported string storage length mismatch: location%name" in generated diff --git a/tests/test_codegen_scopes.py b/tests/test_codegen_scopes.py new file mode 100644 index 0000000..a29c6b8 --- /dev/null +++ b/tests/test_codegen_scopes.py @@ -0,0 +1,324 @@ +"""Cross-source generation scope regressions.""" + +from __future__ import annotations + +import pytest + +from nml_tools.codegen_f2py import build_f2py_namelist_spec, render_f2py_wrappers +from nml_tools.codegen_fortran import ( + ConstantSpec, + collect_local_derived_types, + render_fortran, + render_helper, +) +from nml_tools.schema import resolve_schema + + +def _schema( + type_name: str = "period_t", module: str | None = None, kind: str | None = None +) -> dict: + derived = { + "type": "object", + "x-fortran-type": type_name, + "properties": {"size": {"type": "integer"}, "present": {"type": "integer"}}, + } + if module is not None: + derived["x-fortran-module"] = module + if kind is not None: + derived["properties"]["size"]["x-fortran-kind"] = kind + return resolve_schema( + { + "type": "object", + "x-fortran-namelist": "Run", + "properties": {"value": derived}, + } + ) + + +def test_helper_constant_type_conflict_is_case_insensitive() -> None: + local_types = collect_local_derived_types([_schema()]) + with pytest.raises( + ValueError, match="local derived type 'period_t'.*helper constant 'PERIOD_T'" + ): + render_helper( + file_name="helper.f90", + local_derived_types=local_types, + constants=[ConstantSpec("PERIOD_T", "integer", "2", None)], + ) + + +def test_helper_type_kind_conflict() -> None: + local_types = collect_local_derived_types([_schema("i4", kind="i4")]) + with pytest.raises(ValueError, match="local derived type 'i4'.*imported symbol 'i4'"): + render_helper( + file_name="helper.f90", + local_derived_types=local_types, + kind_map={"i4": "int32"}, + kind_allowlist={"int32"}, + ) + + +def test_helper_reuses_identical_definition_without_duplicate_declaration() -> None: + schema = _schema() + local_types = collect_local_derived_types([schema, schema]) + assert len(local_types) == 1 + helper = render_helper(file_name="helper.f90", local_derived_types=local_types * 2) + assert helper.count("type, public :: period_t") == 1 + + +def test_reader_rejects_property_matching_group() -> None: + with pytest.raises(ValueError, match="property 'rUN'.*namelist group 'Run'.*read__from_file"): + render_fortran( + { + "x-fortran-namelist": "Run", + "type": "object", + "properties": {"rUN": {"type": "integer"}}, + }, + file_name="run.f90", + ) + + +def test_qualified_intrinsic_components_and_repeated_imports_remain_supported() -> None: + schema = _schema("status", "application_types") + schema["properties"]["second"] = schema["properties"]["value"] + native = render_fortran(schema, file_name="run.f90") + assert native.count("use application_types, only: status") == 1 + assert "%size" in native and "%present" in native + + +@pytest.mark.parametrize("kind", ["val", "allow_missing", "in_enum", "in_bounds"]) +def test_constraint_helpers_do_not_shadow_kind_imports(kind: str) -> None: + native = render_fortran( + { + "type": "object", + "x-fortran-namelist": "Run", + "properties": { + "choice": { + "type": "integer", + "x-fortran-kind": kind, + "enum": [1, 2], + "minimum": 1, + } + }, + }, + file_name="run.f90", + kind_map={kind: "int32"}, + kind_allowlist={"int32"}, + ) + assert f"integer({kind}), intent(in) :: nml__val" in native + assert "present(nml__allow_missing)" in native + assert "result(nml__in_enum)" in native + assert "result(nml__in_bounds)" in native + assert "if (nml__val == -huge(nml__val))" in native + + +def test_helper_state_uses_reserved_internal_names() -> None: + helper = render_helper(file_name="helper.f90") + assert "result(nml__status)" in helper + assert "iostat=nml__iostat, iomsg=nml__iomsg" in helper + assert "this%is_open = (nml__iostat == 0)" in helper + assert "function to__lower(nml__string)" in helper + assert "function idx__check(nml__idx, nml__extents, nml__field, errmsg)" in helper + + +def test_reader_group_cannot_shadow_public_error_dummy() -> None: + with pytest.raises( + ValueError, match="'x-fortran-namelist'.*reserved for the generated Fortran API" + ): + render_fortran( + { + "type": "object", + "x-fortran-namelist": "ErrMsg", + "properties": {"value": {"type": "integer"}}, + }, + file_name="errmsg.f90", + ) + + +@pytest.mark.parametrize("name", ["present", "PrEsEnT", "size", "transfer", "TrAnSfEr"]) +def test_native_generation_rejects_intrinsic_namelist_group_names(name: str) -> None: + with pytest.raises(ValueError, match="'x-fortran-namelist'.*reserved as a Fortran intrinsic"): + render_fortran( + { + "type": "object", + "x-fortran-namelist": name, + "properties": {"value": {"type": "integer"}}, + }, + file_name="group.f90", + ) + + +@pytest.mark.parametrize("name", ["transfer", "TrAnSfEr"]) +@pytest.mark.parametrize("source", ["kind", "derived_type"]) +def test_handle_resolver_rejects_transfer_imports(name: str, source: str) -> None: + if source == "kind": + schema = { + "type": "object", + "x-fortran-namelist": "run", + "properties": {"value": {"type": "integer", "x-fortran-kind": name}}, + } + options = {"kind_map": {name: "int32"}, "kind_allowlist": {"int32"}} + else: + schema = { + "type": "object", + "x-fortran-namelist": "run", + "properties": { + "value": { + "type": "object", + "x-fortran-type": name, + "x-fortran-module": "application_types", + "properties": {"code": {"type": "integer"}}, + } + }, + } + options = {} + with pytest.raises(ValueError, match="reserved as a Fortran intrinsic"): + render_fortran(schema, file_name="run.f90", f2py_handle_helpers=True, **options) + + +@pytest.mark.parametrize("name", ["c_intptr_t", "c_ptr", "c_null_ptr", "c_f_pointer"]) +def test_resolver_dependencies_do_not_restrict_schema_fields(name: str) -> None: + schema = { + "type": "object", + "x-fortran-namelist": "run", + "properties": {name: {"type": "integer"}}, + } + native = render_fortran(schema, file_name="run.f90", f2py_handle_helpers=True) + assert "use iso_c_binding" not in native.split("contains", maxsplit=1)[0] + assert f"integer, intent(in), optional :: {name}" in native + spec = build_f2py_namelist_spec(schema) + arg = spec.optional_args[0] + assert arg.name == name + assert arg.abi_name == ("c_intptr_t__value" if name == "c_intptr_t" else name) + + +@pytest.mark.parametrize("name", ["c_intptr_t", "c_ptr", "c_null_ptr", "c_f_pointer"]) +def test_resolver_dependencies_do_not_restrict_runtime_dimensions(name: str) -> None: + schema = { + "type": "object", + "x-fortran-namelist": "run", + "properties": { + "values": { + "type": "array", + "items": {"type": "integer"}, + "x-fortran-shape": name, + } + }, + } + native = render_fortran( + schema, file_name="run.f90", dimensions={name: 2}, f2py_handle_helpers=True + ) + assert f"integer, intent(in), optional :: {name}" in native + spec = build_f2py_namelist_spec(schema, dimensions={name: 2}) + assert spec.set_dims_args[0].name == name + wrapper = render_f2py_wrappers([schema], file_name="wrapper.f90", dimensions={name: 2}) + if name == "c_intptr_t": + assert "c_intptr_t__value" in wrapper + + +@pytest.mark.parametrize("source", ["helper", "kind", "derived_type"]) +def test_native_module_rejects_self_use(source: str) -> None: + options = {} + if source == "derived_type": + schema = _schema("status", "NML_RUN") + else: + schema = { + "type": "object", + "x-fortran-namelist": "run", + "properties": {"value": {"type": "integer"}}, + } + if source == "helper": + options["helper_module"] = "NML_RUN" + else: + options["kind_module"] = "NML_RUN" + schema["properties"]["value"]["x-fortran-kind"] = "int32" + with pytest.raises(ValueError, match="module 'nml_[Rr]un' cannot USE itself"): + render_fortran(schema, file_name="run.f90", **options) + + +def test_default_helper_module_conflicts_with_helper_namelist() -> None: + with pytest.raises(ValueError, match="module 'nml_helper' cannot USE itself"): + render_fortran( + { + "type": "object", + "x-fortran-namelist": "helper", + "properties": {"value": {"type": "integer"}}, + }, + file_name="helper.f90", + ) + native = render_fortran( + { + "type": "object", + "x-fortran-namelist": "helper", + "properties": {"value": {"type": "integer"}}, + }, + file_name="helper.f90", + helper_module="helper_support", + ) + assert "module nml_helper" in native + assert "use helper_support" in native + + +def test_helper_rejects_self_use_of_kind_module() -> None: + with pytest.raises(ValueError, match="module 'shared_kinds' cannot USE itself"): + render_helper( + file_name="helper.f90", + module_name="shared_kinds", + kind_module="SHARED_KINDS", + local_derived_types=collect_local_derived_types([_schema(kind="int32")]), + ) + + +@pytest.mark.parametrize("source", ["helper", "kind"]) +def test_wrapper_rejects_self_use(source: str) -> None: + if source == "helper": + schema = _schema() + options = {"helper_module": "F2PY_RUN"} + else: + schema = { + "type": "object", + "x-fortran-namelist": "run", + "properties": {"value": {"type": "integer", "x-fortran-kind": "int32"}}, + } + options = {"kind_module": "F2PY_RUN"} + with pytest.raises(ValueError, match="module 'f2py_[Rr]un' cannot USE itself"): + render_f2py_wrappers([schema], file_name="wrapper.f90", **options) + + +def test_unused_kind_or_helper_module_configuration_is_not_a_self_use() -> None: + schema = { + "type": "object", + "x-fortran-namelist": "run", + "properties": {"value": {"type": "integer"}}, + } + native = render_fortran(schema, file_name="run.f90", kind_module="NML_RUN") + assert "use NML_RUN" not in native + helper = render_helper(file_name="helper.f90", kind_module="NML_HELPER") + assert "use NML_HELPER" not in helper + wrapper = render_f2py_wrappers( + [schema], file_name="wrapper.f90", helper_module="F2PY_RUN", kind_module="F2PY_RUN" + ) + assert "use F2PY_RUN" not in wrapper + + +@pytest.mark.parametrize("name", ["file", "name", "idx", "filled"]) +@pytest.mark.parametrize("source", ["kind", "derived_type"]) +def test_control_procedures_allow_shadowing_unused_schema_imports(name: str, source: str) -> None: + if source == "derived_type": + schema = _schema(name, "application_types") + options = {} + else: + schema = { + "type": "object", + "x-fortran-namelist": "Run", + "properties": {"value": {"type": "integer", "x-fortran-kind": name}}, + } + options = {"kind_map": {name: "int32"}, "kind_allowlist": {"int32"}} + schema["properties"]["values"] = { + "type": "array", + "items": {"type": "integer"}, + "x-fortran-shape": 2, + "x-fortran-flex-tail-dims": 1, + } + native = render_fortran(schema, file_name="run.f90", f2py_handle_helpers=True, **options) + assert "_filled_shape(nml__obj, name, filled, errmsg)" in native diff --git a/tests/test_dimensions.py b/tests/test_dimensions.py index e2792f5..bfe4d60 100644 --- a/tests/test_dimensions.py +++ b/tests/test_dimensions.py @@ -130,15 +130,15 @@ def test_inference_accepts_multiple_files_and_dimensions() -> None: { "type": "object", "x-fortran-namelist": "other", - "properties": {"size": {"type": "integer"}}, + "properties": {"count": {"type": "integer"}}, } ), } assert infer_runtime_dimensions( - [parse_namelist("&settings count=3 /"), parse_namelist("&other size=4 /")], + [parse_namelist("&settings count=3 /"), parse_namelist("&other count=4 /")], sources={ "n_values": DimensionSource("settings", "count"), - "n_other": DimensionSource("other", "size"), + "n_other": DimensionSource("other", "count"), }, schemas=schemas, defaults={"n_values": 1, "n_other": 2, "unsourced": 5}, diff --git a/tests/test_enum_support.py b/tests/test_enum_support.py index 73059d4..69dd239 100644 --- a/tests/test_enum_support.py +++ b/tests/test_enum_support.py @@ -80,8 +80,14 @@ def test_generate_fortran_emits_enum_helpers(tmp_path: Path) -> None: assert "try_methods__enum_values(2)" in generated assert "sizes__enum_values(3)" in generated assert "elemental logical function method__in_enum" in generated - assert "all(try_methods__in_enum(this%try_methods, allow_missing=.true.))" in generated - assert "all(sizes__in_enum(this%sizes, allow_missing=.true.))" in generated + assert ( + "all(try_methods__in_enum(" + "nml__obj%data%try_methods, nml__allow_missing=.true.))" in generated + ) + assert ( + "all(sizes__in_enum(nml__obj%data%sizes, nml__allow_missing=.true.))" + in generated + ) def test_generate_fortran_rejects_array_enum_at_top_level(tmp_path: Path) -> None: diff --git a/tests/test_fortran_scope.py b/tests/test_fortran_scope.py new file mode 100644 index 0000000..446fbd0 --- /dev/null +++ b/tests/test_fortran_scope.py @@ -0,0 +1,50 @@ +"""Case-insensitive ownership, rather than growing ad-hoc reserved lists.""" + +import pytest + +from nml_tools._fortran_scope import FortranScope + + +def test_repeated_import_is_the_same_entity() -> None: + scope = FortranScope("helper") + scope.import_symbol("I4 => int32", "iso_fortran_env") + scope.import_symbol("i4 => INT32", "ISO_FORTRAN_ENV") + assert scope.names == {"i4"} + reservation = scope.names + reservation.add("other") + assert scope.names == {"i4"} + + +@pytest.mark.parametrize("module, remote", [("other", "int32"), ("kinds", "int64")]) +def test_same_local_name_requires_same_module_and_remote(module: str, remote: str) -> None: + scope = FortranScope("native") + scope.import_symbol("i4 => int32", "kinds") + with pytest.raises(ValueError, match="conflicts.*kinds.*scope 'native'"): + scope.import_symbol(f"I4 => {remote}", module) + + +def test_local_categories_and_child_scopes() -> None: + scope = FortranScope("helper") + scope.declare("period", category="type", identity=("schema", "period"), source="schema type") + scope.declare("PERIOD", category="type", identity=("schema", "period"), source="reused type") + child = scope.child("setter") + with pytest.raises(ValueError, match="dummy conflicts with reused type.*scope 'setter'"): + child.declare("period", category="dummy", identity=("dummy",), source="dummy") + assert scope.names == {"period"} + assert scope.child("unrelated", names=set()).names == set() + + +def test_module_cannot_use_itself_including_from_a_child_scope() -> None: + scope = FortranScope("native", module_name="native") + with pytest.raises(ValueError, match="module 'native' cannot USE itself"): + scope.import_symbol("value", "NATIVE") + with pytest.raises(ValueError, match="module 'native' cannot USE itself"): + scope.child("resolver").import_symbol("other", "Native") + + +def test_source_module_names_do_not_reserve_local_identifiers() -> None: + scope = FortranScope("setter", module_name="native") + scope.import_symbol("i4", "kinds") + scope.child("kinds").import_symbol("other", "kinds") + scope.declare("kinds", category="dummy", identity=("dummy",), source="schema dummy") + assert scope.names == {"i4", "kinds"} diff --git a/tests/test_schema.py b/tests/test_schema.py index 7fbcb88..c090b58 100644 --- a/tests/test_schema.py +++ b/tests/test_schema.py @@ -955,6 +955,11 @@ def test_referenced_derived_types_reject_unsupported_v1_layouts( ("1run", "valid Fortran identifier"), ("run__config", "must not contain '__'"), (" run", "valid Fortran identifier"), + ("present", "reserved as a Fortran intrinsic"), + ("PrEsEnT", "reserved as a Fortran intrinsic"), + ("size", "reserved as a Fortran intrinsic"), + ("transfer", "reserved as a Fortran intrinsic"), + ("TrAnSfEr", "reserved as a Fortran intrinsic"), ], ) def test_schema_rejects_invalid_fortran_namelist_names( @@ -970,6 +975,54 @@ def test_schema_rejects_invalid_fortran_namelist_names( ) +@pytest.mark.parametrize("property_name", ["Run", "rUN"]) +def test_schema_rejects_root_property_matching_group(property_name: str) -> None: + with pytest.raises(ValueError, match=f"property '{property_name}'.*namelist group 'Run'"): + resolve_schema( + { + "type": "object", + "x-fortran-namelist": "Run", + "properties": {property_name: {"type": "integer"}}, + } + ) + + +@pytest.mark.parametrize("inherited", ["property", "group"]) +def test_schema_rejects_group_property_collision_after_root_reference( + tmp_path: Path, inherited: str +) -> None: + base = {"type": "object"} + schema = {"$ref": "base.json"} + if inherited == "property": + base["properties"] = {"rUN": {"type": "integer"}} + schema["x-fortran-namelist"] = "Run" + else: + base["x-fortran-namelist"] = "Run" + schema["properties"] = {"rUN": {"type": "integer"}} + (tmp_path / "base.json").write_text(json.dumps(base), encoding="utf-8") + source = tmp_path / "schema.json" + source.write_text(json.dumps(schema), encoding="utf-8") + with pytest.raises(ValueError, match="property 'rUN'.*namelist group 'Run'"): + load_schema(source) + + +def test_schema_allows_qualified_component_matching_group() -> None: + schema = resolve_schema( + { + "type": "object", + "x-fortran-namelist": "Run", + "properties": { + "value": { + "type": "object", + "x-fortran-type": "value_t", + "properties": {"rUN": {"type": "integer"}}, + } + }, + } + ) + assert "%run" in render_fortran(schema, file_name="run.f90") + + @pytest.mark.parametrize( ("property_schema", "match"), [ @@ -1123,6 +1176,78 @@ def test_schema_rejects_reserved_double_underscore_identifiers( ) +@pytest.mark.parametrize("name", ["errmsg", "ErrMsg"]) +def test_schema_rejects_reserved_errmsg_properties(name: str) -> None: + with pytest.raises(ValueError, match="reserved for the generated Fortran API"): + resolve_schema( + { + "x-fortran-namelist": "run", + "type": "object", + "properties": { + "period": { + "type": "object", + "x-fortran-type": "period_t", + "properties": {name: {"type": "integer"}}, + } + }, + } + ) + + +@pytest.mark.parametrize("name", ["present", "size", "transfer"]) +def test_schema_allows_qualified_derived_components_named_after_intrinsics(name: str) -> None: + schema = resolve_schema( + { + "x-fortran-namelist": "run", + "type": "object", + "properties": { + "value": { + "type": "object", + "x-fortran-type": "value_t", + "properties": {name: {"type": "integer"}}, + } + }, + } + ) + + generated = render_fortran(schema, file_name="nml_run.f90") + assert f"integer :: {name}" in render_helper( + file_name="nml_helper.f90", + local_derived_types=collect_local_derived_types([schema]), + ) + assert f"nml__obj%data%value%{name}" in generated + + +@pytest.mark.parametrize("name", ["present", "SIZE", "NML_OK", "transfer", "TrAnSfEr"]) +def test_schema_rejects_generated_dependency_properties(name: str) -> None: + with pytest.raises(ValueError, match="reserved"): + resolve_schema( + { + "x-fortran-namelist": "run", + "type": "object", + "properties": {name: {"type": "integer"}}, + } + ) + + +@pytest.mark.parametrize("type_name", ["present", "NML_FILE_T", "nml_open", "transfer", "TrAnSfEr"]) +def test_schema_rejects_generated_dependency_type_names(type_name: str) -> None: + with pytest.raises(ValueError, match="reserved"): + resolve_schema( + { + "x-fortran-namelist": "run", + "type": "object", + "properties": { + "value": { + "type": "object", + "x-fortran-type": type_name, + "properties": {"code": {"type": "integer"}}, + } + }, + } + ) + + @pytest.mark.parametrize( ("property_schema", "match"), [ diff --git a/tests/test_validate.py b/tests/test_validate.py index c0f0474..2f58ca2 100644 --- a/tests/test_validate.py +++ b/tests/test_validate.py @@ -107,8 +107,12 @@ def test_normalize_config_values_accept_none_and_reject_invalid_values() -> None with pytest.raises(ValueError, match="constant names must be non-empty"): normalize_constant_values({"": 1}) + with pytest.raises(ValueError, match="reserved"): + normalize_constant_values({"present": 1}) with pytest.raises(ValueError, match="runtime dimension names must be non-empty"): normalize_runtime_dimensions({"": 1}) + with pytest.raises(ValueError, match="reserved"): + normalize_runtime_dimensions({"NML_OK": 1}) with pytest.raises(ValueError, match="duplicates another dimension"): normalize_runtime_dimensions({"n": 1, "N": 2})