From bcbebfe0187d6b45c312fa0c6578e4d96960d420 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Sat, 12 Sep 2026 00:32:11 +0200 Subject: [PATCH 01/22] feat(fortran): separate data and dimension storage Generate dedicated public data and dimensions companion types while keeping lifecycle state and bindings on the outer namelist object. Reserve errmsg, isolate generated locals, alias PRESENT, and simplify owned arrays to one-based bounds. --- src/nml_tools/_utils.py | 10 +- src/nml_tools/cli.py | 10 +- src/nml_tools/codegen_fortran.py | 386 ++++++++-------- src/nml_tools/schema.py | 4 +- src/nml_tools/templates/fortran_module.f90.j2 | 421 +++++++++--------- src/nml_tools/templates/nml_helper.f90.j2 | 14 +- tests/fixtures/01_simple/out/nml_helper.f90 | 16 +- .../01_simple/out/nml_optimization.f90 | 390 ++++++++-------- .../01_simple/out/nml_optimization.md | 39 +- tests/test_cli_config.py | 4 +- tests/test_codegen_fortran.py | 308 +++++++++---- tests/test_enum_support.py | 10 +- tests/test_schema.py | 18 + 13 files changed, 918 insertions(+), 712 deletions(-) diff --git a/src/nml_tools/_utils.py b/src/nml_tools/_utils.py index b9fb389..5a8d829 100644 --- a/src/nml_tools/_utils.py +++ b/src/nml_tools/_utils.py @@ -7,6 +7,7 @@ FORTRAN_IDENTIFIER = re.compile(r"^[A-Za-z][A-Za-z0-9_]*$") RESERVED_IDENTIFIER_SEPARATOR = "__" +RESERVED_NAMELIST_IDENTIFIERS = frozenset({"errmsg"}) def is_fortran_identifier(name: str) -> bool: @@ -25,6 +26,13 @@ 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 an identifier used for a namelist property or runtime dimension.""" + 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 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()) @@ -63,7 +71,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..c377e11 100644 --- a/src/nml_tools/cli.py +++ b/src/nml_tools/cli.py @@ -17,7 +17,11 @@ 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_namelist_identifier, + validate_user_fortran_identifier, +) from ._version import __version__ from .codegen_f2py import ( F2pyCTypeMap, @@ -481,7 +485,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 +497,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" diff --git a/src/nml_tools/codegen_fortran.py b/src/nml_tools/codegen_fortran.py index 82982e6..5a54a67 100644 --- a/src/nml_tools/codegen_fortran.py +++ b/src/nml_tools/codegen_fortran.py @@ -15,6 +15,7 @@ normalize_runtime_dimensions, reject_constant_dimension_overlap, strip_trailing_whitespace, + validate_namelist_identifier, validate_user_fortran_identifier, ) from .schema import DERIVED_REF_ORIGIN_KEY @@ -32,19 +33,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.""" @@ -317,6 +305,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], *, @@ -350,12 +346,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 +371,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 +386,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] = [] @@ -439,6 +432,19 @@ def _build_context( "NML_ERR_INVALID_NAME", "NML_ERR_INVALID_INDEX", "idx_check", + "nml__achar => achar", + "nml__all => all", + "nml__allocated => allocated", + "nml__any => any", + "nml__huge => huge", + "nml__len => len", + "nml__len_trim => len_trim", + "nml__minval => minval", + "nml__present => present", + "nml__reshape => reshape", + "nml__shape => shape", + "nml__size => size", + "nml__trim => trim", "to_lower", ] if f2py_handle_helpers: @@ -461,17 +467,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 +515,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 +569,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 +633,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_namelist_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 @@ -656,9 +656,9 @@ def _register_runtime_dimension(dim_name: str) -> str: ) init_lines.extend( [ - f"if (len({arg_target}) /= {expected_len}) then", - " status = NML_ERR_BOUNDS", - " if (present(errmsg)) " + f"if (nml__len({arg_target}) /= {expected_len}) then", + " nml__status = NML_ERR_BOUNDS", + " if (nml__present(errmsg)) " f'errmsg = "{storage_message}"', " return", "end if", @@ -730,7 +730,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) @@ -777,7 +777,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, } ) @@ -845,7 +845,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 +859,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" + f"if (nml__present({name})) then\n{indented_block}\nend if" ) else: - set_present_assignment = f"if (present({name})) this%{name} = {name}" + set_present_assignment = ( + f"if (nml__present({name})) {_data_ref(name)} = {name}" + ) init_argument_declaration = _render_argument_declaration( name=name, @@ -904,7 +893,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 (nml__allocated({name})) deallocate({name})" + ) dims = ", ".join(runtime_shape) allocation_lines.append(f"allocate({name}({dims}))") else: @@ -1001,7 +992,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 +1004,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 +1019,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 +1029,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 +1044,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 +1058,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,35 +1066,26 @@ 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"nml__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})" + prefix_any_missing_condition = f"nml__any({prefix_missing_expr})" flex_arrays.append( { "name": name, @@ -1124,7 +1094,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 +1183,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 +1225,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}'") @@ -1342,8 +1311,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 +1322,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), } ) @@ -1424,8 +1393,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 +1404,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 +1417,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 +1429,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" + f"if (nml__present({name})) then\n{indented_block}\nend if" ) else: - set_present_assignment = f"if (present({name})) this%{name} = {name}" + set_present_assignment = ( + f"if (nml__present({name})) {_data_ref(name)} = {name}" + ) else: set_present_assignment = None @@ -1478,11 +1447,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 @@ -1635,6 +1604,27 @@ 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, + ) + imported_module_symbols = { + str(entry["type_name"]).lower() for entry in derived_type_imports + } + imported_module_symbols.update( + symbol.split("=>", maxsplit=1)[0].strip().lower() + for symbol in helper_imports + resolved_kind_imports + ) + companion_names = [data_type_name] + if runtime_dimensions: + companion_names.append(dims_type_name) + for companion_name in companion_names: + if companion_name.lower() in imported_module_symbols: + raise ValueError( + f"generated companion type '{companion_name}' conflicts with an imported symbol" + ) + context = { "module_name": module_name, "type_name": type_name, @@ -1660,7 +1650,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 +1677,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 +1726,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. nml__allocated({_data_ref(name)})) then", + " nml__status = NML_ERR_NOT_SET", " return", " end if", ] @@ -1753,35 +1740,37 @@ def array_prefix(lines: list[str]) -> None: array_prefix(lines) lines.extend( [ - " if (present(idx)) then", - f" status = idx_check(idx, lbound(this%{name}), ubound(this%{name}), &", + " if (nml__present(idx)) then", + f" nml__status = idx_check(idx, nml__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 (nml__all({condition})) nml__status = NML_ERR_NOT_SET" + ) lines.append(" end if") else: lines.extend( [ - " if (present(idx)) then", - " status = NML_ERR_INVALID_INDEX", - " if (present(errmsg)) " + " if (nml__present(idx)) then", + " nml__status = NML_ERR_INVALID_INDEX", + " if (nml__present(errmsg)) " f'errmsg = "index not supported for \'{display_name}\'"', " return", " end if", ] ) 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 = [ @@ -1795,14 +1784,14 @@ def array_prefix(lines: list[str]) -> None: array_prefix(lines) lines.extend( [ - " if (present(idx)) then", - f" status = idx_check(idx, lbound(this%{name}), ubound(this%{name}), &", + " if (nml__present(idx)) then", + f" nml__status = idx_check(idx, nml__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 +1802,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,35 +1811,36 @@ 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") append_condition( lines, - prefix=" if (all(", + prefix=" if (nml__all(", conditions=aggregate_conditions, 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, - prefix=" else if (any(", + prefix=" else if (nml__any(", conditions=aggregate_conditions, 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}\'"', + " if (nml__present(idx)) then", + " nml__status = NML_ERR_INVALID_INDEX", + " if (nml__present(errmsg)) " + f'errmsg = "index not supported for \'{display_name}\'"', " return", " end if", ] @@ -1863,7 +1853,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 +1862,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 @@ -2312,7 +2302,7 @@ def _render_runtime_allocations( if any(dim == ":" for dim in runtime_dimensions): raise ValueError("runtime-sized arrays do not support deferred-size dimensions") - lines.append(f"if (allocated({target_ref})) deallocate({target_ref})") + lines.append(f"if (nml__allocated({target_ref})) deallocate({target_ref})") dims_expr = ", ".join(runtime_dimensions) if type_info.element_category == "string" and runtime_length_expr is not None: lines.append(f"allocate(character(len={runtime_length_expr}) :: {target_ref}({dims_expr}))") @@ -2323,7 +2313,7 @@ def _render_runtime_allocations( def _render_runtime_deallocations(name: str, *, target_prefix: str = "") -> list[str]: target_ref = f"{target_prefix}{name}" - return [f"if (allocated({target_ref})) deallocate({target_ref})"] + return [f"if (nml__allocated({target_ref})) deallocate({target_ref})"] def _render_runtime_local_allocations( @@ -2439,26 +2429,30 @@ def _sentinel_expressions( if category == "array": element = type_info.element_category if element == "string": - return "achar(0)", f"all({var_ref} == achar(0))", False + return "nml__achar(0)", f"nml__all({var_ref} == nml__achar(0))", False if element == "integer": - return f"-huge({var_ref})", f"all({var_ref} == -huge({var_ref}))", False + return ( + f"-nml__huge({var_ref})", + f"nml__all({var_ref} == -nml__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"nml__all(nml__ieee_is_nan({var_ref}))", True, ) if element == "boolean": raise ValueError("boolean arrays cannot use sentinels") raise ValueError(f"unsupported sentinel array element '{element}'") if category == "string": - return "achar(0)", f"{var_ref} == achar(0)", False + return "nml__achar(0)", f"{var_ref} == nml__achar(0)", False if category == "integer": - return f"-huge({var_ref})", f"{var_ref} == -huge({var_ref})", False + return f"-nml__huge({var_ref})", f"{var_ref} == -nml__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": @@ -2473,11 +2467,11 @@ def _element_missing_expression( len_ref: str | None = None, ) -> tuple[str, bool]: if category == "string": - return f"{var_ref} == achar(0)", False + return f"{var_ref} == nml__achar(0)", False if category == "integer": - return f"{var_ref} == -huge({var_ref})", False + return f"{var_ref} == -nml__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}'") @@ -2490,75 +2484,47 @@ def _array_missing_conditions( missing_expr, uses_ieee = _element_missing_expression( element_category, var_ref=var_ref, len_ref=len_ref ) - return f"all({missing_expr})", f"any({missing_expr})", uses_ieee + return f"nml__all({missing_expr})", f"nml__any({missing_expr})", uses_ieee 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 (present(errmsg)) errmsg = \"dimension {dim} exceeds bounds for '{name}'\"" + f"if (nml__size({name}, {dim}) > nml__size({_data_ref(name)}, {dim})) then" + ) + lines.append(" nml__status = NML_ERR_INVALID_INDEX") + lines.append( + f" if (nml__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:nml__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)} = nml__reshape( &"] for index, arg in enumerate(arguments): suffix = ", &" if index < len(arguments) - 1 else ")" lines.append(f" {arg}{suffix}") @@ -2601,7 +2567,7 @@ def _format_default( ] arguments.append(f"pad=[{', '.join(pad_elements)}]") - return f"reshape({', '.join(arguments)})" + return f"nml__reshape({', '.join(arguments)})" return _format_scalar_default(value, type_info.kind, type_info.category) diff --git a/src/nml_tools/schema.py b/src/nml_tools/schema.py index e01f337..31dfe28 100644 --- a/src/nml_tools/schema.py +++ b/src/nml_tools/schema.py @@ -14,7 +14,7 @@ import yaml -from ._utils import validate_user_fortran_identifier +from ._utils import validate_namelist_identifier, validate_user_fortran_identifier _DRAFT_2020_12 = "https://json-schema.org/draft/2020-12/schema" _DOCUMENT_SUFFIXES = {".json", ".yml", ".yaml"} @@ -282,7 +282,7 @@ def _resolve_property_value( 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}'") + validate_namelist_identifier(name, label=f"property '{name}'") except ValueError as exc: raise ValueError(f"{_location(document, pointer)}: {exc}") from exc if not isinstance(value, Mapping): diff --git a/src/nml_tools/templates/fortran_module.f90.j2 b/src/nml_tools/templates/fortran_module.f90.j2 index 7a83f64..7ce84fe 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 @@ -46,20 +47,42 @@ module {{ module_name }} {{ stmt }} {% endfor %} +{% endif %} + private :: {{ type_prefix }}_read__from_file + private :: nml__achar, nml__all, nml__allocated, nml__any, nml__huge, nml__len, & + nml__len_trim, nml__minval, nml__present, nml__reshape, nml__shape, nml__size, & + nml__trim +{% if use_ieee %} + private :: nml__ieee_value, nml__ieee_quiet_nan, nml__ieee_is_nan +{% endif %} + + !> \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 %} @@ -86,7 +109,7 @@ contains {{ enum.arg_type_spec }}, intent(in) :: val !< value to check logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - if (present(allow_missing)) then + if (nml__present(allow_missing)) then if (allow_missing) then if ({{ enum.missing_condition }}) then in_enum = .true. @@ -95,9 +118,9 @@ contains end if end if {% if enum.use_trim %} - in_enum = any(trim(val) == {{ enum.enum_values_name }}) + in_enum = nml__any(nml__trim(val) == {{ enum.enum_values_name }}) {% else %} - in_enum = any(val == {{ enum.enum_values_name }}) + in_enum = nml__any(val == {{ enum.enum_values_name }}) {% endif %} end function {{ enum.func_name }} @@ -110,7 +133,7 @@ contains {{ bounds.arg_type_spec }}, intent(in) :: val !< value to check logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - if (present(allow_missing)) then + if (nml__present(allow_missing)) then if (allow_missing) then if ({{ bounds.missing_condition }}) then in_bounds = .true. @@ -132,34 +155,34 @@ 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) + subroutine {{ type_prefix }}_resolve_handle(handle, nml__obj, nml__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 + 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 - if (present(errmsg)) errmsg = "" - nullify(this) + if (nml__present(errmsg)) errmsg = "" + nullify(nml__obj) if (handle == 0_c_intptr_t) then - status = NML_ERR_INVALID_HANDLE - if (present(errmsg)) errmsg = "zero handle" + nml__status = NML_ERR_INVALID_HANDLE + if (nml__present(errmsg)) errmsg = "zero handle" return end if ptr = transfer(handle, c_null_ptr) - call c_f_pointer(ptr, this) - status = NML_OK + call c_f_pointer(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 - if (present(errmsg)) errmsg = "" - this%is_configured = .false. + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + nml__obj%is_configured = .false. {% if runtime_allocations %} ! allocate runtime-sized fields @@ -188,30 +211,30 @@ 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 - if (present(errmsg)) errmsg = "" + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" {% for field in derived_init_type_fields %} - if (present({{ field.name }})) then + if (nml__present({{ field.name }})) then {% for stmt in field.allocation_lines %} {{ stmt | indent(6, True) }} {% endfor %} @@ -226,13 +249,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,36 +264,36 @@ contains {% endfor %} character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values - status = NML_OK - if (present(errmsg)) errmsg = "" + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" {% for entry in set_dims_arguments %} - if (present({{ entry.arg_name }})) then + if (nml__present({{ entry.arg_name }})) then {{ entry.candidate_name }} = {{ entry.arg_name }} else {{ entry.candidate_name }} = {{ entry.default_name }} end if if ({{ entry.candidate_name }} <= 0) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "dimension '{{ entry.name }}' must be positive" + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 - if (present(errmsg)) errmsg = "dimension '{{ entry.name }}' must be >= {{ entry.min_required }}" + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "dimension '{{ entry.name }}' must be >= {{ entry.min_required }}" return end if {% endif %} {% endfor %} {% for check in set_dims_extent_checks %} if ({{ check.condition }}) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "{{ check.message }}" + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 +302,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 +346,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 (nml__present(errmsg)) errmsg = nml__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 +387,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 +408,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 +423,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 - if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET - if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(trim(name))) + select case (to_lower(nml__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. nml__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 }}), & + if (nml__present(idx)) then + nml__status = idx_check(idx, nml__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 - if (present(errmsg)) errmsg = "index not supported for '{{ case.display_name }}'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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,109 +478,100 @@ contains {{ block | indent(4, True) }} {% endfor %} case default - status = NML_ERR_INVALID_NAME - if (present(errmsg)) errmsg = "unknown field: " // trim(name) + nml__status = NML_ERR_INVALID_NAME + if (nml__present(errmsg)) errmsg = "unknown field: " // nml__trim(name) end select - if (status == NML_ERR_NOT_SET .and. present(errmsg)) then - if (len_trim(errmsg) == 0) errmsg = "field not set: " // trim(name) + if (nml__status == NML_ERR_NOT_SET .and. nml__present(errmsg)) then + if (nml__len_trim(errmsg) == 0) errmsg = "field not set: " // nml__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 - if (present(errmsg)) errmsg = "" - select case (to_lower(trim(name))) + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + select case (to_lower(nml__trim(name))) {% for flex in flex_arrays %} case ("{{ flex.name }}") - if (size(filled) /= {{ flex.rank }}) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "shape rank mismatch for '{{ flex.display_name }}'" + if (nml__size(filled) /= {{ flex.rank }}) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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. nml__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) = nml__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 = nml__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 (nml__minval(filled) > 0) then if ({{ flex.prefix_any_missing_condition }}) then - status = NML_ERR_PARTLY_SET - if (present(errmsg)) errmsg = "array partly set: {{ flex.display_name }}" + nml__status = NML_ERR_PARTLY_SET + if (nml__present(errmsg)) errmsg = "array partly set: {{ flex.display_name }}" return end if end if {% endfor %} case default - status = NML_ERR_INVALID_NAME - if (present(errmsg)) errmsg = "field is not a flexible array: " // trim(name) + nml__status = NML_ERR_INVALID_NAME + if (nml__present(errmsg)) errmsg = "field is not a flexible array: " // nml__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 - if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET - if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if {% 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 - if (present(errmsg)) then - if (len_trim(errmsg) == 0) then + nml__istat = nml__obj%is_set("{{ name }}", errmsg=errmsg) + if (nml__istat == NML_ERR_NOT_SET) then + nml__status = NML_ERR_REQUIRED + if (nml__present(errmsg)) then + if (nml__len_trim(errmsg) == 0) then errmsg = "field not set: {{ name }}" end if - errmsg = "required " // trim(errmsg) + errmsg = "required " // nml__trim(errmsg) 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,20 +580,20 @@ 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 (present(errmsg)) errmsg = "required field not set: {{ entry.name }}" + if (.not. nml__allocated(nml__obj%data%{{ entry.attr_name }})) then + nml__status = NML_ERR_REQUIRED + if (nml__present(errmsg)) errmsg = "required field not set: {{ entry.name }}" return end if {% endif %} if ({{ entry.all_missing_condition }}) then - status = NML_ERR_REQUIRED - if (present(errmsg)) errmsg = "required field not set: {{ entry.name }}" + nml__status = NML_ERR_REQUIRED + if (nml__present(errmsg)) errmsg = "required field not set: {{ entry.name }}" return end if if ({{ entry.any_missing_condition }}) then - status = NML_ERR_PARTLY_SET - if (present(errmsg)) errmsg = "array partly set: {{ entry.name }}" + nml__status = NML_ERR_PARTLY_SET + if (nml__present(errmsg)) errmsg = "array partly set: {{ entry.name }}" return end if {% endfor %} @@ -583,24 +601,25 @@ 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 (present(errmsg)) then - if (len_trim(errmsg) == 0) errmsg = "array partly set: {{ entry.display_name }}" + if (nml__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 (nml__present(errmsg)) then + if (nml__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 (present(errmsg)) errmsg = "required field not set: {{ entry.display_name }}" + if (nml__minval(nml__filled) == 0) then + nml__status = NML_ERR_REQUIRED + if (nml__present(errmsg)) errmsg = "required field not set: {{ entry.display_name }}" return end if {% endif %} @@ -611,26 +630,26 @@ contains {% for check in enum_checks %} {% if check.is_array %} {% if check.runtime_array %} - if (allocated({{ check.allocation_ref }})) then + if (nml__allocated({{ check.allocation_ref }})) then {% endif %} - if (.not. all({{ check.func_name }}({{ check.array_ref }}, allow_missing=.true.))) then - status = NML_ERR_ENUM - if (present(errmsg)) errmsg = "enum constraint failed: {{ check.display_name }}" + if (.not. nml__all({{ check.func_name }}({{ check.array_ref }}, allow_missing=.true.))) then + nml__status = NML_ERR_ENUM + if (nml__present(errmsg)) errmsg = "enum constraint failed: {{ check.display_name }}" return end if {% if check.runtime_array %} 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 - if (present(errmsg)) errmsg = "enum constraint failed: {{ check.display_name }}" + nml__status = NML_ERR_ENUM + if (nml__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 %} @@ -641,26 +660,26 @@ contains {% for check in bounds_checks %} {% if check.is_array %} {% if check.runtime_array %} - if (allocated({{ check.allocation_ref }})) then + if (nml__allocated({{ check.allocation_ref }})) then {% endif %} - if (.not. all({{ check.func_name }}({{ check.array_ref }}, allow_missing=.true.))) then - status = NML_ERR_BOUNDS - if (present(errmsg)) errmsg = "bounds constraint failed: {{ check.display_name }}" + if (.not. nml__all({{ check.func_name }}({{ check.array_ref }}, allow_missing=.true.))) then + nml__status = NML_ERR_BOUNDS + if (nml__present(errmsg)) errmsg = "bounds constraint failed: {{ check.display_name }}" return end if {% if check.runtime_array %} 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 - if (present(errmsg)) errmsg = "bounds constraint failed: {{ check.display_name }}" + nml__status = NML_ERR_BOUNDS + if (nml__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..059c2d1 100644 --- a/src/nml_tools/templates/nml_helper.f90.j2 +++ b/src/nml_tools/templates/nml_helper.f90.j2 @@ -16,6 +16,11 @@ module {{ module_name }} {{ kind_imports | join(', &\n ') }} {% endif %} + intrinsic :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & + shape, size, trim + public :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & + shape, size, trim + !> \brief Buffer length for reading lines integer, public :: nml_line_buffer = {{ len_buf }} !> \brief Status code: success @@ -179,19 +184,18 @@ contains end function to_lower !> \brief Validate index bounds for array access - integer function idx_check(idx, lower, upper, field, errmsg) result(status) + integer function idx_check(idx, extents, field, errmsg) result(status) integer, intent(in) :: idx(:) - integer, intent(in) :: lower(:) - integer, intent(in) :: upper(:) + integer, intent(in) :: extents(:) character(len=*), intent(in) :: field character(len=*), intent(out), optional :: errmsg status = NML_OK if (present(errmsg)) errmsg = "" - if (size(idx) /= size(lower)) then + if (size(idx) /= size(extents)) 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 + else if (any(idx < 1) .or. any(idx > extents)) then status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index out of bounds for '" // trim(field) // "'" end if diff --git a/tests/fixtures/01_simple/out/nml_helper.f90 b/tests/fixtures/01_simple/out/nml_helper.f90 index fb670d2..4f24a8d 100644 --- a/tests/fixtures/01_simple/out/nml_helper.f90 +++ b/tests/fixtures/01_simple/out/nml_helper.f90 @@ -7,6 +7,11 @@ !> \version 0.1 module nml_helper + intrinsic :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & + shape, size, trim + public :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & + shape, size, trim + !> \brief Buffer length for reading lines integer, public :: nml_line_buffer = 1024 !> \brief Status code: success @@ -42,7 +47,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 @@ -153,19 +158,18 @@ pure function to_lower(string) result(lower_string) end function to_lower !> \brief Validate index bounds for array access - integer function idx_check(idx, lower, upper, field, errmsg) result(status) + integer function idx_check(idx, extents, field, errmsg) result(status) integer, intent(in) :: idx(:) - integer, intent(in) :: lower(:) - integer, intent(in) :: upper(:) + integer, intent(in) :: extents(:) character(len=*), intent(in) :: field character(len=*), intent(out), optional :: errmsg status = NML_OK if (present(errmsg)) errmsg = "" - if (size(idx) /= size(lower)) then + if (size(idx) /= size(extents)) 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 + else if (any(idx < 1) .or. any(idx > extents)) then status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index out of bounds for '" // trim(field) // "'" end if diff --git a/tests/fixtures/01_simple/out/nml_optimization.f90 b/tests/fixtures/01_simple/out/nml_optimization.f90 index efe475f..5f7dcd3 100644 --- a/tests/fixtures/01_simple/out/nml_optimization.f90 +++ b/tests/fixtures/01_simple/out/nml_optimization.f90 @@ -23,10 +23,24 @@ module nml_optimization NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & idx_check, & + nml__achar => achar, & + nml__all => all, & + nml__allocated => allocated, & + nml__any => any, & + nml__huge => huge, & + nml__len => len, & + nml__len_trim => len_trim, & + nml__minval => minval, & + nml__present => present, & + nml__reshape => reshape, & + nml__shape => shape, & + nml__size => size, & + nml__trim => trim, & 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 +54,15 @@ 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 + private :: nml__achar, nml__all, nml__allocated, nml__any, nml__huge, nml__len, & + nml__len_trim, nml__minval, nml__present, nml__reshape, nml__shape, nml__size, & + nml__trim + private :: nml__ieee_value, nml__ieee_quiet_nan, nml__ieee_is_nan + + !> \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 +70,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 +98,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 - if (present(errmsg)) errmsg = "" - this%is_configured = .false. + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + 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 (nml__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 = nml__achar(0) ! sentinel for optional string + nml__obj%data%niterations = -nml__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 = nml__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 - if (present(errmsg)) errmsg = "" - if (present(max_iter)) then + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + if (nml__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 - if (present(errmsg)) errmsg = "dimension 'max_iter' must be positive" + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 - if (present(errmsg)) errmsg = "shape constants for 'mcmc_error_params' must allow at least 4 default values" + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 (nml__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 +182,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 +196,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() + if (nml__allocated(mcmc_error_params)) deallocate(mcmc_error_params) + 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 (nml__present(errmsg)) errmsg = nml__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 +255,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,172 +266,161 @@ 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(mcmc_error_params)) then - if (size(mcmc_error_params, 1) > size(this%mcmc_error_params, 1)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'mcmc_error_params'" + if (nml__present(name)) nml__obj%data%name = name + if (nml__present(seed)) nml__obj%data%seed = seed + if (nml__present(dds_r)) nml__obj%data%dds_r = dds_r + if (nml__present(mcmc_opti)) nml__obj%data%mcmc_opti = mcmc_opti + if (nml__present(mcmc_error_params)) then + if (nml__size(mcmc_error_params, 1) > nml__size(nml__obj%data%mcmc_error_params, 1)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 (present(errmsg)) errmsg = "dimension 2 exceeds bounds for 'mcmc_error_params'" + if (nml__size(mcmc_error_params, 2) > nml__size(nml__obj%data%mcmc_error_params, 2)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 (present(errmsg)) errmsg = "dimension 3 exceeds bounds for 'mcmc_error_params'" + if (nml__size(mcmc_error_params, 3) > nml__size(nml__obj%data%mcmc_error_params, 3)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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:nml__size(mcmc_error_params, 1), & + 1:nml__size(mcmc_error_params, 2), & + 1:nml__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 - if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET - if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(trim(name))) + select case (to_lower(nml__trim(name))) case ("name") - if (present(idx)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index not supported for 'name'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 == nml__achar(0)) nml__status = NML_ERR_NOT_SET case ("niterations") - if (present(idx)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index not supported for 'niterations'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 == -nml__huge(nml__obj%data%niterations)) nml__status = NML_ERR_NOT_SET case ("tolerance") - if (present(idx)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index not supported for 'tolerance'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 - if (present(errmsg)) errmsg = "index not supported for 'seed'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'seed'" return end if case ("dds_r") - if (present(idx)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index not supported for 'dds_r'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'dds_r'" return end if case ("mcmc_opti") - if (present(idx)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index not supported for 'mcmc_opti'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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. nml__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), & + if (nml__present(idx)) then + nml__status = idx_check(idx, nml__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 - if (present(errmsg)) errmsg = "unknown field: " // trim(name) + nml__status = NML_ERR_INVALID_NAME + if (nml__present(errmsg)) errmsg = "unknown field: " // nml__trim(name) end select - if (status == NML_ERR_NOT_SET .and. present(errmsg)) then - if (len_trim(errmsg) == 0) errmsg = "field not set: " // trim(name) + if (nml__status == NML_ERR_NOT_SET .and. nml__present(errmsg)) then + if (nml__len_trim(errmsg) == 0) errmsg = "field not set: " // nml__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 - if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET - if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (nml__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 - if (present(errmsg)) then - if (len_trim(errmsg) == 0) then + nml__istat = nml__obj%is_set("niterations", errmsg=errmsg) + if (nml__istat == NML_ERR_NOT_SET) then + nml__status = NML_ERR_REQUIRED + if (nml__present(errmsg)) then + if (nml__len_trim(errmsg) == 0) then errmsg = "field not set: niterations" end if - errmsg = "required " // trim(errmsg) + errmsg = "required " // nml__trim(errmsg) 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 - if (present(errmsg)) then - if (len_trim(errmsg) == 0) then + nml__istat = nml__obj%is_set("tolerance", errmsg=errmsg) + if (nml__istat == NML_ERR_NOT_SET) then + nml__status = NML_ERR_REQUIRED + if (nml__present(errmsg)) then + if (nml__len_trim(errmsg) == 0) then errmsg = "field not set: tolerance" end if - errmsg = "required " // trim(errmsg) + errmsg = "required " // nml__trim(errmsg) 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/test_cli_config.py b/tests/test_cli_config.py index 3a14954..70f3082 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"): diff --git a/tests/test_codegen_fortran.py b/tests/test_codegen_fortran.py index ea275a7..ebce90d 100644 --- a/tests/test_codegen_fortran.py +++ b/tests/test_codegen_fortran.py @@ -207,7 +207,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 +237,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 +324,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 +383,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 +408,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 +431,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 +443,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 +476,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 +697,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 ( + "nml__all(counts__in_bounds(nml__obj%data%counts, allow_missing=.true.))" + in generated + ) def test_generate_fortran_rejects_flex_dim_boolean_array(tmp_path: Path) -> None: @@ -730,8 +762,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 +790,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 +814,96 @@ 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}, ) +def test_generate_fortran_rejects_companion_type_import_collision() -> None: + codegen = _import_codegen_module() + schema = { + "x-fortran-namelist": "run", + "type": "object", + "properties": { + "value": { + "type": "object", + "x-fortran-type": "nml_run_data_t", + "x-fortran-module": "application_types", + "properties": {"count": {"type": "integer"}}, + } + }, + } + + with pytest.raises(ValueError, match="generated companion type 'nml_run_data_t'"): + codegen.render_fortran(schema, file_name="nml_run.f90") + + +def test_generate_fortran_aliases_present_for_schema_names() -> None: + codegen = _import_codegen_module() + schema = { + "x-fortran-namelist": "run", + "type": "object", + "properties": { + "present": {"type": "integer"}, + "values": { + "type": "array", + "items": {"type": "integer"}, + "x-fortran-shape": "present", + }, + }, + } + + generated = codegen.render_fortran( + schema, + file_name="nml_run.f90", + dimensions={"present": 2}, + ) + + assert "nml__present => present" in generated + assert "if (nml__present(present))" in generated + assert "nml__obj%dims%present" in generated + + def test_generate_fortran_accepts_required_case_insensitive(tmp_path: Path) -> None: schema = { "title": "Required case", @@ -830,7 +957,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 +1070,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,8 +1103,13 @@ 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 (nml__size(values, 1) > nml__size(nml__obj%data%values, 1)) then" + in generated + ) + assert "nml__obj%data%values( &\n 1:nml__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 @@ -997,15 +1129,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 +1154,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 +1182,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 +1308,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 (nml__size(values, 1) > nml__size(nml__obj%data%values, 1)) then" + in generated + ) + assert "nml__obj%data%values( &\n 1:nml__size(values, 1)) = values" in generated assert "dimension(3), intent(in), optional :: values" not in generated @@ -1207,9 +1344,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 +1378,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 = nml__achar(0)" in generated + assert "nml__all(nml__obj%data%names == nml__achar(0))" in generated def test_generate_fortran_array_default_pad_order(tmp_path: Path) -> None: @@ -1365,29 +1505,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 (nml__allocated(nml__obj%data%periods)) then" in generated def test_generate_fortran_init_type_accepts_fixed_derived_arrays() -> None: @@ -1422,7 +1562,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,10 +1614,10 @@ 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 "if (len(location%name) /= 8) then" in generated - assert "if (len(locations%name) /= 8) then" 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 (nml__len(location%name) /= 8) then" in generated + assert "if (nml__len(locations%name) /= 8) then" in generated assert "imported string storage length mismatch: location%name" in generated assert '+ 1:) = ""' not in generated diff --git a/tests/test_enum_support.py b/tests/test_enum_support.py index 73059d4..97319b2 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 ( + "nml__all(try_methods__in_enum(" + "nml__obj%data%try_methods, allow_missing=.true.))" in generated + ) + assert ( + "nml__all(sizes__in_enum(nml__obj%data%sizes, allow_missing=.true.))" + in generated + ) def test_generate_fortran_rejects_array_enum_at_top_level(tmp_path: Path) -> None: diff --git a/tests/test_schema.py b/tests/test_schema.py index 7fbcb88..309f9fb 100644 --- a/tests/test_schema.py +++ b/tests/test_schema.py @@ -1123,6 +1123,24 @@ 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( ("property_schema", "match"), [ From 3026570d91e8aa2afec0677d24fe8d7a0ff84079 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Sat, 12 Sep 2026 00:32:20 +0200 Subject: [PATCH 02/22] fix(f2py): mangle collision-prone ABI names Use deterministic internal names for wrapper arguments that collide with generated state or Fortran intrinsics, while preserving natural Python-facing parameter names. --- src/nml_tools/codegen_f2py.py | 85 ++++++++++++++----- src/nml_tools/templates/python_wrappers.py.j2 | 14 +-- tests/test_codegen_f2py.py | 34 ++++++++ 3 files changed, 105 insertions(+), 28 deletions(-) diff --git a/src/nml_tools/codegen_f2py.py b/src/nml_tools/codegen_f2py.py index a5f2cbe..4fde1a2 100644 --- a/src/nml_tools/codegen_f2py.py +++ b/src/nml_tools/codegen_f2py.py @@ -66,6 +66,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 +391,29 @@ 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) + wrapper_reserved_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 +422,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) @@ -448,6 +468,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 +559,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 +587,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 +612,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 +636,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 +654,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 +840,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 +858,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( @@ -949,28 +985,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/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/test_codegen_f2py.py b/tests/test_codegen_f2py.py index aac44e8..993ae5b 100644 --- a/tests/test_codegen_f2py.py +++ b/tests/test_codegen_f2py.py @@ -739,3 +739,37 @@ 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"}, + "len": {"type": "string", "x-fortran-len": 8}, + "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 "character(len=*), intent(in) :: len__value" in fortran + assert "status: Any = None" in python + assert 'kwargs["status__value"] = status' in python + assert 'kwargs["len__value"] = len' in python From 6b89f43d40b3ede33b5003739dbe49390a4bf38a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Sat, 12 Sep 2026 00:32:30 +0200 Subject: [PATCH 03/22] test(fortran): cover namespace collisions end to end Add a compiled conformance fixture for generated member collisions, flat namelist reads, transactional dimension updates, one-based storage, and arbitrary-bound setter inputs, and run it in CI. --- .github/workflows/ci.yml | 13 + tests/fortran_namespaces/CMakeLists.txt | 11 + tests/fortran_namespaces/conformance.f90 | 75 +++ tests/fortran_namespaces/input.nml | 22 + tests/fortran_namespaces/namespaces.yml | 70 ++ tests/fortran_namespaces/nml-config.toml | 18 + tests/fortran_namespaces/out/nml_helper.f90 | 175 +++++ .../fortran_namespaces/out/nml_namespaces.f90 | 616 ++++++++++++++++++ 8 files changed, 1000 insertions(+) create mode 100644 tests/fortran_namespaces/CMakeLists.txt create mode 100644 tests/fortran_namespaces/conformance.f90 create mode 100644 tests/fortran_namespaces/input.nml create mode 100644 tests/fortran_namespaces/namespaces.yml create mode 100644 tests/fortran_namespaces/nml-config.toml create mode 100644 tests/fortran_namespaces/out/nml_helper.f90 create mode 100644 tests/fortran_namespaces/out/nml_namespaces.f90 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/tests/fortran_namespaces/CMakeLists.txt b/tests/fortran_namespaces/CMakeLists.txt new file mode 100644 index 0000000..b23c8d7 --- /dev/null +++ b/tests/fortran_namespaces/CMakeLists.txt @@ -0,0 +1,11 @@ +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 + conformance.f90 + out/nml_helper.f90 + out/nml_namespaces.f90 +) diff --git a/tests/fortran_namespaces/conformance.f90 b/tests/fortran_namespaces/conformance.f90 new file mode 100644 index 0000000..6a15daa --- /dev/null +++ b/tests/fortran_namespaces/conformance.f90 @@ -0,0 +1,75 @@ +program conformance + use nml_helper, only: NML_ERR_INVALID_INDEX, NML_OK + use nml_namespaces, only: nml_namespaces_t + + implicit none + + type(nml_namespaces_t) :: config + character(len=256) :: root + character(len=256) :: 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, present=5, 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%present /= 5) error stop "present 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" + if (config%data%size /= 28) error stop "intrinsic-named property mismatch" + + status = config%is_valid(errmsg=errmsg) + call expect_status(status, NML_OK, "validate") + +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/input.nml b/tests/fortran_namespaces/input.nml new file mode 100644 index 0000000..b7783b7 --- /dev/null +++ b/tests/fortran_namespaces/input.nml @@ -0,0 +1,22 @@ +&namespaces + status = 17 + present = 18 + 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 + size = 28 + 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..ad925b3 --- /dev/null +++ b/tests/fortran_namespaces/namespaces.yml @@ -0,0 +1,70 @@ +title: Namespace conformance +x-fortran-namelist: namespaces +type: object +properties: + status: + type: integer + default: 0 + present: + 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 + size: + 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..5326890 --- /dev/null +++ b/tests/fortran_namespaces/nml-config.toml @@ -0,0 +1,18 @@ +[helper] +path = "out/nml_helper.f90" + +[kinds] +module = "iso_fortran_env" +integer = ["int32"] +map = { i4 = "int32" } + +[dimensions.status] +default = 3 + +[dimensions.set_dims] +default = 2 + +[[namelists]] +name = "namespaces" +schema = "namespaces.yml" +mod_path = "out/nml_namespaces.f90" diff --git a/tests/fortran_namespaces/out/nml_helper.f90 b/tests/fortran_namespaces/out/nml_helper.f90 new file mode 100644 index 0000000..90db15d --- /dev/null +++ b/tests/fortran_namespaces/out/nml_helper.f90 @@ -0,0 +1,175 @@ +!> \file nml_helper.f90 +!> \copydoc nml_helper + +!> \brief Helper module for namelist file operations +module nml_helper + + intrinsic :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & + shape, size, trim + public :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & + shape, size, trim + + !> \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 + + !> \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(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 + if (present(errmsg)) errmsg = "" + status = this%close() + inquire(file=file, exist=exists) + if (.not. exists) then + this%is_open = .false. + this%unit = 0 + 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) + if (.not. this%is_open) then + this%unit = 0 + status = NML_ERR_OPEN + if (present(errmsg)) errmsg = trim(iomsg) + return + end if + status = NML_OK + end function nml_open + + !> \brief Find a namelist in the opened file + integer function nml_find(this, nml, errmsg) result(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 + if (present(errmsg)) errmsg = "" + status = NML_ERR_NML_NOT_FOUND + if (.not. this%is_open) then + 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) + return + end if + if (index(to_lower(line), '&' // to_lower(trim(nml))) /= 0) then + 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(status) + class(nml_file_t), intent(inout) :: this + character(len=*), intent(out), optional :: errmsg + integer :: iostat + character(len=nml_line_buffer) :: iomsg + if (present(errmsg)) errmsg = "" + 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) + 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(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) + end do + end function to_lower + + !> \brief Validate index bounds for array access + integer function idx_check(idx, extents, field, errmsg) result(status) + integer, intent(in) :: idx(:) + integer, intent(in) :: extents(:) + character(len=*), intent(in) :: field + character(len=*), intent(out), optional :: errmsg + + status = NML_OK + if (present(errmsg)) errmsg = "" + if (size(idx) /= size(extents)) then + status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index rank mismatch for '" // trim(field) // "'" + else if (any(idx < 1) .or. any(idx > extents)) then + status = NML_ERR_INVALID_INDEX + if (present(errmsg)) errmsg = "index out of bounds for '" // trim(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..484395c --- /dev/null +++ b/tests/fortran_namespaces/out/nml_namespaces.f90 @@ -0,0 +1,616 @@ +!> \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, & + nml__achar => achar, & + nml__all => all, & + nml__allocated => allocated, & + nml__any => any, & + nml__huge => huge, & + nml__len => len, & + nml__len_trim => len_trim, & + nml__minval => minval, & + nml__present => present, & + nml__reshape => reshape, & + nml__shape => shape, & + nml__size => size, & + nml__trim => trim, & + to_lower, & + status__dim_default, & + set_dims__dim_default + + implicit none + + ! default values + integer, parameter, public :: status__default = 0 + integer, parameter, public :: present__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 :: size__default = 0 + integer, parameter, public :: values__default = 0 + integer, parameter, public :: more_values__default = 0 + + private :: nml_namespaces_read__from_file + private :: nml__achar, nml__all, nml__allocated, nml__any, nml__huge, nml__len, & + nml__len_trim, nml__minval, nml__present, nml__reshape, nml__shape, nml__size, & + nml__trim + + !> \class nml_namespaces_data_t + !> \brief Schema-backed values for namespaces + type, public :: nml_namespaces_data_t + integer :: status !< status + integer :: present !< present + 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 :: size !< size + 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 (nml__present(errmsg)) errmsg = "" + nml__obj%is_configured = .false. + + ! allocate runtime-sized fields + if (nml__allocated(nml__obj%data%values)) deallocate(nml__obj%data%values) + allocate(nml__obj%data%values(nml__obj%dims%status)) + if (nml__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%present = present__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%size = size__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 (nml__present(errmsg)) errmsg = "" + if (nml__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 (nml__present(errmsg)) errmsg = "dimension 'status' must be positive" + return + end if + if (nml__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 (nml__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 (nml__allocated(nml__obj%data%values)) deallocate(nml__obj%data%values) + if (nml__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 :: present + 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 :: size + 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, & + present, & + file, & + nml, & + iostat, & + close_status, & + data, & + dims, & + set, & + set_dims, & + init, & + init_type, & + from_file, & + is_set, & + is_valid, & + filled_shape, & + is_configured, & + size, & + 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 (nml__allocated(values)) deallocate(values) + allocate(values(nml__obj%dims%status)) + if (nml__allocated(more_values)) deallocate(more_values) + allocate(more_values(nml__obj%dims%set_dims)) + status = nml__obj%data%status + present = nml__obj%data%present + 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 + size = nml__obj%data%size + 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 (nml__present(errmsg)) errmsg = nml__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%present = present + 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%size = size + 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, & + present, & + file, & + nml, & + iostat, & + close_status, & + data, & + dims, & + set, & + set_dims, & + init, & + init_type, & + from_file, & + is_set, & + is_valid, & + filled_shape, & + is_configured, & + size, & + 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 :: present !< present + 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, intent(in), optional :: size !< size + 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 (nml__present(status)) nml__obj%data%status = status + if (nml__present(present)) nml__obj%data%present = present + if (nml__present(file)) nml__obj%data%file = file + if (nml__present(nml)) nml__obj%data%nml = nml + if (nml__present(iostat)) nml__obj%data%iostat = iostat + if (nml__present(close_status)) nml__obj%data%close_status = close_status + if (nml__present(data)) nml__obj%data%data = data + if (nml__present(dims)) nml__obj%data%dims = dims + if (nml__present(set)) nml__obj%data%set = set + if (nml__present(set_dims)) nml__obj%data%set_dims = set_dims + if (nml__present(init)) nml__obj%data%init = init + if (nml__present(init_type)) nml__obj%data%init_type = init_type + if (nml__present(from_file)) nml__obj%data%from_file = from_file + if (nml__present(is_set)) nml__obj%data%is_set = is_set + if (nml__present(is_valid)) nml__obj%data%is_valid = is_valid + if (nml__present(filled_shape)) nml__obj%data%filled_shape = filled_shape + if (nml__present(is_configured)) nml__obj%data%is_configured = is_configured + if (nml__present(size)) nml__obj%data%size = size + if (nml__present(values)) then + if (nml__size(values, 1) > nml__size(nml__obj%data%values, 1)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'values'" + return + end if + nml__obj%data%values( & + 1:nml__size(values, 1)) = values + end if + if (nml__present(more_values)) then + if (nml__size(more_values, 1) > nml__size(nml__obj%data%more_values, 1)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'more_values'" + return + end if + nml__obj%data%more_values( & + 1:nml__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 (nml__present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" + return + end if + select case (to_lower(nml__trim(name))) + case ("status") + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'status'" + return + end if + case ("present") + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'present'" + return + end if + case ("file") + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'file'" + return + end if + case ("nml") + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'nml'" + return + end if + case ("iostat") + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'iostat'" + return + end if + case ("close_status") + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'close_status'" + return + end if + case ("data") + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'data'" + return + end if + case ("dims") + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'dims'" + return + end if + case ("set") + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'set'" + return + end if + case ("set_dims") + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'set_dims'" + return + end if + case ("init") + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'init'" + return + end if + case ("init_type") + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'init_type'" + return + end if + case ("from_file") + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'from_file'" + return + end if + case ("is_set") + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'is_set'" + return + end if + case ("is_valid") + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'is_valid'" + return + end if + case ("filled_shape") + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'filled_shape'" + return + end if + case ("is_configured") + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'is_configured'" + return + end if + case ("size") + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'size'" + return + end if + case ("values") + if (.not. nml__allocated(nml__obj%data%values)) then + nml__status = NML_ERR_NOT_SET + return + end if + if (nml__present(idx)) then + nml__status = idx_check(idx, nml__shape(nml__obj%data%values), & + "values", errmsg) + if (nml__status /= NML_OK) return + else + end if + case ("more_values") + if (.not. nml__allocated(nml__obj%data%more_values)) then + nml__status = NML_ERR_NOT_SET + return + end if + if (nml__present(idx)) then + nml__status = idx_check(idx, nml__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 (nml__present(errmsg)) errmsg = "unknown field: " // nml__trim(name) + end select + if (nml__status == NML_ERR_NOT_SET .and. nml__present(errmsg)) then + if (nml__len_trim(errmsg) == 0) errmsg = "field not set: " // nml__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 (nml__present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" + return + end if + + end function nml_namespaces_is_valid + +end module nml_namespaces From c0420cb2b5f802c0301ef44ff1739e6eda7becd5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Sat, 12 Sep 2026 00:32:45 +0200 Subject: [PATCH 04/22] docs(examples): migrate to namespaced namelist storage Document the beta API break and one-based storage contract, update manual consumers to use data and dims, and regenerate committed examples and optional-reader fixtures. --- README.md | 42 +- examples/01_simple/main.f90 | 26 +- examples/01_simple/out/nml_helper.f90 | 16 +- examples/01_simple/out/nml_optimization.f90 | 705 +++++++++--------- examples/02_pybind/fortran/config_store.f90 | 26 +- .../fortran/generated/nml_config.f90 | 384 +++++----- .../fortran/generated/nml_helper.f90 | 16 +- examples/03_references/out/nml_helper.f90 | 16 +- examples/03_references/out/nml_report.f90 | 252 ++++--- examples/03_references/out/nml_run.f90 | 386 +++++----- .../04_derived_types/fortran/config_store.f90 | 8 +- .../fortran/generated/nml_helper.f90 | 16 +- .../fortran/generated/nml_run.f90 | 464 ++++++------ tests/fortran_optional_read/conformance.f90 | 2 +- .../fortran_optional_read/out/nml_helper.f90 | 14 +- .../out/nml_optional.f90 | 192 +++-- .../out/nml_required.f90 | 180 +++-- 17 files changed, 1505 insertions(+), 1240 deletions(-) diff --git a/README.md b/README.md index 23eb6f1..148308c 100644 --- a/README.md +++ b/README.md @@ -57,9 +57,11 @@ 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`. +Schema property/component and runtime dimension 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. ### x-fortran-namelist @@ -505,10 +507,8 @@ 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. - 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 +613,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")` @@ -937,6 +937,32 @@ 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 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 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..4f24a8d 100644 --- a/examples/01_simple/out/nml_helper.f90 +++ b/examples/01_simple/out/nml_helper.f90 @@ -7,6 +7,11 @@ !> \version 0.1 module nml_helper + intrinsic :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & + shape, size, trim + public :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & + shape, size, trim + !> \brief Buffer length for reading lines integer, public :: nml_line_buffer = 1024 !> \brief Status code: success @@ -42,7 +47,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 @@ -153,19 +158,18 @@ pure function to_lower(string) result(lower_string) end function to_lower !> \brief Validate index bounds for array access - integer function idx_check(idx, lower, upper, field, errmsg) result(status) + integer function idx_check(idx, extents, field, errmsg) result(status) integer, intent(in) :: idx(:) - integer, intent(in) :: lower(:) - integer, intent(in) :: upper(:) + integer, intent(in) :: extents(:) character(len=*), intent(in) :: field character(len=*), intent(out), optional :: errmsg status = NML_OK if (present(errmsg)) errmsg = "" - if (size(idx) /= size(lower)) then + if (size(idx) /= size(extents)) 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 + else if (any(idx < 1) .or. any(idx > extents)) then status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index out of bounds for '" // trim(field) // "'" end if diff --git a/examples/01_simple/out/nml_optimization.f90 b/examples/01_simple/out/nml_optimization.f90 index fb689cf..0b5bf52 100644 --- a/examples/01_simple/out/nml_optimization.f90 +++ b/examples/01_simple/out/nml_optimization.f90 @@ -22,11 +22,25 @@ module nml_optimization NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & idx_check, & + nml__achar => achar, & + nml__all => all, & + nml__allocated => allocated, & + nml__any => any, & + nml__huge => huge, & + nml__len => len, & + nml__len_trim => len_trim, & + nml__minval => minval, & + nml__present => present, & + nml__reshape => reshape, & + nml__shape => shape, & + nml__size => size, & + nml__trim => trim, & 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 +67,15 @@ 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 + private :: nml__achar, nml__all, nml__allocated, nml__any, nml__huge, nml__len, & + nml__len_trim, nml__minval, nml__present, nml__reshape, nml__shape, nml__size, & + nml__trim + private :: nml__ieee_value, nml__ieee_quiet_nan, nml__ieee_is_nan + + !> \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 +87,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 @@ -87,15 +119,15 @@ 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 (nml__present(allow_missing)) then if (allow_missing) then - if (val == achar(0)) then + if (val == nml__achar(0)) then in_enum = .true. return end if end if end if - in_enum = any(trim(val) == method__enum_values) + in_enum = nml__any(nml__trim(val) == method__enum_values) end function method__in_enum !> \brief Check whether a value is part of an enum @@ -103,15 +135,15 @@ elemental logical function try_methods__in_enum(val, allow_missing) result(in_en 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 (nml__present(allow_missing)) then if (allow_missing) then - if (val == achar(0)) then + if (val == nml__achar(0)) then in_enum = .true. return end if end if end if - in_enum = any(trim(val) == try_methods__enum_values) + in_enum = nml__any(nml__trim(val) == try_methods__enum_values) end function try_methods__in_enum !> \brief Check whether a value is part of an enum @@ -119,15 +151,15 @@ elemental logical function complex_sizes__in_enum(val, allow_missing) result(in_ 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 (nml__present(allow_missing)) then if (allow_missing) then - if (val == -huge(val)) then + if (val == -nml__huge(val)) then in_enum = .true. return end if end if end if - in_enum = any(val == complex_sizes__enum_values) + in_enum = nml__any(val == complex_sizes__enum_values) end function complex_sizes__in_enum !> \brief Check whether a value is within bounds @@ -135,9 +167,9 @@ elemental logical function niterations__in_bounds(val, allow_missing) result(in_ 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 (nml__present(allow_missing)) then if (allow_missing) then - if (val == -huge(val)) then + if (val == -nml__huge(val)) then in_bounds = .true. return end if @@ -153,9 +185,9 @@ elemental logical function tolerance__in_bounds(val, allow_missing) result(in_bo 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 (nml__present(allow_missing)) then if (allow_missing) then - if (ieee_is_nan(val)) then + if (nml__ieee_is_nan(val)) then in_bounds = .true. return end if @@ -171,9 +203,9 @@ 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 (nml__present(allow_missing)) then if (allow_missing) then - if (ieee_is_nan(val)) then + if (nml__ieee_is_nan(val)) then in_bounds = .true. return end if @@ -189,9 +221,9 @@ elemental logical function mcmc_error_params__in_bounds(val, allow_missing) resu 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 (nml__present(allow_missing)) then if (allow_missing) then - if (ieee_is_nan(val)) then + if (nml__ieee_is_nan(val)) then in_bounds = .true. return end if @@ -203,67 +235,76 @@ elemental logical function mcmc_error_params__in_bounds(val, allow_missing) resu 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 - if (present(errmsg)) errmsg = "" - this%is_configured = .false. + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + 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 (nml__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 = nml__achar(0) ! sentinel for optional string + nml__obj%data%method = nml__achar(0) ! NULL string as sentinel for required string + nml__obj%data%try_methods = nml__achar(0) ! sentinel for optional string array + nml__obj%data%complex_sizes = -nml__huge(nml__obj%data%complex_sizes) ! sentinel for optional integer array + nml__obj%data%niterations = -nml__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 - if (present(errmsg)) errmsg = "" - if (present(max_iter)) then + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + if (nml__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 - if (present(errmsg)) errmsg = "dimension 'max_iter' must be positive" + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 (nml__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 +318,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 +336,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() + if (nml__allocated(mcmc_error_params)) deallocate(mcmc_error_params) + 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 (nml__present(errmsg)) errmsg = nml__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 +407,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,398 +422,372 @@ 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 - if (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'mcmc_error_params'" + nml__obj%data%method = method + nml__obj%data%niterations = niterations + nml__obj%data%tolerance = tolerance + if (nml__size(mcmc_error_params, 1) > nml__size(nml__obj%data%mcmc_error_params, 1)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 (present(errmsg)) errmsg = "dimension 2 exceeds bounds for 'mcmc_error_params'" + if (nml__size(mcmc_error_params, 2) > nml__size(nml__obj%data%mcmc_error_params, 2)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 (present(errmsg)) errmsg = "dimension 3 exceeds bounds for 'mcmc_error_params'" + if (nml__size(mcmc_error_params, 3) > nml__size(nml__obj%data%mcmc_error_params, 3)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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:nml__size(mcmc_error_params, 1), & + 1:nml__size(mcmc_error_params, 2), & + 1:nml__size(mcmc_error_params, 3)) = mcmc_error_params ! override with provided values - if (present(name)) this%name = name - if (present(try_methods)) then - if (size(try_methods, 1) > size(this%try_methods, 1)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'try_methods'" + if (nml__present(name)) nml__obj%data%name = name + if (nml__present(try_methods)) then + if (nml__size(try_methods, 1) > nml__size(nml__obj%data%try_methods, 1)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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:nml__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 (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'complex_sizes'" + if (nml__present(complex_sizes)) then + if (nml__size(complex_sizes, 1) > nml__size(nml__obj%data%complex_sizes, 1)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 - 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(include_parameters)) then - if (size(include_parameters, 1) > size(this%include_parameters, 1)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'include_parameters'" + nml__obj%data%complex_sizes( & + 1:nml__size(complex_sizes, 1)) = complex_sizes + end if + if (nml__present(seed)) nml__obj%data%seed = seed + if (nml__present(dds_r)) nml__obj%data%dds_r = dds_r + if (nml__present(mcmc_opti)) nml__obj%data%mcmc_opti = mcmc_opti + if (nml__present(include_parameters)) then + if (nml__size(include_parameters, 1) > nml__size(nml__obj%data%include_parameters, 1)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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:nml__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 - if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET - if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(trim(name))) + select case (to_lower(nml__trim(name))) case ("name") - if (present(idx)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index not supported for 'name'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 == nml__achar(0)) nml__status = NML_ERR_NOT_SET case ("method") - if (present(idx)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index not supported for 'method'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 == nml__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), & + if (nml__present(idx)) then + nml__status = idx_check(idx, nml__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)) == nml__achar(0)) nml__status = NML_ERR_NOT_SET else - if (all(this%try_methods == achar(0))) status = NML_ERR_NOT_SET + if (nml__all(nml__obj%data%try_methods == nml__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), & + if (nml__present(idx)) then + nml__status = idx_check(idx, nml__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)) == -nml__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 (nml__all(nml__obj%data%complex_sizes == -nml__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 - if (present(errmsg)) errmsg = "index not supported for 'niterations'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 == -nml__huge(nml__obj%data%niterations)) nml__status = NML_ERR_NOT_SET case ("tolerance") - if (present(idx)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index not supported for 'tolerance'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 - if (present(errmsg)) errmsg = "index not supported for 'seed'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'seed'" return end if case ("dds_r") - if (present(idx)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index not supported for 'dds_r'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'dds_r'" return end if case ("mcmc_opti") - if (present(idx)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index not supported for 'mcmc_opti'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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. nml__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), & + if (nml__present(idx)) then + nml__status = idx_check(idx, nml__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 (nml__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), & + if (nml__present(idx)) then + nml__status = idx_check(idx, nml__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 - if (present(errmsg)) errmsg = "unknown field: " // trim(name) + nml__status = NML_ERR_INVALID_NAME + if (nml__present(errmsg)) errmsg = "unknown field: " // nml__trim(name) end select - if (status == NML_ERR_NOT_SET .and. present(errmsg)) then - if (len_trim(errmsg) == 0) errmsg = "field not set: " // trim(name) + if (nml__status == NML_ERR_NOT_SET .and. nml__present(errmsg)) then + if (nml__len_trim(errmsg) == 0) errmsg = "field not set: " // nml__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 - if (present(errmsg)) errmsg = "" - select case (to_lower(trim(name))) + integer :: nml__idx + integer :: nml__dim + + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + select case (to_lower(nml__trim(name))) case ("mcmc_error_params") - if (size(filled) /= 3) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "shape rank mismatch for 'mcmc_error_params'" + if (nml__size(filled) /= 3) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "shape rank mismatch for 'mcmc_error_params'" return end if - if (.not. allocated(this%mcmc_error_params)) then + if (.not. nml__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) = nml__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 = nml__size(nml__obj%data%mcmc_error_params, 2), 1, -1 + if (.not. (nml__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 = nml__size(nml__obj%data%mcmc_error_params, 3), 1, -1 + if (.not. (nml__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 (present(errmsg)) errmsg = "array partly set: mcmc_error_params" + if (nml__minval(filled) > 0) then + if (nml__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 (nml__present(errmsg)) errmsg = "array partly set: mcmc_error_params" return end if end if case default - status = NML_ERR_INVALID_NAME - if (present(errmsg)) errmsg = "field is not a flexible array: " // trim(name) + nml__status = NML_ERR_INVALID_NAME + if (nml__present(errmsg)) errmsg = "field is not a flexible array: " // nml__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(:) - - status = NML_OK - if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET - if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" + integer :: nml__istat + integer, allocatable :: nml__filled(:) + + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (nml__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 - if (present(errmsg)) then - if (len_trim(errmsg) == 0) then + nml__istat = nml__obj%is_set("method", errmsg=errmsg) + if (nml__istat == NML_ERR_NOT_SET) then + nml__status = NML_ERR_REQUIRED + if (nml__present(errmsg)) then + if (nml__len_trim(errmsg) == 0) then errmsg = "field not set: method" end if - errmsg = "required " // trim(errmsg) + errmsg = "required " // nml__trim(errmsg) 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 - if (present(errmsg)) then - if (len_trim(errmsg) == 0) then + nml__istat = nml__obj%is_set("niterations", errmsg=errmsg) + if (nml__istat == NML_ERR_NOT_SET) then + nml__status = NML_ERR_REQUIRED + if (nml__present(errmsg)) then + if (nml__len_trim(errmsg) == 0) then errmsg = "field not set: niterations" end if - errmsg = "required " // trim(errmsg) + errmsg = "required " // nml__trim(errmsg) 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 - if (present(errmsg)) then - if (len_trim(errmsg) == 0) then + nml__istat = nml__obj%is_set("tolerance", errmsg=errmsg) + if (nml__istat == NML_ERR_NOT_SET) then + nml__status = NML_ERR_REQUIRED + if (nml__present(errmsg)) then + if (nml__len_trim(errmsg) == 0) then errmsg = "field not set: tolerance" end if - errmsg = "required " // trim(errmsg) + errmsg = "required " // nml__trim(errmsg) 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 (present(errmsg)) then - if (len_trim(errmsg) == 0) errmsg = "array partly set: mcmc_error_params" + if (nml__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 (nml__present(errmsg)) then + if (nml__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 (present(errmsg)) errmsg = "required field not set: mcmc_error_params" + if (nml__minval(nml__filled) == 0) then + nml__status = NML_ERR_REQUIRED + if (nml__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 - if (present(errmsg)) errmsg = "enum constraint failed: method" + 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 (nml__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 (present(errmsg)) errmsg = "enum constraint failed: try_methods" + if (.not. nml__all(try_methods__in_enum(nml__obj%data%try_methods, allow_missing=.true.))) then + nml__status = NML_ERR_ENUM + if (nml__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 (present(errmsg)) errmsg = "enum constraint failed: complex_sizes" + if (.not. nml__all(complex_sizes__in_enum(nml__obj%data%complex_sizes, allow_missing=.true.))) then + nml__status = NML_ERR_ENUM + if (nml__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 - if (present(errmsg)) errmsg = "bounds constraint failed: niterations" + 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 (nml__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 - if (present(errmsg)) errmsg = "bounds constraint failed: tolerance" + 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 (nml__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 - if (present(errmsg)) errmsg = "bounds constraint failed: dds_r" + 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 (nml__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 (present(errmsg)) errmsg = "bounds constraint failed: mcmc_error_params" + if (nml__allocated(nml__obj%data%mcmc_error_params)) then + if (.not. nml__all(mcmc_error_params__in_bounds(nml__obj%data%mcmc_error_params, allow_missing=.true.))) then + nml__status = NML_ERR_BOUNDS + if (nml__present(errmsg)) errmsg = "bounds constraint failed: mcmc_error_params" return end if end if 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..f518541 100644 --- a/examples/02_pybind/fortran/generated/nml_config.f90 +++ b/examples/02_pybind/fortran/generated/nml_config.f90 @@ -25,11 +25,25 @@ module nml_config NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & idx_check, & + nml__achar => achar, & + nml__all => all, & + nml__allocated => allocated, & + nml__any => any, & + nml__huge => huge, & + nml__len => len, & + nml__len_trim => len_trim, & + nml__minval => minval, & + nml__present => present, & + nml__reshape => reshape, & + nml__shape => shape, & + nml__size => size, & + nml__trim => trim, & 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, & @@ -47,6 +61,28 @@ 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 + private :: nml__achar, nml__all, nml__allocated, nml__any, nml__huge, nml__len, & + nml__len_trim, nml__minval, nml__present, nml__reshape, nml__shape, nml__size, & + nml__trim + private :: nml__ieee_value, nml__ieee_quiet_nan, nml__ieee_is_nan + + !> \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 +91,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 @@ -78,9 +110,9 @@ elemental logical function iterations__in_bounds(val, allow_missing) result(in_b 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 (nml__present(allow_missing)) then if (allow_missing) then - if (val == -huge(val)) then + if (val == -nml__huge(val)) then in_bounds = .true. return end if @@ -96,9 +128,9 @@ elemental logical function tolerance__in_bounds(val, allow_missing) result(in_bo 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 (nml__present(allow_missing)) then if (allow_missing) then - if (ieee_is_nan(val)) then + if (nml__ieee_is_nan(val)) then in_bounds = .true. return end if @@ -110,81 +142,90 @@ elemental logical function tolerance__in_bounds(val, allow_missing) result(in_bo 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) + subroutine nml_config_resolve_handle(handle, nml__obj, nml__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 + 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 - if (present(errmsg)) errmsg = "" - nullify(this) + if (nml__present(errmsg)) errmsg = "" + nullify(nml__obj) if (handle == 0_c_intptr_t) then - status = NML_ERR_INVALID_HANDLE - if (present(errmsg)) errmsg = "zero handle" + nml__status = NML_ERR_INVALID_HANDLE + if (nml__present(errmsg)) errmsg = "zero handle" return end if ptr = transfer(handle, c_null_ptr) - call c_f_pointer(ptr, this) - status = NML_OK + call c_f_pointer(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 - if (present(errmsg)) errmsg = "" - this%is_configured = .false. + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + nml__obj%is_configured = .false. ! allocate runtime-sized fields - if (allocated(this%weights)) deallocate(this%weights) - allocate(this%weights(this%n_weights)) + if (nml__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 = -nml__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 - if (present(errmsg)) errmsg = "" - if (present(n_weights)) then + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + if (nml__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 - if (present(errmsg)) errmsg = "dimension 'n_weights' must be positive" + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 (nml__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 +233,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,224 +245,219 @@ 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() + if (nml__allocated(weights)) deallocate(weights) + 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 (nml__present(errmsg)) errmsg = nml__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(weights)) then - if (size(weights, 1) > size(this%weights, 1)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'weights'" + if (nml__present(name)) nml__obj%data%name = name + if (nml__present(enabled)) nml__obj%data%enabled = enabled + if (nml__present(weights)) then + if (nml__size(weights, 1) > nml__size(nml__obj%data%weights, 1)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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:nml__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 - if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET - if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(trim(name))) + select case (to_lower(nml__trim(name))) case ("name") - if (present(idx)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index not supported for 'name'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'name'" return end if case ("iterations") - if (present(idx)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index not supported for 'iterations'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 == -nml__huge(nml__obj%data%iterations)) nml__status = NML_ERR_NOT_SET case ("tolerance") - if (present(idx)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index not supported for 'tolerance'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 - if (present(errmsg)) errmsg = "index not supported for 'enabled'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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. nml__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), & + if (nml__present(idx)) then + nml__status = idx_check(idx, nml__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 - if (present(errmsg)) errmsg = "unknown field: " // trim(name) + nml__status = NML_ERR_INVALID_NAME + if (nml__present(errmsg)) errmsg = "unknown field: " // nml__trim(name) end select - if (status == NML_ERR_NOT_SET .and. present(errmsg)) then - if (len_trim(errmsg) == 0) errmsg = "field not set: " // trim(name) + if (nml__status == NML_ERR_NOT_SET .and. nml__present(errmsg)) then + if (nml__len_trim(errmsg) == 0) errmsg = "field not set: " // nml__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 - if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET - if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (nml__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 - if (present(errmsg)) then - if (len_trim(errmsg) == 0) then + nml__istat = nml__obj%is_set("iterations", errmsg=errmsg) + if (nml__istat == NML_ERR_NOT_SET) then + nml__status = NML_ERR_REQUIRED + if (nml__present(errmsg)) then + if (nml__len_trim(errmsg) == 0) then errmsg = "field not set: iterations" end if - errmsg = "required " // trim(errmsg) + errmsg = "required " // nml__trim(errmsg) 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 - if (present(errmsg)) then - if (len_trim(errmsg) == 0) then + nml__istat = nml__obj%is_set("tolerance", errmsg=errmsg) + if (nml__istat == NML_ERR_NOT_SET) then + nml__status = NML_ERR_REQUIRED + if (nml__present(errmsg)) then + if (nml__len_trim(errmsg) == 0) then errmsg = "field not set: tolerance" end if - errmsg = "required " // trim(errmsg) + errmsg = "required " // nml__trim(errmsg) 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 - if (present(errmsg)) errmsg = "bounds constraint failed: iterations" + 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 (nml__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 - if (present(errmsg)) errmsg = "bounds constraint failed: tolerance" + 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 (nml__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..4ee1249 100644 --- a/examples/02_pybind/fortran/generated/nml_helper.f90 +++ b/examples/02_pybind/fortran/generated/nml_helper.f90 @@ -4,6 +4,11 @@ !> \brief Helper module for namelist file operations module nml_helper + intrinsic :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & + shape, size, trim + public :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & + shape, size, trim + !> \brief Buffer length for reading lines integer, public :: nml_line_buffer = 512 !> \brief Status code: success @@ -39,7 +44,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 @@ -150,19 +155,18 @@ pure function to_lower(string) result(lower_string) end function to_lower !> \brief Validate index bounds for array access - integer function idx_check(idx, lower, upper, field, errmsg) result(status) + integer function idx_check(idx, extents, field, errmsg) result(status) integer, intent(in) :: idx(:) - integer, intent(in) :: lower(:) - integer, intent(in) :: upper(:) + integer, intent(in) :: extents(:) character(len=*), intent(in) :: field character(len=*), intent(out), optional :: errmsg status = NML_OK if (present(errmsg)) errmsg = "" - if (size(idx) /= size(lower)) then + if (size(idx) /= size(extents)) 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 + else if (any(idx < 1) .or. any(idx > extents)) then status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index out of bounds for '" // trim(field) // "'" end if diff --git a/examples/03_references/out/nml_helper.f90 b/examples/03_references/out/nml_helper.f90 index e9f0be8..7339cf8 100644 --- a/examples/03_references/out/nml_helper.f90 +++ b/examples/03_references/out/nml_helper.f90 @@ -6,6 +6,11 @@ !> \brief Helper module for namelist file operations module nml_helper + intrinsic :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & + shape, size, trim + public :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & + shape, size, trim + !> \brief Buffer length for reading lines integer, public :: nml_line_buffer = 512 !> \brief Status code: success @@ -41,7 +46,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 @@ -152,19 +157,18 @@ pure function to_lower(string) result(lower_string) end function to_lower !> \brief Validate index bounds for array access - integer function idx_check(idx, lower, upper, field, errmsg) result(status) + integer function idx_check(idx, extents, field, errmsg) result(status) integer, intent(in) :: idx(:) - integer, intent(in) :: lower(:) - integer, intent(in) :: upper(:) + integer, intent(in) :: extents(:) character(len=*), intent(in) :: field character(len=*), intent(out), optional :: errmsg status = NML_OK if (present(errmsg)) errmsg = "" - if (size(idx) /= size(lower)) then + if (size(idx) /= size(extents)) 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 + else if (any(idx < 1) .or. any(idx > extents)) then status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index out of bounds for '" // trim(field) // "'" end if diff --git a/examples/03_references/out/nml_report.f90 b/examples/03_references/out/nml_report.f90 index bd49da7..ccf9d34 100644 --- a/examples/03_references/out/nml_report.f90 +++ b/examples/03_references/out/nml_report.f90 @@ -21,9 +21,23 @@ module nml_report NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & idx_check, & + nml__achar => achar, & + nml__all => all, & + nml__allocated => allocated, & + nml__any => any, & + nml__huge => huge, & + nml__len => len, & + nml__len_trim => len_trim, & + nml__minval => minval, & + nml__present => present, & + nml__reshape => reshape, & + nml__shape => shape, & + nml__size => size, & + nml__trim => trim, & 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 +57,26 @@ 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 + private :: nml__achar, nml__all, nml__allocated, nml__any, nml__huge, nml__len, & + nml__len_trim, nml__minval, nml__present, nml__reshape, nml__shape, nml__size, & + nml__trim + private :: nml__ieee_value, nml__ieee_quiet_nan, nml__ieee_is_nan + + !> \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 @@ -66,15 +92,15 @@ 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 (nml__present(allow_missing)) then if (allow_missing) then - if (val == -huge(val)) then + if (val == -nml__huge(val)) then in_enum = .true. return end if end if end if - in_enum = any(val == level__enum_values) + in_enum = nml__any(val == level__enum_values) end function level__in_enum !> \brief Check whether a value is within bounds @@ -82,9 +108,9 @@ elemental logical function acceptance_fraction__in_bounds(val, allow_missing) re 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 (nml__present(allow_missing)) then if (allow_missing) then - if (ieee_is_nan(val)) then + if (nml__ieee_is_nan(val)) then in_bounds = .true. return end if @@ -97,195 +123,203 @@ elemental logical function acceptance_fraction__in_bounds(val, allow_missing) re 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 - if (present(errmsg)) errmsg = "" - this%is_configured = .false. + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + 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 (nml__present(errmsg)) errmsg = nml__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 (nml__present(label)) nml__obj%data%label = label + if (nml__present(level)) nml__obj%data%level = level + if (nml__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 - if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET - if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(trim(name))) + select case (to_lower(nml__trim(name))) case ("label") - if (present(idx)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index not supported for 'label'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'label'" return end if case ("level") - if (present(idx)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index not supported for 'level'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'level'" return end if case ("acceptance_fraction") - if (present(idx)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index not supported for 'acceptance_fraction'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'acceptance_fraction'" return end if case default - status = NML_ERR_INVALID_NAME - if (present(errmsg)) errmsg = "unknown field: " // trim(name) + nml__status = NML_ERR_INVALID_NAME + if (nml__present(errmsg)) errmsg = "unknown field: " // nml__trim(name) end select - if (status == NML_ERR_NOT_SET .and. present(errmsg)) then - if (len_trim(errmsg) == 0) errmsg = "field not set: " // trim(name) + if (nml__status == NML_ERR_NOT_SET .and. nml__present(errmsg)) then + if (nml__len_trim(errmsg) == 0) errmsg = "field not set: " // nml__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 - if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET - if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (nml__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 - if (present(errmsg)) errmsg = "enum constraint failed: level" + 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 (nml__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 - if (present(errmsg)) errmsg = "bounds constraint failed: acceptance_fraction" + 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 (nml__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..4d36fda 100644 --- a/examples/03_references/out/nml_run.f90 +++ b/examples/03_references/out/nml_run.f90 @@ -21,10 +21,24 @@ module nml_run NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & idx_check, & + nml__achar => achar, & + nml__all => all, & + nml__allocated => allocated, & + nml__any => any, & + nml__huge => huge, & + nml__len => len, & + nml__len_trim => len_trim, & + nml__minval => minval, & + nml__present => present, & + nml__reshape => reshape, & + nml__shape => shape, & + nml__size => size, & + nml__trim => trim, & 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 +63,35 @@ 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 + private :: nml__achar, nml__all, nml__allocated, nml__any, nml__huge, nml__len, & + nml__len_trim, nml__minval, nml__present, nml__reshape, nml__shape, nml__size, & + nml__trim + private :: nml__ieee_value, nml__ieee_quiet_nan, nml__ieee_is_nan + + !> \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 @@ -76,15 +108,15 @@ 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 (nml__present(allow_missing)) then if (allow_missing) then - if (val == achar(0)) then + if (val == nml__achar(0)) then in_enum = .true. return end if end if end if - in_enum = any(trim(val) == method__enum_values) + in_enum = nml__any(nml__trim(val) == method__enum_values) end function method__in_enum !> \brief Check whether a value is within bounds @@ -92,9 +124,9 @@ 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 (nml__present(allow_missing)) then if (allow_missing) then - if (val == -huge(val)) then + if (val == -nml__huge(val)) then in_bounds = .true. return end if @@ -111,9 +143,9 @@ elemental logical function station_weights__in_bounds(val, allow_missing) result 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 (nml__present(allow_missing)) then if (allow_missing) then - if (ieee_is_nan(val)) then + if (nml__ieee_is_nan(val)) then in_bounds = .true. return end if @@ -129,9 +161,9 @@ elemental logical function relaxation__in_bounds(val, allow_missing) result(in_b 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 (nml__present(allow_missing)) then if (allow_missing) then - if (ieee_is_nan(val)) then + if (nml__ieee_is_nan(val)) then in_bounds = .true. return end if @@ -144,69 +176,78 @@ elemental logical function relaxation__in_bounds(val, allow_missing) result(in_b 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 - if (present(errmsg)) errmsg = "" - this%is_configured = .false. + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + 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 (nml__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 = -nml__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 = nml__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 - if (present(errmsg)) errmsg = "" - if (present(n_stations)) then + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + if (nml__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 - if (present(errmsg)) errmsg = "dimension 'n_stations' must be positive" + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "dimension 'n_stations' must be positive" return end if if (candidate__n_stations < 2) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "shape constants for 'station_weights' must allow at least 2 default values" + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 (nml__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 +255,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,227 +267,222 @@ 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() + if (nml__allocated(station_weights)) deallocate(station_weights) + 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 (nml__present(errmsg)) errmsg = nml__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(station_weights)) then - if (size(station_weights, 1) > size(this%station_weights, 1)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'station_weights'" + if (nml__present(label)) nml__obj%data%label = label + if (nml__present(station_weights)) then + if (nml__size(station_weights, 1) > nml__size(nml__obj%data%station_weights, 1)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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:nml__size(station_weights, 1)) = station_weights end if - if (present(method)) this%method = method - if (present(relaxation)) this%relaxation = relaxation + if (nml__present(method)) nml__obj%data%method = method + if (nml__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 - if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET - if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(trim(name))) + select case (to_lower(nml__trim(name))) case ("label") - if (present(idx)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index not supported for 'label'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'label'" return end if case ("steps") - if (present(idx)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index not supported for 'steps'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 == -nml__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. nml__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), & + if (nml__present(idx)) then + nml__status = idx_check(idx, nml__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 - if (present(errmsg)) errmsg = "index not supported for 'method'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'method'" return end if case ("relaxation") - if (present(idx)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index not supported for 'relaxation'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'relaxation'" return end if case default - status = NML_ERR_INVALID_NAME - if (present(errmsg)) errmsg = "unknown field: " // trim(name) + nml__status = NML_ERR_INVALID_NAME + if (nml__present(errmsg)) errmsg = "unknown field: " // nml__trim(name) end select - if (status == NML_ERR_NOT_SET .and. present(errmsg)) then - if (len_trim(errmsg) == 0) errmsg = "field not set: " // trim(name) + if (nml__status == NML_ERR_NOT_SET .and. nml__present(errmsg)) then + if (nml__len_trim(errmsg) == 0) errmsg = "field not set: " // nml__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 - if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET - if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (nml__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 - if (present(errmsg)) then - if (len_trim(errmsg) == 0) then + nml__istat = nml__obj%is_set("steps", errmsg=errmsg) + if (nml__istat == NML_ERR_NOT_SET) then + nml__status = NML_ERR_REQUIRED + if (nml__present(errmsg)) then + if (nml__len_trim(errmsg) == 0) then errmsg = "field not set: steps" end if - errmsg = "required " // trim(errmsg) + errmsg = "required " // nml__trim(errmsg) 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 - if (present(errmsg)) errmsg = "enum constraint failed: method" + 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 (nml__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 - if (present(errmsg)) errmsg = "bounds constraint failed: steps" + 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 (nml__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 (present(errmsg)) errmsg = "bounds constraint failed: station_weights" + if (nml__allocated(nml__obj%data%station_weights)) then + if (.not. nml__all(station_weights__in_bounds(nml__obj%data%station_weights, allow_missing=.true.))) then + nml__status = NML_ERR_BOUNDS + if (nml__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 - if (present(errmsg)) errmsg = "bounds constraint failed: relaxation" + 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 (nml__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/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..b545884 100644 --- a/examples/04_derived_types/fortran/generated/nml_helper.f90 +++ b/examples/04_derived_types/fortran/generated/nml_helper.f90 @@ -7,6 +7,11 @@ module nml_helper use iso_fortran_env, only: & i4=>int32 + intrinsic :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & + shape, size, trim + public :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & + shape, size, trim + !> \brief Buffer length for reading lines integer, public :: nml_line_buffer = 512 !> \brief Status code: success @@ -43,7 +48,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 @@ -163,19 +168,18 @@ pure function to_lower(string) result(lower_string) end function to_lower !> \brief Validate index bounds for array access - integer function idx_check(idx, lower, upper, field, errmsg) result(status) + integer function idx_check(idx, extents, field, errmsg) result(status) integer, intent(in) :: idx(:) - integer, intent(in) :: lower(:) - integer, intent(in) :: upper(:) + integer, intent(in) :: extents(:) character(len=*), intent(in) :: field character(len=*), intent(out), optional :: errmsg status = NML_OK if (present(errmsg)) errmsg = "" - if (size(idx) /= size(lower)) then + if (size(idx) /= size(extents)) 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 + else if (any(idx < 1) .or. any(idx > extents)) then status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index out of bounds for '" // trim(field) // "'" end if diff --git a/examples/04_derived_types/fortran/generated/nml_run.f90 b/examples/04_derived_types/fortran/generated/nml_run.f90 index f204da4..1ca82cf 100644 --- a/examples/04_derived_types/fortran/generated/nml_run.f90 +++ b/examples/04_derived_types/fortran/generated/nml_run.f90 @@ -21,11 +21,24 @@ module nml_run NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & idx_check, & + nml__achar => achar, & + nml__all => all, & + nml__allocated => allocated, & + nml__any => any, & + nml__huge => huge, & + nml__len => len, & + nml__len_trim => len_trim, & + nml__minval => minval, & + nml__present => present, & + nml__reshape => reshape, & + nml__shape => shape, & + nml__size => size, & + nml__trim => trim, & 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: & @@ -42,15 +55,32 @@ 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 + private :: nml__achar, nml__all, nml__allocated, nml__any, nml__huge, nml__len, & + nml__len_trim, nml__minval, nml__present, nml__reshape, nml__shape, nml__size, & + nml__trim + + !> \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 @@ -68,9 +98,9 @@ elemental logical function period__start_year__in_bounds(val, allow_missing) res 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 (nml__present(allow_missing)) then if (allow_missing) then - if (val == -huge(val)) then + if (val == -nml__huge(val)) then in_bounds = .true. return end if @@ -87,9 +117,9 @@ elemental logical function periods__start_year__in_bounds(val, allow_missing) re 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 (nml__present(allow_missing)) then if (allow_missing) then - if (val == -huge(val)) then + if (val == -nml__huge(val)) then in_bounds = .true. return end if @@ -106,9 +136,9 @@ elemental logical function station__code__in_bounds(val, allow_missing) result(i 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 (nml__present(allow_missing)) then if (allow_missing) then - if (val == -huge(val)) then + if (val == -nml__huge(val)) then in_bounds = .true. return end if @@ -120,77 +150,77 @@ elemental logical function station__code__in_bounds(val, allow_missing) result(i 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) + subroutine nml_run_resolve_handle(handle, nml__obj, nml__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 + 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 - if (present(errmsg)) errmsg = "" - nullify(this) + if (nml__present(errmsg)) errmsg = "" + nullify(nml__obj) if (handle == 0_c_intptr_t) then - status = NML_ERR_INVALID_HANDLE - if (present(errmsg)) errmsg = "zero handle" + nml__status = NML_ERR_INVALID_HANDLE + if (nml__present(errmsg)) errmsg = "zero handle" return end if ptr = transfer(handle, c_null_ptr) - call c_f_pointer(ptr, this) - status = NML_OK + call c_f_pointer(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 - if (present(errmsg)) errmsg = "" - this%is_configured = .false. + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + 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 - if (present(errmsg)) errmsg = "" - if (present(period)) then - period%start_year = -huge(period%start_year) ! sentinel for derived component start_year - period%end_year = -huge(period%end_year) ! sentinel for derived component end_year + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + if (nml__present(period)) then + period%start_year = -nml__huge(period%start_year) ! sentinel for derived component start_year + period%end_year = -nml__huge(period%end_year) ! sentinel for derived component end_year period%label = "main" period%start_year = 2000_i4 end if - if (present(periods)) then - if (allocated(periods)) deallocate(periods) - allocate(periods(this%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 + if (nml__present(periods)) then + if (nml__allocated(periods)) deallocate(periods) + allocate(periods(nml__obj%dims%n_periods)) + periods%start_year = -nml__huge(periods%start_year) ! sentinel for derived component start_year + periods%end_year = -nml__huge(periods%end_year) ! sentinel for derived component end_year periods%label = "period" periods%start_year = 1980_i4 periods%end_year = 1999_i4 end if - 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 - if (present(errmsg)) errmsg = "imported string storage length mismatch: station%label" + if (nml__present(station)) then + station%code = -nml__huge(station%code) ! sentinel for derived component code + if (nml__len(station%label) /= station_label_len) then + nml__status = NML_ERR_BOUNDS + if (nml__present(errmsg)) errmsg = "imported string storage length mismatch: station%label" return end if station%label = "unknown" @@ -198,322 +228,326 @@ 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 - if (present(errmsg)) errmsg = "" - if (present(n_periods)) then + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + if (nml__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 - if (present(errmsg)) errmsg = "dimension 'n_periods' must be positive" + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 (nml__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 - - 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() + if (nml__allocated(periods)) deallocate(periods) + allocate(periods(nml__obj%dims%n_periods)) + period = nml__obj%data%period + periods = nml__obj%data%periods + station = nml__obj%data%station + + 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 (nml__present(errmsg)) errmsg = nml__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 (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'periods'" + if (nml__present(periods)) then + if (nml__size(periods, 1) > nml__size(nml__obj%data%periods, 1)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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:nml__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 - if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET - if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(trim(name))) + select case (to_lower(nml__trim(name))) case ("period%start_year") - if (present(idx)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index not supported for 'period'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'period'" return end if case ("period%end_year") - if (present(idx)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index not supported for 'period'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 == -nml__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 - if (present(errmsg)) errmsg = "index not supported for 'period'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'period'" return end if case ("period") - if (present(idx)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index not supported for 'period'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 == -nml__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. nml__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), & + if (nml__present(idx)) then + nml__status = idx_check(idx, nml__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. nml__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), & + if (nml__present(idx)) then + nml__status = idx_check(idx, nml__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. nml__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), & + if (nml__present(idx)) then + nml__status = idx_check(idx, nml__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. nml__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), & + if (nml__present(idx)) then + nml__status = idx_check(idx, nml__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 - if (present(errmsg)) errmsg = "index not supported for 'station'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 == -nml__huge(nml__obj%data%station%code)) nml__status = NML_ERR_NOT_SET case ("station%label") - if (present(idx)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index not supported for 'station'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'station'" return end if case ("station") - if (present(idx)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index not supported for 'station'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 == -nml__huge(nml__obj%data%station%code)) then + nml__status = NML_ERR_NOT_SET end if case default - status = NML_ERR_INVALID_NAME - if (present(errmsg)) errmsg = "unknown field: " // trim(name) + nml__status = NML_ERR_INVALID_NAME + if (nml__present(errmsg)) errmsg = "unknown field: " // nml__trim(name) end select - if (status == NML_ERR_NOT_SET .and. present(errmsg)) then - if (len_trim(errmsg) == 0) errmsg = "field not set: " // trim(name) + if (nml__status == NML_ERR_NOT_SET .and. nml__present(errmsg)) then + if (nml__len_trim(errmsg) == 0) errmsg = "field not set: " // nml__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 - if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET - if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (nml__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 - if (present(errmsg)) then - if (len_trim(errmsg) == 0) then + nml__istat = nml__obj%is_set("period", errmsg=errmsg) + if (nml__istat == NML_ERR_NOT_SET) then + nml__status = NML_ERR_REQUIRED + if (nml__present(errmsg)) then + if (nml__len_trim(errmsg) == 0) then errmsg = "field not set: period" end if - errmsg = "required " // trim(errmsg) + errmsg = "required " // nml__trim(errmsg) 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 - if (present(errmsg)) then - if (len_trim(errmsg) == 0) then + nml__istat = nml__obj%is_set("station", errmsg=errmsg) + if (nml__istat == NML_ERR_NOT_SET) then + nml__status = NML_ERR_REQUIRED + if (nml__present(errmsg)) then + if (nml__len_trim(errmsg) == 0) then errmsg = "field not set: station" end if - errmsg = "required " // trim(errmsg) + errmsg = "required " // nml__trim(errmsg) 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 - if (present(errmsg)) errmsg = "bounds constraint failed: period%start_year" + 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 (nml__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 (present(errmsg)) errmsg = "bounds constraint failed: periods%start_year" + if (nml__allocated(nml__obj%data%periods)) then + if (.not. nml__all(periods__start_year__in_bounds(nml__obj%data%periods%start_year, allow_missing=.true.))) then + nml__status = NML_ERR_BOUNDS + if (nml__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 - if (present(errmsg)) errmsg = "bounds constraint failed: station%code" + 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 (nml__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/tests/fortran_optional_read/conformance.f90 b/tests/fortran_optional_read/conformance.f90 index 2384b3d..b439a9f 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) diff --git a/tests/fortran_optional_read/out/nml_helper.f90 b/tests/fortran_optional_read/out/nml_helper.f90 index 0606531..a4912fb 100644 --- a/tests/fortran_optional_read/out/nml_helper.f90 +++ b/tests/fortran_optional_read/out/nml_helper.f90 @@ -4,6 +4,11 @@ !> \brief Helper module for namelist file operations module nml_helper + intrinsic :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & + shape, size, trim + public :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & + shape, size, trim + !> \brief Buffer length for reading lines integer, public :: nml_line_buffer = 1024 !> \brief Status code: success @@ -147,19 +152,18 @@ pure function to_lower(string) result(lower_string) end function to_lower !> \brief Validate index bounds for array access - integer function idx_check(idx, lower, upper, field, errmsg) result(status) + integer function idx_check(idx, extents, field, errmsg) result(status) integer, intent(in) :: idx(:) - integer, intent(in) :: lower(:) - integer, intent(in) :: upper(:) + integer, intent(in) :: extents(:) character(len=*), intent(in) :: field character(len=*), intent(out), optional :: errmsg status = NML_OK if (present(errmsg)) errmsg = "" - if (size(idx) /= size(lower)) then + if (size(idx) /= size(extents)) 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 + else if (any(idx < 1) .or. any(idx > extents)) then status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index out of bounds for '" // trim(field) // "'" end if diff --git a/tests/fortran_optional_read/out/nml_optional.f90 b/tests/fortran_optional_read/out/nml_optional.f90 index c8724cd..ec70ba5 100644 --- a/tests/fortran_optional_read/out/nml_optional.f90 +++ b/tests/fortran_optional_read/out/nml_optional.f90 @@ -21,6 +21,19 @@ module nml_optional NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & idx_check, & + nml__achar => achar, & + nml__all => all, & + nml__allocated => allocated, & + nml__any => any, & + nml__huge => huge, & + nml__len => len, & + nml__len_trim => len_trim, & + nml__minval => minval, & + nml__present => present, & + nml__reshape => reshape, & + nml__shape => shape, & + nml__size => size, & + nml__trim => trim, & to_lower ! kind specifiers listed in the nml-tools configuration file use iso_fortran_env, only: & @@ -31,13 +44,24 @@ module nml_optional ! default values integer(i4), parameter, public :: count__default = 7_i4 + private :: nml_optional_read__from_file + private :: nml__achar, nml__all, nml__allocated, nml__any, nml__huge, nml__len, & + nml__len_trim, nml__minval, nml__present, nml__reshape, nml__shape, nml__size, & + nml__trim + + !> \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,158 +73,166 @@ 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 - if (present(errmsg)) errmsg = "" - this%is_configured = .false. + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + nml__obj%is_configured = .false. ! sentinel values for required/optional parameters - this%label = achar(0) ! sentinel for optional string + nml__obj%data%label = nml__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 (nml__present(errmsg)) errmsg = nml__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 (nml__present(count)) nml__obj%data%count = count + if (nml__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 - if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET - if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(trim(name))) + select case (to_lower(nml__trim(name))) case ("count") - if (present(idx)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index not supported for 'count'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__present(errmsg)) errmsg = "index not supported for 'count'" return end if case ("label") - if (present(idx)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index not supported for 'label'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 == nml__achar(0)) nml__status = NML_ERR_NOT_SET case default - status = NML_ERR_INVALID_NAME - if (present(errmsg)) errmsg = "unknown field: " // trim(name) + nml__status = NML_ERR_INVALID_NAME + if (nml__present(errmsg)) errmsg = "unknown field: " // nml__trim(name) end select - if (status == NML_ERR_NOT_SET .and. present(errmsg)) then - if (len_trim(errmsg) == 0) errmsg = "field not set: " // trim(name) + if (nml__status == NML_ERR_NOT_SET .and. nml__present(errmsg)) then + if (nml__len_trim(errmsg) == 0) errmsg = "field not set: " // nml__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 - if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET - if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (nml__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..2e559b3 100644 --- a/tests/fortran_optional_read/out/nml_required.f90 +++ b/tests/fortran_optional_read/out/nml_required.f90 @@ -21,6 +21,19 @@ module nml_required NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & idx_check, & + nml__achar => achar, & + nml__all => all, & + nml__allocated => allocated, & + nml__any => any, & + nml__huge => huge, & + nml__len => len, & + nml__len_trim => len_trim, & + nml__minval => minval, & + nml__present => present, & + nml__reshape => reshape, & + nml__shape => shape, & + nml__size => size, & + nml__trim => trim, & to_lower ! kind specifiers listed in the nml-tools configuration file use iso_fortran_env, only: & @@ -28,12 +41,23 @@ module nml_required implicit none + private :: nml_required_read__from_file + private :: nml__achar, nml__all, nml__allocated, nml__any, nml__huge, nml__len, & + nml__len_trim, nml__minval, nml__present, nml__reshape, nml__shape, nml__size, & + nml__trim + + !> \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,149 +69,157 @@ 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 - if (present(errmsg)) errmsg = "" - this%is_configured = .false. + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + nml__obj%is_configured = .false. ! sentinel values for required/optional parameters - this%count = -huge(this%count) ! sentinel for required integer + nml__obj%data%count = -nml__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 (nml__present(errmsg)) errmsg = nml__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 - if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET - if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(trim(name))) + select case (to_lower(nml__trim(name))) case ("count") - if (present(idx)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index not supported for 'count'" + if (nml__present(idx)) then + nml__status = NML_ERR_INVALID_INDEX + if (nml__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 == -nml__huge(nml__obj%data%count)) nml__status = NML_ERR_NOT_SET case default - status = NML_ERR_INVALID_NAME - if (present(errmsg)) errmsg = "unknown field: " // trim(name) + nml__status = NML_ERR_INVALID_NAME + if (nml__present(errmsg)) errmsg = "unknown field: " // nml__trim(name) end select - if (status == NML_ERR_NOT_SET .and. present(errmsg)) then - if (len_trim(errmsg) == 0) errmsg = "field not set: " // trim(name) + if (nml__status == NML_ERR_NOT_SET .and. nml__present(errmsg)) then + if (nml__len_trim(errmsg) == 0) errmsg = "field not set: " // nml__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 - if (present(errmsg)) errmsg = "" - if (.not. this%is_configured) then - status = NML_ERR_NOT_SET - if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" + nml__status = NML_OK + if (nml__present(errmsg)) errmsg = "" + if (.not. nml__obj%is_configured) then + nml__status = NML_ERR_NOT_SET + if (nml__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 - if (present(errmsg)) then - if (len_trim(errmsg) == 0) then + nml__istat = nml__obj%is_set("count", errmsg=errmsg) + if (nml__istat == NML_ERR_NOT_SET) then + nml__status = NML_ERR_REQUIRED + if (nml__present(errmsg)) then + if (nml__len_trim(errmsg) == 0) then errmsg = "field not set: count" end if - errmsg = "required " // trim(errmsg) + errmsg = "required " // nml__trim(errmsg) 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 From 3df307088220d3a1501654cf9f0392045fbd27d7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Sat, 12 Sep 2026 00:40:05 +0200 Subject: [PATCH 05/22] fix(fortran): isolate re-exported intrinsics Declare intrinsic procedures in a dedicated helper module so gfortran 10 and newer preserve them for renamed use association, while retaining collision-safe nml__ aliases. --- examples/01_simple/out/nml_helper.f90 | 11 +++++--- examples/01_simple/out/nml_optimization.f90 | 26 +++++++++---------- .../fortran/generated/nml_config.f90 | 26 +++++++++---------- .../fortran/generated/nml_helper.f90 | 9 +++++-- examples/03_references/out/nml_helper.f90 | 9 +++++-- examples/03_references/out/nml_report.f90 | 26 +++++++++---------- examples/03_references/out/nml_run.f90 | 26 +++++++++---------- .../fortran/generated/nml_helper.f90 | 15 +++++++---- .../fortran/generated/nml_run.f90 | 26 +++++++++---------- src/nml_tools/codegen_fortran.py | 6 ++++- src/nml_tools/templates/fortran_module.f90.j2 | 5 ++++ src/nml_tools/templates/nml_helper.f90.j2 | 15 +++++++---- tests/fixtures/01_simple/out/nml_helper.f90 | 11 +++++--- .../01_simple/out/nml_optimization.f90 | 26 +++++++++---------- tests/fortran_namespaces/out/nml_helper.f90 | 9 +++++-- .../fortran_namespaces/out/nml_namespaces.f90 | 26 +++++++++---------- .../fortran_optional_read/out/nml_helper.f90 | 9 +++++-- .../out/nml_optional.f90 | 26 +++++++++---------- .../out/nml_required.f90 | 26 +++++++++---------- tests/test_codegen_fortran.py | 25 ++++++++++++++++-- 20 files changed, 214 insertions(+), 144 deletions(-) diff --git a/examples/01_simple/out/nml_helper.f90 b/examples/01_simple/out/nml_helper.f90 index 4f24a8d..a8d11c0 100644 --- a/examples/01_simple/out/nml_helper.f90 +++ b/examples/01_simple/out/nml_helper.f90 @@ -3,14 +3,19 @@ !> \file nml_helper.f90 !> \copydoc nml_helper -!> \brief Helper module for namelist file operations -!> \version 0.1 -module nml_helper +!> \brief Intrinsic procedures re-exported for collision-safe generated aliases +module nml_helper_intrinsics + implicit none intrinsic :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & shape, size, trim public :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & shape, size, trim +end module nml_helper_intrinsics + +!> \brief Helper module for namelist file operations +!> \version 0.1 +module nml_helper !> \brief Buffer length for reading lines integer, public :: nml_line_buffer = 1024 diff --git a/examples/01_simple/out/nml_optimization.f90 b/examples/01_simple/out/nml_optimization.f90 index 0b5bf52..c401782 100644 --- a/examples/01_simple/out/nml_optimization.f90 +++ b/examples/01_simple/out/nml_optimization.f90 @@ -22,23 +22,23 @@ module nml_optimization NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & idx_check, & - nml__achar => achar, & - nml__all => all, & - nml__allocated => allocated, & - nml__any => any, & - nml__huge => huge, & - nml__len => len, & - nml__len_trim => len_trim, & - nml__minval => minval, & - nml__present => present, & - nml__reshape => reshape, & - nml__shape => shape, & - nml__size => size, & - nml__trim => trim, & to_lower, & buf, & max_iter__dim_default, & NML_ERR_PARTLY_SET + use nml_helper_intrinsics, only: nml__achar => achar + use nml_helper_intrinsics, only: nml__all => all + use nml_helper_intrinsics, only: nml__allocated => allocated + use nml_helper_intrinsics, only: nml__any => any + use nml_helper_intrinsics, only: nml__huge => huge + use nml_helper_intrinsics, only: nml__len => len + use nml_helper_intrinsics, only: nml__len_trim => len_trim + use nml_helper_intrinsics, only: nml__minval => minval + use nml_helper_intrinsics, only: nml__present => present + use nml_helper_intrinsics, only: nml__reshape => reshape + use nml_helper_intrinsics, only: nml__shape => shape + use nml_helper_intrinsics, only: nml__size => size + use nml_helper_intrinsics, only: nml__trim => trim 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 diff --git a/examples/02_pybind/fortran/generated/nml_config.f90 b/examples/02_pybind/fortran/generated/nml_config.f90 index f518541..39c2352 100644 --- a/examples/02_pybind/fortran/generated/nml_config.f90 +++ b/examples/02_pybind/fortran/generated/nml_config.f90 @@ -25,23 +25,23 @@ module nml_config NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & idx_check, & - nml__achar => achar, & - nml__all => all, & - nml__allocated => allocated, & - nml__any => any, & - nml__huge => huge, & - nml__len => len, & - nml__len_trim => len_trim, & - nml__minval => minval, & - nml__present => present, & - nml__reshape => reshape, & - nml__shape => shape, & - nml__size => size, & - nml__trim => trim, & to_lower, & NML_ERR_INVALID_HANDLE, & str_len, & n_weights__dim_default + use nml_helper_intrinsics, only: nml__achar => achar + use nml_helper_intrinsics, only: nml__all => all + use nml_helper_intrinsics, only: nml__allocated => allocated + use nml_helper_intrinsics, only: nml__any => any + use nml_helper_intrinsics, only: nml__huge => huge + use nml_helper_intrinsics, only: nml__len => len + use nml_helper_intrinsics, only: nml__len_trim => len_trim + use nml_helper_intrinsics, only: nml__minval => minval + use nml_helper_intrinsics, only: nml__present => present + use nml_helper_intrinsics, only: nml__reshape => reshape + use nml_helper_intrinsics, only: nml__shape => shape + use nml_helper_intrinsics, only: nml__size => size + use nml_helper_intrinsics, only: nml__trim => trim 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 diff --git a/examples/02_pybind/fortran/generated/nml_helper.f90 b/examples/02_pybind/fortran/generated/nml_helper.f90 index 4ee1249..5333ef5 100644 --- a/examples/02_pybind/fortran/generated/nml_helper.f90 +++ b/examples/02_pybind/fortran/generated/nml_helper.f90 @@ -1,13 +1,18 @@ !> \file nml_helper.f90 !> \copydoc nml_helper -!> \brief Helper module for namelist file operations -module nml_helper +!> \brief Intrinsic procedures re-exported for collision-safe generated aliases +module nml_helper_intrinsics + implicit none intrinsic :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & shape, size, trim public :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & shape, size, trim +end module nml_helper_intrinsics + +!> \brief Helper module for namelist file operations +module nml_helper !> \brief Buffer length for reading lines integer, public :: nml_line_buffer = 512 diff --git a/examples/03_references/out/nml_helper.f90 b/examples/03_references/out/nml_helper.f90 index 7339cf8..2f9f80c 100644 --- a/examples/03_references/out/nml_helper.f90 +++ b/examples/03_references/out/nml_helper.f90 @@ -3,13 +3,18 @@ !> \file nml_helper.f90 !> \copydoc nml_helper -!> \brief Helper module for namelist file operations -module nml_helper +!> \brief Intrinsic procedures re-exported for collision-safe generated aliases +module nml_helper_intrinsics + implicit none intrinsic :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & shape, size, trim public :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & shape, size, trim +end module nml_helper_intrinsics + +!> \brief Helper module for namelist file operations +module nml_helper !> \brief Buffer length for reading lines integer, public :: nml_line_buffer = 512 diff --git a/examples/03_references/out/nml_report.f90 b/examples/03_references/out/nml_report.f90 index ccf9d34..c2e0acb 100644 --- a/examples/03_references/out/nml_report.f90 +++ b/examples/03_references/out/nml_report.f90 @@ -21,21 +21,21 @@ module nml_report NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & idx_check, & - nml__achar => achar, & - nml__all => all, & - nml__allocated => allocated, & - nml__any => any, & - nml__huge => huge, & - nml__len => len, & - nml__len_trim => len_trim, & - nml__minval => minval, & - nml__present => present, & - nml__reshape => reshape, & - nml__shape => shape, & - nml__size => size, & - nml__trim => trim, & to_lower, & label_len + use nml_helper_intrinsics, only: nml__achar => achar + use nml_helper_intrinsics, only: nml__all => all + use nml_helper_intrinsics, only: nml__allocated => allocated + use nml_helper_intrinsics, only: nml__any => any + use nml_helper_intrinsics, only: nml__huge => huge + use nml_helper_intrinsics, only: nml__len => len + use nml_helper_intrinsics, only: nml__len_trim => len_trim + use nml_helper_intrinsics, only: nml__minval => minval + use nml_helper_intrinsics, only: nml__present => present + use nml_helper_intrinsics, only: nml__reshape => reshape + use nml_helper_intrinsics, only: nml__shape => shape + use nml_helper_intrinsics, only: nml__size => size + use nml_helper_intrinsics, only: nml__trim => trim 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 diff --git a/examples/03_references/out/nml_run.f90 b/examples/03_references/out/nml_run.f90 index 4d36fda..da29b8d 100644 --- a/examples/03_references/out/nml_run.f90 +++ b/examples/03_references/out/nml_run.f90 @@ -21,22 +21,22 @@ module nml_run NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & idx_check, & - nml__achar => achar, & - nml__all => all, & - nml__allocated => allocated, & - nml__any => any, & - nml__huge => huge, & - nml__len => len, & - nml__len_trim => len_trim, & - nml__minval => minval, & - nml__present => present, & - nml__reshape => reshape, & - nml__shape => shape, & - nml__size => size, & - nml__trim => trim, & to_lower, & label_len, & n_stations__dim_default + use nml_helper_intrinsics, only: nml__achar => achar + use nml_helper_intrinsics, only: nml__all => all + use nml_helper_intrinsics, only: nml__allocated => allocated + use nml_helper_intrinsics, only: nml__any => any + use nml_helper_intrinsics, only: nml__huge => huge + use nml_helper_intrinsics, only: nml__len => len + use nml_helper_intrinsics, only: nml__len_trim => len_trim + use nml_helper_intrinsics, only: nml__minval => minval + use nml_helper_intrinsics, only: nml__present => present + use nml_helper_intrinsics, only: nml__reshape => reshape + use nml_helper_intrinsics, only: nml__shape => shape + use nml_helper_intrinsics, only: nml__size => size + use nml_helper_intrinsics, only: nml__trim => trim 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 diff --git a/examples/04_derived_types/fortran/generated/nml_helper.f90 b/examples/04_derived_types/fortran/generated/nml_helper.f90 index b545884..22efcae 100644 --- a/examples/04_derived_types/fortran/generated/nml_helper.f90 +++ b/examples/04_derived_types/fortran/generated/nml_helper.f90 @@ -1,16 +1,21 @@ !> \file nml_helper.f90 !> \copydoc nml_helper -!> \brief Helper module for namelist file operations -module nml_helper - ! kind specifiers used by locally generated derived types - use iso_fortran_env, only: & - i4=>int32 +!> \brief Intrinsic procedures re-exported for collision-safe generated aliases +module nml_helper_intrinsics + implicit none intrinsic :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & shape, size, trim public :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & shape, size, trim +end module nml_helper_intrinsics + +!> \brief Helper module for namelist file operations +module nml_helper + ! kind specifiers used by locally generated derived types + use iso_fortran_env, only: & + i4=>int32 !> \brief Buffer length for reading lines integer, public :: nml_line_buffer = 512 diff --git a/examples/04_derived_types/fortran/generated/nml_run.f90 b/examples/04_derived_types/fortran/generated/nml_run.f90 index 1ca82cf..bab1179 100644 --- a/examples/04_derived_types/fortran/generated/nml_run.f90 +++ b/examples/04_derived_types/fortran/generated/nml_run.f90 @@ -21,25 +21,25 @@ module nml_run NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & idx_check, & - nml__achar => achar, & - nml__all => all, & - nml__allocated => allocated, & - nml__any => any, & - nml__huge => huge, & - nml__len => len, & - nml__len_trim => len_trim, & - nml__minval => minval, & - nml__present => present, & - nml__reshape => reshape, & - nml__shape => shape, & - nml__size => size, & - nml__trim => trim, & to_lower, & NML_ERR_INVALID_HANDLE, & period_t, & period_label_len, & n_periods__dim_default, & station_label_len + use nml_helper_intrinsics, only: nml__achar => achar + use nml_helper_intrinsics, only: nml__all => all + use nml_helper_intrinsics, only: nml__allocated => allocated + use nml_helper_intrinsics, only: nml__any => any + use nml_helper_intrinsics, only: nml__huge => huge + use nml_helper_intrinsics, only: nml__len => len + use nml_helper_intrinsics, only: nml__len_trim => len_trim + use nml_helper_intrinsics, only: nml__minval => minval + use nml_helper_intrinsics, only: nml__present => present + use nml_helper_intrinsics, only: nml__reshape => reshape + use nml_helper_intrinsics, only: nml__shape => shape + use nml_helper_intrinsics, only: nml__size => size + use nml_helper_intrinsics, only: nml__trim => trim ! kind specifiers listed in the nml-tools configuration file use iso_fortran_env, only: & i4=>int32 diff --git a/src/nml_tools/codegen_fortran.py b/src/nml_tools/codegen_fortran.py index 5a54a67..dde180c 100644 --- a/src/nml_tools/codegen_fortran.py +++ b/src/nml_tools/codegen_fortran.py @@ -432,6 +432,9 @@ def _build_context( "NML_ERR_INVALID_NAME", "NML_ERR_INVALID_INDEX", "idx_check", + "to_lower", + ] + helper_intrinsic_imports = [ "nml__achar => achar", "nml__all => all", "nml__allocated => allocated", @@ -445,7 +448,6 @@ def _build_context( "nml__shape => shape", "nml__size => size", "nml__trim => trim", - "to_lower", ] if f2py_handle_helpers: helper_imports.append("NML_ERR_INVALID_HANDLE") @@ -1680,7 +1682,9 @@ def _register_runtime_dimension(dim_name: str) -> str: "kind_imports": resolved_kind_imports, "use_ieee": requires_ieee, "helper_module": helper_module, + "helper_intrinsic_module": f"{helper_module}_intrinsics", "helper_imports": helper_imports, + "helper_intrinsic_imports": helper_intrinsic_imports, "presence_cases": presence_cases, "data_type_name": data_type_name, "dims_type_name": dims_type_name, diff --git a/src/nml_tools/templates/fortran_module.f90.j2 b/src/nml_tools/templates/fortran_module.f90.j2 index 7ce84fe..b0ca8f6 100644 --- a/src/nml_tools/templates/fortran_module.f90.j2 +++ b/src/nml_tools/templates/fortran_module.f90.j2 @@ -9,6 +9,11 @@ module {{ module_name }} use {{ helper_module }}, only: & {{ helper_imports | join(', &\n ') }} +{# Import from a declaration-only module. gfortran 10+ omits an intrinsic from + a module interface when that intrinsic is also referenced inside the module. #} +{% for intrinsic_import in helper_intrinsic_imports %} + use {{ helper_intrinsic_module }}, only: {{ intrinsic_import }} +{% endfor %} {% if use_ieee %} use ieee_arithmetic, only: nml__ieee_value => ieee_value, & nml__ieee_quiet_nan => ieee_quiet_nan, nml__ieee_is_nan => ieee_is_nan diff --git a/src/nml_tools/templates/nml_helper.f90.j2 b/src/nml_tools/templates/nml_helper.f90.j2 index 059c2d1..6fb87f9 100644 --- a/src/nml_tools/templates/nml_helper.f90.j2 +++ b/src/nml_tools/templates/nml_helper.f90.j2 @@ -5,6 +5,16 @@ !> \file {{ file_name }} !> \copydoc {{ module_name }} +!> \brief Intrinsic procedures re-exported for collision-safe generated aliases +module {{ module_name }}_intrinsics + implicit none + + intrinsic :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & + shape, size, trim + public :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & + shape, size, trim +end module {{ module_name }}_intrinsics + !> \brief Helper module for namelist file operations {% if module_doc %} {{ module_doc }} @@ -16,11 +26,6 @@ module {{ module_name }} {{ kind_imports | join(', &\n ') }} {% endif %} - intrinsic :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & - shape, size, trim - public :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & - shape, size, trim - !> \brief Buffer length for reading lines integer, public :: nml_line_buffer = {{ len_buf }} !> \brief Status code: success diff --git a/tests/fixtures/01_simple/out/nml_helper.f90 b/tests/fixtures/01_simple/out/nml_helper.f90 index 4f24a8d..a8d11c0 100644 --- a/tests/fixtures/01_simple/out/nml_helper.f90 +++ b/tests/fixtures/01_simple/out/nml_helper.f90 @@ -3,14 +3,19 @@ !> \file nml_helper.f90 !> \copydoc nml_helper -!> \brief Helper module for namelist file operations -!> \version 0.1 -module nml_helper +!> \brief Intrinsic procedures re-exported for collision-safe generated aliases +module nml_helper_intrinsics + implicit none intrinsic :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & shape, size, trim public :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & shape, size, trim +end module nml_helper_intrinsics + +!> \brief Helper module for namelist file operations +!> \version 0.1 +module nml_helper !> \brief Buffer length for reading lines integer, public :: nml_line_buffer = 1024 diff --git a/tests/fixtures/01_simple/out/nml_optimization.f90 b/tests/fixtures/01_simple/out/nml_optimization.f90 index 5f7dcd3..e51b46c 100644 --- a/tests/fixtures/01_simple/out/nml_optimization.f90 +++ b/tests/fixtures/01_simple/out/nml_optimization.f90 @@ -23,22 +23,22 @@ module nml_optimization NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & idx_check, & - nml__achar => achar, & - nml__all => all, & - nml__allocated => allocated, & - nml__any => any, & - nml__huge => huge, & - nml__len => len, & - nml__len_trim => len_trim, & - nml__minval => minval, & - nml__present => present, & - nml__reshape => reshape, & - nml__shape => shape, & - nml__size => size, & - nml__trim => trim, & to_lower, & buf, & max_iter__dim_default + use nml_helper_intrinsics, only: nml__achar => achar + use nml_helper_intrinsics, only: nml__all => all + use nml_helper_intrinsics, only: nml__allocated => allocated + use nml_helper_intrinsics, only: nml__any => any + use nml_helper_intrinsics, only: nml__huge => huge + use nml_helper_intrinsics, only: nml__len => len + use nml_helper_intrinsics, only: nml__len_trim => len_trim + use nml_helper_intrinsics, only: nml__minval => minval + use nml_helper_intrinsics, only: nml__present => present + use nml_helper_intrinsics, only: nml__reshape => reshape + use nml_helper_intrinsics, only: nml__shape => shape + use nml_helper_intrinsics, only: nml__size => size + use nml_helper_intrinsics, only: nml__trim => trim 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 diff --git a/tests/fortran_namespaces/out/nml_helper.f90 b/tests/fortran_namespaces/out/nml_helper.f90 index 90db15d..95f6d8b 100644 --- a/tests/fortran_namespaces/out/nml_helper.f90 +++ b/tests/fortran_namespaces/out/nml_helper.f90 @@ -1,13 +1,18 @@ !> \file nml_helper.f90 !> \copydoc nml_helper -!> \brief Helper module for namelist file operations -module nml_helper +!> \brief Intrinsic procedures re-exported for collision-safe generated aliases +module nml_helper_intrinsics + implicit none intrinsic :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & shape, size, trim public :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & shape, size, trim +end module nml_helper_intrinsics + +!> \brief Helper module for namelist file operations +module nml_helper !> \brief Buffer length for reading lines integer, public :: nml_line_buffer = 1024 diff --git a/tests/fortran_namespaces/out/nml_namespaces.f90 b/tests/fortran_namespaces/out/nml_namespaces.f90 index 484395c..d04a04d 100644 --- a/tests/fortran_namespaces/out/nml_namespaces.f90 +++ b/tests/fortran_namespaces/out/nml_namespaces.f90 @@ -21,22 +21,22 @@ module nml_namespaces NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & idx_check, & - nml__achar => achar, & - nml__all => all, & - nml__allocated => allocated, & - nml__any => any, & - nml__huge => huge, & - nml__len => len, & - nml__len_trim => len_trim, & - nml__minval => minval, & - nml__present => present, & - nml__reshape => reshape, & - nml__shape => shape, & - nml__size => size, & - nml__trim => trim, & to_lower, & status__dim_default, & set_dims__dim_default + use nml_helper_intrinsics, only: nml__achar => achar + use nml_helper_intrinsics, only: nml__all => all + use nml_helper_intrinsics, only: nml__allocated => allocated + use nml_helper_intrinsics, only: nml__any => any + use nml_helper_intrinsics, only: nml__huge => huge + use nml_helper_intrinsics, only: nml__len => len + use nml_helper_intrinsics, only: nml__len_trim => len_trim + use nml_helper_intrinsics, only: nml__minval => minval + use nml_helper_intrinsics, only: nml__present => present + use nml_helper_intrinsics, only: nml__reshape => reshape + use nml_helper_intrinsics, only: nml__shape => shape + use nml_helper_intrinsics, only: nml__size => size + use nml_helper_intrinsics, only: nml__trim => trim implicit none diff --git a/tests/fortran_optional_read/out/nml_helper.f90 b/tests/fortran_optional_read/out/nml_helper.f90 index a4912fb..335cf3c 100644 --- a/tests/fortran_optional_read/out/nml_helper.f90 +++ b/tests/fortran_optional_read/out/nml_helper.f90 @@ -1,13 +1,18 @@ !> \file nml_helper.f90 !> \copydoc nml_helper -!> \brief Helper module for namelist file operations -module nml_helper +!> \brief Intrinsic procedures re-exported for collision-safe generated aliases +module nml_helper_intrinsics + implicit none intrinsic :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & shape, size, trim public :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & shape, size, trim +end module nml_helper_intrinsics + +!> \brief Helper module for namelist file operations +module nml_helper !> \brief Buffer length for reading lines integer, public :: nml_line_buffer = 1024 diff --git a/tests/fortran_optional_read/out/nml_optional.f90 b/tests/fortran_optional_read/out/nml_optional.f90 index ec70ba5..124e27e 100644 --- a/tests/fortran_optional_read/out/nml_optional.f90 +++ b/tests/fortran_optional_read/out/nml_optional.f90 @@ -21,20 +21,20 @@ module nml_optional NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & idx_check, & - nml__achar => achar, & - nml__all => all, & - nml__allocated => allocated, & - nml__any => any, & - nml__huge => huge, & - nml__len => len, & - nml__len_trim => len_trim, & - nml__minval => minval, & - nml__present => present, & - nml__reshape => reshape, & - nml__shape => shape, & - nml__size => size, & - nml__trim => trim, & to_lower + use nml_helper_intrinsics, only: nml__achar => achar + use nml_helper_intrinsics, only: nml__all => all + use nml_helper_intrinsics, only: nml__allocated => allocated + use nml_helper_intrinsics, only: nml__any => any + use nml_helper_intrinsics, only: nml__huge => huge + use nml_helper_intrinsics, only: nml__len => len + use nml_helper_intrinsics, only: nml__len_trim => len_trim + use nml_helper_intrinsics, only: nml__minval => minval + use nml_helper_intrinsics, only: nml__present => present + use nml_helper_intrinsics, only: nml__reshape => reshape + use nml_helper_intrinsics, only: nml__shape => shape + use nml_helper_intrinsics, only: nml__size => size + use nml_helper_intrinsics, only: nml__trim => trim ! kind specifiers listed in the nml-tools configuration file use iso_fortran_env, only: & i4=>int32 diff --git a/tests/fortran_optional_read/out/nml_required.f90 b/tests/fortran_optional_read/out/nml_required.f90 index 2e559b3..2fb8733 100644 --- a/tests/fortran_optional_read/out/nml_required.f90 +++ b/tests/fortran_optional_read/out/nml_required.f90 @@ -21,20 +21,20 @@ module nml_required NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & idx_check, & - nml__achar => achar, & - nml__all => all, & - nml__allocated => allocated, & - nml__any => any, & - nml__huge => huge, & - nml__len => len, & - nml__len_trim => len_trim, & - nml__minval => minval, & - nml__present => present, & - nml__reshape => reshape, & - nml__shape => shape, & - nml__size => size, & - nml__trim => trim, & to_lower + use nml_helper_intrinsics, only: nml__achar => achar + use nml_helper_intrinsics, only: nml__all => all + use nml_helper_intrinsics, only: nml__allocated => allocated + use nml_helper_intrinsics, only: nml__any => any + use nml_helper_intrinsics, only: nml__huge => huge + use nml_helper_intrinsics, only: nml__len => len + use nml_helper_intrinsics, only: nml__len_trim => len_trim + use nml_helper_intrinsics, only: nml__minval => minval + use nml_helper_intrinsics, only: nml__present => present + use nml_helper_intrinsics, only: nml__reshape => reshape + use nml_helper_intrinsics, only: nml__shape => shape + use nml_helper_intrinsics, only: nml__size => size + use nml_helper_intrinsics, only: nml__trim => trim ! kind specifiers listed in the nml-tools configuration file use iso_fortran_env, only: & i4=>int32 diff --git a/tests/test_codegen_fortran.py b/tests/test_codegen_fortran.py index ebce90d..1b56c3f 100644 --- a/tests/test_codegen_fortran.py +++ b/tests/test_codegen_fortran.py @@ -898,8 +898,29 @@ def test_generate_fortran_aliases_present_for_schema_names() -> None: file_name="nml_run.f90", dimensions={"present": 2}, ) - - assert "nml__present => present" in generated + helper = codegen.render_helper(file_name="nml_helper.f90") + + intrinsic_aliases = ( + "nml__achar => achar", + "nml__all => all", + "nml__allocated => allocated", + "nml__any => any", + "nml__huge => huge", + "nml__len => len", + "nml__len_trim => len_trim", + "nml__minval => minval", + "nml__present => present", + "nml__reshape => reshape", + "nml__shape => shape", + "nml__size => size", + "nml__trim => trim", + ) + generated_lines = generated.splitlines() + for intrinsic_alias in intrinsic_aliases: + assert f" use nml_helper_intrinsics, only: {intrinsic_alias}" in generated_lines + assert "module nml_helper_intrinsics" in helper + assert "end module nml_helper_intrinsics" in helper + assert helper.index("end module nml_helper_intrinsics") < helper.index("module nml_helper\n") assert "if (nml__present(present))" in generated assert "nml__obj%dims%present" in generated From 78e71546afeaa51ef21bb1c4de16912a64a8132b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Mon, 14 Sep 2026 11:11:57 +0200 Subject: [PATCH 06/22] refactor(fortran): make generated helper ownership explicit Require an explicit generated helper path for native output, reserve dependency names, remove intrinsic forwarding, and rename internal helper procedures. --- examples/01_simple/out/nml_helper.f90 | 20 +- examples/01_simple/out/nml_optimization.f90 | 280 +++++++++--------- .../fortran/generated/nml_config.f90 | 116 ++++---- .../fortran/generated/nml_helper.f90 | 20 +- examples/03_references/out/nml_helper.f90 | 20 +- examples/03_references/out/nml_report.f90 | 70 ++--- examples/03_references/out/nml_run.f90 | 128 ++++---- .../fortran/generated/nml_helper.f90 | 20 +- .../fortran/generated/nml_run.f90 | 180 +++++------ src/nml_tools/_utils.py | 54 ++++ src/nml_tools/cli.py | 16 + src/nml_tools/codegen_fortran.py | 108 ++++--- src/nml_tools/schema.py | 12 +- src/nml_tools/templates/fortran_module.f90.j2 | 124 ++++---- src/nml_tools/templates/nml_helper.f90.j2 | 20 +- tests/fixtures/01_simple/out/nml_helper.f90 | 20 +- .../01_simple/out/nml_optimization.f90 | 134 ++++----- tests/fortran_namespaces/conformance.f90 | 5 +- tests/fortran_namespaces/input.nml | 2 - tests/fortran_namespaces/namespaces.yml | 6 - tests/fortran_namespaces/out/nml_helper.f90 | 20 +- .../fortran_namespaces/out/nml_namespaces.f90 | 218 ++++++-------- .../fortran_optional_read/out/nml_helper.f90 | 20 +- .../out/nml_optional.f90 | 56 ++-- .../out/nml_required.f90 | 54 ++-- tests/test_cli_config.py | 69 +++++ tests/test_codegen_fortran.py | 97 +++--- tests/test_schema.py | 30 ++ tests/test_validate.py | 4 + 29 files changed, 915 insertions(+), 1008 deletions(-) diff --git a/examples/01_simple/out/nml_helper.f90 b/examples/01_simple/out/nml_helper.f90 index a8d11c0..5ea2d13 100644 --- a/examples/01_simple/out/nml_helper.f90 +++ b/examples/01_simple/out/nml_helper.f90 @@ -3,16 +3,6 @@ !> \file nml_helper.f90 !> \copydoc nml_helper -!> \brief Intrinsic procedures re-exported for collision-safe generated aliases -module nml_helper_intrinsics - implicit none - - intrinsic :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & - shape, size, trim - public :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & - shape, size, trim -end module nml_helper_intrinsics - !> \brief Helper module for namelist file operations !> \version 0.1 module nml_helper @@ -121,7 +111,7 @@ integer function nml_find(this, nml, errmsg) result(status) if (present(errmsg)) errmsg = trim(iomsg) return end if - if (index(to_lower(line), '&' // to_lower(trim(nml))) /= 0) then + if (index(to__lower(line), '&' // to__lower(trim(nml))) /= 0) then status = NML_OK backspace(this%unit) return @@ -150,7 +140,7 @@ 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) + 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') @@ -160,10 +150,10 @@ pure function to_lower(string) result(lower_string) if (k>=upA .and. k<=upZ) k = k + shift lower_string(i:i) = char(k) end do - end function to_lower + end function to__lower !> \brief Validate index bounds for array access - integer function idx_check(idx, extents, field, errmsg) result(status) + integer function idx__check(idx, extents, field, errmsg) result(status) integer, intent(in) :: idx(:) integer, intent(in) :: extents(:) character(len=*), intent(in) :: field @@ -178,6 +168,6 @@ integer function idx_check(idx, extents, field, errmsg) result(status) status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index out of bounds for '" // trim(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 c401782..a24859e 100644 --- a/examples/01_simple/out/nml_optimization.f90 +++ b/examples/01_simple/out/nml_optimization.f90 @@ -21,24 +21,11 @@ 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__dim_default, & NML_ERR_PARTLY_SET - use nml_helper_intrinsics, only: nml__achar => achar - use nml_helper_intrinsics, only: nml__all => all - use nml_helper_intrinsics, only: nml__allocated => allocated - use nml_helper_intrinsics, only: nml__any => any - use nml_helper_intrinsics, only: nml__huge => huge - use nml_helper_intrinsics, only: nml__len => len - use nml_helper_intrinsics, only: nml__len_trim => len_trim - use nml_helper_intrinsics, only: nml__minval => minval - use nml_helper_intrinsics, only: nml__present => present - use nml_helper_intrinsics, only: nml__reshape => reshape - use nml_helper_intrinsics, only: nml__shape => shape - use nml_helper_intrinsics, only: nml__size => size - use nml_helper_intrinsics, only: nml__trim => trim 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 @@ -68,9 +55,6 @@ module nml_optimization real(dp), parameter, public :: mcmc_error_params__min = 0.0_dp private :: nml_optimization_read__from_file - private :: nml__achar, nml__all, nml__allocated, nml__any, nml__huge, nml__len, & - nml__len_trim, nml__minval, nml__present, nml__reshape, nml__shape, nml__size, & - nml__trim private :: nml__ieee_value, nml__ieee_quiet_nan, nml__ieee_is_nan !> \class nml_optimization_data_t @@ -119,15 +103,15 @@ 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 (nml__present(allow_missing)) then + if (present(allow_missing)) then if (allow_missing) then - if (val == nml__achar(0)) then + if (val == achar(0)) then in_enum = .true. return end if end if end if - in_enum = nml__any(nml__trim(val) == method__enum_values) + in_enum = any(trim(val) == method__enum_values) end function method__in_enum !> \brief Check whether a value is part of an enum @@ -135,15 +119,15 @@ elemental logical function try_methods__in_enum(val, allow_missing) result(in_en character(len=*), intent(in) :: val !< value to check logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - if (nml__present(allow_missing)) then + if (present(allow_missing)) then if (allow_missing) then - if (val == nml__achar(0)) then + if (val == achar(0)) then in_enum = .true. return end if end if end if - in_enum = nml__any(nml__trim(val) == try_methods__enum_values) + in_enum = any(trim(val) == try_methods__enum_values) end function try_methods__in_enum !> \brief Check whether a value is part of an enum @@ -151,15 +135,15 @@ elemental logical function complex_sizes__in_enum(val, allow_missing) result(in_ integer(i4), intent(in) :: val !< value to check logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - if (nml__present(allow_missing)) then + if (present(allow_missing)) then if (allow_missing) then - if (val == -nml__huge(val)) then + if (val == -huge(val)) then in_enum = .true. return end if end if end if - in_enum = nml__any(val == complex_sizes__enum_values) + in_enum = any(val == complex_sizes__enum_values) end function complex_sizes__in_enum !> \brief Check whether a value is within bounds @@ -167,9 +151,9 @@ elemental logical function niterations__in_bounds(val, allow_missing) result(in_ integer(i4), intent(in) :: val !< value to check logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - if (nml__present(allow_missing)) then + if (present(allow_missing)) then if (allow_missing) then - if (val == -nml__huge(val)) then + if (val == -huge(val)) then in_bounds = .true. return end if @@ -185,7 +169,7 @@ elemental logical function tolerance__in_bounds(val, allow_missing) result(in_bo real(dp), intent(in) :: val !< value to check logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - if (nml__present(allow_missing)) then + if (present(allow_missing)) then if (allow_missing) then if (nml__ieee_is_nan(val)) then in_bounds = .true. @@ -203,7 +187,7 @@ 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 (nml__present(allow_missing)) then + if (present(allow_missing)) then if (allow_missing) then if (nml__ieee_is_nan(val)) then in_bounds = .true. @@ -221,7 +205,7 @@ elemental logical function mcmc_error_params__in_bounds(val, allow_missing) resu real(dp), intent(in) :: val !< value to check logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - if (nml__present(allow_missing)) then + if (present(allow_missing)) then if (allow_missing) then if (nml__ieee_is_nan(val)) then in_bounds = .true. @@ -240,19 +224,19 @@ integer function nml_optimization_init(nml__obj, errmsg) result(nml__status) character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" nml__obj%is_configured = .false. ! allocate runtime-sized fields - if (nml__allocated(nml__obj%data%mcmc_error_params)) deallocate(nml__obj%data%mcmc_error_params) + 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 - nml__obj%data%name = nml__achar(0) ! sentinel for optional string - nml__obj%data%method = nml__achar(0) ! NULL string as sentinel for required string - nml__obj%data%try_methods = nml__achar(0) ! sentinel for optional string array - nml__obj%data%complex_sizes = -nml__huge(nml__obj%data%complex_sizes) ! sentinel for optional integer array - nml__obj%data%niterations = -nml__huge(nml__obj%data%niterations) ! sentinel for required integer + 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 @@ -272,21 +256,21 @@ integer function nml_optimization_set_dims(nml__obj, & character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" - if (nml__present(max_iter)) then + if (present(errmsg)) errmsg = "" + if (present(max_iter)) then candidate__max_iter = max_iter else candidate__max_iter = max_iter__dim_default end if if (candidate__max_iter <= 0) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "dimension 'max_iter' must be positive" + if (present(errmsg)) errmsg = "dimension 'max_iter' must be positive" return end if nml__obj%dims%max_iter = candidate__max_iter ! deallocate runtime-sized fields; init/set/from_file allocate them again - if (nml__allocated(nml__obj%data%mcmc_error_params)) deallocate(nml__obj%data%mcmc_error_params) + 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 @@ -339,7 +323,7 @@ integer function nml_optimization_read__from_file(nml__obj, nml__file, errmsg) & nml__status = nml__obj%init(errmsg=errmsg) if (nml__status /= NML_OK) return ! allocate local namelist variables matching runtime-sized fields - if (nml__allocated(mcmc_error_params)) deallocate(mcmc_error_params) + if (allocated(mcmc_error_params)) deallocate(mcmc_error_params) allocate(mcmc_error_params(3, 2, nml__obj%dims%max_iter)) name = nml__obj%data%name method = nml__obj%data%method @@ -366,7 +350,7 @@ integer function nml_optimization_read__from_file(nml__obj, nml__file, errmsg) & read(nml__reader%unit, nml=optimization, iostat=nml__iostat, iomsg=nml__iomsg) if (nml__iostat /= 0) then nml__status = NML_ERR_READ - if (nml__present(errmsg)) errmsg = nml__trim(nml__iomsg) + if (present(errmsg)) errmsg = trim(nml__iomsg) nml__close_status = nml__reader%close() return end if @@ -429,56 +413,56 @@ integer function nml_optimization_set(nml__obj, & nml__obj%data%method = method nml__obj%data%niterations = niterations nml__obj%data%tolerance = tolerance - if (nml__size(mcmc_error_params, 1) > nml__size(nml__obj%data%mcmc_error_params, 1)) then + if (size(mcmc_error_params, 1) > size(nml__obj%data%mcmc_error_params, 1)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'mcmc_error_params'" + if (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'mcmc_error_params'" return end if - if (nml__size(mcmc_error_params, 2) > nml__size(nml__obj%data%mcmc_error_params, 2)) then + if (size(mcmc_error_params, 2) > size(nml__obj%data%mcmc_error_params, 2)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "dimension 2 exceeds bounds for 'mcmc_error_params'" + if (present(errmsg)) errmsg = "dimension 2 exceeds bounds for 'mcmc_error_params'" return end if - if (nml__size(mcmc_error_params, 3) > nml__size(nml__obj%data%mcmc_error_params, 3)) then + if (size(mcmc_error_params, 3) > size(nml__obj%data%mcmc_error_params, 3)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "dimension 3 exceeds bounds for 'mcmc_error_params'" + if (present(errmsg)) errmsg = "dimension 3 exceeds bounds for 'mcmc_error_params'" return end if nml__obj%data%mcmc_error_params( & - 1:nml__size(mcmc_error_params, 1), & - 1:nml__size(mcmc_error_params, 2), & - 1:nml__size(mcmc_error_params, 3)) = 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 (nml__present(name)) nml__obj%data%name = name - if (nml__present(try_methods)) then - if (nml__size(try_methods, 1) > nml__size(nml__obj%data%try_methods, 1)) then + if (present(name)) nml__obj%data%name = name + if (present(try_methods)) then + if (size(try_methods, 1) > size(nml__obj%data%try_methods, 1)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'try_methods'" + if (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'try_methods'" return end if nml__obj%data%try_methods( & - 1:nml__size(try_methods, 1)) = try_methods + 1:size(try_methods, 1)) = try_methods end if - if (nml__present(complex_sizes)) then - if (nml__size(complex_sizes, 1) > nml__size(nml__obj%data%complex_sizes, 1)) then + if (present(complex_sizes)) then + if (size(complex_sizes, 1) > size(nml__obj%data%complex_sizes, 1)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'complex_sizes'" + if (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'complex_sizes'" return end if nml__obj%data%complex_sizes( & - 1:nml__size(complex_sizes, 1)) = complex_sizes + 1:size(complex_sizes, 1)) = complex_sizes end if - if (nml__present(seed)) nml__obj%data%seed = seed - if (nml__present(dds_r)) nml__obj%data%dds_r = dds_r - if (nml__present(mcmc_opti)) nml__obj%data%mcmc_opti = mcmc_opti - if (nml__present(include_parameters)) then - if (nml__size(include_parameters, 1) > nml__size(nml__obj%data%include_parameters, 1)) then + 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(nml__obj%data%include_parameters, 1)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'include_parameters'" + if (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'include_parameters'" return end if nml__obj%data%include_parameters( & - 1:nml__size(include_parameters, 1)) = include_parameters + 1:size(include_parameters, 1)) = include_parameters end if ! mark as configured @@ -494,103 +478,103 @@ integer function nml_optimization_is_set(nml__obj, name, idx, errmsg) result(nml character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" if (.not. nml__obj%is_configured) then nml__status = NML_ERR_NOT_SET - if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" + if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(nml__trim(name))) + select case (to__lower(trim(name))) case ("name") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'name'" + if (present(errmsg)) errmsg = "index not supported for 'name'" return end if - if (nml__obj%data%name == nml__achar(0)) nml__status = NML_ERR_NOT_SET + if (nml__obj%data%name == achar(0)) nml__status = NML_ERR_NOT_SET case ("method") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'method'" + if (present(errmsg)) errmsg = "index not supported for 'method'" return end if - if (nml__obj%data%method == nml__achar(0)) nml__status = NML_ERR_NOT_SET + if (nml__obj%data%method == achar(0)) nml__status = NML_ERR_NOT_SET case ("try_methods") - if (nml__present(idx)) then - nml__status = idx_check(idx, nml__shape(nml__obj%data%try_methods), & + if (present(idx)) then + nml__status = idx__check(idx, shape(nml__obj%data%try_methods), & "try_methods", errmsg) if (nml__status /= NML_OK) return - if (nml__obj%data%try_methods(idx(1)) == nml__achar(0)) nml__status = NML_ERR_NOT_SET + if (nml__obj%data%try_methods(idx(1)) == achar(0)) nml__status = NML_ERR_NOT_SET else - if (nml__all(nml__obj%data%try_methods == nml__achar(0))) nml__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 (nml__present(idx)) then - nml__status = idx_check(idx, nml__shape(nml__obj%data%complex_sizes), & + if (present(idx)) then + nml__status = idx__check(idx, shape(nml__obj%data%complex_sizes), & "complex_sizes", errmsg) if (nml__status /= NML_OK) return - if (nml__obj%data%complex_sizes(idx(1)) == -nml__huge(nml__obj%data%complex_sizes(idx(1)))) nml__status = NML_ERR_NOT_SET + if (nml__obj%data%complex_sizes(idx(1)) == -huge(nml__obj%data%complex_sizes(idx(1)))) nml__status = NML_ERR_NOT_SET else - if (nml__all(nml__obj%data%complex_sizes == -nml__huge(nml__obj%data%complex_sizes))) nml__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 (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'niterations'" + if (present(errmsg)) errmsg = "index not supported for 'niterations'" return end if - if (nml__obj%data%niterations == -nml__huge(nml__obj%data%niterations)) nml__status = NML_ERR_NOT_SET + if (nml__obj%data%niterations == -huge(nml__obj%data%niterations)) nml__status = NML_ERR_NOT_SET case ("tolerance") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'tolerance'" + if (present(errmsg)) errmsg = "index not supported for 'tolerance'" return end if if (nml__ieee_is_nan(nml__obj%data%tolerance)) nml__status = NML_ERR_NOT_SET case ("seed") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'seed'" + if (present(errmsg)) errmsg = "index not supported for 'seed'" return end if case ("dds_r") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'dds_r'" + if (present(errmsg)) errmsg = "index not supported for 'dds_r'" return end if case ("mcmc_opti") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'mcmc_opti'" + if (present(errmsg)) errmsg = "index not supported for 'mcmc_opti'" return end if case ("mcmc_error_params") - if (.not. nml__allocated(nml__obj%data%mcmc_error_params)) then + if (.not. allocated(nml__obj%data%mcmc_error_params)) then nml__status = NML_ERR_NOT_SET return end if - if (nml__present(idx)) then - nml__status = idx_check(idx, nml__shape(nml__obj%data%mcmc_error_params), & + if (present(idx)) then + nml__status = idx__check(idx, shape(nml__obj%data%mcmc_error_params), & "mcmc_error_params", errmsg) 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 (nml__all(nml__ieee_is_nan(nml__obj%data%mcmc_error_params))) nml__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 (nml__present(idx)) then - nml__status = idx_check(idx, nml__shape(nml__obj%data%include_parameters), & + if (present(idx)) then + nml__status = idx__check(idx, shape(nml__obj%data%include_parameters), & "include_parameters", errmsg) if (nml__status /= NML_OK) return else end if case default nml__status = NML_ERR_INVALID_NAME - if (nml__present(errmsg)) errmsg = "unknown field: " // nml__trim(name) + if (present(errmsg)) errmsg = "unknown field: " // trim(name) end select - if (nml__status == NML_ERR_NOT_SET .and. nml__present(errmsg)) then - if (nml__len_trim(errmsg) == 0) errmsg = "field not set: " // nml__trim(name) + 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 @@ -604,45 +588,45 @@ integer function nml_optimization_filled_shape(nml__obj, name, filled, errmsg) r integer :: nml__dim nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" - select case (to_lower(nml__trim(name))) + if (present(errmsg)) errmsg = "" + select case (to__lower(trim(name))) case ("mcmc_error_params") - if (nml__size(filled) /= 3) then + if (size(filled) /= 3) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "shape rank mismatch for 'mcmc_error_params'" + if (present(errmsg)) errmsg = "shape rank mismatch for 'mcmc_error_params'" return end if - if (.not. nml__allocated(nml__obj%data%mcmc_error_params)) then + if (.not. allocated(nml__obj%data%mcmc_error_params)) then filled = 0 return end if do nml__dim = 1, 3 - filled(nml__dim) = nml__size(nml__obj%data%mcmc_error_params, nml__dim) + filled(nml__dim) = size(nml__obj%data%mcmc_error_params, nml__dim) end do filled(2) = 0 - do nml__idx = nml__size(nml__obj%data%mcmc_error_params, 2), 1, -1 - if (.not. (nml__all(nml__ieee_is_nan(nml__obj%data%mcmc_error_params(:, nml__idx, :))))) then + 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 nml__idx = nml__size(nml__obj%data%mcmc_error_params, 3), 1, -1 - if (.not. (nml__all(nml__ieee_is_nan(nml__obj%data%mcmc_error_params(:, :, nml__idx))))) then + 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 (nml__minval(filled) > 0) then - if (nml__any(nml__ieee_is_nan(nml__obj%data%mcmc_error_params(:, 1:filled(2), 1:filled(3))))) then + if (minval(filled) > 0) then + 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 (nml__present(errmsg)) errmsg = "array partly set: mcmc_error_params" + if (present(errmsg)) errmsg = "array partly set: mcmc_error_params" return end if end if case default nml__status = NML_ERR_INVALID_NAME - if (nml__present(errmsg)) errmsg = "field is not a flexible array: " // nml__trim(name) + if (present(errmsg)) errmsg = "field is not a flexible array: " // trim(name) end select end function nml_optimization_filled_shape @@ -654,10 +638,10 @@ integer function nml_optimization_is_valid(nml__obj, errmsg) result(nml__status) integer, allocatable :: nml__filled(:) nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" if (.not. nml__obj%is_configured) then nml__status = NML_ERR_NOT_SET - if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" + if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if @@ -665,11 +649,11 @@ integer function nml_optimization_is_valid(nml__obj, errmsg) result(nml__status) nml__istat = nml__obj%is_set("method", errmsg=errmsg) if (nml__istat == NML_ERR_NOT_SET) then nml__status = NML_ERR_REQUIRED - if (nml__present(errmsg)) then - if (nml__len_trim(errmsg) == 0) then + if (present(errmsg)) then + if (len_trim(errmsg) == 0) then errmsg = "field not set: method" end if - errmsg = "required " // nml__trim(errmsg) + errmsg = "required " // trim(errmsg) end if return end if @@ -680,11 +664,11 @@ integer function nml_optimization_is_valid(nml__obj, errmsg) result(nml__status) nml__istat = nml__obj%is_set("niterations", errmsg=errmsg) if (nml__istat == NML_ERR_NOT_SET) then nml__status = NML_ERR_REQUIRED - if (nml__present(errmsg)) then - if (nml__len_trim(errmsg) == 0) then + if (present(errmsg)) then + if (len_trim(errmsg) == 0) then errmsg = "field not set: niterations" end if - errmsg = "required " // nml__trim(errmsg) + errmsg = "required " // trim(errmsg) end if return end if @@ -695,11 +679,11 @@ integer function nml_optimization_is_valid(nml__obj, errmsg) result(nml__status) nml__istat = nml__obj%is_set("tolerance", errmsg=errmsg) if (nml__istat == NML_ERR_NOT_SET) then nml__status = NML_ERR_REQUIRED - if (nml__present(errmsg)) then - if (nml__len_trim(errmsg) == 0) then + if (present(errmsg)) then + if (len_trim(errmsg) == 0) then errmsg = "field not set: tolerance" end if - errmsg = "required " // nml__trim(errmsg) + errmsg = "required " // trim(errmsg) end if return end if @@ -708,14 +692,14 @@ integer function nml_optimization_is_valid(nml__obj, errmsg) result(nml__status) return end if ! flexible arrays - if (nml__allocated(nml__filled)) deallocate(nml__filled) + 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 (nml__present(errmsg)) then - if (nml__len_trim(errmsg) == 0) errmsg = "array partly set: mcmc_error_params" + if (present(errmsg)) then + if (len_trim(errmsg) == 0) errmsg = "array partly set: mcmc_error_params" end if return end if @@ -723,9 +707,9 @@ integer function nml_optimization_is_valid(nml__obj, errmsg) result(nml__status) nml__status = nml__istat return end if - if (nml__minval(nml__filled) == 0) then + if (minval(nml__filled) == 0) then nml__status = NML_ERR_REQUIRED - if (nml__present(errmsg)) errmsg = "required field not set: mcmc_error_params" + if (present(errmsg)) errmsg = "required field not set: mcmc_error_params" return end if ! enum constraints @@ -733,21 +717,21 @@ integer function nml_optimization_is_valid(nml__obj, errmsg) result(nml__status) if (nml__istat == NML_OK) then if (.not. method__in_enum(nml__obj%data%method)) then nml__status = NML_ERR_ENUM - if (nml__present(errmsg)) errmsg = "enum constraint failed: method" + if (present(errmsg)) errmsg = "enum constraint failed: method" return end if else if (nml__istat /= NML_ERR_NOT_SET) then nml__status = nml__istat return end if - if (.not. nml__all(try_methods__in_enum(nml__obj%data%try_methods, allow_missing=.true.))) then + if (.not. all(try_methods__in_enum(nml__obj%data%try_methods, allow_missing=.true.))) then nml__status = NML_ERR_ENUM - if (nml__present(errmsg)) errmsg = "enum constraint failed: try_methods" + if (present(errmsg)) errmsg = "enum constraint failed: try_methods" return end if - if (.not. nml__all(complex_sizes__in_enum(nml__obj%data%complex_sizes, allow_missing=.true.))) then + if (.not. all(complex_sizes__in_enum(nml__obj%data%complex_sizes, allow_missing=.true.))) then nml__status = NML_ERR_ENUM - if (nml__present(errmsg)) errmsg = "enum constraint failed: complex_sizes" + if (present(errmsg)) errmsg = "enum constraint failed: complex_sizes" return end if ! bounds constraints @@ -755,7 +739,7 @@ integer function nml_optimization_is_valid(nml__obj, errmsg) result(nml__status) if (nml__istat == NML_OK) then if (.not. niterations__in_bounds(nml__obj%data%niterations)) then nml__status = NML_ERR_BOUNDS - if (nml__present(errmsg)) errmsg = "bounds constraint failed: niterations" + if (present(errmsg)) errmsg = "bounds constraint failed: niterations" return end if else if (nml__istat /= NML_ERR_NOT_SET) then @@ -766,7 +750,7 @@ integer function nml_optimization_is_valid(nml__obj, errmsg) result(nml__status) if (nml__istat == NML_OK) then if (.not. tolerance__in_bounds(nml__obj%data%tolerance)) then nml__status = NML_ERR_BOUNDS - if (nml__present(errmsg)) errmsg = "bounds constraint failed: tolerance" + if (present(errmsg)) errmsg = "bounds constraint failed: tolerance" return end if else if (nml__istat /= NML_ERR_NOT_SET) then @@ -777,17 +761,17 @@ integer function nml_optimization_is_valid(nml__obj, errmsg) result(nml__status) if (nml__istat == NML_OK) then if (.not. dds_r__in_bounds(nml__obj%data%dds_r)) then nml__status = NML_ERR_BOUNDS - if (nml__present(errmsg)) errmsg = "bounds constraint failed: dds_r" + if (present(errmsg)) errmsg = "bounds constraint failed: dds_r" return end if else if (nml__istat /= NML_ERR_NOT_SET) then nml__status = nml__istat return end if - if (nml__allocated(nml__obj%data%mcmc_error_params)) then - if (.not. nml__all(mcmc_error_params__in_bounds(nml__obj%data%mcmc_error_params, allow_missing=.true.))) then + if (allocated(nml__obj%data%mcmc_error_params)) then + if (.not. all(mcmc_error_params__in_bounds(nml__obj%data%mcmc_error_params, allow_missing=.true.))) then nml__status = NML_ERR_BOUNDS - if (nml__present(errmsg)) errmsg = "bounds constraint failed: mcmc_error_params" + if (present(errmsg)) errmsg = "bounds constraint failed: mcmc_error_params" return end if end if diff --git a/examples/02_pybind/fortran/generated/nml_config.f90 b/examples/02_pybind/fortran/generated/nml_config.f90 index 39c2352..f5938bd 100644 --- a/examples/02_pybind/fortran/generated/nml_config.f90 +++ b/examples/02_pybind/fortran/generated/nml_config.f90 @@ -24,24 +24,11 @@ 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__dim_default - use nml_helper_intrinsics, only: nml__achar => achar - use nml_helper_intrinsics, only: nml__all => all - use nml_helper_intrinsics, only: nml__allocated => allocated - use nml_helper_intrinsics, only: nml__any => any - use nml_helper_intrinsics, only: nml__huge => huge - use nml_helper_intrinsics, only: nml__len => len - use nml_helper_intrinsics, only: nml__len_trim => len_trim - use nml_helper_intrinsics, only: nml__minval => minval - use nml_helper_intrinsics, only: nml__present => present - use nml_helper_intrinsics, only: nml__reshape => reshape - use nml_helper_intrinsics, only: nml__shape => shape - use nml_helper_intrinsics, only: nml__size => size - use nml_helper_intrinsics, only: nml__trim => trim 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 @@ -62,9 +49,6 @@ module nml_config real(dp), parameter, public :: tolerance__min_excl = 0.0_dp private :: nml_config_read__from_file - private :: nml__achar, nml__all, nml__allocated, nml__any, nml__huge, nml__len, & - nml__len_trim, nml__minval, nml__present, nml__reshape, nml__shape, nml__size, & - nml__trim private :: nml__ieee_value, nml__ieee_quiet_nan, nml__ieee_is_nan !> \class nml_config_data_t @@ -110,9 +94,9 @@ elemental logical function iterations__in_bounds(val, allow_missing) result(in_b integer(i4), intent(in) :: val !< value to check logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - if (nml__present(allow_missing)) then + if (present(allow_missing)) then if (allow_missing) then - if (val == -nml__huge(val)) then + if (val == -huge(val)) then in_bounds = .true. return end if @@ -128,7 +112,7 @@ elemental logical function tolerance__in_bounds(val, allow_missing) result(in_bo real(dp), intent(in) :: val !< value to check logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - if (nml__present(allow_missing)) then + if (present(allow_missing)) then if (allow_missing) then if (nml__ieee_is_nan(val)) then in_bounds = .true. @@ -149,11 +133,11 @@ subroutine nml_config_resolve_handle(handle, nml__obj, nml__status, errmsg) character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values type(c_ptr) :: ptr - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" nullify(nml__obj) if (handle == 0_c_intptr_t) then nml__status = NML_ERR_INVALID_HANDLE - if (nml__present(errmsg)) errmsg = "zero handle" + if (present(errmsg)) errmsg = "zero handle" return end if ptr = transfer(handle, c_null_ptr) @@ -167,15 +151,15 @@ integer function nml_config_init(nml__obj, errmsg) result(nml__status) character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" nml__obj%is_configured = .false. ! allocate runtime-sized fields - if (nml__allocated(nml__obj%data%weights)) deallocate(nml__obj%data%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 - nml__obj%data%iterations = -nml__huge(nml__obj%data%iterations) ! sentinel for required integer + 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 nml__obj%data%name = name__default @@ -193,21 +177,21 @@ integer function nml_config_set_dims(nml__obj, & character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" - if (nml__present(n_weights)) then + if (present(errmsg)) errmsg = "" + if (present(n_weights)) then candidate__n_weights = n_weights else candidate__n_weights = n_weights__dim_default end if if (candidate__n_weights <= 0) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "dimension 'n_weights' must be positive" + if (present(errmsg)) errmsg = "dimension 'n_weights' must be positive" return end if nml__obj%dims%n_weights = candidate__n_weights ! deallocate runtime-sized fields; init/set/from_file allocate them again - if (nml__allocated(nml__obj%data%weights)) deallocate(nml__obj%data%weights) + if (allocated(nml__obj%data%weights)) deallocate(nml__obj%data%weights) nml__obj%is_configured = .false. end function nml_config_set_dims @@ -248,7 +232,7 @@ integer function nml_config_read__from_file(nml__obj, nml__file, errmsg) & nml__status = nml__obj%init(errmsg=errmsg) if (nml__status /= NML_OK) return ! allocate local namelist variables matching runtime-sized fields - if (nml__allocated(weights)) deallocate(weights) + if (allocated(weights)) deallocate(weights) allocate(weights(nml__obj%dims%n_weights)) name = nml__obj%data%name iterations = nml__obj%data%iterations @@ -269,7 +253,7 @@ integer function nml_config_read__from_file(nml__obj, nml__file, errmsg) & read(nml__reader%unit, nml=config, iostat=nml__iostat, iomsg=nml__iomsg) if (nml__iostat /= 0) then nml__status = NML_ERR_READ - if (nml__present(errmsg)) errmsg = nml__trim(nml__iomsg) + if (present(errmsg)) errmsg = trim(nml__iomsg) nml__close_status = nml__reader%close() return end if @@ -314,16 +298,16 @@ integer function nml_config_set(nml__obj, & nml__obj%data%iterations = iterations nml__obj%data%tolerance = tolerance ! override with provided values - if (nml__present(name)) nml__obj%data%name = name - if (nml__present(enabled)) nml__obj%data%enabled = enabled - if (nml__present(weights)) then - if (nml__size(weights, 1) > nml__size(nml__obj%data%weights, 1)) then + 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(nml__obj%data%weights, 1)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'weights'" + if (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'weights'" return end if nml__obj%data%weights( & - 1:nml__size(weights, 1)) = weights + 1:size(weights, 1)) = weights end if ! mark as configured @@ -339,56 +323,56 @@ integer function nml_config_is_set(nml__obj, name, idx, errmsg) result(nml__stat character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" if (.not. nml__obj%is_configured) then nml__status = NML_ERR_NOT_SET - if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" + if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(nml__trim(name))) + select case (to__lower(trim(name))) case ("name") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'name'" + if (present(errmsg)) errmsg = "index not supported for 'name'" return end if case ("iterations") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'iterations'" + if (present(errmsg)) errmsg = "index not supported for 'iterations'" return end if - if (nml__obj%data%iterations == -nml__huge(nml__obj%data%iterations)) nml__status = NML_ERR_NOT_SET + if (nml__obj%data%iterations == -huge(nml__obj%data%iterations)) nml__status = NML_ERR_NOT_SET case ("tolerance") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'tolerance'" + if (present(errmsg)) errmsg = "index not supported for 'tolerance'" return end if if (nml__ieee_is_nan(nml__obj%data%tolerance)) nml__status = NML_ERR_NOT_SET case ("enabled") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'enabled'" + if (present(errmsg)) errmsg = "index not supported for 'enabled'" return end if case ("weights") - if (.not. nml__allocated(nml__obj%data%weights)) then + if (.not. allocated(nml__obj%data%weights)) then nml__status = NML_ERR_NOT_SET return end if - if (nml__present(idx)) then - nml__status = idx_check(idx, nml__shape(nml__obj%data%weights), & + if (present(idx)) then + nml__status = idx__check(idx, shape(nml__obj%data%weights), & "weights", errmsg) if (nml__status /= NML_OK) return else end if case default nml__status = NML_ERR_INVALID_NAME - if (nml__present(errmsg)) errmsg = "unknown field: " // nml__trim(name) + if (present(errmsg)) errmsg = "unknown field: " // trim(name) end select - if (nml__status == NML_ERR_NOT_SET .and. nml__present(errmsg)) then - if (nml__len_trim(errmsg) == 0) errmsg = "field not set: " // nml__trim(name) + 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 @@ -399,10 +383,10 @@ integer function nml_config_is_valid(nml__obj, errmsg) result(nml__status) integer :: nml__istat nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" if (.not. nml__obj%is_configured) then nml__status = NML_ERR_NOT_SET - if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" + if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if @@ -410,11 +394,11 @@ integer function nml_config_is_valid(nml__obj, errmsg) result(nml__status) nml__istat = nml__obj%is_set("iterations", errmsg=errmsg) if (nml__istat == NML_ERR_NOT_SET) then nml__status = NML_ERR_REQUIRED - if (nml__present(errmsg)) then - if (nml__len_trim(errmsg) == 0) then + if (present(errmsg)) then + if (len_trim(errmsg) == 0) then errmsg = "field not set: iterations" end if - errmsg = "required " // nml__trim(errmsg) + errmsg = "required " // trim(errmsg) end if return end if @@ -425,11 +409,11 @@ integer function nml_config_is_valid(nml__obj, errmsg) result(nml__status) nml__istat = nml__obj%is_set("tolerance", errmsg=errmsg) if (nml__istat == NML_ERR_NOT_SET) then nml__status = NML_ERR_REQUIRED - if (nml__present(errmsg)) then - if (nml__len_trim(errmsg) == 0) then + if (present(errmsg)) then + if (len_trim(errmsg) == 0) then errmsg = "field not set: tolerance" end if - errmsg = "required " // nml__trim(errmsg) + errmsg = "required " // trim(errmsg) end if return end if @@ -442,7 +426,7 @@ integer function nml_config_is_valid(nml__obj, errmsg) result(nml__status) if (nml__istat == NML_OK) then if (.not. iterations__in_bounds(nml__obj%data%iterations)) then nml__status = NML_ERR_BOUNDS - if (nml__present(errmsg)) errmsg = "bounds constraint failed: iterations" + if (present(errmsg)) errmsg = "bounds constraint failed: iterations" return end if else if (nml__istat /= NML_ERR_NOT_SET) then @@ -453,7 +437,7 @@ integer function nml_config_is_valid(nml__obj, errmsg) result(nml__status) if (nml__istat == NML_OK) then if (.not. tolerance__in_bounds(nml__obj%data%tolerance)) then nml__status = NML_ERR_BOUNDS - if (nml__present(errmsg)) errmsg = "bounds constraint failed: tolerance" + if (present(errmsg)) errmsg = "bounds constraint failed: tolerance" return end if else if (nml__istat /= NML_ERR_NOT_SET) then diff --git a/examples/02_pybind/fortran/generated/nml_helper.f90 b/examples/02_pybind/fortran/generated/nml_helper.f90 index 5333ef5..961befe 100644 --- a/examples/02_pybind/fortran/generated/nml_helper.f90 +++ b/examples/02_pybind/fortran/generated/nml_helper.f90 @@ -1,16 +1,6 @@ !> \file nml_helper.f90 !> \copydoc nml_helper -!> \brief Intrinsic procedures re-exported for collision-safe generated aliases -module nml_helper_intrinsics - implicit none - - intrinsic :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & - shape, size, trim - public :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & - shape, size, trim -end module nml_helper_intrinsics - !> \brief Helper module for namelist file operations module nml_helper @@ -118,7 +108,7 @@ integer function nml_find(this, nml, errmsg) result(status) if (present(errmsg)) errmsg = trim(iomsg) return end if - if (index(to_lower(line), '&' // to_lower(trim(nml))) /= 0) then + if (index(to__lower(line), '&' // to__lower(trim(nml))) /= 0) then status = NML_OK backspace(this%unit) return @@ -147,7 +137,7 @@ 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) + 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') @@ -157,10 +147,10 @@ pure function to_lower(string) result(lower_string) if (k>=upA .and. k<=upZ) k = k + shift lower_string(i:i) = char(k) end do - end function to_lower + end function to__lower !> \brief Validate index bounds for array access - integer function idx_check(idx, extents, field, errmsg) result(status) + integer function idx__check(idx, extents, field, errmsg) result(status) integer, intent(in) :: idx(:) integer, intent(in) :: extents(:) character(len=*), intent(in) :: field @@ -175,6 +165,6 @@ integer function idx_check(idx, extents, field, errmsg) result(status) status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index out of bounds for '" // trim(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 2f9f80c..ce6cd1a 100644 --- a/examples/03_references/out/nml_helper.f90 +++ b/examples/03_references/out/nml_helper.f90 @@ -3,16 +3,6 @@ !> \file nml_helper.f90 !> \copydoc nml_helper -!> \brief Intrinsic procedures re-exported for collision-safe generated aliases -module nml_helper_intrinsics - implicit none - - intrinsic :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & - shape, size, trim - public :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & - shape, size, trim -end module nml_helper_intrinsics - !> \brief Helper module for namelist file operations module nml_helper @@ -120,7 +110,7 @@ integer function nml_find(this, nml, errmsg) result(status) if (present(errmsg)) errmsg = trim(iomsg) return end if - if (index(to_lower(line), '&' // to_lower(trim(nml))) /= 0) then + if (index(to__lower(line), '&' // to__lower(trim(nml))) /= 0) then status = NML_OK backspace(this%unit) return @@ -149,7 +139,7 @@ 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) + 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') @@ -159,10 +149,10 @@ pure function to_lower(string) result(lower_string) if (k>=upA .and. k<=upZ) k = k + shift lower_string(i:i) = char(k) end do - end function to_lower + end function to__lower !> \brief Validate index bounds for array access - integer function idx_check(idx, extents, field, errmsg) result(status) + integer function idx__check(idx, extents, field, errmsg) result(status) integer, intent(in) :: idx(:) integer, intent(in) :: extents(:) character(len=*), intent(in) :: field @@ -177,6 +167,6 @@ integer function idx_check(idx, extents, field, errmsg) result(status) status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index out of bounds for '" // trim(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 c2e0acb..12caa04 100644 --- a/examples/03_references/out/nml_report.f90 +++ b/examples/03_references/out/nml_report.f90 @@ -20,22 +20,9 @@ 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 nml_helper_intrinsics, only: nml__achar => achar - use nml_helper_intrinsics, only: nml__all => all - use nml_helper_intrinsics, only: nml__allocated => allocated - use nml_helper_intrinsics, only: nml__any => any - use nml_helper_intrinsics, only: nml__huge => huge - use nml_helper_intrinsics, only: nml__len => len - use nml_helper_intrinsics, only: nml__len_trim => len_trim - use nml_helper_intrinsics, only: nml__minval => minval - use nml_helper_intrinsics, only: nml__present => present - use nml_helper_intrinsics, only: nml__reshape => reshape - use nml_helper_intrinsics, only: nml__shape => shape - use nml_helper_intrinsics, only: nml__size => size - use nml_helper_intrinsics, only: nml__trim => trim 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 @@ -58,9 +45,6 @@ module nml_report real(dp), parameter, public :: acceptance_fraction__max = 1.0_dp private :: nml_report_read__from_file - private :: nml__achar, nml__all, nml__allocated, nml__any, nml__huge, nml__len, & - nml__len_trim, nml__minval, nml__present, nml__reshape, nml__shape, nml__size, & - nml__trim private :: nml__ieee_value, nml__ieee_quiet_nan, nml__ieee_is_nan !> \class nml_report_data_t @@ -92,15 +76,15 @@ 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 (nml__present(allow_missing)) then + if (present(allow_missing)) then if (allow_missing) then - if (val == -nml__huge(val)) then + if (val == -huge(val)) then in_enum = .true. return end if end if end if - in_enum = nml__any(val == level__enum_values) + in_enum = any(val == level__enum_values) end function level__in_enum !> \brief Check whether a value is within bounds @@ -108,7 +92,7 @@ elemental logical function acceptance_fraction__in_bounds(val, allow_missing) re real(dp), intent(in) :: val !< value to check logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - if (nml__present(allow_missing)) then + if (present(allow_missing)) then if (allow_missing) then if (nml__ieee_is_nan(val)) then in_bounds = .true. @@ -128,7 +112,7 @@ integer function nml_report_init(nml__obj, errmsg) result(nml__status) character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" nml__obj%is_configured = .false. ! default values @@ -196,7 +180,7 @@ integer function nml_report_read__from_file(nml__obj, nml__file, errmsg) & read(nml__reader%unit, nml=report, iostat=nml__iostat, iomsg=nml__iomsg) if (nml__iostat /= 0) then nml__status = NML_ERR_READ - if (nml__present(errmsg)) errmsg = nml__trim(nml__iomsg) + if (present(errmsg)) errmsg = trim(nml__iomsg) nml__close_status = nml__reader%close() return end if @@ -233,9 +217,9 @@ integer function nml_report_set(nml__obj, & ! required parameters ! override with provided values - if (nml__present(label)) nml__obj%data%label = label - if (nml__present(level)) nml__obj%data%level = level - if (nml__present(acceptance_fraction)) nml__obj%data%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 nml__obj%is_configured = .true. @@ -250,37 +234,37 @@ integer function nml_report_is_set(nml__obj, name, idx, errmsg) result(nml__stat character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" if (.not. nml__obj%is_configured) then nml__status = NML_ERR_NOT_SET - if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" + if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(nml__trim(name))) + select case (to__lower(trim(name))) case ("label") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'label'" + if (present(errmsg)) errmsg = "index not supported for 'label'" return end if case ("level") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'level'" + if (present(errmsg)) errmsg = "index not supported for 'level'" return end if case ("acceptance_fraction") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'acceptance_fraction'" + if (present(errmsg)) errmsg = "index not supported for 'acceptance_fraction'" return end if case default nml__status = NML_ERR_INVALID_NAME - if (nml__present(errmsg)) errmsg = "unknown field: " // nml__trim(name) + if (present(errmsg)) errmsg = "unknown field: " // trim(name) end select - if (nml__status == NML_ERR_NOT_SET .and. nml__present(errmsg)) then - if (nml__len_trim(errmsg) == 0) errmsg = "field not set: " // nml__trim(name) + 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 @@ -291,10 +275,10 @@ integer function nml_report_is_valid(nml__obj, errmsg) result(nml__status) integer :: nml__istat nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" if (.not. nml__obj%is_configured) then nml__status = NML_ERR_NOT_SET - if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" + if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if @@ -303,7 +287,7 @@ integer function nml_report_is_valid(nml__obj, errmsg) result(nml__status) if (nml__istat == NML_OK) then if (.not. level__in_enum(nml__obj%data%level)) then nml__status = NML_ERR_ENUM - if (nml__present(errmsg)) errmsg = "enum constraint failed: level" + if (present(errmsg)) errmsg = "enum constraint failed: level" return end if else if (nml__istat /= NML_ERR_NOT_SET) then @@ -315,7 +299,7 @@ integer function nml_report_is_valid(nml__obj, errmsg) result(nml__status) if (nml__istat == NML_OK) then if (.not. acceptance_fraction__in_bounds(nml__obj%data%acceptance_fraction)) then nml__status = NML_ERR_BOUNDS - if (nml__present(errmsg)) errmsg = "bounds constraint failed: acceptance_fraction" + if (present(errmsg)) errmsg = "bounds constraint failed: acceptance_fraction" return end if else if (nml__istat /= NML_ERR_NOT_SET) then diff --git a/examples/03_references/out/nml_run.f90 b/examples/03_references/out/nml_run.f90 index da29b8d..8c0272e 100644 --- a/examples/03_references/out/nml_run.f90 +++ b/examples/03_references/out/nml_run.f90 @@ -20,23 +20,10 @@ 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__dim_default - use nml_helper_intrinsics, only: nml__achar => achar - use nml_helper_intrinsics, only: nml__all => all - use nml_helper_intrinsics, only: nml__allocated => allocated - use nml_helper_intrinsics, only: nml__any => any - use nml_helper_intrinsics, only: nml__huge => huge - use nml_helper_intrinsics, only: nml__len => len - use nml_helper_intrinsics, only: nml__len_trim => len_trim - use nml_helper_intrinsics, only: nml__minval => minval - use nml_helper_intrinsics, only: nml__present => present - use nml_helper_intrinsics, only: nml__reshape => reshape - use nml_helper_intrinsics, only: nml__shape => shape - use nml_helper_intrinsics, only: nml__size => size - use nml_helper_intrinsics, only: nml__trim => trim 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 @@ -64,9 +51,6 @@ module nml_run real(dp), parameter, public :: relaxation__max = 0.5_dp private :: nml_run_read__from_file - private :: nml__achar, nml__all, nml__allocated, nml__any, nml__huge, nml__len, & - nml__len_trim, nml__minval, nml__present, nml__reshape, nml__shape, nml__size, & - nml__trim private :: nml__ieee_value, nml__ieee_quiet_nan, nml__ieee_is_nan !> \class nml_run_data_t @@ -108,15 +92,15 @@ 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 (nml__present(allow_missing)) then + if (present(allow_missing)) then if (allow_missing) then - if (val == nml__achar(0)) then + if (val == achar(0)) then in_enum = .true. return end if end if end if - in_enum = nml__any(nml__trim(val) == method__enum_values) + in_enum = any(trim(val) == method__enum_values) end function method__in_enum !> \brief Check whether a value is within bounds @@ -124,9 +108,9 @@ 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 (nml__present(allow_missing)) then + if (present(allow_missing)) then if (allow_missing) then - if (val == -nml__huge(val)) then + if (val == -huge(val)) then in_bounds = .true. return end if @@ -143,7 +127,7 @@ elemental logical function station_weights__in_bounds(val, allow_missing) result real(dp), intent(in) :: val !< value to check logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - if (nml__present(allow_missing)) then + if (present(allow_missing)) then if (allow_missing) then if (nml__ieee_is_nan(val)) then in_bounds = .true. @@ -161,7 +145,7 @@ elemental logical function relaxation__in_bounds(val, allow_missing) result(in_b real(dp), intent(in) :: val !< value to check logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - if (nml__present(allow_missing)) then + if (present(allow_missing)) then if (allow_missing) then if (nml__ieee_is_nan(val)) then in_bounds = .true. @@ -181,18 +165,18 @@ integer function nml_run_init(nml__obj, errmsg) result(nml__status) character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" nml__obj%is_configured = .false. ! allocate runtime-sized fields - if (nml__allocated(nml__obj%data%station_weights)) deallocate(nml__obj%data%station_weights) + 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 - nml__obj%data%steps = -nml__huge(nml__obj%data%steps) ! sentinel for required integer + nml__obj%data%steps = -huge(nml__obj%data%steps) ! sentinel for required integer ! default values nml__obj%data%label = label__default - nml__obj%data%station_weights = nml__reshape( & + nml__obj%data%station_weights = reshape( & station_weights__default, & shape=[nml__obj%dims%n_stations], & pad=station_weights__default) @@ -210,26 +194,26 @@ integer function nml_run_set_dims(nml__obj, & character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" - if (nml__present(n_stations)) then + if (present(errmsg)) errmsg = "" + if (present(n_stations)) then candidate__n_stations = n_stations else candidate__n_stations = n_stations__dim_default end if if (candidate__n_stations <= 0) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "dimension 'n_stations' must be positive" + if (present(errmsg)) errmsg = "dimension 'n_stations' must be positive" return end if if (candidate__n_stations < 2) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "shape constants for 'station_weights' must allow at least 2 default values" + if (present(errmsg)) errmsg = "shape constants for 'station_weights' must allow at least 2 default values" return end if nml__obj%dims%n_stations = candidate__n_stations ! deallocate runtime-sized fields; init/set/from_file allocate them again - if (nml__allocated(nml__obj%data%station_weights)) deallocate(nml__obj%data%station_weights) + if (allocated(nml__obj%data%station_weights)) deallocate(nml__obj%data%station_weights) nml__obj%is_configured = .false. end function nml_run_set_dims @@ -270,7 +254,7 @@ integer function nml_run_read__from_file(nml__obj, nml__file, errmsg) & nml__status = nml__obj%init(errmsg=errmsg) if (nml__status /= NML_OK) return ! allocate local namelist variables matching runtime-sized fields - if (nml__allocated(station_weights)) deallocate(station_weights) + if (allocated(station_weights)) deallocate(station_weights) allocate(station_weights(nml__obj%dims%n_stations)) label = nml__obj%data%label steps = nml__obj%data%steps @@ -291,7 +275,7 @@ integer function nml_run_read__from_file(nml__obj, nml__file, errmsg) & read(nml__reader%unit, nml=run, iostat=nml__iostat, iomsg=nml__iomsg) if (nml__iostat /= 0) then nml__status = NML_ERR_READ - if (nml__present(errmsg)) errmsg = nml__trim(nml__iomsg) + if (present(errmsg)) errmsg = trim(nml__iomsg) nml__close_status = nml__reader%close() return end if @@ -335,18 +319,18 @@ integer function nml_run_set(nml__obj, & ! required parameters nml__obj%data%steps = steps ! override with provided values - if (nml__present(label)) nml__obj%data%label = label - if (nml__present(station_weights)) then - if (nml__size(station_weights, 1) > nml__size(nml__obj%data%station_weights, 1)) then + if (present(label)) nml__obj%data%label = label + if (present(station_weights)) then + if (size(station_weights, 1) > size(nml__obj%data%station_weights, 1)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'station_weights'" + if (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'station_weights'" return end if nml__obj%data%station_weights( & - 1:nml__size(station_weights, 1)) = station_weights + 1:size(station_weights, 1)) = station_weights end if - if (nml__present(method)) nml__obj%data%method = method - if (nml__present(relaxation)) nml__obj%data%relaxation = relaxation + if (present(method)) nml__obj%data%method = method + if (present(relaxation)) nml__obj%data%relaxation = relaxation ! mark as configured nml__obj%is_configured = .true. @@ -361,55 +345,55 @@ integer function nml_run_is_set(nml__obj, name, idx, errmsg) result(nml__status) character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" if (.not. nml__obj%is_configured) then nml__status = NML_ERR_NOT_SET - if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" + if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(nml__trim(name))) + select case (to__lower(trim(name))) case ("label") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'label'" + if (present(errmsg)) errmsg = "index not supported for 'label'" return end if case ("steps") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'steps'" + if (present(errmsg)) errmsg = "index not supported for 'steps'" return end if - if (nml__obj%data%steps == -nml__huge(nml__obj%data%steps)) nml__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. nml__allocated(nml__obj%data%station_weights)) then + if (.not. allocated(nml__obj%data%station_weights)) then nml__status = NML_ERR_NOT_SET return end if - if (nml__present(idx)) then - nml__status = idx_check(idx, nml__shape(nml__obj%data%station_weights), & + if (present(idx)) then + nml__status = idx__check(idx, shape(nml__obj%data%station_weights), & "station_weights", errmsg) if (nml__status /= NML_OK) return else end if case ("method") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'method'" + if (present(errmsg)) errmsg = "index not supported for 'method'" return end if case ("relaxation") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'relaxation'" + if (present(errmsg)) errmsg = "index not supported for 'relaxation'" return end if case default nml__status = NML_ERR_INVALID_NAME - if (nml__present(errmsg)) errmsg = "unknown field: " // nml__trim(name) + if (present(errmsg)) errmsg = "unknown field: " // trim(name) end select - if (nml__status == NML_ERR_NOT_SET .and. nml__present(errmsg)) then - if (nml__len_trim(errmsg) == 0) errmsg = "field not set: " // nml__trim(name) + 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 @@ -420,10 +404,10 @@ integer function nml_run_is_valid(nml__obj, errmsg) result(nml__status) integer :: nml__istat nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" if (.not. nml__obj%is_configured) then nml__status = NML_ERR_NOT_SET - if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" + if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if @@ -431,11 +415,11 @@ integer function nml_run_is_valid(nml__obj, errmsg) result(nml__status) nml__istat = nml__obj%is_set("steps", errmsg=errmsg) if (nml__istat == NML_ERR_NOT_SET) then nml__status = NML_ERR_REQUIRED - if (nml__present(errmsg)) then - if (nml__len_trim(errmsg) == 0) then + if (present(errmsg)) then + if (len_trim(errmsg) == 0) then errmsg = "field not set: steps" end if - errmsg = "required " // nml__trim(errmsg) + errmsg = "required " // trim(errmsg) end if return end if @@ -448,7 +432,7 @@ integer function nml_run_is_valid(nml__obj, errmsg) result(nml__status) if (nml__istat == NML_OK) then if (.not. method__in_enum(nml__obj%data%method)) then nml__status = NML_ERR_ENUM - if (nml__present(errmsg)) errmsg = "enum constraint failed: method" + if (present(errmsg)) errmsg = "enum constraint failed: method" return end if else if (nml__istat /= NML_ERR_NOT_SET) then @@ -460,17 +444,17 @@ integer function nml_run_is_valid(nml__obj, errmsg) result(nml__status) if (nml__istat == NML_OK) then if (.not. steps__in_bounds(nml__obj%data%steps)) then nml__status = NML_ERR_BOUNDS - if (nml__present(errmsg)) errmsg = "bounds constraint failed: steps" + if (present(errmsg)) errmsg = "bounds constraint failed: steps" return end if else if (nml__istat /= NML_ERR_NOT_SET) then nml__status = nml__istat return end if - if (nml__allocated(nml__obj%data%station_weights)) then - if (.not. nml__all(station_weights__in_bounds(nml__obj%data%station_weights, allow_missing=.true.))) then + if (allocated(nml__obj%data%station_weights)) then + if (.not. all(station_weights__in_bounds(nml__obj%data%station_weights, allow_missing=.true.))) then nml__status = NML_ERR_BOUNDS - if (nml__present(errmsg)) errmsg = "bounds constraint failed: station_weights" + if (present(errmsg)) errmsg = "bounds constraint failed: station_weights" return end if end if @@ -478,7 +462,7 @@ integer function nml_run_is_valid(nml__obj, errmsg) result(nml__status) if (nml__istat == NML_OK) then if (.not. relaxation__in_bounds(nml__obj%data%relaxation)) then nml__status = NML_ERR_BOUNDS - if (nml__present(errmsg)) errmsg = "bounds constraint failed: relaxation" + if (present(errmsg)) errmsg = "bounds constraint failed: relaxation" return end if else if (nml__istat /= NML_ERR_NOT_SET) then diff --git a/examples/04_derived_types/fortran/generated/nml_helper.f90 b/examples/04_derived_types/fortran/generated/nml_helper.f90 index 22efcae..ff757c4 100644 --- a/examples/04_derived_types/fortran/generated/nml_helper.f90 +++ b/examples/04_derived_types/fortran/generated/nml_helper.f90 @@ -1,16 +1,6 @@ !> \file nml_helper.f90 !> \copydoc nml_helper -!> \brief Intrinsic procedures re-exported for collision-safe generated aliases -module nml_helper_intrinsics - implicit none - - intrinsic :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & - shape, size, trim - public :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & - shape, size, trim -end module nml_helper_intrinsics - !> \brief Helper module for namelist file operations module nml_helper ! kind specifiers used by locally generated derived types @@ -131,7 +121,7 @@ integer function nml_find(this, nml, errmsg) result(status) if (present(errmsg)) errmsg = trim(iomsg) return end if - if (index(to_lower(line), '&' // to_lower(trim(nml))) /= 0) then + if (index(to__lower(line), '&' // to__lower(trim(nml))) /= 0) then status = NML_OK backspace(this%unit) return @@ -160,7 +150,7 @@ 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) + 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') @@ -170,10 +160,10 @@ pure function to_lower(string) result(lower_string) if (k>=upA .and. k<=upZ) k = k + shift lower_string(i:i) = char(k) end do - end function to_lower + end function to__lower !> \brief Validate index bounds for array access - integer function idx_check(idx, extents, field, errmsg) result(status) + integer function idx__check(idx, extents, field, errmsg) result(status) integer, intent(in) :: idx(:) integer, intent(in) :: extents(:) character(len=*), intent(in) :: field @@ -188,6 +178,6 @@ integer function idx_check(idx, extents, field, errmsg) result(status) status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index out of bounds for '" // trim(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 bab1179..5a16625 100644 --- a/examples/04_derived_types/fortran/generated/nml_run.f90 +++ b/examples/04_derived_types/fortran/generated/nml_run.f90 @@ -20,26 +20,13 @@ 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__dim_default, & station_label_len - use nml_helper_intrinsics, only: nml__achar => achar - use nml_helper_intrinsics, only: nml__all => all - use nml_helper_intrinsics, only: nml__allocated => allocated - use nml_helper_intrinsics, only: nml__any => any - use nml_helper_intrinsics, only: nml__huge => huge - use nml_helper_intrinsics, only: nml__len => len - use nml_helper_intrinsics, only: nml__len_trim => len_trim - use nml_helper_intrinsics, only: nml__minval => minval - use nml_helper_intrinsics, only: nml__present => present - use nml_helper_intrinsics, only: nml__reshape => reshape - use nml_helper_intrinsics, only: nml__shape => shape - use nml_helper_intrinsics, only: nml__size => size - use nml_helper_intrinsics, only: nml__trim => trim ! kind specifiers listed in the nml-tools configuration file use iso_fortran_env, only: & i4=>int32 @@ -56,9 +43,6 @@ module nml_run integer(i4), parameter, public :: station__code__min = 1_i4 private :: nml_run_read__from_file - private :: nml__achar, nml__all, nml__allocated, nml__any, nml__huge, nml__len, & - nml__len_trim, nml__minval, nml__present, nml__reshape, nml__shape, nml__size, & - nml__trim !> \class nml_run_data_t !> \brief Schema-backed values for run @@ -98,9 +82,9 @@ elemental logical function period__start_year__in_bounds(val, allow_missing) res integer(i4), intent(in) :: val !< value to check logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - if (nml__present(allow_missing)) then + if (present(allow_missing)) then if (allow_missing) then - if (val == -nml__huge(val)) then + if (val == -huge(val)) then in_bounds = .true. return end if @@ -117,9 +101,9 @@ elemental logical function periods__start_year__in_bounds(val, allow_missing) re integer(i4), intent(in) :: val !< value to check logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - if (nml__present(allow_missing)) then + if (present(allow_missing)) then if (allow_missing) then - if (val == -nml__huge(val)) then + if (val == -huge(val)) then in_bounds = .true. return end if @@ -136,9 +120,9 @@ elemental logical function station__code__in_bounds(val, allow_missing) result(i integer(i4), intent(in) :: val !< value to check logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - if (nml__present(allow_missing)) then + if (present(allow_missing)) then if (allow_missing) then - if (val == -nml__huge(val)) then + if (val == -huge(val)) then in_bounds = .true. return end if @@ -157,11 +141,11 @@ subroutine nml_run_resolve_handle(handle, nml__obj, nml__status, errmsg) character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values type(c_ptr) :: ptr - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" nullify(nml__obj) if (handle == 0_c_intptr_t) then nml__status = NML_ERR_INVALID_HANDLE - if (nml__present(errmsg)) errmsg = "zero handle" + if (present(errmsg)) errmsg = "zero handle" return end if ptr = transfer(handle, c_null_ptr) @@ -175,7 +159,7 @@ integer function nml_run_init(nml__obj, errmsg) result(nml__status) character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" nml__obj%is_configured = .false. ! derived values @@ -200,27 +184,27 @@ integer function nml_run_init_type(nml__obj, & character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" - if (nml__present(period)) then - period%start_year = -nml__huge(period%start_year) ! sentinel for derived component start_year - period%end_year = -nml__huge(period%end_year) ! sentinel for derived component end_year + if (present(errmsg)) errmsg = "" + if (present(period)) then + period%start_year = -huge(period%start_year) ! sentinel for derived component start_year + period%end_year = -huge(period%end_year) ! sentinel for derived component end_year period%label = "main" period%start_year = 2000_i4 end if - if (nml__present(periods)) then - if (nml__allocated(periods)) deallocate(periods) + if (present(periods)) then + if (allocated(periods)) deallocate(periods) allocate(periods(nml__obj%dims%n_periods)) - periods%start_year = -nml__huge(periods%start_year) ! sentinel for derived component start_year - periods%end_year = -nml__huge(periods%end_year) ! sentinel for derived component end_year + 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" periods%start_year = 1980_i4 periods%end_year = 1999_i4 end if - if (nml__present(station)) then - station%code = -nml__huge(station%code) ! sentinel for derived component code - if (nml__len(station%label) /= station_label_len) then + if (present(station)) then + station%code = -huge(station%code) ! sentinel for derived component code + if (len(station%label) /= station_label_len) then nml__status = NML_ERR_BOUNDS - if (nml__present(errmsg)) errmsg = "imported string storage length mismatch: station%label" + if (present(errmsg)) errmsg = "imported string storage length mismatch: station%label" return end if station%label = "unknown" @@ -237,21 +221,21 @@ integer function nml_run_set_dims(nml__obj, & character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" - if (nml__present(n_periods)) then + if (present(errmsg)) errmsg = "" + if (present(n_periods)) then candidate__n_periods = n_periods else candidate__n_periods = n_periods__dim_default end if if (candidate__n_periods <= 0) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "dimension 'n_periods' must be positive" + if (present(errmsg)) errmsg = "dimension 'n_periods' must be positive" return end if nml__obj%dims%n_periods = candidate__n_periods ! deallocate runtime-sized fields; init/set/from_file allocate them again - if (nml__allocated(nml__obj%data%periods)) deallocate(nml__obj%data%periods) + if (allocated(nml__obj%data%periods)) deallocate(nml__obj%data%periods) nml__obj%is_configured = .false. end function nml_run_set_dims @@ -288,7 +272,7 @@ integer function nml_run_read__from_file(nml__obj, nml__file, errmsg) & nml__status = nml__obj%init(errmsg=errmsg) if (nml__status /= NML_OK) return ! allocate local namelist variables matching runtime-sized fields - if (nml__allocated(periods)) deallocate(periods) + if (allocated(periods)) deallocate(periods) allocate(periods(nml__obj%dims%n_periods)) period = nml__obj%data%period periods = nml__obj%data%periods @@ -307,7 +291,7 @@ integer function nml_run_read__from_file(nml__obj, nml__file, errmsg) & read(nml__reader%unit, nml=run, iostat=nml__iostat, iomsg=nml__iomsg) if (nml__iostat /= 0) then nml__status = NML_ERR_READ - if (nml__present(errmsg)) errmsg = nml__trim(nml__iomsg) + if (present(errmsg)) errmsg = trim(nml__iomsg) nml__close_status = nml__reader%close() return end if @@ -346,14 +330,14 @@ integer function nml_run_set(nml__obj, & nml__obj%data%period = period nml__obj%data%station = station ! override with provided values - if (nml__present(periods)) then - if (nml__size(periods, 1) > nml__size(nml__obj%data%periods, 1)) then + if (present(periods)) then + if (size(periods, 1) > size(nml__obj%data%periods, 1)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'periods'" + if (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'periods'" return end if nml__obj%data%periods( & - 1:nml__size(periods, 1)) = periods + 1:size(periods, 1)) = periods end if ! mark as configured @@ -369,109 +353,109 @@ integer function nml_run_is_set(nml__obj, name, idx, errmsg) result(nml__status) character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" if (.not. nml__obj%is_configured) then nml__status = NML_ERR_NOT_SET - if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" + if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(nml__trim(name))) + select case (to__lower(trim(name))) case ("period%start_year") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'period'" + if (present(errmsg)) errmsg = "index not supported for 'period'" return end if case ("period%end_year") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'period'" + if (present(errmsg)) errmsg = "index not supported for 'period'" return end if - if (nml__obj%data%period%end_year == -nml__huge(nml__obj%data%period%end_year)) nml__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 (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'period'" + if (present(errmsg)) errmsg = "index not supported for 'period'" return end if case ("period") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'period'" + if (present(errmsg)) errmsg = "index not supported for 'period'" return end if - if (nml__obj%data%period%end_year == -nml__huge(nml__obj%data%period%end_year)) then + 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. nml__allocated(nml__obj%data%periods)) then + if (.not. allocated(nml__obj%data%periods)) then nml__status = NML_ERR_NOT_SET return end if - if (nml__present(idx)) then - nml__status = idx_check(idx, nml__shape(nml__obj%data%periods), & + if (present(idx)) then + nml__status = idx__check(idx, shape(nml__obj%data%periods), & "periods", errmsg) if (nml__status /= NML_OK) return end if case ("periods%end_year") - if (.not. nml__allocated(nml__obj%data%periods)) then + if (.not. allocated(nml__obj%data%periods)) then nml__status = NML_ERR_NOT_SET return end if - if (nml__present(idx)) then - nml__status = idx_check(idx, nml__shape(nml__obj%data%periods), & + if (present(idx)) then + nml__status = idx__check(idx, shape(nml__obj%data%periods), & "periods", errmsg) if (nml__status /= NML_OK) return end if case ("periods%label") - if (.not. nml__allocated(nml__obj%data%periods)) then + if (.not. allocated(nml__obj%data%periods)) then nml__status = NML_ERR_NOT_SET return end if - if (nml__present(idx)) then - nml__status = idx_check(idx, nml__shape(nml__obj%data%periods), & + if (present(idx)) then + nml__status = idx__check(idx, shape(nml__obj%data%periods), & "periods", errmsg) if (nml__status /= NML_OK) return end if case ("periods") - if (.not. nml__allocated(nml__obj%data%periods)) then + if (.not. allocated(nml__obj%data%periods)) then nml__status = NML_ERR_NOT_SET return end if - if (nml__present(idx)) then - nml__status = idx_check(idx, nml__shape(nml__obj%data%periods), & + if (present(idx)) then + nml__status = idx__check(idx, shape(nml__obj%data%periods), & "periods", errmsg) if (nml__status /= NML_OK) return end if case ("station%code") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'station'" + if (present(errmsg)) errmsg = "index not supported for 'station'" return end if - if (nml__obj%data%station%code == -nml__huge(nml__obj%data%station%code)) nml__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 (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'station'" + if (present(errmsg)) errmsg = "index not supported for 'station'" return end if case ("station") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'station'" + if (present(errmsg)) errmsg = "index not supported for 'station'" return end if - if (nml__obj%data%station%code == -nml__huge(nml__obj%data%station%code)) then + if (nml__obj%data%station%code == -huge(nml__obj%data%station%code)) then nml__status = NML_ERR_NOT_SET end if case default nml__status = NML_ERR_INVALID_NAME - if (nml__present(errmsg)) errmsg = "unknown field: " // nml__trim(name) + if (present(errmsg)) errmsg = "unknown field: " // trim(name) end select - if (nml__status == NML_ERR_NOT_SET .and. nml__present(errmsg)) then - if (nml__len_trim(errmsg) == 0) errmsg = "field not set: " // nml__trim(name) + 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 @@ -482,10 +466,10 @@ integer function nml_run_is_valid(nml__obj, errmsg) result(nml__status) integer :: nml__istat nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" if (.not. nml__obj%is_configured) then nml__status = NML_ERR_NOT_SET - if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" + if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if @@ -493,11 +477,11 @@ integer function nml_run_is_valid(nml__obj, errmsg) result(nml__status) nml__istat = nml__obj%is_set("period", errmsg=errmsg) if (nml__istat == NML_ERR_NOT_SET) then nml__status = NML_ERR_REQUIRED - if (nml__present(errmsg)) then - if (nml__len_trim(errmsg) == 0) then + if (present(errmsg)) then + if (len_trim(errmsg) == 0) then errmsg = "field not set: period" end if - errmsg = "required " // nml__trim(errmsg) + errmsg = "required " // trim(errmsg) end if return end if @@ -508,11 +492,11 @@ integer function nml_run_is_valid(nml__obj, errmsg) result(nml__status) nml__istat = nml__obj%is_set("station", errmsg=errmsg) if (nml__istat == NML_ERR_NOT_SET) then nml__status = NML_ERR_REQUIRED - if (nml__present(errmsg)) then - if (nml__len_trim(errmsg) == 0) then + if (present(errmsg)) then + if (len_trim(errmsg) == 0) then errmsg = "field not set: station" end if - errmsg = "required " // nml__trim(errmsg) + errmsg = "required " // trim(errmsg) end if return end if @@ -525,17 +509,17 @@ integer function nml_run_is_valid(nml__obj, errmsg) result(nml__status) 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 (nml__present(errmsg)) errmsg = "bounds constraint failed: period%start_year" + if (present(errmsg)) errmsg = "bounds constraint failed: period%start_year" return end if else if (nml__istat /= NML_ERR_NOT_SET) then nml__status = nml__istat return end if - if (nml__allocated(nml__obj%data%periods)) then - if (.not. nml__all(periods__start_year__in_bounds(nml__obj%data%periods%start_year, allow_missing=.true.))) then + if (allocated(nml__obj%data%periods)) then + if (.not. all(periods__start_year__in_bounds(nml__obj%data%periods%start_year, allow_missing=.true.))) then nml__status = NML_ERR_BOUNDS - if (nml__present(errmsg)) errmsg = "bounds constraint failed: periods%start_year" + if (present(errmsg)) errmsg = "bounds constraint failed: periods%start_year" return end if end if @@ -543,7 +527,7 @@ integer function nml_run_is_valid(nml__obj, errmsg) result(nml__status) if (nml__istat == NML_OK) then if (.not. station__code__in_bounds(nml__obj%data%station%code)) then nml__status = NML_ERR_BOUNDS - if (nml__present(errmsg)) errmsg = "bounds constraint failed: station%code" + if (present(errmsg)) errmsg = "bounds constraint failed: station%code" return end if else if (nml__istat /= NML_ERR_NOT_SET) then diff --git a/src/nml_tools/_utils.py b/src/nml_tools/_utils.py index 5a8d829..d905578 100644 --- a/src/nml_tools/_utils.py +++ b/src/nml_tools/_utils.py @@ -8,6 +8,49 @@ 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", + "trim", + } +) +GENERATED_HELPER_IDENTIFIERS = frozenset( + { + "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_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: @@ -31,6 +74,16 @@ def validate_namelist_identifier(name: str, *, label: str) -> None: 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") + validate_generated_fortran_identifier(name, label=label) + + +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 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: @@ -52,6 +105,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") diff --git a/src/nml_tools/cli.py b/src/nml_tools/cli.py index c377e11..a73f90e 100644 --- a/src/nml_tools/cli.py +++ b/src/nml_tools/cli.py @@ -19,6 +19,7 @@ from ._namelist_parser import NamelistSyntaxError, ParsedFile, ParsedGroup, parse_namelist from ._utils import ( constant_dimension_overlap, + validate_generated_fortran_identifier, validate_namelist_identifier, validate_user_fortran_identifier, ) @@ -83,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) @@ -343,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", []) @@ -433,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() @@ -1084,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)) @@ -1458,6 +1470,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: diff --git a/src/nml_tools/codegen_fortran.py b/src/nml_tools/codegen_fortran.py index dde180c..5b8c2ea 100644 --- a/src/nml_tools/codegen_fortran.py +++ b/src/nml_tools/codegen_fortran.py @@ -15,6 +15,7 @@ normalize_runtime_dimensions, reject_constant_dimension_overlap, strip_trailing_whitespace, + validate_generated_fortran_identifier, validate_namelist_identifier, validate_user_fortran_identifier, ) @@ -395,6 +396,7 @@ def _build_context( bounds_functions: list[dict[str, Any]] = [] bounds_checks: list[dict[str, Any]] = [] derived_type_imports: list[dict[str, str]] = [] + derived_type_scope_names: set[str] = set() derived_init_type_fields: list[dict[str, Any]] = [] derived_presence_blocks: list[str] = [] static_constants = normalize_constant_values(constants) @@ -431,23 +433,8 @@ def _build_context( "NML_ERR_NOT_SET", "NML_ERR_INVALID_NAME", "NML_ERR_INVALID_INDEX", - "idx_check", - "to_lower", - ] - helper_intrinsic_imports = [ - "nml__achar => achar", - "nml__all => all", - "nml__allocated => allocated", - "nml__any => any", - "nml__huge => huge", - "nml__len => len", - "nml__len_trim => len_trim", - "nml__minval => minval", - "nml__present => present", - "nml__reshape => reshape", - "nml__shape => shape", - "nml__size => size", - "nml__trim => trim", + "idx__check", + "to__lower", ] if f2py_handle_helpers: helper_imports.append("NML_ERR_INVALID_HANDLE") @@ -610,6 +597,7 @@ def _register_runtime_dimension(dim_name: str) -> str: requires_input = requirement.requires_input if derived is not None: derived_type_name = _derived_type_name(derived) + derived_type_scope_names.add(derived_type_name.lower()) module = derived.get("x-fortran-module") if module is None: _add_helper_import(derived_type_name) @@ -658,9 +646,9 @@ def _register_runtime_dimension(dim_name: str) -> str: ) init_lines.extend( [ - f"if (nml__len({arg_target}) /= {expected_len}) then", + f"if (len({arg_target}) /= {expected_len}) then", " nml__status = NML_ERR_BOUNDS", - " if (nml__present(errmsg)) " + " if (present(errmsg)) " f'errmsg = "{storage_message}"', " return", "end if", @@ -874,11 +862,11 @@ def _register_runtime_dimension(dim_name: str) -> str: 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 (nml__present({name})) then\n{indented_block}\nend if" + f"if (present({name})) then\n{indented_block}\nend if" ) else: set_present_assignment = ( - f"if (nml__present({name})) {_data_ref(name)} = {name}" + f"if (present({name})) {_data_ref(name)} = {name}" ) init_argument_declaration = _render_argument_declaration( @@ -896,7 +884,7 @@ def _register_runtime_dimension(dim_name: str) -> str: ", allocatable, intent(inout), optional", ) allocation_lines.append( - f"if (nml__allocated({name})) deallocate({name})" + f"if (allocated({name})) deallocate({name})" ) dims = ", ".join(runtime_shape) allocation_lines.append(f"allocate({name}({dims}))") @@ -1076,7 +1064,7 @@ def _register_runtime_dimension(dim_name: str) -> str: len_ref=_data_ref(name), ) slice_missing_conditions.append( - f"nml__all({slice_missing_expr})" + f"all({slice_missing_expr})" if rank > 1 else slice_missing_expr ) @@ -1087,7 +1075,7 @@ def _register_runtime_dimension(dim_name: str) -> str: var_ref=prefix_ref, len_ref=_data_ref(name), ) - prefix_any_missing_condition = f"nml__any({prefix_missing_expr})" + prefix_any_missing_condition = f"any({prefix_missing_expr})" flex_arrays.append( { "name": name, @@ -1434,11 +1422,11 @@ def _register_runtime_dimension(dim_name: str) -> str: ) indented_block = "\n".join(f" {line}" for line in block.splitlines()) set_present_assignment = ( - f"if (nml__present({name})) then\n{indented_block}\nend if" + f"if (present({name})) then\n{indented_block}\nend if" ) else: set_present_assignment = ( - f"if (nml__present({name})) {_data_ref(name)} = {name}" + f"if (present({name})) {_data_ref(name)} = {name}" ) else: set_present_assignment = None @@ -1523,6 +1511,13 @@ 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") + root_scope_names = set(property_name_map) | set(runtime_dimension_values) + type_name_collisions = sorted(derived_type_scope_names & root_scope_names) + if type_name_collisions: + raise ValueError( + "derived type name conflicts with a root property or runtime dimension: " + + ", ".join(type_name_collisions) + ) 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] = [] @@ -1682,9 +1677,7 @@ def _register_runtime_dimension(dim_name: str) -> str: "kind_imports": resolved_kind_imports, "use_ieee": requires_ieee, "helper_module": helper_module, - "helper_intrinsic_module": f"{helper_module}_intrinsics", "helper_imports": helper_imports, - "helper_intrinsic_imports": helper_intrinsic_imports, "presence_cases": presence_cases, "data_type_name": data_type_name, "dims_type_name": dims_type_name, @@ -1730,7 +1723,7 @@ def array_prefix(lines: list[str]) -> None: if runtime_array: lines.extend( [ - f" if (.not. nml__allocated({_data_ref(name)})) then", + f" if (.not. allocated({_data_ref(name)})) then", " nml__status = NML_ERR_NOT_SET", " return", " end if", @@ -1744,8 +1737,8 @@ def array_prefix(lines: list[str]) -> None: array_prefix(lines) lines.extend( [ - " if (nml__present(idx)) then", - f" nml__status = idx_check(idx, nml__shape({_data_ref(name)}), &", + " if (present(idx)) then", + f" nml__status = idx__check(idx, shape({_data_ref(name)}), &", f' "{display_name}", errmsg)', " if (nml__status /= NML_OK) return", ] @@ -1759,15 +1752,15 @@ def array_prefix(lines: list[str]) -> None: if condition is not None: lines.append(" else") lines.append( - f" if (nml__all({condition})) nml__status = NML_ERR_NOT_SET" + f" if (all({condition})) nml__status = NML_ERR_NOT_SET" ) lines.append(" end if") else: lines.extend( [ - " if (nml__present(idx)) then", + " if (present(idx)) then", " nml__status = NML_ERR_INVALID_INDEX", - " if (nml__present(errmsg)) " + " if (present(errmsg)) " f'errmsg = "index not supported for \'{display_name}\'"', " return", " end if", @@ -1788,8 +1781,8 @@ def array_prefix(lines: list[str]) -> None: array_prefix(lines) lines.extend( [ - " if (nml__present(idx)) then", - f" nml__status = idx_check(idx, nml__shape({_data_ref(name)}), &", + " if (present(idx)) then", + f" nml__status = idx__check(idx, shape({_data_ref(name)}), &", f' "{display_name}", errmsg)', " if (nml__status /= NML_OK) return", ] @@ -1821,7 +1814,7 @@ def array_prefix(lines: list[str]) -> None: lines.append(" else") append_condition( lines, - prefix=" if (nml__all(", + prefix=" if (all(", conditions=aggregate_conditions, operator=".and.", suffix=")) then", @@ -1830,7 +1823,7 @@ def array_prefix(lines: list[str]) -> None: if required_conditions and (len(aggregate_conditions) > 1 or is_array): append_condition( lines, - prefix=" else if (nml__any(", + prefix=" else if (any(", conditions=aggregate_conditions, operator=".or.", suffix=")) then", @@ -1841,9 +1834,9 @@ def array_prefix(lines: list[str]) -> None: else: lines.extend( [ - " if (nml__present(idx)) then", + " if (present(idx)) then", " nml__status = NML_ERR_INVALID_INDEX", - " if (nml__present(errmsg)) " + " if (present(errmsg)) " f'errmsg = "index not supported for \'{display_name}\'"', " return", " end if", @@ -1908,6 +1901,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] @@ -2009,6 +2004,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 @@ -2306,7 +2302,7 @@ def _render_runtime_allocations( if any(dim == ":" for dim in runtime_dimensions): raise ValueError("runtime-sized arrays do not support deferred-size dimensions") - lines.append(f"if (nml__allocated({target_ref})) deallocate({target_ref})") + lines.append(f"if (allocated({target_ref})) deallocate({target_ref})") dims_expr = ", ".join(runtime_dimensions) if type_info.element_category == "string" and runtime_length_expr is not None: lines.append(f"allocate(character(len={runtime_length_expr}) :: {target_ref}({dims_expr}))") @@ -2317,7 +2313,7 @@ def _render_runtime_allocations( def _render_runtime_deallocations(name: str, *, target_prefix: str = "") -> list[str]: target_ref = f"{target_prefix}{name}" - return [f"if (nml__allocated({target_ref})) deallocate({target_ref})"] + return [f"if (allocated({target_ref})) deallocate({target_ref})"] def _render_runtime_local_allocations( @@ -2433,26 +2429,26 @@ def _sentinel_expressions( if category == "array": element = type_info.element_category if element == "string": - return "nml__achar(0)", f"nml__all({var_ref} == nml__achar(0))", False + return "achar(0)", f"all({var_ref} == achar(0))", False if element == "integer": return ( - f"-nml__huge({var_ref})", - f"nml__all({var_ref} == -nml__huge({var_ref}))", + f"-huge({var_ref})", + f"all({var_ref} == -huge({var_ref}))", False, ) if element == "real": return ( f"nml__ieee_value({var_ref}, nml__ieee_quiet_nan)", - f"nml__all(nml__ieee_is_nan({var_ref}))", + f"all(nml__ieee_is_nan({var_ref}))", True, ) if element == "boolean": raise ValueError("boolean arrays cannot use sentinels") raise ValueError(f"unsupported sentinel array element '{element}'") if category == "string": - return "nml__achar(0)", f"{var_ref} == nml__achar(0)", False + return "achar(0)", f"{var_ref} == achar(0)", False if category == "integer": - return f"-nml__huge({var_ref})", f"{var_ref} == -nml__huge({var_ref})", False + return f"-huge({var_ref})", f"{var_ref} == -huge({var_ref})", False if category == "real": return ( f"nml__ieee_value({var_ref}, nml__ieee_quiet_nan)", @@ -2471,9 +2467,9 @@ def _element_missing_expression( len_ref: str | None = None, ) -> tuple[str, bool]: if category == "string": - return f"{var_ref} == nml__achar(0)", False + return f"{var_ref} == achar(0)", False if category == "integer": - return f"{var_ref} == -nml__huge({var_ref})", False + return f"{var_ref} == -huge({var_ref})", False if category == "real": return f"nml__ieee_is_nan({var_ref})", True raise ValueError(f"unsupported missing category '{category}'") @@ -2488,7 +2484,7 @@ def _array_missing_conditions( missing_expr, uses_ieee = _element_missing_expression( element_category, var_ref=var_ref, len_ref=len_ref ) - return f"nml__all({missing_expr})", f"nml__any({missing_expr})", uses_ieee + return f"all({missing_expr})", f"any({missing_expr})", uses_ieee def _slice_ref(name: str, rank: int, dim: int, index_var: str) -> str: @@ -2511,11 +2507,11 @@ def _render_partial_set_block(name: str, rank: int) -> str: lines: list[str] = [] for dim in range(1, rank + 1): lines.append( - f"if (nml__size({name}, {dim}) > nml__size({_data_ref(name)}, {dim})) then" + f"if (size({name}, {dim}) > size({_data_ref(name)}, {dim})) then" ) lines.append(" nml__status = NML_ERR_INVALID_INDEX") lines.append( - f" if (nml__present(errmsg)) " + f" if (present(errmsg)) " f"errmsg = \"dimension {dim} exceeds bounds for '{name}'\"" ) lines.append(" return") @@ -2523,12 +2519,12 @@ def _render_partial_set_block(name: str, rank: int) -> str: lines.append(f"{_data_ref(name)}( &") for dim in range(1, rank + 1): suffix = ", &" if dim < rank else f") = {name}" - lines.append(f" 1:nml__size({name}, {dim}){suffix}") + lines.append(f" 1:size({name}, {dim}){suffix}") return "\n".join(lines) def _format_reshape_assignment(name: str, arguments: list[str]) -> str: - lines = [f"{_data_ref(name)} = nml__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}") @@ -2571,7 +2567,7 @@ def _format_default( ] arguments.append(f"pad=[{', '.join(pad_elements)}]") - return f"nml__reshape({', '.join(arguments)})" + return f"reshape({', '.join(arguments)})" return _format_scalar_default(value, type_info.kind, type_info.category) diff --git a/src/nml_tools/schema.py b/src/nml_tools/schema.py index 31dfe28..91937d0 100644 --- a/src/nml_tools/schema.py +++ b/src/nml_tools/schema.py @@ -14,7 +14,11 @@ import yaml -from ._utils import validate_namelist_identifier, validate_user_fortran_identifier +from ._utils import ( + 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"} @@ -463,6 +467,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 +498,7 @@ 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}'") + validate_namelist_identifier(name, label=f"property '{name}'") except ValueError as exc: raise ValueError( f"{_location(document, child_pointer)}: {exc}" @@ -820,6 +827,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): diff --git a/src/nml_tools/templates/fortran_module.f90.j2 b/src/nml_tools/templates/fortran_module.f90.j2 index b0ca8f6..0e869ba 100644 --- a/src/nml_tools/templates/fortran_module.f90.j2 +++ b/src/nml_tools/templates/fortran_module.f90.j2 @@ -9,11 +9,6 @@ module {{ module_name }} use {{ helper_module }}, only: & {{ helper_imports | join(', &\n ') }} -{# Import from a declaration-only module. gfortran 10+ omits an intrinsic from - a module interface when that intrinsic is also referenced inside the module. #} -{% for intrinsic_import in helper_intrinsic_imports %} - use {{ helper_intrinsic_module }}, only: {{ intrinsic_import }} -{% endfor %} {% if use_ieee %} use ieee_arithmetic, only: nml__ieee_value => ieee_value, & nml__ieee_quiet_nan => ieee_quiet_nan, nml__ieee_is_nan => ieee_is_nan @@ -54,9 +49,6 @@ module {{ module_name }} {% endif %} private :: {{ type_prefix }}_read__from_file - private :: nml__achar, nml__all, nml__allocated, nml__any, nml__huge, nml__len, & - nml__len_trim, nml__minval, nml__present, nml__reshape, nml__shape, nml__size, & - nml__trim {% if use_ieee %} private :: nml__ieee_value, nml__ieee_quiet_nan, nml__ieee_is_nan {% endif %} @@ -114,7 +106,7 @@ contains {{ enum.arg_type_spec }}, intent(in) :: val !< value to check logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - if (nml__present(allow_missing)) then + if (present(allow_missing)) then if (allow_missing) then if ({{ enum.missing_condition }}) then in_enum = .true. @@ -123,9 +115,9 @@ contains end if end if {% if enum.use_trim %} - in_enum = nml__any(nml__trim(val) == {{ enum.enum_values_name }}) + in_enum = any(trim(val) == {{ enum.enum_values_name }}) {% else %} - in_enum = nml__any(val == {{ enum.enum_values_name }}) + in_enum = any(val == {{ enum.enum_values_name }}) {% endif %} end function {{ enum.func_name }} @@ -138,7 +130,7 @@ contains {{ bounds.arg_type_spec }}, intent(in) :: val !< value to check logical, intent(in), optional :: allow_missing !< allow sentinel values as valid - if (nml__present(allow_missing)) then + if (present(allow_missing)) then if (allow_missing) then if ({{ bounds.missing_condition }}) then in_bounds = .true. @@ -167,11 +159,11 @@ contains character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values type(c_ptr) :: ptr - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" nullify(nml__obj) if (handle == 0_c_intptr_t) then nml__status = NML_ERR_INVALID_HANDLE - if (nml__present(errmsg)) errmsg = "zero handle" + if (present(errmsg)) errmsg = "zero handle" return end if ptr = transfer(handle, c_null_ptr) @@ -186,7 +178,7 @@ contains character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" nml__obj%is_configured = .false. {% if runtime_allocations %} @@ -237,9 +229,9 @@ contains character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" {% for field in derived_init_type_fields %} - if (nml__present({{ field.name }})) then + if (present({{ field.name }})) then {% for stmt in field.allocation_lines %} {{ stmt | indent(6, True) }} {% endfor %} @@ -270,22 +262,22 @@ contains character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" {% for entry in set_dims_arguments %} - if (nml__present({{ entry.arg_name }})) then + if (present({{ entry.arg_name }})) then {{ entry.candidate_name }} = {{ entry.arg_name }} else {{ entry.candidate_name }} = {{ entry.default_name }} end if if ({{ entry.candidate_name }} <= 0) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "dimension '{{ entry.name }}' must be positive" + 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 nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "dimension '{{ entry.name }}' must be >= {{ entry.min_required }}" + if (present(errmsg)) errmsg = "dimension '{{ entry.name }}' must be >= {{ entry.min_required }}" return end if {% endif %} @@ -293,7 +285,7 @@ contains {% for check in set_dims_extent_checks %} if ({{ check.condition }}) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "{{ check.message }}" + if (present(errmsg)) errmsg = "{{ check.message }}" return end if {% endfor %} @@ -376,7 +368,7 @@ contains read(nml__reader%unit, nml={{ namelist_name }}, iostat=nml__iostat, iomsg=nml__iomsg) if (nml__iostat /= 0) then nml__status = NML_ERR_READ - if (nml__present(errmsg)) errmsg = nml__trim(nml__iomsg) + if (present(errmsg)) errmsg = trim(nml__iomsg) nml__close_status = nml__reader%close() return end if @@ -440,24 +432,24 @@ contains character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" if (.not. nml__obj%is_configured) then nml__status = NML_ERR_NOT_SET - if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" + if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(nml__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. nml__allocated(nml__obj%data%{{ case.name }})) then + if (.not. allocated(nml__obj%data%{{ case.name }})) then nml__status = NML_ERR_NOT_SET return end if {% endif %} - if (nml__present(idx)) then - nml__status = idx_check(idx, nml__shape(nml__obj%data%{{ case.name }}), & + if (present(idx)) then + nml__status = idx__check(idx, shape(nml__obj%data%{{ case.name }}), & "{{ case.display_name }}", errmsg) if (nml__status /= NML_OK) return {% if not case.always_true %} @@ -469,9 +461,9 @@ contains {% endif %} end if {% else %} - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for '{{ case.display_name }}'" + if (present(errmsg)) errmsg = "index not supported for '{{ case.display_name }}'" return end if {% if not case.always_true %} @@ -484,10 +476,10 @@ contains {% endfor %} case default nml__status = NML_ERR_INVALID_NAME - if (nml__present(errmsg)) errmsg = "unknown field: " // nml__trim(name) + if (present(errmsg)) errmsg = "unknown field: " // trim(name) end select - if (nml__status == NML_ERR_NOT_SET .and. nml__present(errmsg)) then - if (nml__len_trim(errmsg) == 0) errmsg = "field not set: " // nml__trim(name) + 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 @@ -502,44 +494,44 @@ contains integer :: nml__dim nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" - select case (to_lower(nml__trim(name))) + if (present(errmsg)) errmsg = "" + select case (to__lower(trim(name))) {% for flex in flex_arrays %} case ("{{ flex.name }}") - if (nml__size(filled) /= {{ flex.rank }}) then + if (size(filled) /= {{ flex.rank }}) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "shape rank mismatch for '{{ flex.display_name }}'" + if (present(errmsg)) errmsg = "shape rank mismatch for '{{ flex.display_name }}'" return end if {% if flex.runtime_array %} - if (.not. nml__allocated(nml__obj%data%{{ flex.name }})) then + if (.not. allocated(nml__obj%data%{{ flex.name }})) then filled = 0 return end if {% endif %} do nml__dim = 1, {{ flex.rank }} - filled(nml__dim) = nml__size(nml__obj%data%{{ flex.name }}, nml__dim) + filled(nml__dim) = size(nml__obj%data%{{ flex.name }}, nml__dim) end do {% for dim in flex.flex_dims %} filled({{ dim }}) = 0 - do nml__idx = nml__size(nml__obj%data%{{ flex.name }}, {{ dim }}), 1, -1 + do nml__idx = size(nml__obj%data%{{ flex.name }}, {{ dim }}), 1, -1 if (.not. ({{ flex.slice_missing_conditions[loop.index0] }})) then filled({{ dim }}) = nml__idx exit end if end do {% endfor %} - if (nml__minval(filled) > 0) then + if (minval(filled) > 0) then if ({{ flex.prefix_any_missing_condition }}) then nml__status = NML_ERR_PARTLY_SET - if (nml__present(errmsg)) errmsg = "array partly set: {{ flex.display_name }}" + if (present(errmsg)) errmsg = "array partly set: {{ flex.display_name }}" return end if end if {% endfor %} case default nml__status = NML_ERR_INVALID_NAME - if (nml__present(errmsg)) errmsg = "field is not a flexible array: " // nml__trim(name) + if (present(errmsg)) errmsg = "field is not a flexible array: " // trim(name) end select end function {{ type_prefix }}_filled_shape @@ -554,10 +546,10 @@ contains {% endif %} nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" if (.not. nml__obj%is_configured) then nml__status = NML_ERR_NOT_SET - if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" + if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if @@ -567,11 +559,11 @@ contains nml__istat = nml__obj%is_set("{{ name }}", errmsg=errmsg) if (nml__istat == NML_ERR_NOT_SET) then nml__status = NML_ERR_REQUIRED - if (nml__present(errmsg)) then - if (nml__len_trim(errmsg) == 0) then + if (present(errmsg)) then + if (len_trim(errmsg) == 0) then errmsg = "field not set: {{ name }}" end if - errmsg = "required " // nml__trim(errmsg) + errmsg = "required " // trim(errmsg) end if return end if @@ -585,20 +577,20 @@ contains ! required arrays {% for entry in required_array_validations %} {% if entry.runtime_array %} - if (.not. nml__allocated(nml__obj%data%{{ entry.attr_name }})) then + if (.not. allocated(nml__obj%data%{{ entry.attr_name }})) then nml__status = NML_ERR_REQUIRED - if (nml__present(errmsg)) errmsg = "required field not set: {{ entry.name }}" + if (present(errmsg)) errmsg = "required field not set: {{ entry.name }}" return end if {% endif %} if ({{ entry.all_missing_condition }}) then nml__status = NML_ERR_REQUIRED - if (nml__present(errmsg)) errmsg = "required field not set: {{ entry.name }}" + if (present(errmsg)) errmsg = "required field not set: {{ entry.name }}" return end if if ({{ entry.any_missing_condition }}) then nml__status = NML_ERR_PARTLY_SET - if (nml__present(errmsg)) errmsg = "array partly set: {{ entry.name }}" + if (present(errmsg)) errmsg = "array partly set: {{ entry.name }}" return end if {% endfor %} @@ -606,14 +598,14 @@ contains {% if flex_arrays %} ! flexible arrays {% for entry in flex_arrays %} - if (nml__allocated(nml__filled)) deallocate(nml__filled) + 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 (nml__present(errmsg)) then - if (nml__len_trim(errmsg) == 0) errmsg = "array partly set: {{ entry.display_name }}" + if (present(errmsg)) then + if (len_trim(errmsg) == 0) errmsg = "array partly set: {{ entry.display_name }}" end if return end if @@ -622,9 +614,9 @@ contains return end if {% if entry.required %} - if (nml__minval(nml__filled) == 0) then + if (minval(nml__filled) == 0) then nml__status = NML_ERR_REQUIRED - if (nml__present(errmsg)) errmsg = "required field not set: {{ entry.display_name }}" + if (present(errmsg)) errmsg = "required field not set: {{ entry.display_name }}" return end if {% endif %} @@ -635,11 +627,11 @@ contains {% for check in enum_checks %} {% if check.is_array %} {% if check.runtime_array %} - if (nml__allocated({{ check.allocation_ref }})) then + if (allocated({{ check.allocation_ref }})) then {% endif %} - if (.not. nml__all({{ check.func_name }}({{ check.array_ref }}, allow_missing=.true.))) then + if (.not. all({{ check.func_name }}({{ check.array_ref }}, allow_missing=.true.))) then nml__status = NML_ERR_ENUM - if (nml__present(errmsg)) errmsg = "enum constraint failed: {{ check.display_name }}" + if (present(errmsg)) errmsg = "enum constraint failed: {{ check.display_name }}" return end if {% if check.runtime_array %} @@ -650,7 +642,7 @@ contains if (nml__istat == NML_OK) then if (.not. {{ check.func_name }}({{ check.element_ref }})) then nml__status = NML_ERR_ENUM - if (nml__present(errmsg)) errmsg = "enum constraint failed: {{ check.display_name }}" + if (present(errmsg)) errmsg = "enum constraint failed: {{ check.display_name }}" return end if else if (nml__istat /= NML_ERR_NOT_SET) then @@ -665,11 +657,11 @@ contains {% for check in bounds_checks %} {% if check.is_array %} {% if check.runtime_array %} - if (nml__allocated({{ check.allocation_ref }})) then + if (allocated({{ check.allocation_ref }})) then {% endif %} - if (.not. nml__all({{ check.func_name }}({{ check.array_ref }}, allow_missing=.true.))) then + if (.not. all({{ check.func_name }}({{ check.array_ref }}, allow_missing=.true.))) then nml__status = NML_ERR_BOUNDS - if (nml__present(errmsg)) errmsg = "bounds constraint failed: {{ check.display_name }}" + if (present(errmsg)) errmsg = "bounds constraint failed: {{ check.display_name }}" return end if {% if check.runtime_array %} @@ -680,7 +672,7 @@ contains if (nml__istat == NML_OK) then if (.not. {{ check.func_name }}({{ check.element_ref }})) then nml__status = NML_ERR_BOUNDS - if (nml__present(errmsg)) errmsg = "bounds constraint failed: {{ check.display_name }}" + if (present(errmsg)) errmsg = "bounds constraint failed: {{ check.display_name }}" return end if else if (nml__istat /= NML_ERR_NOT_SET) then diff --git a/src/nml_tools/templates/nml_helper.f90.j2 b/src/nml_tools/templates/nml_helper.f90.j2 index 6fb87f9..8f68402 100644 --- a/src/nml_tools/templates/nml_helper.f90.j2 +++ b/src/nml_tools/templates/nml_helper.f90.j2 @@ -5,16 +5,6 @@ !> \file {{ file_name }} !> \copydoc {{ module_name }} -!> \brief Intrinsic procedures re-exported for collision-safe generated aliases -module {{ module_name }}_intrinsics - implicit none - - intrinsic :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & - shape, size, trim - public :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & - shape, size, trim -end module {{ module_name }}_intrinsics - !> \brief Helper module for namelist file operations {% if module_doc %} {{ module_doc }} @@ -147,7 +137,7 @@ contains if (present(errmsg)) errmsg = trim(iomsg) return end if - if (index(to_lower(line), '&' // to_lower(trim(nml))) /= 0) then + if (index(to__lower(line), '&' // to__lower(trim(nml))) /= 0) then status = NML_OK backspace(this%unit) return @@ -176,7 +166,7 @@ contains end function nml_close !> \brief Convert string to lower case - pure function to_lower(string) result(lower_string) + 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') @@ -186,10 +176,10 @@ contains if (k>=upA .and. k<=upZ) k = k + shift lower_string(i:i) = char(k) end do - end function to_lower + end function to__lower !> \brief Validate index bounds for array access - integer function idx_check(idx, extents, field, errmsg) result(status) + integer function idx__check(idx, extents, field, errmsg) result(status) integer, intent(in) :: idx(:) integer, intent(in) :: extents(:) character(len=*), intent(in) :: field @@ -204,6 +194,6 @@ contains status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index out of bounds for '" // trim(field) // "'" end if - end function idx_check + end function idx__check end module {{ module_name }} diff --git a/tests/fixtures/01_simple/out/nml_helper.f90 b/tests/fixtures/01_simple/out/nml_helper.f90 index a8d11c0..5ea2d13 100644 --- a/tests/fixtures/01_simple/out/nml_helper.f90 +++ b/tests/fixtures/01_simple/out/nml_helper.f90 @@ -3,16 +3,6 @@ !> \file nml_helper.f90 !> \copydoc nml_helper -!> \brief Intrinsic procedures re-exported for collision-safe generated aliases -module nml_helper_intrinsics - implicit none - - intrinsic :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & - shape, size, trim - public :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & - shape, size, trim -end module nml_helper_intrinsics - !> \brief Helper module for namelist file operations !> \version 0.1 module nml_helper @@ -121,7 +111,7 @@ integer function nml_find(this, nml, errmsg) result(status) if (present(errmsg)) errmsg = trim(iomsg) return end if - if (index(to_lower(line), '&' // to_lower(trim(nml))) /= 0) then + if (index(to__lower(line), '&' // to__lower(trim(nml))) /= 0) then status = NML_OK backspace(this%unit) return @@ -150,7 +140,7 @@ 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) + 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') @@ -160,10 +150,10 @@ pure function to_lower(string) result(lower_string) if (k>=upA .and. k<=upZ) k = k + shift lower_string(i:i) = char(k) end do - end function to_lower + end function to__lower !> \brief Validate index bounds for array access - integer function idx_check(idx, extents, field, errmsg) result(status) + integer function idx__check(idx, extents, field, errmsg) result(status) integer, intent(in) :: idx(:) integer, intent(in) :: extents(:) character(len=*), intent(in) :: field @@ -178,6 +168,6 @@ integer function idx_check(idx, extents, field, errmsg) result(status) status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index out of bounds for '" // trim(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 e51b46c..b9aa823 100644 --- a/tests/fixtures/01_simple/out/nml_optimization.f90 +++ b/tests/fixtures/01_simple/out/nml_optimization.f90 @@ -22,23 +22,10 @@ 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__dim_default - use nml_helper_intrinsics, only: nml__achar => achar - use nml_helper_intrinsics, only: nml__all => all - use nml_helper_intrinsics, only: nml__allocated => allocated - use nml_helper_intrinsics, only: nml__any => any - use nml_helper_intrinsics, only: nml__huge => huge - use nml_helper_intrinsics, only: nml__len => len - use nml_helper_intrinsics, only: nml__len_trim => len_trim - use nml_helper_intrinsics, only: nml__minval => minval - use nml_helper_intrinsics, only: nml__present => present - use nml_helper_intrinsics, only: nml__reshape => reshape - use nml_helper_intrinsics, only: nml__shape => shape - use nml_helper_intrinsics, only: nml__size => size - use nml_helper_intrinsics, only: nml__trim => trim 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 @@ -55,9 +42,6 @@ module nml_optimization real(dp), parameter, public :: mcmc_error_params__default(4) = [0.01_dp, 0.6_dp, 0.2_dp, 0.3_dp] private :: nml_optimization_read__from_file - private :: nml__achar, nml__all, nml__allocated, nml__any, nml__huge, nml__len, & - nml__len_trim, nml__minval, nml__present, nml__reshape, nml__shape, nml__size, & - nml__trim private :: nml__ieee_value, nml__ieee_quiet_nan, nml__ieee_is_nan !> \class nml_optimization_data_t @@ -103,22 +87,22 @@ integer function nml_optimization_init(nml__obj, errmsg) result(nml__status) character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" nml__obj%is_configured = .false. ! allocate runtime-sized fields - if (nml__allocated(nml__obj%data%mcmc_error_params)) deallocate(nml__obj%data%mcmc_error_params) + 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 - nml__obj%data%name = nml__achar(0) ! sentinel for optional string - nml__obj%data%niterations = -nml__huge(nml__obj%data%niterations) ! sentinel for required integer + 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 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 = nml__reshape( & + nml__obj%data%mcmc_error_params = reshape( & mcmc_error_params__default, & shape=[3, 2, nml__obj%dims%max_iter], & order=[3, 2, 1], & @@ -135,26 +119,26 @@ integer function nml_optimization_set_dims(nml__obj, & character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" - if (nml__present(max_iter)) then + if (present(errmsg)) errmsg = "" + if (present(max_iter)) then candidate__max_iter = max_iter else candidate__max_iter = max_iter__dim_default end if if (candidate__max_iter <= 0) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "dimension 'max_iter' must be positive" + if (present(errmsg)) errmsg = "dimension 'max_iter' must be positive" return end if if ((3 * 2 * candidate__max_iter) < 4) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "shape constants for 'mcmc_error_params' must allow at least 4 default values" + if (present(errmsg)) errmsg = "shape constants for 'mcmc_error_params' must allow at least 4 default values" return end if nml__obj%dims%max_iter = candidate__max_iter ! deallocate runtime-sized fields; init/set/from_file allocate them again - if (nml__allocated(nml__obj%data%mcmc_error_params)) deallocate(nml__obj%data%mcmc_error_params) + 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 @@ -199,7 +183,7 @@ integer function nml_optimization_read__from_file(nml__obj, nml__file, errmsg) & nml__status = nml__obj%init(errmsg=errmsg) if (nml__status /= NML_OK) return ! allocate local namelist variables matching runtime-sized fields - if (nml__allocated(mcmc_error_params)) deallocate(mcmc_error_params) + if (allocated(mcmc_error_params)) deallocate(mcmc_error_params) allocate(mcmc_error_params(3, 2, nml__obj%dims%max_iter)) name = nml__obj%data%name niterations = nml__obj%data%niterations @@ -222,7 +206,7 @@ integer function nml_optimization_read__from_file(nml__obj, nml__file, errmsg) & read(nml__reader%unit, nml=optimization, iostat=nml__iostat, iomsg=nml__iomsg) if (nml__iostat /= 0) then nml__status = NML_ERR_READ - if (nml__present(errmsg)) errmsg = nml__trim(nml__iomsg) + if (present(errmsg)) errmsg = trim(nml__iomsg) nml__close_status = nml__reader%close() return end if @@ -273,30 +257,30 @@ integer function nml_optimization_set(nml__obj, & nml__obj%data%niterations = niterations nml__obj%data%tolerance = tolerance ! override with provided values - if (nml__present(name)) nml__obj%data%name = name - if (nml__present(seed)) nml__obj%data%seed = seed - if (nml__present(dds_r)) nml__obj%data%dds_r = dds_r - if (nml__present(mcmc_opti)) nml__obj%data%mcmc_opti = mcmc_opti - if (nml__present(mcmc_error_params)) then - if (nml__size(mcmc_error_params, 1) > nml__size(nml__obj%data%mcmc_error_params, 1)) then + 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(nml__obj%data%mcmc_error_params, 1)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'mcmc_error_params'" + if (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'mcmc_error_params'" return end if - if (nml__size(mcmc_error_params, 2) > nml__size(nml__obj%data%mcmc_error_params, 2)) then + if (size(mcmc_error_params, 2) > size(nml__obj%data%mcmc_error_params, 2)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "dimension 2 exceeds bounds for 'mcmc_error_params'" + if (present(errmsg)) errmsg = "dimension 2 exceeds bounds for 'mcmc_error_params'" return end if - if (nml__size(mcmc_error_params, 3) > nml__size(nml__obj%data%mcmc_error_params, 3)) then + if (size(mcmc_error_params, 3) > size(nml__obj%data%mcmc_error_params, 3)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "dimension 3 exceeds bounds for 'mcmc_error_params'" + if (present(errmsg)) errmsg = "dimension 3 exceeds bounds for 'mcmc_error_params'" return end if nml__obj%data%mcmc_error_params( & - 1:nml__size(mcmc_error_params, 1), & - 1:nml__size(mcmc_error_params, 2), & - 1:nml__size(mcmc_error_params, 3)) = 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 @@ -312,69 +296,69 @@ integer function nml_optimization_is_set(nml__obj, name, idx, errmsg) result(nml character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" if (.not. nml__obj%is_configured) then nml__status = NML_ERR_NOT_SET - if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" + if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(nml__trim(name))) + select case (to__lower(trim(name))) case ("name") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'name'" + if (present(errmsg)) errmsg = "index not supported for 'name'" return end if - if (nml__obj%data%name == nml__achar(0)) nml__status = NML_ERR_NOT_SET + if (nml__obj%data%name == achar(0)) nml__status = NML_ERR_NOT_SET case ("niterations") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'niterations'" + if (present(errmsg)) errmsg = "index not supported for 'niterations'" return end if - if (nml__obj%data%niterations == -nml__huge(nml__obj%data%niterations)) nml__status = NML_ERR_NOT_SET + if (nml__obj%data%niterations == -huge(nml__obj%data%niterations)) nml__status = NML_ERR_NOT_SET case ("tolerance") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'tolerance'" + if (present(errmsg)) errmsg = "index not supported for 'tolerance'" return end if if (nml__ieee_is_nan(nml__obj%data%tolerance)) nml__status = NML_ERR_NOT_SET case ("seed") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'seed'" + if (present(errmsg)) errmsg = "index not supported for 'seed'" return end if case ("dds_r") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'dds_r'" + if (present(errmsg)) errmsg = "index not supported for 'dds_r'" return end if case ("mcmc_opti") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'mcmc_opti'" + if (present(errmsg)) errmsg = "index not supported for 'mcmc_opti'" return end if case ("mcmc_error_params") - if (.not. nml__allocated(nml__obj%data%mcmc_error_params)) then + if (.not. allocated(nml__obj%data%mcmc_error_params)) then nml__status = NML_ERR_NOT_SET return end if - if (nml__present(idx)) then - nml__status = idx_check(idx, nml__shape(nml__obj%data%mcmc_error_params), & + if (present(idx)) then + nml__status = idx__check(idx, shape(nml__obj%data%mcmc_error_params), & "mcmc_error_params", errmsg) if (nml__status /= NML_OK) return else end if case default nml__status = NML_ERR_INVALID_NAME - if (nml__present(errmsg)) errmsg = "unknown field: " // nml__trim(name) + if (present(errmsg)) errmsg = "unknown field: " // trim(name) end select - if (nml__status == NML_ERR_NOT_SET .and. nml__present(errmsg)) then - if (nml__len_trim(errmsg) == 0) errmsg = "field not set: " // nml__trim(name) + 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 @@ -385,10 +369,10 @@ integer function nml_optimization_is_valid(nml__obj, errmsg) result(nml__status) integer :: nml__istat nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" if (.not. nml__obj%is_configured) then nml__status = NML_ERR_NOT_SET - if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" + if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if @@ -396,11 +380,11 @@ integer function nml_optimization_is_valid(nml__obj, errmsg) result(nml__status) nml__istat = nml__obj%is_set("niterations", errmsg=errmsg) if (nml__istat == NML_ERR_NOT_SET) then nml__status = NML_ERR_REQUIRED - if (nml__present(errmsg)) then - if (nml__len_trim(errmsg) == 0) then + if (present(errmsg)) then + if (len_trim(errmsg) == 0) then errmsg = "field not set: niterations" end if - errmsg = "required " // nml__trim(errmsg) + errmsg = "required " // trim(errmsg) end if return end if @@ -411,11 +395,11 @@ integer function nml_optimization_is_valid(nml__obj, errmsg) result(nml__status) nml__istat = nml__obj%is_set("tolerance", errmsg=errmsg) if (nml__istat == NML_ERR_NOT_SET) then nml__status = NML_ERR_REQUIRED - if (nml__present(errmsg)) then - if (nml__len_trim(errmsg) == 0) then + if (present(errmsg)) then + if (len_trim(errmsg) == 0) then errmsg = "field not set: tolerance" end if - errmsg = "required " // nml__trim(errmsg) + errmsg = "required " // trim(errmsg) end if return end if diff --git a/tests/fortran_namespaces/conformance.f90 b/tests/fortran_namespaces/conformance.f90 index 6a15daa..1bae085 100644 --- a/tests/fortran_namespaces/conformance.f90 +++ b/tests/fortran_namespaces/conformance.f90 @@ -19,10 +19,9 @@ program conformance if (config%dims%set_dims /= 2) error stop "operation-named dimension mismatch" source = [7, 8] - status = config%set(status=42, present=5, set_dims=6, values=source, errmsg=errmsg) + 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%present /= 5) error stop "present 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" @@ -54,8 +53,6 @@ program conformance error stop "validation/shape-named property mismatch" end if if (config%data%is_configured /= 27) error stop "lifecycle-named property mismatch" - if (config%data%size /= 28) error stop "intrinsic-named property mismatch" - status = config%is_valid(errmsg=errmsg) call expect_status(status, NML_OK, "validate") diff --git a/tests/fortran_namespaces/input.nml b/tests/fortran_namespaces/input.nml index b7783b7..12a0e2e 100644 --- a/tests/fortran_namespaces/input.nml +++ b/tests/fortran_namespaces/input.nml @@ -1,6 +1,5 @@ &namespaces status = 17 - present = 18 file = 19 nml = 20 iostat = 21 @@ -16,7 +15,6 @@ is_valid = 32 filled_shape = 33 is_configured = 27 - size = 28 values = 3, 4, 5 more_values = 6, 7 / diff --git a/tests/fortran_namespaces/namespaces.yml b/tests/fortran_namespaces/namespaces.yml index ad925b3..0ab814e 100644 --- a/tests/fortran_namespaces/namespaces.yml +++ b/tests/fortran_namespaces/namespaces.yml @@ -5,9 +5,6 @@ properties: status: type: integer default: 0 - present: - type: integer - default: 0 file: type: integer default: 0 @@ -53,9 +50,6 @@ properties: is_configured: type: integer default: 0 - size: - type: integer - default: 0 values: type: array x-fortran-shape: status diff --git a/tests/fortran_namespaces/out/nml_helper.f90 b/tests/fortran_namespaces/out/nml_helper.f90 index 95f6d8b..c359f9c 100644 --- a/tests/fortran_namespaces/out/nml_helper.f90 +++ b/tests/fortran_namespaces/out/nml_helper.f90 @@ -1,16 +1,6 @@ !> \file nml_helper.f90 !> \copydoc nml_helper -!> \brief Intrinsic procedures re-exported for collision-safe generated aliases -module nml_helper_intrinsics - implicit none - - intrinsic :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & - shape, size, trim - public :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & - shape, size, trim -end module nml_helper_intrinsics - !> \brief Helper module for namelist file operations module nml_helper @@ -118,7 +108,7 @@ integer function nml_find(this, nml, errmsg) result(status) if (present(errmsg)) errmsg = trim(iomsg) return end if - if (index(to_lower(line), '&' // to_lower(trim(nml))) /= 0) then + if (index(to__lower(line), '&' // to__lower(trim(nml))) /= 0) then status = NML_OK backspace(this%unit) return @@ -147,7 +137,7 @@ 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) + 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') @@ -157,10 +147,10 @@ pure function to_lower(string) result(lower_string) if (k>=upA .and. k<=upZ) k = k + shift lower_string(i:i) = char(k) end do - end function to_lower + end function to__lower !> \brief Validate index bounds for array access - integer function idx_check(idx, extents, field, errmsg) result(status) + integer function idx__check(idx, extents, field, errmsg) result(status) integer, intent(in) :: idx(:) integer, intent(in) :: extents(:) character(len=*), intent(in) :: field @@ -175,6 +165,6 @@ integer function idx_check(idx, extents, field, errmsg) result(status) status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index out of bounds for '" // trim(field) // "'" end if - end function idx_check + 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 index d04a04d..bd5745c 100644 --- a/tests/fortran_namespaces/out/nml_namespaces.f90 +++ b/tests/fortran_namespaces/out/nml_namespaces.f90 @@ -20,29 +20,15 @@ module nml_namespaces NML_ERR_NOT_SET, & NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & - idx_check, & - to_lower, & + idx__check, & + to__lower, & status__dim_default, & set_dims__dim_default - use nml_helper_intrinsics, only: nml__achar => achar - use nml_helper_intrinsics, only: nml__all => all - use nml_helper_intrinsics, only: nml__allocated => allocated - use nml_helper_intrinsics, only: nml__any => any - use nml_helper_intrinsics, only: nml__huge => huge - use nml_helper_intrinsics, only: nml__len => len - use nml_helper_intrinsics, only: nml__len_trim => len_trim - use nml_helper_intrinsics, only: nml__minval => minval - use nml_helper_intrinsics, only: nml__present => present - use nml_helper_intrinsics, only: nml__reshape => reshape - use nml_helper_intrinsics, only: nml__shape => shape - use nml_helper_intrinsics, only: nml__size => size - use nml_helper_intrinsics, only: nml__trim => trim implicit none ! default values integer, parameter, public :: status__default = 0 - integer, parameter, public :: present__default = 0 integer, parameter, public :: file__default = 0 integer, parameter, public :: nml__default = 0 integer, parameter, public :: iostat__default = 0 @@ -58,20 +44,15 @@ module nml_namespaces integer, parameter, public :: is_valid__default = 0 integer, parameter, public :: filled_shape__default = 0 integer, parameter, public :: is_configured__default = 0 - integer, parameter, public :: size__default = 0 integer, parameter, public :: values__default = 0 integer, parameter, public :: more_values__default = 0 private :: nml_namespaces_read__from_file - private :: nml__achar, nml__all, nml__allocated, nml__any, nml__huge, nml__len, & - nml__len_trim, nml__minval, nml__present, nml__reshape, nml__shape, nml__size, & - nml__trim !> \class nml_namespaces_data_t !> \brief Schema-backed values for namespaces type, public :: nml_namespaces_data_t integer :: status !< status - integer :: present !< present integer :: file !< file integer :: nml !< nml integer :: iostat !< iostat @@ -87,7 +68,6 @@ module nml_namespaces integer :: is_valid !< is_valid integer :: filled_shape !< filled_shape integer :: is_configured !< is_configured - integer :: size !< size integer, allocatable, dimension(:) :: values !< values integer, allocatable, dimension(:) :: more_values !< more_values end type nml_namespaces_data_t @@ -123,18 +103,17 @@ integer function nml_namespaces_init(nml__obj, errmsg) result(nml__status) character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" nml__obj%is_configured = .false. ! allocate runtime-sized fields - if (nml__allocated(nml__obj%data%values)) deallocate(nml__obj%data%values) + if (allocated(nml__obj%data%values)) deallocate(nml__obj%data%values) allocate(nml__obj%data%values(nml__obj%dims%status)) - if (nml__allocated(nml__obj%data%more_values)) deallocate(nml__obj%data%more_values) + 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%present = present__default nml__obj%data%file = file__default nml__obj%data%nml = nml__default nml__obj%data%iostat = iostat__default @@ -150,7 +129,6 @@ integer function nml_namespaces_init(nml__obj, errmsg) result(nml__status) 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%size = size__default nml__obj%data%values = values__default nml__obj%data%more_values = more_values__default end function nml_namespaces_init @@ -168,33 +146,33 @@ integer function nml_namespaces_set_dims(nml__obj, & character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" - if (nml__present(status)) then + 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 (nml__present(errmsg)) errmsg = "dimension 'status' must be positive" + if (present(errmsg)) errmsg = "dimension 'status' must be positive" return end if - if (nml__present(set_dims)) then + 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 (nml__present(errmsg)) errmsg = "dimension 'set_dims' must be positive" + 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 (nml__allocated(nml__obj%data%values)) deallocate(nml__obj%data%values) - if (nml__allocated(nml__obj%data%more_values)) deallocate(nml__obj%data%more_values) + 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 @@ -215,7 +193,6 @@ integer function nml_namespaces_read__from_file(nml__obj, nml__file, errmsg) & character(len=*), intent(out), optional :: errmsg ! namelist variables integer :: status - integer :: present integer :: file integer :: nml integer :: iostat @@ -231,7 +208,6 @@ integer function nml_namespaces_read__from_file(nml__obj, nml__file, errmsg) & integer :: is_valid integer :: filled_shape integer :: is_configured - integer :: size integer, allocatable, dimension(:) :: values integer, allocatable, dimension(:) :: more_values ! locals @@ -242,7 +218,6 @@ integer function nml_namespaces_read__from_file(nml__obj, nml__file, errmsg) & namelist /namespaces/ & status, & - present, & file, & nml, & iostat, & @@ -258,19 +233,17 @@ integer function nml_namespaces_read__from_file(nml__obj, nml__file, errmsg) & is_valid, & filled_shape, & is_configured, & - size, & 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 (nml__allocated(values)) deallocate(values) + if (allocated(values)) deallocate(values) allocate(values(nml__obj%dims%status)) - if (nml__allocated(more_values)) deallocate(more_values) + if (allocated(more_values)) deallocate(more_values) allocate(more_values(nml__obj%dims%set_dims)) status = nml__obj%data%status - present = nml__obj%data%present file = nml__obj%data%file nml = nml__obj%data%nml iostat = nml__obj%data%iostat @@ -286,7 +259,6 @@ integer function nml_namespaces_read__from_file(nml__obj, nml__file, errmsg) & is_valid = nml__obj%data%is_valid filled_shape = nml__obj%data%filled_shape is_configured = nml__obj%data%is_configured - size = nml__obj%data%size values = nml__obj%data%values more_values = nml__obj%data%more_values @@ -313,7 +285,7 @@ integer function nml_namespaces_read__from_file(nml__obj, nml__file, errmsg) & read(nml__reader%unit, nml=namespaces, iostat=nml__iostat, iomsg=nml__iomsg) if (nml__iostat /= 0) then nml__status = NML_ERR_READ - if (nml__present(errmsg)) errmsg = nml__trim(nml__iomsg) + if (present(errmsg)) errmsg = trim(nml__iomsg) nml__close_status = nml__reader%close() return end if @@ -325,7 +297,6 @@ integer function nml_namespaces_read__from_file(nml__obj, nml__file, errmsg) & ! assign values nml__obj%data%status = status - nml__obj%data%present = present nml__obj%data%file = file nml__obj%data%nml = nml nml__obj%data%iostat = iostat @@ -341,7 +312,6 @@ integer function nml_namespaces_read__from_file(nml__obj, nml__file, errmsg) & nml__obj%data%is_valid = is_valid nml__obj%data%filled_shape = filled_shape nml__obj%data%is_configured = is_configured - nml__obj%data%size = size nml__obj%data%values = values nml__obj%data%more_values = more_values @@ -353,7 +323,6 @@ end function nml_namespaces_read__from_file !> \brief Set namespaces values integer function nml_namespaces_set(nml__obj, & status, & - present, & file, & nml, & iostat, & @@ -369,7 +338,6 @@ integer function nml_namespaces_set(nml__obj, & is_valid, & filled_shape, & is_configured, & - size, & values, & more_values, & errmsg) result(nml__status) @@ -377,7 +345,6 @@ integer function nml_namespaces_set(nml__obj, & 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 :: present !< present integer, intent(in), optional :: file !< file integer, intent(in), optional :: nml !< nml integer, intent(in), optional :: iostat !< iostat @@ -393,7 +360,6 @@ integer function nml_namespaces_set(nml__obj, & 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, intent(in), optional :: size !< size integer, dimension(:), intent(in), optional :: values !< values integer, dimension(:), intent(in), optional :: more_values !< more_values nml__status = nml__obj%init(errmsg=errmsg) @@ -401,41 +367,39 @@ integer function nml_namespaces_set(nml__obj, & ! required parameters ! override with provided values - if (nml__present(status)) nml__obj%data%status = status - if (nml__present(present)) nml__obj%data%present = present - if (nml__present(file)) nml__obj%data%file = file - if (nml__present(nml)) nml__obj%data%nml = nml - if (nml__present(iostat)) nml__obj%data%iostat = iostat - if (nml__present(close_status)) nml__obj%data%close_status = close_status - if (nml__present(data)) nml__obj%data%data = data - if (nml__present(dims)) nml__obj%data%dims = dims - if (nml__present(set)) nml__obj%data%set = set - if (nml__present(set_dims)) nml__obj%data%set_dims = set_dims - if (nml__present(init)) nml__obj%data%init = init - if (nml__present(init_type)) nml__obj%data%init_type = init_type - if (nml__present(from_file)) nml__obj%data%from_file = from_file - if (nml__present(is_set)) nml__obj%data%is_set = is_set - if (nml__present(is_valid)) nml__obj%data%is_valid = is_valid - if (nml__present(filled_shape)) nml__obj%data%filled_shape = filled_shape - if (nml__present(is_configured)) nml__obj%data%is_configured = is_configured - if (nml__present(size)) nml__obj%data%size = size - if (nml__present(values)) then - if (nml__size(values, 1) > nml__size(nml__obj%data%values, 1)) then + 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 (nml__present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'values'" + if (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'values'" return end if nml__obj%data%values( & - 1:nml__size(values, 1)) = values + 1:size(values, 1)) = values end if - if (nml__present(more_values)) then - if (nml__size(more_values, 1) > nml__size(nml__obj%data%more_values, 1)) then + 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 (nml__present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'more_values'" + if (present(errmsg)) errmsg = "dimension 1 exceeds bounds for 'more_values'" return end if nml__obj%data%more_values( & - 1:nml__size(more_values, 1)) = more_values + 1:size(more_values, 1)) = more_values end if ! mark as configured @@ -451,149 +415,137 @@ integer function nml_namespaces_is_set(nml__obj, name, idx, errmsg) result(nml__ character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" if (.not. nml__obj%is_configured) then nml__status = NML_ERR_NOT_SET - if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" + if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(nml__trim(name))) + select case (to__lower(trim(name))) case ("status") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'status'" - return - end if - case ("present") - if (nml__present(idx)) then - nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'present'" + if (present(errmsg)) errmsg = "index not supported for 'status'" return end if case ("file") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'file'" + if (present(errmsg)) errmsg = "index not supported for 'file'" return end if case ("nml") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'nml'" + if (present(errmsg)) errmsg = "index not supported for 'nml'" return end if case ("iostat") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'iostat'" + if (present(errmsg)) errmsg = "index not supported for 'iostat'" return end if case ("close_status") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'close_status'" + if (present(errmsg)) errmsg = "index not supported for 'close_status'" return end if case ("data") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'data'" + if (present(errmsg)) errmsg = "index not supported for 'data'" return end if case ("dims") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'dims'" + if (present(errmsg)) errmsg = "index not supported for 'dims'" return end if case ("set") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'set'" + if (present(errmsg)) errmsg = "index not supported for 'set'" return end if case ("set_dims") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'set_dims'" + if (present(errmsg)) errmsg = "index not supported for 'set_dims'" return end if case ("init") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'init'" + if (present(errmsg)) errmsg = "index not supported for 'init'" return end if case ("init_type") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'init_type'" + if (present(errmsg)) errmsg = "index not supported for 'init_type'" return end if case ("from_file") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'from_file'" + if (present(errmsg)) errmsg = "index not supported for 'from_file'" return end if case ("is_set") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'is_set'" + if (present(errmsg)) errmsg = "index not supported for 'is_set'" return end if case ("is_valid") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'is_valid'" + if (present(errmsg)) errmsg = "index not supported for 'is_valid'" return end if case ("filled_shape") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'filled_shape'" + if (present(errmsg)) errmsg = "index not supported for 'filled_shape'" return end if case ("is_configured") - if (nml__present(idx)) then - nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'is_configured'" - return - end if - case ("size") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'size'" + if (present(errmsg)) errmsg = "index not supported for 'is_configured'" return end if case ("values") - if (.not. nml__allocated(nml__obj%data%values)) then + if (.not. allocated(nml__obj%data%values)) then nml__status = NML_ERR_NOT_SET return end if - if (nml__present(idx)) then - nml__status = idx_check(idx, nml__shape(nml__obj%data%values), & + 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. nml__allocated(nml__obj%data%more_values)) then + if (.not. allocated(nml__obj%data%more_values)) then nml__status = NML_ERR_NOT_SET return end if - if (nml__present(idx)) then - nml__status = idx_check(idx, nml__shape(nml__obj%data%more_values), & + 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 (nml__present(errmsg)) errmsg = "unknown field: " // nml__trim(name) + if (present(errmsg)) errmsg = "unknown field: " // trim(name) end select - if (nml__status == NML_ERR_NOT_SET .and. nml__present(errmsg)) then - if (nml__len_trim(errmsg) == 0) errmsg = "field not set: " // nml__trim(name) + 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 @@ -604,10 +556,10 @@ integer function nml_namespaces_is_valid(nml__obj, errmsg) result(nml__status) integer :: nml__istat nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" if (.not. nml__obj%is_configured) then nml__status = NML_ERR_NOT_SET - if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" + if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if diff --git a/tests/fortran_optional_read/out/nml_helper.f90 b/tests/fortran_optional_read/out/nml_helper.f90 index 335cf3c..c860c2c 100644 --- a/tests/fortran_optional_read/out/nml_helper.f90 +++ b/tests/fortran_optional_read/out/nml_helper.f90 @@ -1,16 +1,6 @@ !> \file nml_helper.f90 !> \copydoc nml_helper -!> \brief Intrinsic procedures re-exported for collision-safe generated aliases -module nml_helper_intrinsics - implicit none - - intrinsic :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & - shape, size, trim - public :: achar, all, allocated, any, huge, len, len_trim, minval, present, reshape, & - shape, size, trim -end module nml_helper_intrinsics - !> \brief Helper module for namelist file operations module nml_helper @@ -115,7 +105,7 @@ integer function nml_find(this, nml, errmsg) result(status) if (present(errmsg)) errmsg = trim(iomsg) return end if - if (index(to_lower(line), '&' // to_lower(trim(nml))) /= 0) then + if (index(to__lower(line), '&' // to__lower(trim(nml))) /= 0) then status = NML_OK backspace(this%unit) return @@ -144,7 +134,7 @@ 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) + 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') @@ -154,10 +144,10 @@ pure function to_lower(string) result(lower_string) if (k>=upA .and. k<=upZ) k = k + shift lower_string(i:i) = char(k) end do - end function to_lower + end function to__lower !> \brief Validate index bounds for array access - integer function idx_check(idx, extents, field, errmsg) result(status) + integer function idx__check(idx, extents, field, errmsg) result(status) integer, intent(in) :: idx(:) integer, intent(in) :: extents(:) character(len=*), intent(in) :: field @@ -172,6 +162,6 @@ integer function idx_check(idx, extents, field, errmsg) result(status) status = NML_ERR_INVALID_INDEX if (present(errmsg)) errmsg = "index out of bounds for '" // trim(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 124e27e..a483eda 100644 --- a/tests/fortran_optional_read/out/nml_optional.f90 +++ b/tests/fortran_optional_read/out/nml_optional.f90 @@ -20,21 +20,8 @@ module nml_optional NML_ERR_NOT_SET, & NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & - idx_check, & - to_lower - use nml_helper_intrinsics, only: nml__achar => achar - use nml_helper_intrinsics, only: nml__all => all - use nml_helper_intrinsics, only: nml__allocated => allocated - use nml_helper_intrinsics, only: nml__any => any - use nml_helper_intrinsics, only: nml__huge => huge - use nml_helper_intrinsics, only: nml__len => len - use nml_helper_intrinsics, only: nml__len_trim => len_trim - use nml_helper_intrinsics, only: nml__minval => minval - use nml_helper_intrinsics, only: nml__present => present - use nml_helper_intrinsics, only: nml__reshape => reshape - use nml_helper_intrinsics, only: nml__shape => shape - use nml_helper_intrinsics, only: nml__size => size - use nml_helper_intrinsics, only: nml__trim => trim + idx__check, & + to__lower ! kind specifiers listed in the nml-tools configuration file use iso_fortran_env, only: & i4=>int32 @@ -45,9 +32,6 @@ module nml_optional integer(i4), parameter, public :: count__default = 7_i4 private :: nml_optional_read__from_file - private :: nml__achar, nml__all, nml__allocated, nml__any, nml__huge, nml__len, & - nml__len_trim, nml__minval, nml__present, nml__reshape, nml__shape, nml__size, & - nml__trim !> \class nml_optional_data_t !> \brief Schema-backed values for optional @@ -78,11 +62,11 @@ integer function nml_optional_init(nml__obj, errmsg) result(nml__status) character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" nml__obj%is_configured = .false. ! sentinel values for required/optional parameters - nml__obj%data%label = nml__achar(0) ! sentinel for optional string + nml__obj%data%label = achar(0) ! sentinel for optional string ! default values nml__obj%data%count = count__default end function nml_optional_init @@ -143,7 +127,7 @@ integer function nml_optional_read__from_file(nml__obj, nml__file, errmsg) & read(nml__reader%unit, nml=optional, iostat=nml__iostat, iomsg=nml__iomsg) if (nml__iostat /= 0) then nml__status = NML_ERR_READ - if (nml__present(errmsg)) errmsg = nml__trim(nml__iomsg) + if (present(errmsg)) errmsg = trim(nml__iomsg) nml__close_status = nml__reader%close() return end if @@ -177,8 +161,8 @@ integer function nml_optional_set(nml__obj, & ! required parameters ! override with provided values - if (nml__present(count)) nml__obj%data%count = count - if (nml__present(label)) nml__obj%data%label = label + if (present(count)) nml__obj%data%count = count + if (present(label)) nml__obj%data%label = label ! mark as configured nml__obj%is_configured = .true. @@ -193,32 +177,32 @@ integer function nml_optional_is_set(nml__obj, name, idx, errmsg) result(nml__st character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" if (.not. nml__obj%is_configured) then nml__status = NML_ERR_NOT_SET - if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" + if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(nml__trim(name))) + select case (to__lower(trim(name))) case ("count") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'count'" + if (present(errmsg)) errmsg = "index not supported for 'count'" return end if case ("label") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'label'" + if (present(errmsg)) errmsg = "index not supported for 'label'" return end if - if (nml__obj%data%label == nml__achar(0)) nml__status = NML_ERR_NOT_SET + if (nml__obj%data%label == achar(0)) nml__status = NML_ERR_NOT_SET case default nml__status = NML_ERR_INVALID_NAME - if (nml__present(errmsg)) errmsg = "unknown field: " // nml__trim(name) + if (present(errmsg)) errmsg = "unknown field: " // trim(name) end select - if (nml__status == NML_ERR_NOT_SET .and. nml__present(errmsg)) then - if (nml__len_trim(errmsg) == 0) errmsg = "field not set: " // nml__trim(name) + 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 @@ -229,10 +213,10 @@ integer function nml_optional_is_valid(nml__obj, errmsg) result(nml__status) integer :: nml__istat nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" if (.not. nml__obj%is_configured) then nml__status = NML_ERR_NOT_SET - if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" + 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 2fb8733..662a03c 100644 --- a/tests/fortran_optional_read/out/nml_required.f90 +++ b/tests/fortran_optional_read/out/nml_required.f90 @@ -20,21 +20,8 @@ module nml_required NML_ERR_NOT_SET, & NML_ERR_INVALID_NAME, & NML_ERR_INVALID_INDEX, & - idx_check, & - to_lower - use nml_helper_intrinsics, only: nml__achar => achar - use nml_helper_intrinsics, only: nml__all => all - use nml_helper_intrinsics, only: nml__allocated => allocated - use nml_helper_intrinsics, only: nml__any => any - use nml_helper_intrinsics, only: nml__huge => huge - use nml_helper_intrinsics, only: nml__len => len - use nml_helper_intrinsics, only: nml__len_trim => len_trim - use nml_helper_intrinsics, only: nml__minval => minval - use nml_helper_intrinsics, only: nml__present => present - use nml_helper_intrinsics, only: nml__reshape => reshape - use nml_helper_intrinsics, only: nml__shape => shape - use nml_helper_intrinsics, only: nml__size => size - use nml_helper_intrinsics, only: nml__trim => trim + idx__check, & + to__lower ! kind specifiers listed in the nml-tools configuration file use iso_fortran_env, only: & i4=>int32 @@ -42,9 +29,6 @@ module nml_required implicit none private :: nml_required_read__from_file - private :: nml__achar, nml__all, nml__allocated, nml__any, nml__huge, nml__len, & - nml__len_trim, nml__minval, nml__present, nml__reshape, nml__shape, nml__size, & - nml__trim !> \class nml_required_data_t !> \brief Schema-backed values for required @@ -74,11 +58,11 @@ integer function nml_required_init(nml__obj, errmsg) result(nml__status) character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" nml__obj%is_configured = .false. ! sentinel values for required/optional parameters - nml__obj%data%count = -nml__huge(nml__obj%data%count) ! sentinel for required integer + nml__obj%data%count = -huge(nml__obj%data%count) ! sentinel for required integer end function nml_required_init @@ -124,7 +108,7 @@ integer function nml_required_read__from_file(nml__obj, nml__file, errmsg) & read(nml__reader%unit, nml=required, iostat=nml__iostat, iomsg=nml__iomsg) if (nml__iostat /= 0) then nml__status = NML_ERR_READ - if (nml__present(errmsg)) errmsg = nml__trim(nml__iomsg) + if (present(errmsg)) errmsg = trim(nml__iomsg) nml__close_status = nml__reader%close() return end if @@ -169,26 +153,26 @@ integer function nml_required_is_set(nml__obj, name, idx, errmsg) result(nml__st character(len=*), intent(out), optional :: errmsg !< error message for non-OK status values nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" if (.not. nml__obj%is_configured) then nml__status = NML_ERR_NOT_SET - if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" + if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if - select case (to_lower(nml__trim(name))) + select case (to__lower(trim(name))) case ("count") - if (nml__present(idx)) then + if (present(idx)) then nml__status = NML_ERR_INVALID_INDEX - if (nml__present(errmsg)) errmsg = "index not supported for 'count'" + if (present(errmsg)) errmsg = "index not supported for 'count'" return end if - if (nml__obj%data%count == -nml__huge(nml__obj%data%count)) nml__status = NML_ERR_NOT_SET + if (nml__obj%data%count == -huge(nml__obj%data%count)) nml__status = NML_ERR_NOT_SET case default nml__status = NML_ERR_INVALID_NAME - if (nml__present(errmsg)) errmsg = "unknown field: " // nml__trim(name) + if (present(errmsg)) errmsg = "unknown field: " // trim(name) end select - if (nml__status == NML_ERR_NOT_SET .and. nml__present(errmsg)) then - if (nml__len_trim(errmsg) == 0) errmsg = "field not set: " // nml__trim(name) + 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 @@ -199,10 +183,10 @@ integer function nml_required_is_valid(nml__obj, errmsg) result(nml__status) integer :: nml__istat nml__status = NML_OK - if (nml__present(errmsg)) errmsg = "" + if (present(errmsg)) errmsg = "" if (.not. nml__obj%is_configured) then nml__status = NML_ERR_NOT_SET - if (nml__present(errmsg)) errmsg = "namelist not configured; call set or from_file" + if (present(errmsg)) errmsg = "namelist not configured; call set or from_file" return end if @@ -210,11 +194,11 @@ integer function nml_required_is_valid(nml__obj, errmsg) result(nml__status) nml__istat = nml__obj%is_set("count", errmsg=errmsg) if (nml__istat == NML_ERR_NOT_SET) then nml__status = NML_ERR_REQUIRED - if (nml__present(errmsg)) then - if (nml__len_trim(errmsg) == 0) then + if (present(errmsg)) then + if (len_trim(errmsg) == 0) then errmsg = "field not set: count" end if - errmsg = "required " // nml__trim(errmsg) + errmsg = "required " // trim(errmsg) end if return end if diff --git a/tests/test_cli_config.py b/tests/test_cli_config.py index 70f3082..d906312 100644 --- a/tests/test_cli_config.py +++ b/tests/test_cli_config.py @@ -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,60 @@ 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() + + +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"], + } + } + ) + + 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 +1468,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 +1690,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 +1910,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 +1975,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_codegen_fortran.py b/tests/test_codegen_fortran.py index 1b56c3f..54325f7 100644 --- a/tests/test_codegen_fortran.py +++ b/tests/test_codegen_fortran.py @@ -698,7 +698,7 @@ def test_generate_fortran_emits_bounds_helpers(tmp_path: Path) -> None: assert "elemental logical function tolerance__in_bounds" in generated assert "elemental logical function counts__in_bounds" in generated assert ( - "nml__all(counts__in_bounds(nml__obj%data%counts, allow_missing=.true.))" + "all(counts__in_bounds(nml__obj%data%counts, allow_missing=.true.))" in generated ) @@ -878,51 +878,56 @@ def test_generate_fortran_rejects_companion_type_import_collision() -> None: codegen.render_fortran(schema, file_name="nml_run.f90") -def test_generate_fortran_aliases_present_for_schema_names() -> None: +@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_rejects_derived_type_root_symbol_collision() -> None: codegen = _import_codegen_module() schema = { "x-fortran-namelist": "run", "type": "object", "properties": { - "present": {"type": "integer"}, - "values": { - "type": "array", - "items": {"type": "integer"}, - "x-fortran-shape": "present", + "period": {"type": "integer"}, + "value": { + "type": "object", + "x-fortran-type": "period", + "properties": {"year": {"type": "integer"}}, }, }, } - generated = codegen.render_fortran( - schema, - file_name="nml_run.f90", - dimensions={"present": 2}, - ) - helper = codegen.render_helper(file_name="nml_helper.f90") - - intrinsic_aliases = ( - "nml__achar => achar", - "nml__all => all", - "nml__allocated => allocated", - "nml__any => any", - "nml__huge => huge", - "nml__len => len", - "nml__len_trim => len_trim", - "nml__minval => minval", - "nml__present => present", - "nml__reshape => reshape", - "nml__shape => shape", - "nml__size => size", - "nml__trim => trim", - ) - generated_lines = generated.splitlines() - for intrinsic_alias in intrinsic_aliases: - assert f" use nml_helper_intrinsics, only: {intrinsic_alias}" in generated_lines - assert "module nml_helper_intrinsics" in helper - assert "end module nml_helper_intrinsics" in helper - assert helper.index("end module nml_helper_intrinsics") < helper.index("module nml_helper\n") - assert "if (nml__present(present))" in generated - assert "nml__obj%dims%present" in generated + with pytest.raises(ValueError, match="derived type name conflicts"): + codegen.render_fortran(schema, file_name="nml_run.f90") def test_generate_fortran_accepts_required_case_insensitive(tmp_path: Path) -> None: @@ -1125,10 +1130,10 @@ def test_generate_fortran_runtime_sized_array_with_default_uses_partial_set(tmp_ generated = output.read_text() assert ( - "if (nml__size(values, 1) > nml__size(nml__obj%data%values, 1)) then" + "if (size(values, 1) > size(nml__obj%data%values, 1)) then" in generated ) - assert "nml__obj%data%values( &\n 1:nml__size(values, 1)) = values" 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 @@ -1330,10 +1335,10 @@ 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 (nml__size(values, 1) > nml__size(nml__obj%data%values, 1)) then" + "if (size(values, 1) > size(nml__obj%data%values, 1)) then" in generated ) - assert "nml__obj%data%values( &\n 1:nml__size(values, 1)) = values" 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 @@ -1399,8 +1404,8 @@ def test_generate_fortran_multidimensional_string_array_sentinels( ) generated = output.read_text() - assert "nml__obj%data%names = nml__achar(0)" in generated - assert "nml__all(nml__obj%data%names == nml__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: @@ -1548,7 +1553,7 @@ def test_generate_fortran_emits_local_derived_types_and_typed_fields() -> None: assert "elemental logical function period__start_year__in_bounds" 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 (nml__allocated(nml__obj%data%periods)) then" in generated + assert "if (allocated(nml__obj%data%periods)) then" in generated def test_generate_fortran_init_type_accepts_fixed_derived_arrays() -> None: @@ -1637,8 +1642,8 @@ def test_generate_fortran_imports_application_owned_derived_type() -> None: assert "type(location_t), dimension(:), intent(in), optional :: locations" 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 (nml__len(location%name) /= 8) then" in generated - assert "if (nml__len(locations%name) /= 8) then" 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 assert '+ 1:) = ""' not in generated diff --git a/tests/test_schema.py b/tests/test_schema.py index 309f9fb..9954ba2 100644 --- a/tests/test_schema.py +++ b/tests/test_schema.py @@ -1141,6 +1141,36 @@ def test_schema_rejects_reserved_errmsg_properties(name: str) -> None: ) +@pytest.mark.parametrize("name", ["present", "SIZE", "NML_OK"]) +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"]) +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}) From 2cbedd7b274acd15641c8e33cb5997bef72fc714 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Mon, 14 Sep 2026 11:17:57 +0200 Subject: [PATCH 07/22] fix(f2py): namespace wrapper operational state Use reserved nml__ wrapper locals so imported types such as status do not collide with operational results. --- .../02_pybind/f2py/generated/f2py_config.f90 | 88 +++--- .../f2py/generated/f2py_config.f90 | 104 ++++---- src/nml_tools/codegen_f2py.py | 14 +- src/nml_tools/codegen_fortran.py | 4 +- src/nml_tools/templates/f2py_wrappers.f90.j2 | 92 +++---- tests/fortran_namespaces/CMakeLists.txt | 3 + .../fortran_namespaces/application_types.f90 | 7 + tests/fortran_namespaces/nml-config.toml | 6 + .../out/f2py_wrapper_status.f90 | 99 +++++++ .../out/nml_wrapper_status.f90 | 251 ++++++++++++++++++ tests/fortran_namespaces/wrapper_status.yml | 12 + tests/test_cli_smoke.py | 6 + tests/test_codegen_f2py.py | 59 +++- tests/test_enum_support.py | 4 +- 14 files changed, 586 insertions(+), 163 deletions(-) create mode 100644 tests/fortran_namespaces/application_types.f90 create mode 100644 tests/fortran_namespaces/out/f2py_wrapper_status.f90 create mode 100644 tests/fortran_namespaces/out/nml_wrapper_status.f90 create mode 100644 tests/fortran_namespaces/wrapper_status.yml 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/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/src/nml_tools/codegen_f2py.py b/src/nml_tools/codegen_f2py.py index 4fde1a2..10f9c3d 100644 --- a/src/nml_tools/codegen_f2py.py +++ b/src/nml_tools/codegen_f2py.py @@ -937,16 +937,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", ] diff --git a/src/nml_tools/codegen_fortran.py b/src/nml_tools/codegen_fortran.py index 5b8c2ea..43eb857 100644 --- a/src/nml_tools/codegen_fortran.py +++ b/src/nml_tools/codegen_fortran.py @@ -1511,11 +1511,11 @@ 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") - root_scope_names = set(property_name_map) | set(runtime_dimension_values) + root_scope_names = set(property_name_map) type_name_collisions = sorted(derived_type_scope_names & root_scope_names) if type_name_collisions: raise ValueError( - "derived type name conflicts with a root property or runtime dimension: " + "derived type name conflicts with a root property: " + ", ".join(type_name_collisions) ) required_flex_names = {entry["name"] for entry in flex_arrays if entry["required"]} 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/tests/fortran_namespaces/CMakeLists.txt b/tests/fortran_namespaces/CMakeLists.txt index b23c8d7..0982c38 100644 --- a/tests/fortran_namespaces/CMakeLists.txt +++ b/tests/fortran_namespaces/CMakeLists.txt @@ -5,7 +5,10 @@ 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 ) diff --git a/tests/fortran_namespaces/application_types.f90 b/tests/fortran_namespaces/application_types.f90 new file mode 100644 index 0000000..c36b2b3 --- /dev/null +++ b/tests/fortran_namespaces/application_types.f90 @@ -0,0 +1,7 @@ +module application_types + implicit none + + type :: status + integer :: code + end type status +end module application_types diff --git a/tests/fortran_namespaces/nml-config.toml b/tests/fortran_namespaces/nml-config.toml index 5326890..02df47e 100644 --- a/tests/fortran_namespaces/nml-config.toml +++ b/tests/fortran_namespaces/nml-config.toml @@ -16,3 +16,9 @@ default = 2 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" 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..17ba8c6 --- /dev/null +++ b/tests/fortran_namespaces/out/f2py_wrapper_status.f90 @@ -0,0 +1,99 @@ +! 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 + 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, & + 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 + 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 + + 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 + nml__status = nml__obj%set( & + state=maybe__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_wrapper_status.f90 b/tests/fortran_namespaces/out/nml_wrapper_status.f90 new file mode 100644 index 0000000..1e7ffc6 --- /dev/null +++ b/tests/fortran_namespaces/out/nml_wrapper_status.f90 @@ -0,0 +1,251 @@ +!> \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 iso_c_binding, only: c_f_pointer, c_intptr_t, c_null_ptr, 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 + 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(handle, nml__obj, nml__status, errmsg) + integer(c_intptr_t), intent(in) :: 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) :: ptr + + if (present(errmsg)) errmsg = "" + nullify(nml__obj) + if (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, 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, & + 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, & + errmsg) result(nml__status) + class(nml_wrapper_status_t), intent(in) :: nml__obj !< parent namelist instance + type(status), intent(inout), optional :: state !< 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 + 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 + ! 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 + + nml__status = nml__obj%init(errmsg=errmsg) + if (nml__status /= NML_OK) return + state = nml__obj%data%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 + + ! 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, & + 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 + 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 + + ! 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 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..eae4195 --- /dev/null +++ b/tests/fortran_namespaces/wrapper_status.yml @@ -0,0 +1,12 @@ +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 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 993ae5b..4670694 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: @@ -748,7 +760,6 @@ def test_f2py_mangles_internal_status_names_but_preserves_python_names() -> None "type": "object", "properties": { "status": {"type": "integer"}, - "len": {"type": "string", "x-fortran-len": 8}, "values": { "type": "array", "x-fortran-shape": "status", @@ -769,7 +780,29 @@ def test_f2py_mangles_internal_status_names_but_preserves_python_names() -> None 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 "character(len=*), intent(in) :: len__value" in fortran assert "status: Any = None" in python assert 'kwargs["status__value"] = status' in python - assert 'kwargs["len__value"] = len' 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 diff --git a/tests/test_enum_support.py b/tests/test_enum_support.py index 97319b2..1e98ecb 100644 --- a/tests/test_enum_support.py +++ b/tests/test_enum_support.py @@ -81,11 +81,11 @@ def test_generate_fortran_emits_enum_helpers(tmp_path: Path) -> None: assert "sizes__enum_values(3)" in generated assert "elemental logical function method__in_enum" in generated assert ( - "nml__all(try_methods__in_enum(" + "all(try_methods__in_enum(" "nml__obj%data%try_methods, allow_missing=.true.))" in generated ) assert ( - "nml__all(sizes__in_enum(nml__obj%data%sizes, allow_missing=.true.))" + "all(sizes__in_enum(nml__obj%data%sizes, allow_missing=.true.))" in generated ) From 90b6237fbf5b6a5c4cde25e665b1ae6bb253579a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Mon, 14 Sep 2026 11:22:43 +0200 Subject: [PATCH 08/22] docs: document generated identifier limitations Explain the direct-intrinsic reservation set and generated helper ownership. --- README.md | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 148308c..f949cba 100644 --- a/README.md +++ b/README.md @@ -63,6 +63,17 @@ 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: 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`, and `minval`. The generated helper API also reserves `NML_OK`, all +`NML_ERR_*` names, `nml_file_t`, and `nml_line_buffer` in those scopes. +An imported or generated derived-type name also cannot duplicate a root +property name used in the same generated procedure scope. + ### x-fortran-namelist - Location: schema root. @@ -467,9 +478,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. From cd714364aec5531bd7e41f2d4f5cc26c76fe9747 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Mon, 14 Sep 2026 12:26:58 +0200 Subject: [PATCH 09/22] fix(fortran): bound generated identifier collisions Reserve errmsg in unqualified generated scopes, protect f2py leaf names, and keep qualified derived components usable. --- src/nml_tools/_utils.py | 9 ++- src/nml_tools/cli.py | 20 +++---- src/nml_tools/codegen_f2py.py | 15 +++++ src/nml_tools/codegen_fortran.py | 26 +++++++- src/nml_tools/schema.py | 25 ++++++-- tests/test_cli_config.py | 35 +++++++++++ tests/test_codegen_f2py.py | 42 +++++++++++++ tests/test_codegen_fortran.py | 100 ++++++++++++++++++++++++++++++- tests/test_schema.py | 24 ++++++++ 9 files changed, 274 insertions(+), 22 deletions(-) diff --git a/src/nml_tools/_utils.py b/src/nml_tools/_utils.py index d905578..f1c4b21 100644 --- a/src/nml_tools/_utils.py +++ b/src/nml_tools/_utils.py @@ -72,14 +72,21 @@ def validate_user_fortran_identifier(name: str, *, label: str) -> None: def validate_namelist_identifier(name: str, *, label: str) -> None: """Validate an identifier used for a namelist property or runtime dimension.""" 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") - validate_generated_fortran_identifier(name, label=label) 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: diff --git a/src/nml_tools/cli.py b/src/nml_tools/cli.py index a73f90e..5c6df08 100644 --- a/src/nml_tools/cli.py +++ b/src/nml_tools/cli.py @@ -1150,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( @@ -1500,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 10f9c3d..9dcae8c 100644 --- a/src/nml_tools/codegen_f2py.py +++ b/src/nml_tools/codegen_f2py.py @@ -396,10 +396,25 @@ def build_f2py_namelist_spec( "errmsg", "handle", "len", + "nml__errmsg", + "nml__handle", + "nml__obj", + "nml__status", "size", "status", "this", } + namelist_name = cast("str", context["namelist_name"]) + wrapper_reserved_names.update( + f"{namelist_name}_{suffix}" + for suffix in ( + "from_file_wrapper", + "set_wrapper", + "set_dims_wrapper", + "is_set_wrapper", + "is_valid_wrapper", + ) + ) field_abi_names: dict[str, str] = {} field_names_in_use = set(wrapper_reserved_names) for field in fields: diff --git a/src/nml_tools/codegen_fortran.py b/src/nml_tools/codegen_fortran.py index 43eb857..530374b 100644 --- a/src/nml_tools/codegen_fortran.py +++ b/src/nml_tools/codegen_fortran.py @@ -15,6 +15,7 @@ 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, @@ -623,7 +624,7 @@ 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_namelist_identifier( + validate_derived_component_identifier( child_display_name, label=f"property '{child_display_name}'", ) @@ -1518,6 +1519,27 @@ def _register_runtime_dimension(dim_name: str) -> str: "derived type name conflicts with a root property: " + ", ".join(type_name_collisions) ) + set_name = f"{module_name}_set" + if set_name.lower() in property_name_map: + raise ValueError( + f"property '{property_name_map[set_name.lower()]}' conflicts with " + f"generated set procedure '{set_name}'" + ) + if derived_init_type_fields: + init_type_name = f"{module_name}_init_type" + derived_field_names = {entry["name"].lower() for entry in derived_init_type_fields} + if init_type_name.lower() in derived_field_names: + raise ValueError( + f"property '{property_name_map[init_type_name.lower()]}' conflicts with " + f"generated init_type procedure '{init_type_name}'" + ) + if runtime_dimension_values: + set_dims_name = f"{module_name}_set_dims" + if set_dims_name.lower() in runtime_dimension_values: + raise ValueError( + f"runtime dimension '{set_dims_name}' conflicts with " + f"generated set_dims procedure '{set_dims_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] = [] @@ -1613,7 +1635,7 @@ def _register_runtime_dimension(dim_name: str) -> str: symbol.split("=>", maxsplit=1)[0].strip().lower() for symbol in helper_imports + resolved_kind_imports ) - companion_names = [data_type_name] + companion_names = [type_name, data_type_name] if runtime_dimensions: companion_names.append(dims_type_name) for companion_name in companion_names: diff --git a/src/nml_tools/schema.py b/src/nml_tools/schema.py index 91937d0..4f355f9 100644 --- a/src/nml_tools/schema.py +++ b/src/nml_tools/schema.py @@ -15,6 +15,7 @@ import yaml from ._utils import ( + validate_derived_component_identifier, validate_generated_fortran_identifier, validate_namelist_identifier, validate_user_fortran_identifier, @@ -261,7 +262,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: @@ -282,11 +289,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_namelist_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): @@ -498,7 +510,12 @@ def _validate_user_identifiers(raw: Any, document: _Document, pointer: str) -> N "property names must be strings" ) try: - validate_namelist_identifier(name, label=f"property '{name}'") + if namelist_name is not None: + 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, child_pointer)}: {exc}" @@ -840,7 +857,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/tests/test_cli_config.py b/tests/test_cli_config.py index d906312..004f5a1 100644 --- a/tests/test_cli_config.py +++ b/tests/test_cli_config.py @@ -1416,6 +1416,41 @@ def test_generate_command_allows_missing_helper_path_without_fortran_output( 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( diff --git a/tests/test_codegen_f2py.py b/tests/test_codegen_f2py.py index 4670694..920a135 100644 --- a/tests/test_codegen_f2py.py +++ b/tests/test_codegen_f2py.py @@ -806,3 +806,45 @@ def test_f2py_wrapper_uses_internal_status_for_imported_status_type() -> None: 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 + + +def test_f2py_mangles_schema_arguments_matching_wrapper_procedures() -> None: + codegen = _import_codegen_f2py() + schema = { + "x-fortran-namelist": "run", + "type": "object", + "properties": {"run_set_wrapper": {"type": "integer"}}, + } + + generated = codegen.render_f2py_wrappers([schema], file_name="f2py_run.f90") + + assert "subroutine run_set_wrapper(nml__handle, &\n run_set_wrapper__value," in generated + assert "integer, intent(in) :: run_set_wrapper__value" in generated diff --git a/tests/test_codegen_fortran.py b/tests/test_codegen_fortran.py index 54325f7..4e0b483 100644 --- a/tests/test_codegen_fortran.py +++ b/tests/test_codegen_fortran.py @@ -859,7 +859,8 @@ def test_generate_fortran_rejects_reserved_errmsg_dimension() -> None: ) -def test_generate_fortran_rejects_companion_type_import_collision() -> None: +@pytest.mark.parametrize("type_name", ["nml_run_t", "nml_run_data_t"]) +def test_generate_fortran_rejects_generated_type_import_collision(type_name: str) -> None: codegen = _import_codegen_module() schema = { "x-fortran-namelist": "run", @@ -867,17 +868,110 @@ def test_generate_fortran_rejects_companion_type_import_collision() -> None: "properties": { "value": { "type": "object", - "x-fortran-type": "nml_run_data_t", + "x-fortran-type": type_name, "x-fortran-module": "application_types", "properties": {"count": {"type": "integer"}}, } }, } - with pytest.raises(ValueError, match="generated companion type 'nml_run_data_t'"): + with pytest.raises(ValueError, match=f"generated companion type '{type_name}'"): 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}, + ) + + @pytest.mark.parametrize("name", ["present", "Present", "size", "NML_OK"]) def test_generate_fortran_rejects_generated_dependency_names(name: str) -> None: codegen = _import_codegen_module() diff --git a/tests/test_schema.py b/tests/test_schema.py index 9954ba2..3ab9a9f 100644 --- a/tests/test_schema.py +++ b/tests/test_schema.py @@ -1141,6 +1141,30 @@ def test_schema_rejects_reserved_errmsg_properties(name: str) -> None: ) +@pytest.mark.parametrize("name", ["present", "size"]) +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"]) def test_schema_rejects_generated_dependency_properties(name: str) -> None: with pytest.raises(ValueError, match="reserved"): From 7435efb747a2ce45155d7f8df67a4765dc71acbb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Mon, 14 Sep 2026 14:11:55 +0200 Subject: [PATCH 10/22] fix(fortran): reject generated module symbol imports Normalize f2py wrapper reservations and reject imported symbols that conflict with generated procedures. --- src/nml_tools/codegen_f2py.py | 2 +- src/nml_tools/codegen_fortran.py | 24 +++++++++++++++++++----- tests/test_codegen_f2py.py | 12 +++++++++--- tests/test_codegen_fortran.py | 29 ++++++++++++++++++++++++++--- 4 files changed, 55 insertions(+), 12 deletions(-) diff --git a/src/nml_tools/codegen_f2py.py b/src/nml_tools/codegen_f2py.py index 9dcae8c..5893346 100644 --- a/src/nml_tools/codegen_f2py.py +++ b/src/nml_tools/codegen_f2py.py @@ -406,7 +406,7 @@ def build_f2py_namelist_spec( } namelist_name = cast("str", context["namelist_name"]) wrapper_reserved_names.update( - f"{namelist_name}_{suffix}" + f"{namelist_name}_{suffix}".lower() for suffix in ( "from_file_wrapper", "set_wrapper", diff --git a/src/nml_tools/codegen_fortran.py b/src/nml_tools/codegen_fortran.py index 530374b..3a44fdf 100644 --- a/src/nml_tools/codegen_fortran.py +++ b/src/nml_tools/codegen_fortran.py @@ -1635,13 +1635,27 @@ def _register_runtime_dimension(dim_name: str) -> str: symbol.split("=>", maxsplit=1)[0].strip().lower() for symbol in helper_imports + resolved_kind_imports ) - companion_names = [type_name, data_type_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", + ] if runtime_dimensions: - companion_names.append(dims_type_name) - for companion_name in companion_names: - if companion_name.lower() in imported_module_symbols: + 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: + if symbol_name.lower() in imported_module_symbols: raise ValueError( - f"generated companion type '{companion_name}' conflicts with an imported symbol" + f"generated module symbol '{symbol_name}' conflicts with an imported symbol" ) context = { diff --git a/tests/test_codegen_f2py.py b/tests/test_codegen_f2py.py index 920a135..28af9ba 100644 --- a/tests/test_codegen_f2py.py +++ b/tests/test_codegen_f2py.py @@ -836,15 +836,21 @@ def test_f2py_derived_leaf_names_avoid_internal_wrapper_state() -> None: assert "integer, intent(out) :: nml__status !< nml-tools status code" in generated -def test_f2py_mangles_schema_arguments_matching_wrapper_procedures() -> None: +@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": "run", + "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 "subroutine run_set_wrapper(nml__handle, &\n run_set_wrapper__value," in generated + 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 diff --git a/tests/test_codegen_fortran.py b/tests/test_codegen_fortran.py index 4e0b483..2543208 100644 --- a/tests/test_codegen_fortran.py +++ b/tests/test_codegen_fortran.py @@ -859,8 +859,8 @@ def test_generate_fortran_rejects_reserved_errmsg_dimension() -> None: ) -@pytest.mark.parametrize("type_name", ["nml_run_t", "nml_run_data_t"]) -def test_generate_fortran_rejects_generated_type_import_collision(type_name: str) -> None: +@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", @@ -875,10 +875,33 @@ def test_generate_fortran_rejects_generated_type_import_collision(type_name: str }, } - with pytest.raises(ValueError, match=f"generated companion type '{type_name}'"): + 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, + ) + + @pytest.mark.parametrize( ("schema", "kwargs"), [ From 625fd4161c934f7144cd306b44d5132f1c2e917d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Mon, 14 Sep 2026 21:18:09 +0200 Subject: [PATCH 11/22] fix(fortran): preserve helper and dimension namespaces Reserve helper procedure names and retain configured runtime dimension order in public APIs. --- README.md | 2 ++ src/nml_tools/_utils.py | 3 +++ src/nml_tools/codegen_fortran.py | 6 ++++++ tests/test_codegen_fortran.py | 35 ++++++++++++++++++++++++++++++++ tests/test_schema.py | 2 +- 5 files changed, 47 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index f949cba..d4ca370 100644 --- a/README.md +++ b/README.md @@ -525,6 +525,8 @@ Named runtime array dimension defaults. generated helper identifiers. - 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. diff --git a/src/nml_tools/_utils.py b/src/nml_tools/_utils.py index f1c4b21..6ab792d 100644 --- a/src/nml_tools/_utils.py +++ b/src/nml_tools/_utils.py @@ -32,8 +32,11 @@ ) 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", diff --git a/src/nml_tools/codegen_fortran.py b/src/nml_tools/codegen_fortran.py index 3a44fdf..759642e 100644 --- a/src/nml_tools/codegen_fortran.py +++ b/src/nml_tools/codegen_fortran.py @@ -1512,6 +1512,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"])] + ) root_scope_names = set(property_name_map) type_name_collisions = sorted(derived_type_scope_names & root_scope_names) if type_name_collisions: diff --git a/tests/test_codegen_fortran.py b/tests/test_codegen_fortran.py index 2543208..886965e 100644 --- a/tests/test_codegen_fortran.py +++ b/tests/test_codegen_fortran.py @@ -1256,6 +1256,41 @@ def test_generate_fortran_runtime_sized_array_with_default_uses_partial_set(tmp_ 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 = { diff --git a/tests/test_schema.py b/tests/test_schema.py index 3ab9a9f..17d6f1a 100644 --- a/tests/test_schema.py +++ b/tests/test_schema.py @@ -1177,7 +1177,7 @@ def test_schema_rejects_generated_dependency_properties(name: str) -> None: ) -@pytest.mark.parametrize("type_name", ["present", "NML_FILE_T"]) +@pytest.mark.parametrize("type_name", ["present", "NML_FILE_T", "nml_open"]) def test_schema_rejects_generated_dependency_type_names(type_name: str) -> None: with pytest.raises(ValueError, match="reserved"): resolve_schema( From 24bd4fd84fec1c68115a500a4f5dd96d7367c9d5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Mon, 14 Sep 2026 22:14:53 +0200 Subject: [PATCH 12/22] fix(fortran): detect ambiguous generated imports Reject kind and derived-type imports that collide in generated wrapper and module scopes. --- src/nml_tools/codegen_f2py.py | 11 +++++-- src/nml_tools/codegen_fortran.py | 29 +++++++++++++------ tests/test_codegen_f2py.py | 18 ++++++++++++ tests/test_codegen_fortran.py | 49 ++++++++++++++++++++++++++++++++ 4 files changed, 97 insertions(+), 10 deletions(-) diff --git a/src/nml_tools/codegen_f2py.py b/src/nml_tools/codegen_f2py.py index 5893346..b528df8 100644 --- a/src/nml_tools/codegen_f2py.py +++ b/src/nml_tools/codegen_f2py.py @@ -405,7 +405,7 @@ def build_f2py_namelist_spec( "this", } namelist_name = cast("str", context["namelist_name"]) - wrapper_reserved_names.update( + wrapper_procedure_names = { f"{namelist_name}_{suffix}".lower() for suffix in ( "from_file_wrapper", @@ -414,7 +414,14 @@ def build_f2py_namelist_spec( "is_set_wrapper", "is_valid_wrapper", ) - ) + } + wrapper_reserved_names.update(wrapper_procedure_names) + for kind_import in cast("list[str]", context["kind_imports"]): + kind_name = kind_import.split("=>", maxsplit=1)[0].strip().lower() + if kind_name in wrapper_procedure_names: + raise ValueError( + f"kind import '{kind_name}' conflicts with generated f2py wrapper procedure" + ) field_abi_names: dict[str, str] = {} field_names_in_use = set(wrapper_reserved_names) for field in fields: diff --git a/src/nml_tools/codegen_fortran.py b/src/nml_tools/codegen_fortran.py index 759642e..6898c33 100644 --- a/src/nml_tools/codegen_fortran.py +++ b/src/nml_tools/codegen_fortran.py @@ -1634,13 +1634,26 @@ def _register_runtime_dimension(dim_name: str) -> str: kind_map=kind_map, kind_allowlist=kind_allowlist, ) - imported_module_symbols = { - str(entry["type_name"]).lower() for entry in derived_type_imports - } - imported_module_symbols.update( - symbol.split("=>", maxsplit=1)[0].strip().lower() - for symbol in helper_imports + resolved_kind_imports - ) + imported_symbol_owners: dict[str, str] = {} + + def _register_imported_symbol(symbol: str, module: str) -> None: + local_name = symbol.split("=>", maxsplit=1)[0].strip() + canonical_name = local_name.lower() + canonical_module = module.lower() + existing_module = imported_symbol_owners.get(canonical_name) + if existing_module is not None and existing_module != canonical_module: + raise ValueError( + f"imported symbol '{local_name}' is provided by both " + f"'{existing_module}' and '{canonical_module}'" + ) + imported_symbol_owners[canonical_name] = canonical_module + + for symbol in helper_imports: + _register_imported_symbol(symbol, helper_module) + for symbol in resolved_kind_imports: + _register_imported_symbol(symbol, resolved_kind_module) + for entry in derived_type_imports: + _register_imported_symbol(str(entry["type_name"]), str(entry["module"])) generated_module_symbols = [ type_name, data_type_name, @@ -1659,7 +1672,7 @@ def _register_runtime_dimension(dim_name: str) -> str: if f2py_handle_helpers: generated_module_symbols.append(f"{module_name}_resolve_handle") for symbol_name in generated_module_symbols: - if symbol_name.lower() in imported_module_symbols: + if symbol_name.lower() in imported_symbol_owners: raise ValueError( f"generated module symbol '{symbol_name}' conflicts with an imported symbol" ) diff --git a/tests/test_codegen_f2py.py b/tests/test_codegen_f2py.py index 28af9ba..a7fd5fb 100644 --- a/tests/test_codegen_f2py.py +++ b/tests/test_codegen_f2py.py @@ -854,3 +854,21 @@ def test_f2py_mangles_schema_arguments_matching_wrapper_procedures( " 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="kind import 'run_set_wrapper' conflicts"): + codegen.build_f2py_namelist_spec( + schema, + kind_map={"run_set_wrapper": "int32"}, + kind_allowlist={"int32"}, + ) diff --git a/tests/test_codegen_fortran.py b/tests/test_codegen_fortran.py index 886965e..00093ff 100644 --- a/tests/test_codegen_fortran.py +++ b/tests/test_codegen_fortran.py @@ -902,6 +902,55 @@ def test_generate_fortran_rejects_f2py_handle_helper_import_collision() -> None: ) +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="imported symbol 'status' is provided by both"): + 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="imported symbol 'status' is provided by both"): + codegen.render_fortran(schema, file_name="nml_run.f90") + + @pytest.mark.parametrize( ("schema", "kwargs"), [ From b5c8bce15e91daa7b1903fc4464d7edcd86c598d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Tue, 15 Sep 2026 10:11:35 +0200 Subject: [PATCH 13/22] fix(fortran): reserve generated import scopes Protect wrapper ABI names and reject configured imports that shadow generated procedure scopes. --- examples/01_simple/out/nml_optimization.f90 | 1 - .../fortran/generated/nml_config.f90 | 1 - examples/03_references/out/nml_report.f90 | 1 - examples/03_references/out/nml_run.f90 | 1 - src/nml_tools/codegen_f2py.py | 8 ++ src/nml_tools/codegen_fortran.py | 19 ++++ src/nml_tools/templates/fortran_module.f90.j2 | 3 - .../01_simple/out/nml_optimization.f90 | 1 - tests/test_codegen_f2py.py | 16 +++ tests/test_codegen_fortran.py | 106 ++++++++++++++++++ 10 files changed, 149 insertions(+), 8 deletions(-) diff --git a/examples/01_simple/out/nml_optimization.f90 b/examples/01_simple/out/nml_optimization.f90 index a24859e..1504ace 100644 --- a/examples/01_simple/out/nml_optimization.f90 +++ b/examples/01_simple/out/nml_optimization.f90 @@ -55,7 +55,6 @@ module nml_optimization real(dp), parameter, public :: mcmc_error_params__min = 0.0_dp private :: nml_optimization_read__from_file - private :: nml__ieee_value, nml__ieee_quiet_nan, nml__ieee_is_nan !> \class nml_optimization_data_t !> \brief Schema-backed values for optimization diff --git a/examples/02_pybind/fortran/generated/nml_config.f90 b/examples/02_pybind/fortran/generated/nml_config.f90 index f5938bd..adc1803 100644 --- a/examples/02_pybind/fortran/generated/nml_config.f90 +++ b/examples/02_pybind/fortran/generated/nml_config.f90 @@ -49,7 +49,6 @@ module nml_config real(dp), parameter, public :: tolerance__min_excl = 0.0_dp private :: nml_config_read__from_file - private :: nml__ieee_value, nml__ieee_quiet_nan, nml__ieee_is_nan !> \class nml_config_data_t !> \brief Schema-backed values for config diff --git a/examples/03_references/out/nml_report.f90 b/examples/03_references/out/nml_report.f90 index 12caa04..a6a5047 100644 --- a/examples/03_references/out/nml_report.f90 +++ b/examples/03_references/out/nml_report.f90 @@ -45,7 +45,6 @@ module nml_report real(dp), parameter, public :: acceptance_fraction__max = 1.0_dp private :: nml_report_read__from_file - private :: nml__ieee_value, nml__ieee_quiet_nan, nml__ieee_is_nan !> \class nml_report_data_t !> \brief Schema-backed values for report diff --git a/examples/03_references/out/nml_run.f90 b/examples/03_references/out/nml_run.f90 index 8c0272e..b4c0c45 100644 --- a/examples/03_references/out/nml_run.f90 +++ b/examples/03_references/out/nml_run.f90 @@ -51,7 +51,6 @@ module nml_run real(dp), parameter, public :: relaxation__max = 0.5_dp private :: nml_run_read__from_file - private :: nml__ieee_value, nml__ieee_quiet_nan, nml__ieee_is_nan !> \class nml_run_data_t !> \brief Schema-backed values for run diff --git a/src/nml_tools/codegen_f2py.py b/src/nml_tools/codegen_f2py.py index b528df8..1d34c76 100644 --- a/src/nml_tools/codegen_f2py.py +++ b/src/nml_tools/codegen_f2py.py @@ -393,6 +393,7 @@ def build_f2py_namelist_spec( wrapper_reserved_names = { "associated", + "c_intptr_t", "errmsg", "handle", "len", @@ -405,6 +406,13 @@ def build_f2py_namelist_spec( "this", } namelist_name = cast("str", context["namelist_name"]) + module_name = cast("str", context["module_name"]) + wrapper_reserved_names.update( + { + cast("str", context["type_name"]).lower(), + f"{module_name}_resolve_handle".lower(), + } + ) wrapper_procedure_names = { f"{namelist_name}_{suffix}".lower() for suffix in ( diff --git a/src/nml_tools/codegen_fortran.py b/src/nml_tools/codegen_fortran.py index 6898c33..9719329 100644 --- a/src/nml_tools/codegen_fortran.py +++ b/src/nml_tools/codegen_fortran.py @@ -1525,6 +1525,11 @@ def _register_runtime_dimension(dim_name: str) -> str: "derived type name conflicts with a root property: " + ", ".join(type_name_collisions) ) + if type_name.lower() in property_name_map: + raise ValueError( + f"property '{property_name_map[type_name.lower()]}' conflicts with " + f"generated outer type '{type_name}'" + ) set_name = f"{module_name}_set" if set_name.lower() in property_name_map: raise ValueError( @@ -1540,6 +1545,11 @@ def _register_runtime_dimension(dim_name: str) -> str: f"generated init_type procedure '{init_type_name}'" ) if runtime_dimension_values: + if type_name.lower() in runtime_dimension_values: + raise ValueError( + f"runtime dimension '{type_name}' conflicts with " + f"generated outer type '{type_name}'" + ) set_dims_name = f"{module_name}_set_dims" if set_dims_name.lower() in runtime_dimension_values: raise ValueError( @@ -1652,8 +1662,17 @@ def _register_imported_symbol(symbol: str, module: str) -> None: _register_imported_symbol(symbol, helper_module) for symbol in resolved_kind_imports: _register_imported_symbol(symbol, resolved_kind_module) + if f2py_handle_helpers: + for symbol in ("c_f_pointer", "c_intptr_t", "c_null_ptr", "c_ptr"): + _register_imported_symbol(symbol, "iso_c_binding") for entry in derived_type_imports: _register_imported_symbol(str(entry["type_name"]), str(entry["module"])) + for property_name, display_name in property_name_map.items(): + if property_name in imported_symbol_owners: + raise ValueError( + f"property '{display_name}' conflicts with unqualified imported symbol " + f"'{display_name}'" + ) generated_module_symbols = [ type_name, data_type_name, diff --git a/src/nml_tools/templates/fortran_module.f90.j2 b/src/nml_tools/templates/fortran_module.f90.j2 index 0e869ba..4f1d44d 100644 --- a/src/nml_tools/templates/fortran_module.f90.j2 +++ b/src/nml_tools/templates/fortran_module.f90.j2 @@ -49,9 +49,6 @@ module {{ module_name }} {% endif %} private :: {{ type_prefix }}_read__from_file -{% if use_ieee %} - private :: nml__ieee_value, nml__ieee_quiet_nan, nml__ieee_is_nan -{% endif %} !> \class {{ data_type_name }} !> \brief Schema-backed values for {{ namelist_name }} diff --git a/tests/fixtures/01_simple/out/nml_optimization.f90 b/tests/fixtures/01_simple/out/nml_optimization.f90 index b9aa823..4f72920 100644 --- a/tests/fixtures/01_simple/out/nml_optimization.f90 +++ b/tests/fixtures/01_simple/out/nml_optimization.f90 @@ -42,7 +42,6 @@ module nml_optimization real(dp), parameter, public :: mcmc_error_params__default(4) = [0.01_dp, 0.6_dp, 0.2_dp, 0.3_dp] private :: nml_optimization_read__from_file - private :: nml__ieee_value, nml__ieee_quiet_nan, nml__ieee_is_nan !> \class nml_optimization_data_t !> \brief Schema-backed values for optimization diff --git a/tests/test_codegen_f2py.py b/tests/test_codegen_f2py.py index a7fd5fb..4bc229f 100644 --- a/tests/test_codegen_f2py.py +++ b/tests/test_codegen_f2py.py @@ -872,3 +872,19 @@ def test_f2py_rejects_kind_import_matching_wrapper_procedure() -> None: kind_map={"run_set_wrapper": "int32"}, kind_allowlist={"int32"}, ) + + +@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 00093ff..6c41d71 100644 --- a/tests/test_codegen_fortran.py +++ b/tests/test_codegen_fortran.py @@ -1044,6 +1044,96 @@ def test_generate_fortran_rejects_generated_procedure_dummy_collisions() -> None ) +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 unqualified 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 unqualified 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_rejects_iso_c_binding_import_collision() -> 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"}}, + } + }, + } + + with pytest.raises(ValueError, match="imported symbol 'c_ptr' is provided by both"): + codegen.render_fortran( + schema, + file_name="nml_run.f90", + f2py_handle_helpers=True, + ) + + @pytest.mark.parametrize("name", ["present", "Present", "size", "NML_OK"]) def test_generate_fortran_rejects_generated_dependency_names(name: str) -> None: codegen = _import_codegen_module() @@ -1077,6 +1167,22 @@ def test_generate_fortran_uses_direct_intrinsics_and_internal_helper_procedures( 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 = { From 2e2e4eb3b13a7e1614650c2cc2c8fa46dfdd3a5c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Wed, 16 Sep 2026 13:32:00 +0200 Subject: [PATCH 14/22] fix(fortran): isolate f2py resolver state Reject wrapper-procedure type imports and namespace native handle resolution internals. --- .../02_pybind/fortran/generated/nml_config.f90 | 12 ++++++------ .../fortran/generated/nml_run.f90 | 12 ++++++------ src/nml_tools/codegen_f2py.py | 5 +++++ src/nml_tools/templates/fortran_module.f90.j2 | 12 ++++++------ .../out/nml_wrapper_status.f90 | 12 ++++++------ tests/test_codegen_f2py.py | 18 ++++++++++++++++++ tests/test_codegen_fortran.py | 5 +++-- 7 files changed, 50 insertions(+), 26 deletions(-) diff --git a/examples/02_pybind/fortran/generated/nml_config.f90 b/examples/02_pybind/fortran/generated/nml_config.f90 index adc1803..281af46 100644 --- a/examples/02_pybind/fortran/generated/nml_config.f90 +++ b/examples/02_pybind/fortran/generated/nml_config.f90 @@ -125,22 +125,22 @@ elemental logical function tolerance__in_bounds(val, allow_missing) result(in_bo end function tolerance__in_bounds !> \brief Resolve an opaque C pointer handle to a nml_config_t pointer - subroutine nml_config_resolve_handle(handle, nml__obj, nml__status, errmsg) - integer(c_intptr_t), intent(in) :: handle !< opaque handle to a nml_config_t instance + subroutine nml_config_resolve_handle(nml__handle, nml__obj, nml__status, errmsg) + 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(nml__obj) - if (handle == 0_c_intptr_t) then + 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, nml__obj) + 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 diff --git a/examples/04_derived_types/fortran/generated/nml_run.f90 b/examples/04_derived_types/fortran/generated/nml_run.f90 index 5a16625..12b948a 100644 --- a/examples/04_derived_types/fortran/generated/nml_run.f90 +++ b/examples/04_derived_types/fortran/generated/nml_run.f90 @@ -134,22 +134,22 @@ elemental logical function station__code__in_bounds(val, allow_missing) result(i 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, nml__obj, nml__status, errmsg) - integer(c_intptr_t), intent(in) :: handle !< opaque handle to a nml_run_t instance + subroutine nml_run_resolve_handle(nml__handle, nml__obj, nml__status, errmsg) + 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(nml__obj) - if (handle == 0_c_intptr_t) then + 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, nml__obj) + 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 diff --git a/src/nml_tools/codegen_f2py.py b/src/nml_tools/codegen_f2py.py index 1d34c76..3409b88 100644 --- a/src/nml_tools/codegen_f2py.py +++ b/src/nml_tools/codegen_f2py.py @@ -464,6 +464,11 @@ 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() in wrapper_procedure_names: + raise ValueError( + f"derived type '{derived_type_name}' conflicts with " + "generated f2py wrapper procedure" + ) if derived_type_name.lower() not in { name.lower() for name in derived_type_names }: diff --git a/src/nml_tools/templates/fortran_module.f90.j2 b/src/nml_tools/templates/fortran_module.f90.j2 index 4f1d44d..ff090d5 100644 --- a/src/nml_tools/templates/fortran_module.f90.j2 +++ b/src/nml_tools/templates/fortran_module.f90.j2 @@ -149,22 +149,22 @@ contains {% endif %} {% if f2py_handle_helpers %} !> \brief Resolve an opaque C pointer handle to a {{ type_name }} pointer - subroutine {{ type_prefix }}_resolve_handle(handle, nml__obj, nml__status, errmsg) - integer(c_intptr_t), intent(in) :: handle !< opaque handle to a {{ type_name }} instance + subroutine {{ type_prefix }}_resolve_handle(nml__handle, nml__obj, nml__status, errmsg) + 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(nml__obj) - if (handle == 0_c_intptr_t) then + 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, nml__obj) + 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 diff --git a/tests/fortran_namespaces/out/nml_wrapper_status.f90 b/tests/fortran_namespaces/out/nml_wrapper_status.f90 index 1e7ffc6..fc7b01b 100644 --- a/tests/fortran_namespaces/out/nml_wrapper_status.f90 +++ b/tests/fortran_namespaces/out/nml_wrapper_status.f90 @@ -54,22 +54,22 @@ module nml_wrapper_status contains !> \brief Resolve an opaque C pointer handle to a nml_wrapper_status_t pointer - subroutine nml_wrapper_status_resolve_handle(handle, nml__obj, nml__status, errmsg) - integer(c_intptr_t), intent(in) :: handle !< opaque handle to a nml_wrapper_status_t instance + subroutine nml_wrapper_status_resolve_handle(nml__handle, nml__obj, nml__status, errmsg) + 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) :: ptr + type(c_ptr) :: nml__ptr if (present(errmsg)) errmsg = "" nullify(nml__obj) - if (handle == 0_c_intptr_t) then + 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, nml__obj) + 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 diff --git a/tests/test_codegen_f2py.py b/tests/test_codegen_f2py.py index 4bc229f..3d3413f 100644 --- a/tests/test_codegen_f2py.py +++ b/tests/test_codegen_f2py.py @@ -874,6 +874,24 @@ def test_f2py_rejects_kind_import_matching_wrapper_procedure() -> None: ) +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="derived type 'run_set_wrapper' conflicts"): + 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, diff --git a/tests/test_codegen_fortran.py b/tests/test_codegen_fortran.py index 6c41d71..569a27d 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: From b65eb70c58966689ce0ee08bf27363d7473a5595 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Wed, 7 Oct 2026 23:13:21 +0200 Subject: [PATCH 15/22] test: align dimension inference fixture with identifier policy Use count instead of the reserved size intrinsic in the upstream multi-file inference fixture after rebasing onto main. --- tests/test_dimensions.py | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) 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}, From 3e24f7247b99e1b546f7066ae5fc310a938ac94e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Wed, 7 Oct 2026 23:47:11 +0200 Subject: [PATCH 16/22] refactor(codegen): centralize generated scope validation Track declaration categories and case-insensitive entity ownership across helper, native, and f2py scopes. Use wrapper inventories for ABI reservations and reject helper declaration and flat namelist group collisions before rendering. --- src/nml_tools/_fortran_scope.py | 62 +++++++++++ src/nml_tools/codegen_f2py.py | 67 ++++++------ src/nml_tools/codegen_fortran.py | 175 ++++++++++++++++++------------- tests/test_codegen_f2py.py | 4 +- tests/test_codegen_fortran.py | 16 +-- tests/test_codegen_scopes.py | 85 +++++++++++++++ tests/test_fortran_scope.py | 34 ++++++ 7 files changed, 324 insertions(+), 119 deletions(-) create mode 100644 src/nml_tools/_fortran_scope.py create mode 100644 tests/test_codegen_scopes.py create mode 100644 tests/test_fortran_scope.py diff --git a/src/nml_tools/_fortran_scope.py b/src/nml_tools/_fortran_scope.py new file mode 100644 index 0000000..7eb4f6e --- /dev/null +++ b/src/nml_tools/_fortran_scope.py @@ -0,0 +1,62 @@ +"""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) -> None: + self.name = 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.""" + 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) + 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/codegen_f2py.py b/src/nml_tools/codegen_f2py.py index 3409b88..e4cac72 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, @@ -391,28 +392,24 @@ def build_f2py_namelist_spec( array_dimensions: list[F2pyArrayDimensionSpec] = [] derived_type_names: list[str] = [] - wrapper_reserved_names = { - "associated", - "c_intptr_t", - "errmsg", - "handle", - "len", - "nml__errmsg", - "nml__handle", - "nml__obj", - "nml__status", - "size", - "status", - "this", - } namelist_name = cast("str", context["namelist_name"]) module_name = cast("str", context["module_name"]) - wrapper_reserved_names.update( - { - cast("str", context["type_name"]).lower(), - f"{module_name}_resolve_handle".lower(), - } - ) + wrapper_scope = FortranScope(f"f2py_{namelist_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 ( @@ -423,13 +420,20 @@ def build_f2py_namelist_spec( "is_valid_wrapper", ) } - wrapper_reserved_names.update(wrapper_procedure_names) - for kind_import in cast("list[str]", context["kind_imports"]): - kind_name = kind_import.split("=>", maxsplit=1)[0].strip().lower() - if kind_name in wrapper_procedure_names: - raise ValueError( - f"kind import '{kind_name}' conflicts with generated f2py wrapper procedure" - ) + 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: @@ -464,15 +468,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() in wrapper_procedure_names: - raise ValueError( - f"derived type '{derived_type_name}' conflicts with " - "generated f2py wrapper procedure" - ) - 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, diff --git a/src/nml_tools/codegen_fortran.py b/src/nml_tools/codegen_fortran.py index 9719329..55cc2fc 100644 --- a/src/nml_tools/codegen_fortran.py +++ b/src/nml_tools/codegen_fortran.py @@ -9,8 +9,10 @@ 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, @@ -227,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) + 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, } @@ -397,7 +418,6 @@ def _build_context( bounds_functions: list[dict[str, Any]] = [] bounds_checks: list[dict[str, Any]] = [] derived_type_imports: list[dict[str, str]] = [] - derived_type_scope_names: set[str] = set() derived_init_type_fields: list[dict[str, Any]] = [] derived_presence_blocks: list[str] = [] static_constants = normalize_constant_values(constants) @@ -598,7 +618,6 @@ def _register_runtime_dimension(dim_name: str) -> str: requires_input = requirement.requires_input if derived is not None: derived_type_name = _derived_type_name(derived) - derived_type_scope_names.add(derived_type_name.lower()) module = derived.get("x-fortran-module") if module is None: _add_helper_import(derived_type_name) @@ -1518,44 +1537,6 @@ def _register_runtime_dimension(dim_name: str) -> str: runtime_dimensions.sort( key=lambda entry: runtime_dimension_order[str(entry["name"])] ) - root_scope_names = set(property_name_map) - type_name_collisions = sorted(derived_type_scope_names & root_scope_names) - if type_name_collisions: - raise ValueError( - "derived type name conflicts with a root property: " - + ", ".join(type_name_collisions) - ) - if type_name.lower() in property_name_map: - raise ValueError( - f"property '{property_name_map[type_name.lower()]}' conflicts with " - f"generated outer type '{type_name}'" - ) - set_name = f"{module_name}_set" - if set_name.lower() in property_name_map: - raise ValueError( - f"property '{property_name_map[set_name.lower()]}' conflicts with " - f"generated set procedure '{set_name}'" - ) - if derived_init_type_fields: - init_type_name = f"{module_name}_init_type" - derived_field_names = {entry["name"].lower() for entry in derived_init_type_fields} - if init_type_name.lower() in derived_field_names: - raise ValueError( - f"property '{property_name_map[init_type_name.lower()]}' conflicts with " - f"generated init_type procedure '{init_type_name}'" - ) - if runtime_dimension_values: - if type_name.lower() in runtime_dimension_values: - raise ValueError( - f"runtime dimension '{type_name}' conflicts with " - f"generated outer type '{type_name}'" - ) - set_dims_name = f"{module_name}_set_dims" - if set_dims_name.lower() in runtime_dimension_values: - raise ValueError( - f"runtime dimension '{set_dims_name}' conflicts with " - f"generated set_dims procedure '{set_dims_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] = [] @@ -1644,35 +1625,22 @@ def _register_runtime_dimension(dim_name: str) -> str: kind_map=kind_map, kind_allowlist=kind_allowlist, ) - imported_symbol_owners: dict[str, str] = {} - - def _register_imported_symbol(symbol: str, module: str) -> None: - local_name = symbol.split("=>", maxsplit=1)[0].strip() - canonical_name = local_name.lower() - canonical_module = module.lower() - existing_module = imported_symbol_owners.get(canonical_name) - if existing_module is not None and existing_module != canonical_module: - raise ValueError( - f"imported symbol '{local_name}' is provided by both " - f"'{existing_module}' and '{canonical_module}'" - ) - imported_symbol_owners[canonical_name] = canonical_module - + module_scope = FortranScope(module_name) for symbol in helper_imports: - _register_imported_symbol(symbol, helper_module) + module_scope.import_symbol(symbol, helper_module) for symbol in resolved_kind_imports: - _register_imported_symbol(symbol, resolved_kind_module) + module_scope.import_symbol(symbol, resolved_kind_module) if f2py_handle_helpers: for symbol in ("c_f_pointer", "c_intptr_t", "c_null_ptr", "c_ptr"): - _register_imported_symbol(symbol, "iso_c_binding") + module_scope.import_symbol(symbol, "iso_c_binding") + 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: - _register_imported_symbol(str(entry["type_name"]), str(entry["module"])) - for property_name, display_name in property_name_map.items(): - if property_name in imported_symbol_owners: - raise ValueError( - f"property '{display_name}' conflicts with unqualified imported symbol " - f"'{display_name}'" - ) + 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, @@ -1681,6 +1649,7 @@ def _register_imported_symbol(symbol: str, module: str) -> None: 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"]) @@ -1691,10 +1660,66 @@ def _register_imported_symbol(symbol: str, module: str) -> None: if f2py_handle_helpers: generated_module_symbols.append(f"{module_name}_resolve_handle") for symbol_name in generated_module_symbols: - if symbol_name.lower() in imported_symbol_owners: - raise ValueError( - f"generated module symbol '{symbol_name}' conflicts with an imported symbol" - ) + 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}" + scope = dependencies.child(procedure, names=( + {type_name.lower()} | {symbol.lower() for symbol in helper_imports} + if suffix == "set_dims" else None + )) + scope.declare(procedure, category="procedure", identity=("procedure", procedure), + source=f"generated {suffix} procedure '{procedure}'") + 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'")]) + 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, diff --git a/tests/test_codegen_f2py.py b/tests/test_codegen_f2py.py index 3d3413f..b46c478 100644 --- a/tests/test_codegen_f2py.py +++ b/tests/test_codegen_f2py.py @@ -866,7 +866,7 @@ def test_f2py_rejects_kind_import_matching_wrapper_procedure() -> None: }, } - with pytest.raises(ValueError, match="kind import 'run_set_wrapper' conflicts"): + with pytest.raises(ValueError, match="wrapper procedure 'run_set_wrapper' conflicts.*int32"): codegen.build_f2py_namelist_spec( schema, kind_map={"run_set_wrapper": "int32"}, @@ -888,7 +888,7 @@ def test_f2py_rejects_derived_type_matching_wrapper_procedure() -> None: }, } - with pytest.raises(ValueError, match="derived type 'run_set_wrapper' conflicts"): + with pytest.raises(ValueError, match="wrapper procedure 'run_set_wrapper' conflicts.*nml_run"): codegen.build_f2py_namelist_spec(schema) diff --git a/tests/test_codegen_fortran.py b/tests/test_codegen_fortran.py index 569a27d..5d7759f 100644 --- a/tests/test_codegen_fortran.py +++ b/tests/test_codegen_fortran.py @@ -924,7 +924,9 @@ def test_generate_fortran_rejects_ambiguous_imported_type_names() -> None: }, } - with pytest.raises(ValueError, match="imported symbol 'status' is provided by both"): + with pytest.raises( + ValueError, match="application_b.*conflicts.*application_a.*scope 'nml_run'" + ): codegen.render_fortran(schema, file_name="nml_run.f90") @@ -948,7 +950,7 @@ def test_generate_fortran_rejects_local_and_imported_type_name_collision() -> No }, } - with pytest.raises(ValueError, match="imported symbol 'status' is provided by both"): + with pytest.raises(ValueError, match="application_types.*conflicts.*nml_helper"): codegen.render_fortran(schema, file_name="nml_run.f90") @@ -1079,7 +1081,7 @@ def test_generate_fortran_rejects_outer_type_procedure_scope_collisions() -> Non def test_generate_fortran_rejects_property_colliding_with_configured_import() -> None: codegen = _import_codegen_module() - with pytest.raises(ValueError, match="property 'n' conflicts with unqualified imported symbol"): + with pytest.raises(ValueError, match="property 'n' conflicts with imported symbol"): codegen.render_fortran( { "x-fortran-namelist": "run", @@ -1098,7 +1100,7 @@ def test_generate_fortran_rejects_property_colliding_with_configured_import() -> ) with pytest.raises( - ValueError, match="property 'i4' conflicts with unqualified imported symbol" + ValueError, match="property 'i4' conflicts with imported symbol" ): codegen.render_fortran( { @@ -1127,7 +1129,7 @@ def test_generate_fortran_rejects_iso_c_binding_import_collision() -> None: }, } - with pytest.raises(ValueError, match="imported symbol 'c_ptr' is provided by both"): + with pytest.raises(ValueError, match="application_types.*conflicts.*iso_c_binding"): codegen.render_fortran( schema, file_name="nml_run.f90", @@ -1199,7 +1201,9 @@ def test_generate_fortran_rejects_derived_type_root_symbol_collision() -> None: }, } - with pytest.raises(ValueError, match="derived type name conflicts"): + with pytest.raises( + ValueError, match="property 'period' conflicts with imported symbol 'period'" + ): codegen.render_fortran(schema, file_name="nml_run.f90") diff --git a/tests/test_codegen_scopes.py b/tests/test_codegen_scopes.py new file mode 100644 index 0000000..d881de3 --- /dev/null +++ b/tests/test_codegen_scopes.py @@ -0,0 +1,85 @@ +"""Cross-source generation scope regressions.""" + +from __future__ import annotations + +import pytest + +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 diff --git a/tests/test_fortran_scope.py b/tests/test_fortran_scope.py new file mode 100644 index 0000000..d1957c5 --- /dev/null +++ b/tests/test_fortran_scope.py @@ -0,0 +1,34 @@ +"""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() From 1990b0751d317d9bc699c097411520ce5e1ddebc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Wed, 7 Oct 2026 23:49:33 +0200 Subject: [PATCH 17/22] fix(fortran): isolate remaining generated helper state Move enum/bounds procedure state and file-helper locals/results into the reserved double-underscore namespace. Exercise old kind-alias collisions and imported type(status) wrapper calls in the compiler matrix fixture, and assert reader cleanup preserves error messages. --- src/nml_tools/codegen_fortran.py | 21 ++-- src/nml_tools/templates/fortran_module.f90.j2 | 38 +++--- src/nml_tools/templates/nml_helper.f90.j2 | 108 +++++++++--------- tests/fortran_namespaces/CMakeLists.txt | 1 + tests/fortran_namespaces/conformance.f90 | 33 +++++- tests/fortran_namespaces/constraints.yml | 18 +++ tests/fortran_namespaces/nml-config.toml | 9 +- tests/fortran_optional_read/conformance.f90 | 2 + tests/test_codegen_f2py.py | 4 + tests/test_codegen_fortran.py | 2 +- tests/test_codegen_scopes.py | 47 ++++++++ tests/test_enum_support.py | 4 +- 12 files changed, 199 insertions(+), 88 deletions(-) create mode 100644 tests/fortran_namespaces/constraints.yml diff --git a/src/nml_tools/codegen_fortran.py b/src/nml_tools/codegen_fortran.py index 55cc2fc..6464898 100644 --- a/src/nml_tools/codegen_fortran.py +++ b/src/nml_tools/codegen_fortran.py @@ -766,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( { @@ -828,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 @@ -1300,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( { @@ -1376,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 @@ -1695,6 +1695,11 @@ def validate_procedure( )) 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)), diff --git a/src/nml_tools/templates/fortran_module.f90.j2 b/src/nml_tools/templates/fortran_module.f90.j2 index ff090d5..ed54e68 100644 --- a/src/nml_tools/templates/fortran_module.f90.j2 +++ b/src/nml_tools/templates/fortran_module.f90.j2 @@ -99,22 +99,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 }} @@ -123,25 +123,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 }} @@ -626,7 +626,7 @@ 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 + 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 @@ -656,7 +656,7 @@ 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 + 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 diff --git a/src/nml_tools/templates/nml_helper.f90.j2 b/src/nml_tools/templates/nml_helper.f90.j2 index 8f68402..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,33 +166,33 @@ 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 !> \brief Validate index bounds for array access - integer function idx__check(idx, extents, field, errmsg) result(status) - integer, intent(in) :: idx(:) - integer, intent(in) :: extents(:) - 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(extents)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index rank mismatch for '" // trim(field) // "'" - else if (any(idx < 1) .or. any(idx > extents)) 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 diff --git a/tests/fortran_namespaces/CMakeLists.txt b/tests/fortran_namespaces/CMakeLists.txt index 0982c38..fbdab61 100644 --- a/tests/fortran_namespaces/CMakeLists.txt +++ b/tests/fortran_namespaces/CMakeLists.txt @@ -11,4 +11,5 @@ add_executable(generated_namespaces out/nml_namespaces.f90 out/nml_wrapper_status.f90 out/f2py_wrapper_status.f90 + out/nml_constraints.f90 ) diff --git a/tests/fortran_namespaces/conformance.f90 b/tests/fortran_namespaces/conformance.f90 index 1bae085..06258c2 100644 --- a/tests/fortran_namespaces/conformance.f90 +++ b/tests/fortran_namespaces/conformance.f90 @@ -1,12 +1,20 @@ program conformance - use nml_helper, only: NML_ERR_INVALID_INDEX, NML_OK + 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 implicit none type(nml_namespaces_t) :: config + type(nml_constraints_t) :: constraints + type(nml_wrapper_status_t), target :: wrapped + integer(c_intptr_t) :: handle character(len=256) :: root - character(len=256) :: errmsg + character(len=1024) :: errmsg integer :: source(0:1) integer :: status @@ -56,6 +64,27 @@ program conformance 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, .true., 42, .true., status, 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") + + 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) 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/nml-config.toml b/tests/fortran_namespaces/nml-config.toml index 02df47e..924360d 100644 --- a/tests/fortran_namespaces/nml-config.toml +++ b/tests/fortran_namespaces/nml-config.toml @@ -3,8 +3,8 @@ path = "out/nml_helper.f90" [kinds] module = "iso_fortran_env" -integer = ["int32"] -map = { i4 = "int32" } +integer = ["int16", "int32", "int64"] +map = { i4 = "int32", val = "int32", allow_missing = "int16", in_bounds = "int64" } [dimensions.status] default = 3 @@ -22,3 +22,8 @@ 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" diff --git a/tests/fortran_optional_read/conformance.f90 b/tests/fortran_optional_read/conformance.f90 index b439a9f..1541618 100644 --- a/tests/fortran_optional_read/conformance.f90 +++ b/tests/fortran_optional_read/conformance.f90 @@ -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/test_codegen_f2py.py b/tests/test_codegen_f2py.py index b46c478..926df65 100644 --- a/tests/test_codegen_f2py.py +++ b/tests/test_codegen_f2py.py @@ -509,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]) diff --git a/tests/test_codegen_fortran.py b/tests/test_codegen_fortran.py index 5d7759f..9c7a6c4 100644 --- a/tests/test_codegen_fortran.py +++ b/tests/test_codegen_fortran.py @@ -699,7 +699,7 @@ def test_generate_fortran_emits_bounds_helpers(tmp_path: Path) -> None: assert "elemental logical function tolerance__in_bounds" in generated assert "elemental logical function counts__in_bounds" in generated assert ( - "all(counts__in_bounds(nml__obj%data%counts, allow_missing=.true.))" + "all(counts__in_bounds(nml__obj%data%counts, nml__allow_missing=.true.))" in generated ) diff --git a/tests/test_codegen_scopes.py b/tests/test_codegen_scopes.py index d881de3..7a361c7 100644 --- a/tests/test_codegen_scopes.py +++ b/tests/test_codegen_scopes.py @@ -83,3 +83,50 @@ def test_qualified_intrinsic_components_and_repeated_imports_remain_supported() 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="namelist group 'ErrMsg'.*procedure state 'errmsg'"): + render_fortran( + { + "type": "object", + "x-fortran-namelist": "ErrMsg", + "properties": {"value": {"type": "integer"}}, + }, + file_name="errmsg.f90", + ) diff --git a/tests/test_enum_support.py b/tests/test_enum_support.py index 1e98ecb..69dd239 100644 --- a/tests/test_enum_support.py +++ b/tests/test_enum_support.py @@ -82,10 +82,10 @@ def test_generate_fortran_emits_enum_helpers(tmp_path: Path) -> None: assert "elemental logical function method__in_enum" in generated assert ( "all(try_methods__in_enum(" - "nml__obj%data%try_methods, allow_missing=.true.))" in generated + "nml__obj%data%try_methods, nml__allow_missing=.true.))" in generated ) assert ( - "all(sizes__in_enum(nml__obj%data%sizes, allow_missing=.true.))" + "all(sizes__in_enum(nml__obj%data%sizes, nml__allow_missing=.true.))" in generated ) From 8cb511b1c4ed36faf055c80174f69657afea7d2a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Wed, 7 Oct 2026 23:55:50 +0200 Subject: [PATCH 18/22] docs: finalize namespace contracts and migration guidance Document the bounded intrinsic/identifier policy, public storage invariants, focused toolbox scope, and caller-owned integer/message error contract. Regenerate committed Fortran outputs and the expanded namespace conformance fixture. --- README.md | 66 +++- examples/01_simple/out/nml_helper.f90 | 108 +++--- examples/01_simple/out/nml_optimization.f90 | 140 +++---- .../fortran/generated/nml_config.f90 | 40 +- .../fortran/generated/nml_helper.f90 | 108 +++--- examples/03_references/out/nml_helper.f90 | 108 +++--- examples/03_references/out/nml_report.f90 | 40 +- examples/03_references/out/nml_run.f90 | 84 ++-- .../fortran/generated/nml_helper.f90 | 108 +++--- .../fortran/generated/nml_run.f90 | 66 ++-- tests/fixtures/01_simple/out/nml_helper.f90 | 108 +++--- .../out/nml_constraints.f90 | 366 ++++++++++++++++++ tests/fortran_namespaces/out/nml_helper.f90 | 108 +++--- .../fortran_optional_read/out/nml_helper.f90 | 108 +++--- 14 files changed, 990 insertions(+), 568 deletions(-) create mode 100644 tests/fortran_namespaces/out/nml_constraints.f90 diff --git a/README.md b/README.md index d4ca370..115780b 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,7 +62,8 @@ 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/component and runtime dimension names must not be `errmsg` +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`; @@ -69,10 +75,31 @@ case-insensitively wherever they are emitted unqualified: 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`, and `minval`. The generated helper API also reserves `NML_OK`, all -`NML_ERR_*` names, `nml_file_t`, and `nml_line_buffer` in those scopes. -An imported or generated derived-type name also cannot duplicate a root -property name used in the same generated procedure scope. +`len_trim`, and `minval`. 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. +- 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. + +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 @@ -972,6 +999,14 @@ The generated module declares public `nml_run_data_t`, optional 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. @@ -1009,6 +1044,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 @@ -1018,6 +1056,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/out/nml_helper.f90 b/examples/01_simple/out/nml_helper.f90 index 5ea2d13..97c0b7e 100644 --- a/examples/01_simple/out/nml_helper.f90 +++ b/examples/01_simple/out/nml_helper.f90 @@ -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,33 +140,33 @@ 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 !> \brief Validate index bounds for array access - integer function idx__check(idx, extents, field, errmsg) result(status) - integer, intent(in) :: idx(:) - integer, intent(in) :: extents(:) - 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(extents)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index rank mismatch for '" // trim(field) // "'" - else if (any(idx < 1) .or. any(idx > extents)) 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 diff --git a/examples/01_simple/out/nml_optimization.f90 b/examples/01_simple/out/nml_optimization.f90 index 1504ace..79653b8 100644 --- a/examples/01_simple/out/nml_optimization.f90 +++ b/examples/01_simple/out/nml_optimization.f90 @@ -98,123 +98,123 @@ 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 (nml__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 (nml__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 (nml__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 @@ -723,12 +723,12 @@ integer function nml_optimization_is_valid(nml__obj, errmsg) result(nml__status) nml__status = nml__istat return end if - if (.not. all(try_methods__in_enum(nml__obj%data%try_methods, allow_missing=.true.))) then + 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(nml__obj%data%complex_sizes, allow_missing=.true.))) then + 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 @@ -768,7 +768,7 @@ integer function nml_optimization_is_valid(nml__obj, errmsg) result(nml__status) return end if if (allocated(nml__obj%data%mcmc_error_params)) then - if (.not. all(mcmc_error_params__in_bounds(nml__obj%data%mcmc_error_params, allow_missing=.true.))) 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 diff --git a/examples/02_pybind/fortran/generated/nml_config.f90 b/examples/02_pybind/fortran/generated/nml_config.f90 index 281af46..14c6ade 100644 --- a/examples/02_pybind/fortran/generated/nml_config.f90 +++ b/examples/02_pybind/fortran/generated/nml_config.f90 @@ -89,39 +89,39 @@ 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 (nml__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 diff --git a/examples/02_pybind/fortran/generated/nml_helper.f90 b/examples/02_pybind/fortran/generated/nml_helper.f90 index 961befe..e5e90af 100644 --- a/examples/02_pybind/fortran/generated/nml_helper.f90 +++ b/examples/02_pybind/fortran/generated/nml_helper.f90 @@ -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,33 +137,33 @@ 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 !> \brief Validate index bounds for array access - integer function idx__check(idx, extents, field, errmsg) result(status) - integer, intent(in) :: idx(:) - integer, intent(in) :: extents(:) - 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(extents)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index rank mismatch for '" // trim(field) // "'" - else if (any(idx < 1) .or. any(idx > extents)) 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 diff --git a/examples/03_references/out/nml_helper.f90 b/examples/03_references/out/nml_helper.f90 index ce6cd1a..c49c4a6 100644 --- a/examples/03_references/out/nml_helper.f90 +++ b/examples/03_references/out/nml_helper.f90 @@ -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,33 +139,33 @@ 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 !> \brief Validate index bounds for array access - integer function idx__check(idx, extents, field, errmsg) result(status) - integer, intent(in) :: idx(:) - integer, intent(in) :: extents(:) - 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(extents)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index rank mismatch for '" // trim(field) // "'" - else if (any(idx < 1) .or. any(idx > extents)) 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 diff --git a/examples/03_references/out/nml_report.f90 b/examples/03_references/out/nml_report.f90 index a6a5047..14b1447 100644 --- a/examples/03_references/out/nml_report.f90 +++ b/examples/03_references/out/nml_report.f90 @@ -71,38 +71,38 @@ 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 (nml__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 diff --git a/examples/03_references/out/nml_run.f90 b/examples/03_references/out/nml_run.f90 index b4c0c45..0424c5f 100644 --- a/examples/03_references/out/nml_run.f90 +++ b/examples/03_references/out/nml_run.f90 @@ -87,75 +87,75 @@ 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 (nml__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 (nml__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 @@ -451,7 +451,7 @@ integer function nml_run_is_valid(nml__obj, errmsg) result(nml__status) return end if if (allocated(nml__obj%data%station_weights)) then - if (.not. all(station_weights__in_bounds(nml__obj%data%station_weights, allow_missing=.true.))) 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 diff --git a/examples/04_derived_types/fortran/generated/nml_helper.f90 b/examples/04_derived_types/fortran/generated/nml_helper.f90 index ff757c4..c807732 100644 --- a/examples/04_derived_types/fortran/generated/nml_helper.f90 +++ b/examples/04_derived_types/fortran/generated/nml_helper.f90 @@ -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,33 +150,33 @@ 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 !> \brief Validate index bounds for array access - integer function idx__check(idx, extents, field, errmsg) result(status) - integer, intent(in) :: idx(:) - integer, intent(in) :: extents(:) - 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(extents)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index rank mismatch for '" // trim(field) // "'" - else if (any(idx < 1) .or. any(idx > extents)) 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 diff --git a/examples/04_derived_types/fortran/generated/nml_run.f90 b/examples/04_derived_types/fortran/generated/nml_run.f90 index 12b948a..283afa9 100644 --- a/examples/04_derived_types/fortran/generated/nml_run.f90 +++ b/examples/04_derived_types/fortran/generated/nml_run.f90 @@ -78,59 +78,59 @@ 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 @@ -517,7 +517,7 @@ integer function nml_run_is_valid(nml__obj, errmsg) result(nml__status) return end if if (allocated(nml__obj%data%periods)) then - if (.not. all(periods__start_year__in_bounds(nml__obj%data%periods%start_year, allow_missing=.true.))) 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 diff --git a/tests/fixtures/01_simple/out/nml_helper.f90 b/tests/fixtures/01_simple/out/nml_helper.f90 index 5ea2d13..97c0b7e 100644 --- a/tests/fixtures/01_simple/out/nml_helper.f90 +++ b/tests/fixtures/01_simple/out/nml_helper.f90 @@ -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,33 +140,33 @@ 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 !> \brief Validate index bounds for array access - integer function idx__check(idx, extents, field, errmsg) result(status) - integer, intent(in) :: idx(:) - integer, intent(in) :: extents(:) - 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(extents)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index rank mismatch for '" // trim(field) // "'" - else if (any(idx < 1) .or. any(idx > extents)) 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 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 index c359f9c..d7f6386 100644 --- a/tests/fortran_namespaces/out/nml_helper.f90 +++ b/tests/fortran_namespaces/out/nml_helper.f90 @@ -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,33 +137,33 @@ 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 !> \brief Validate index bounds for array access - integer function idx__check(idx, extents, field, errmsg) result(status) - integer, intent(in) :: idx(:) - integer, intent(in) :: extents(:) - 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(extents)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index rank mismatch for '" // trim(field) // "'" - else if (any(idx < 1) .or. any(idx > extents)) 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 diff --git a/tests/fortran_optional_read/out/nml_helper.f90 b/tests/fortran_optional_read/out/nml_helper.f90 index c860c2c..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,33 +134,33 @@ 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 !> \brief Validate index bounds for array access - integer function idx__check(idx, extents, field, errmsg) result(status) - integer, intent(in) :: idx(:) - integer, intent(in) :: extents(:) - 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(extents)) then - status = NML_ERR_INVALID_INDEX - if (present(errmsg)) errmsg = "index rank mismatch for '" // trim(field) // "'" - else if (any(idx < 1) .or. any(idx > extents)) 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 From ce4036fe524dff6a86d63798b4fccfa3a90c3280 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Thu, 8 Oct 2026 00:12:37 +0200 Subject: [PATCH 19/22] fix(fortran): reserve resolver and namelist group intrinsics Reserve transfer wherever generated dependencies are used unqualified, and apply the shared identifier policy to x-fortran-namelist in schema resolution and direct native generation. Add case-insensitive regressions for groups, imported types, and kind aliases, while preserving qualified intrinsic-named components. --- README.md | 15 ++++++----- src/nml_tools/_utils.py | 3 ++- src/nml_tools/codegen_fortran.py | 2 +- src/nml_tools/schema.py | 2 +- tests/test_codegen_scopes.py | 45 +++++++++++++++++++++++++++++++- tests/test_schema.py | 11 +++++--- 6 files changed, 64 insertions(+), 14 deletions(-) diff --git a/README.md b/README.md index 115780b..b4125ed 100644 --- a/README.md +++ b/README.md @@ -62,8 +62,8 @@ 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 properties/components, runtime dimensions, constants, kind aliases, -and derived-type names must not be `errmsg` +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`; @@ -71,12 +71,12 @@ 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: root properties, -runtime dimensions, constants, kind aliases, and derived-type names: +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`, and `minval`. Fortran developers should avoid intrinsic names in -these roles; the generator checks this explicit dependency list, not every +`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. @@ -702,7 +702,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. diff --git a/src/nml_tools/_utils.py b/src/nml_tools/_utils.py index 6ab792d..e052508 100644 --- a/src/nml_tools/_utils.py +++ b/src/nml_tools/_utils.py @@ -27,6 +27,7 @@ "reshape", "shape", "size", + "transfer", "trim", } ) @@ -73,7 +74,7 @@ def validate_user_fortran_identifier(name: str, *, label: str) -> None: def validate_namelist_identifier(name: str, *, label: str) -> None: - """Validate an identifier used for a namelist property or runtime dimension.""" + """Validate a namelist group, root property, or runtime dimension identifier.""" validate_user_fortran_identifier(name, label=label) validate_generated_fortran_identifier(name, label=label) diff --git a/src/nml_tools/codegen_fortran.py b/src/nml_tools/codegen_fortran.py index 6464898..5983f6f 100644 --- a/src/nml_tools/codegen_fortran.py +++ b/src/nml_tools/codegen_fortran.py @@ -355,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'") diff --git a/src/nml_tools/schema.py b/src/nml_tools/schema.py index 4f355f9..ba03c70 100644 --- a/src/nml_tools/schema.py +++ b/src/nml_tools/schema.py @@ -467,7 +467,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") diff --git a/tests/test_codegen_scopes.py b/tests/test_codegen_scopes.py index 7a361c7..a786301 100644 --- a/tests/test_codegen_scopes.py +++ b/tests/test_codegen_scopes.py @@ -121,7 +121,9 @@ def test_helper_state_uses_reserved_internal_names() -> None: def test_reader_group_cannot_shadow_public_error_dummy() -> None: - with pytest.raises(ValueError, match="namelist group 'ErrMsg'.*procedure state 'errmsg'"): + with pytest.raises( + ValueError, match="'x-fortran-namelist'.*reserved for the generated Fortran API" + ): render_fortran( { "type": "object", @@ -130,3 +132,44 @@ def test_reader_group_cannot_shadow_public_error_dummy() -> None: }, 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) diff --git a/tests/test_schema.py b/tests/test_schema.py index 17d6f1a..abdee68 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( @@ -1141,7 +1146,7 @@ def test_schema_rejects_reserved_errmsg_properties(name: str) -> None: ) -@pytest.mark.parametrize("name", ["present", "size"]) +@pytest.mark.parametrize("name", ["present", "size", "transfer"]) def test_schema_allows_qualified_derived_components_named_after_intrinsics(name: str) -> None: schema = resolve_schema( { @@ -1165,7 +1170,7 @@ def test_schema_allows_qualified_derived_components_named_after_intrinsics(name: assert f"nml__obj%data%value%{name}" in generated -@pytest.mark.parametrize("name", ["present", "SIZE", "NML_OK"]) +@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( @@ -1177,7 +1182,7 @@ def test_schema_rejects_generated_dependency_properties(name: str) -> None: ) -@pytest.mark.parametrize("type_name", ["present", "NML_FILE_T", "nml_open"]) +@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( From 19155d3297f2439fe93ab8ecee7368cd15932d66 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Thu, 8 Oct 2026 00:27:51 +0200 Subject: [PATCH 20/22] fix(schema): reject namelist group property collisions early Validate case-insensitive root property/group overlap during schema loading and recheck identifiers after root reference composition. Cover helper-free documentation/template generation and checks, inherited group/property declarations, and legal qualified components. --- README.md | 4 +++- src/nml_tools/schema.py | 8 +++++++ tests/test_cli_config.py | 36 ++++++++++++++++++++++++++++++ tests/test_schema.py | 48 ++++++++++++++++++++++++++++++++++++++++ 4 files changed, 95 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index b4125ed..802680c 100644 --- a/README.md +++ b/README.md @@ -85,7 +85,9 @@ 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. +- 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. diff --git a/src/nml_tools/schema.py b/src/nml_tools/schema.py index ba03c70..42454d4 100644 --- a/src/nml_tools/schema.py +++ b/src/nml_tools/schema.py @@ -242,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( @@ -512,6 +515,11 @@ def _validate_user_identifiers(raw: Any, document: _Document, pointer: str) -> N try: 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}'" diff --git a/tests/test_cli_config.py b/tests/test_cli_config.py index 004f5a1..7c53b76 100644 --- a/tests/test_cli_config.py +++ b/tests/test_cli_config.py @@ -1464,6 +1464,42 @@ def test_load_kind_settings_rejects_generated_dependency_alias() -> None: ) +@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): diff --git a/tests/test_schema.py b/tests/test_schema.py index abdee68..c090b58 100644 --- a/tests/test_schema.py +++ b/tests/test_schema.py @@ -975,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"), [ From cffdf1dba906e941a1701d565a37b36b35278023 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Thu, 8 Oct 2026 10:23:55 +0200 Subject: [PATCH 21/22] fix(codegen): isolate resolver imports and reject self-use modules Keep C-binding dependencies inside resolve_handle so opaque-handle support does not restrict native fields/dimensions. Track the emitted owner module separately from local symbols and reject actual case-insensitive self-USE in helper, native, and f2py scopes, while allowing unused module configuration and source-module-spelled fields. --- src/nml_tools/_fortran_scope.py | 10 +- src/nml_tools/codegen_f2py.py | 3 +- src/nml_tools/codegen_fortran.py | 31 ++-- src/nml_tools/templates/fortran_module.f90.j2 | 4 +- tests/test_codegen_fortran.py | 15 +- tests/test_codegen_scopes.py | 149 ++++++++++++++++++ tests/test_fortran_scope.py | 16 ++ 7 files changed, 206 insertions(+), 22 deletions(-) diff --git a/src/nml_tools/_fortran_scope.py b/src/nml_tools/_fortran_scope.py index 7eb4f6e..b5874cf 100644 --- a/src/nml_tools/_fortran_scope.py +++ b/src/nml_tools/_fortran_scope.py @@ -19,8 +19,9 @@ class _Symbol: class FortranScope: """Reject conflicting entities under the same case-insensitive local name.""" - def __init__(self, name: str) -> None: + 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 @@ -43,6 +44,11 @@ def declare(self, name: str, *, category: str, identity: tuple[str, ...], source 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() @@ -55,7 +61,7 @@ def import_symbol(self, symbol: str, module: str, *, category: str = "import") - def child(self, name: str, *, names: set[str] | None = None) -> FortranScope: """Copy dependencies to a procedure inventory without changing its host.""" - scope = FortranScope(name) + 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 } diff --git a/src/nml_tools/codegen_f2py.py b/src/nml_tools/codegen_f2py.py index e4cac72..aec05ec 100644 --- a/src/nml_tools/codegen_f2py.py +++ b/src/nml_tools/codegen_f2py.py @@ -394,7 +394,8 @@ def build_f2py_namelist_spec( namelist_name = cast("str", context["namelist_name"]) module_name = cast("str", context["module_name"]) - wrapper_scope = FortranScope(f"f2py_{namelist_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) diff --git a/src/nml_tools/codegen_fortran.py b/src/nml_tools/codegen_fortran.py index 5983f6f..b437c10 100644 --- a/src/nml_tools/codegen_fortran.py +++ b/src/nml_tools/codegen_fortran.py @@ -232,7 +232,7 @@ def render_helper( kind_imports = _resolve_kind_imports( helper_kind_ids, kind_map=kind_map, kind_allowlist=kind_allowlist ) - scope = FortranScope(module_name) + 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"): @@ -1625,14 +1625,11 @@ def _register_runtime_dimension(dim_name: str) -> str: kind_map=kind_map, kind_allowlist=kind_allowlist, ) - module_scope = FortranScope(module_name) + 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 f2py_handle_helpers: - for symbol in ("c_f_pointer", "c_intptr_t", "c_null_ptr", "c_ptr"): - module_scope.import_symbol(symbol, "iso_c_binding") if requires_ieee: for symbol in ("ieee_value", "ieee_quiet_nan", "ieee_is_nan"): module_scope.import_symbol(f"nml__{symbol} => {symbol}", "ieee_arithmetic") @@ -1689,10 +1686,24 @@ def validate_procedure( suffix: str, arguments: list[tuple[str, str]], *, reader: bool = False ) -> None: procedure = f"{module_name}_{suffix}" - scope = dependencies.child(procedure, names=( - {type_name.lower()} | {symbol.lower() for symbol in helper_imports} - if suffix == "set_dims" else None - )) + 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"): @@ -1714,6 +1725,8 @@ def validate_procedure( 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}'") diff --git a/src/nml_tools/templates/fortran_module.f90.j2 b/src/nml_tools/templates/fortran_module.f90.j2 index ed54e68..24980de 100644 --- a/src/nml_tools/templates/fortran_module.f90.j2 +++ b/src/nml_tools/templates/fortran_module.f90.j2 @@ -21,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 @@ -150,6 +147,7 @@ contains {% if f2py_handle_helpers %} !> \brief Resolve an opaque C pointer handle to a {{ type_name }} pointer 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 diff --git a/tests/test_codegen_fortran.py b/tests/test_codegen_fortran.py index 9c7a6c4..db0b10e 100644 --- a/tests/test_codegen_fortran.py +++ b/tests/test_codegen_fortran.py @@ -1114,7 +1114,7 @@ def test_generate_fortran_rejects_property_colliding_with_configured_import() -> ) -def test_generate_fortran_rejects_iso_c_binding_import_collision() -> None: +def test_generate_fortran_isolates_resolver_imports_from_application_types() -> None: codegen = _import_codegen_module() schema = { "x-fortran-namelist": "run", @@ -1129,12 +1129,13 @@ def test_generate_fortran_rejects_iso_c_binding_import_collision() -> None: }, } - with pytest.raises(ValueError, match="application_types.*conflicts.*iso_c_binding"): - codegen.render_fortran( - schema, - file_name="nml_run.f90", - f2py_handle_helpers=True, - ) + 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"]) diff --git a/tests/test_codegen_scopes.py b/tests/test_codegen_scopes.py index a786301..a29c6b8 100644 --- a/tests/test_codegen_scopes.py +++ b/tests/test_codegen_scopes.py @@ -4,6 +4,7 @@ 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, @@ -173,3 +174,151 @@ def test_handle_resolver_rejects_transfer_imports(name: str, source: str) -> Non 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_fortran_scope.py b/tests/test_fortran_scope.py index d1957c5..446fbd0 100644 --- a/tests/test_fortran_scope.py +++ b/tests/test_fortran_scope.py @@ -32,3 +32,19 @@ def test_local_categories_and_child_scopes() -> None: 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"} From 58a1ec874b9a4d6f881cf824b8e5e3e55e13a174 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Thu, 8 Oct 2026 10:31:53 +0200 Subject: [PATCH 22/22] test(fortran): cover resolver isolation in compiled namespace fixtures Exercise C-binding-named fields and dimensions, f2py ABI mangling, flat reader calls, and an application-owned type(c_ptr) alongside resolver-local C imports. Document conditional self-USE rejection and regenerate the affected committed modules and wrappers. --- README.md | 10 + .../fortran/generated/nml_config.f90 | 2 +- .../fortran/generated/nml_run.f90 | 2 +- tests/fortran_namespaces/CMakeLists.txt | 2 + .../fortran_namespaces/application_types.f90 | 4 + tests/fortran_namespaces/c_bindings.nml | 7 + tests/fortran_namespaces/c_bindings.yml | 22 ++ tests/fortran_namespaces/conformance.f90 | 28 +- tests/fortran_namespaces/nml-config.toml | 9 + .../out/f2py_c_bindings.f90 | 162 ++++++++ .../out/f2py_wrapper_status.f90 | 16 +- .../fortran_namespaces/out/nml_c_bindings.f90 | 348 ++++++++++++++++++ tests/fortran_namespaces/out/nml_helper.f90 | 1 + .../out/nml_wrapper_status.f90 | 31 +- tests/fortran_namespaces/wrapper_status.yml | 8 + 15 files changed, 646 insertions(+), 6 deletions(-) create mode 100644 tests/fortran_namespaces/c_bindings.nml create mode 100644 tests/fortran_namespaces/c_bindings.yml create mode 100644 tests/fortran_namespaces/out/f2py_c_bindings.f90 create mode 100644 tests/fortran_namespaces/out/nml_c_bindings.f90 diff --git a/README.md b/README.md index 802680c..ca4e22e 100644 --- a/README.md +++ b/README.md @@ -97,6 +97,16 @@ and configuration and are checked case-insensitively before rendering: - 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 diff --git a/examples/02_pybind/fortran/generated/nml_config.f90 b/examples/02_pybind/fortran/generated/nml_config.f90 index 14c6ade..a502f4b 100644 --- a/examples/02_pybind/fortran/generated/nml_config.f90 +++ b/examples/02_pybind/fortran/generated/nml_config.f90 @@ -35,7 +35,6 @@ module nml_config 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 @@ -126,6 +125,7 @@ end function tolerance__in_bounds !> \brief Resolve an opaque C pointer handle to a nml_config_t pointer 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 diff --git a/examples/04_derived_types/fortran/generated/nml_run.f90 b/examples/04_derived_types/fortran/generated/nml_run.f90 index 283afa9..0afe8b2 100644 --- a/examples/04_derived_types/fortran/generated/nml_run.f90 +++ b/examples/04_derived_types/fortran/generated/nml_run.f90 @@ -31,7 +31,6 @@ module nml_run 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 @@ -135,6 +134,7 @@ end function station__code__in_bounds !> \brief Resolve an opaque C pointer handle to a nml_run_t pointer 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 diff --git a/tests/fortran_namespaces/CMakeLists.txt b/tests/fortran_namespaces/CMakeLists.txt index fbdab61..ac5f35f 100644 --- a/tests/fortran_namespaces/CMakeLists.txt +++ b/tests/fortran_namespaces/CMakeLists.txt @@ -12,4 +12,6 @@ add_executable(generated_namespaces 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 index c36b2b3..4f62a91 100644 --- a/tests/fortran_namespaces/application_types.f90 +++ b/tests/fortran_namespaces/application_types.f90 @@ -4,4 +4,8 @@ module application_types 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 index 06258c2..7fdd1ac 100644 --- a/tests/fortran_namespaces/conformance.f90 +++ b/tests/fortran_namespaces/conformance.f90 @@ -6,12 +6,15 @@ program conformance 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 @@ -65,11 +68,34 @@ program conformance call expect_status(status, NML_OK, "validate") handle = transfer(c_loc(wrapped), handle) - call wrapper_status_set_wrapper(handle, .true., 42, .true., status, errmsg) + 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") diff --git a/tests/fortran_namespaces/nml-config.toml b/tests/fortran_namespaces/nml-config.toml index 924360d..10ab263 100644 --- a/tests/fortran_namespaces/nml-config.toml +++ b/tests/fortran_namespaces/nml-config.toml @@ -12,6 +12,9 @@ default = 3 [dimensions.set_dims] default = 2 +[dimensions.c_intptr_t] +default = 2 + [[namelists]] name = "namespaces" schema = "namespaces.yml" @@ -27,3 +30,9 @@ f2py_path = "out/f2py_wrapper_status.f90" 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 index 17ba8c6..0f405f1 100644 --- a/tests/fortran_namespaces/out/f2py_wrapper_status.f90 +++ b/tests/fortran_namespaces/out/f2py_wrapper_status.f90 @@ -7,7 +7,7 @@ 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 + use nml_wrapper_status, only: nml_wrapper_status_t, nml_wrapper_status_resolve_handle, status, c_ptr implicit none contains @@ -32,15 +32,22 @@ 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 @@ -52,8 +59,15 @@ subroutine wrapper_status_set_wrapper(nml__handle, & 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 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_helper.f90 b/tests/fortran_namespaces/out/nml_helper.f90 index d7f6386..c52a825 100644 --- a/tests/fortran_namespaces/out/nml_helper.f90 +++ b/tests/fortran_namespaces/out/nml_helper.f90 @@ -40,6 +40,7 @@ module nml_helper !> \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 diff --git a/tests/fortran_namespaces/out/nml_wrapper_status.f90 b/tests/fortran_namespaces/out/nml_wrapper_status.f90 index fc7b01b..c4154b9 100644 --- a/tests/fortran_namespaces/out/nml_wrapper_status.f90 +++ b/tests/fortran_namespaces/out/nml_wrapper_status.f90 @@ -24,7 +24,7 @@ module nml_wrapper_status to__lower, & NML_ERR_INVALID_HANDLE use application_types, only: status - use iso_c_binding, only: c_f_pointer, c_intptr_t, c_null_ptr, c_ptr + use application_types, only: c_ptr implicit none @@ -34,6 +34,7 @@ module nml_wrapper_status !> \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 @@ -55,6 +56,7 @@ module nml_wrapper_status !> \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 @@ -85,6 +87,7 @@ integer function nml_wrapper_status_init(nml__obj, errmsg) result(nml__status) ! 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 @@ -92,9 +95,11 @@ 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 @@ -102,6 +107,9 @@ integer function nml_wrapper_status_init_type(nml__obj, & 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 @@ -121,6 +129,7 @@ integer function nml_wrapper_status_read__from_file(nml__obj, nml__file, errmsg) 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 @@ -128,11 +137,13 @@ integer function nml_wrapper_status_read__from_file(nml__obj, nml__file, errmsg) character(len=nml_line_buffer) :: nml__iomsg namelist /wrapper_status/ & - state + 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 @@ -169,6 +180,7 @@ integer function nml_wrapper_status_read__from_file(nml__obj, nml__file, errmsg) ! assign values nml__obj%data%state = state + nml__obj%data%pointer_state = pointer_state ! mark as configured nml__obj%is_configured = .true. @@ -178,17 +190,20 @@ 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. @@ -223,6 +238,18 @@ integer function nml_wrapper_status_is_set(nml__obj, name, idx, errmsg) result(n 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) diff --git a/tests/fortran_namespaces/wrapper_status.yml b/tests/fortran_namespaces/wrapper_status.yml index eae4195..148b2be 100644 --- a/tests/fortran_namespaces/wrapper_status.yml +++ b/tests/fortran_namespaces/wrapper_status.yml @@ -10,3 +10,11 @@ properties: properties: code: type: integer + pointer_state: + type: object + x-fortran-type: c_ptr + x-fortran-module: application_types + properties: + code: + type: integer + default: 0