diff --git a/src/psyclone/domain/lfric/lfric_scalar_array_args.py b/src/psyclone/domain/lfric/lfric_scalar_array_args.py index 1e47e73629..663d39ddf7 100644 --- a/src/psyclone/domain/lfric/lfric_scalar_array_args.py +++ b/src/psyclone/domain/lfric/lfric_scalar_array_args.py @@ -200,11 +200,6 @@ def _create_declarations(self): array_symbol.datatype = ArrayType( type_map[arg.intrinsic_type], sym_list) - # Replace the symbol with itself to ensure - # the ScalarArray is generated after the - # dimensions array to avoid compilation errors - # TODO: #2202 may allow this to be removed - self.symtab.swap(array_symbol, array_symbol) array_symbol.interface = ArgumentInterface( INTENT_MAPPING[intent]) self.symtab.append_argument(array_symbol) diff --git a/src/psyclone/psyir/backend/fortran.py b/src/psyclone/psyir/backend/fortran.py index d1d9d5f077..add72aec83 100644 --- a/src/psyclone/psyir/backend/fortran.py +++ b/src/psyclone/psyir/backend/fortran.py @@ -218,8 +218,8 @@ def __init__(self, **kwargs): Fparser2Reader.binary_operators) # Create and store a CallTreeUtils instance for use when ordering - # parameter declarations. Have to import it here as CallTreeUtils - # also uses this Fortran backend. + # declarations. Have to import it here as CallTreeUtils also uses + # this Fortran backend. # pylint: disable=import-outside-toplevel from psyclone.psyir.tools.call_tree_utils import CallTreeUtils self._call_tree_utils = CallTreeUtils() @@ -862,78 +862,17 @@ def gen_access_stmts(self, symbol_table: SymbolTable) -> str: return result return "" - # pylint: disable=too-many-branches - def _gen_parameter_decls(self, symbol_table, is_module_scope=False): - ''' Create the declarations of all parameters present in the supplied - symbol table. Declarations are ordered so as to satisfy any inter- - dependencies between them. - - :param symbol_table: the SymbolTable instance. - :type symbol: :py:class:`psyclone.psyir.symbols.SymbolTable` - :param bool is_module_scope: whether or not the declarations are in - a module scoping unit. Default is False. - - :returns: Fortran code declaring all parameters. - :rtype: str - - :raises VisitorError: if there is no way of resolving - interdependencies between parameter declarations. - - ''' - declarations = "" - local_constants = [] - - # First add the local constants - for sym in symbol_table.datasymbols: - if sym.is_import or sym.is_unresolved: - continue # Skip, these don't need declarations - if sym.is_constant: - local_constants.append(sym) - - # There may be dependencies between these constants so setup a dict - # holding a set of all their dependencies. The checks have to be done - # with case-insensitive name comparisons because the dependent symbols - # are not always created in the same scope. - local_lowered_names = [sym.name.lower() for sym in local_constants] - decln_inputs = {} - for symbol in local_constants: - dependencies = symbol.get_all_accessed_symbols() - dependencies = {sym for sym in dependencies - # Discard self-dependencies: e.g. "a :: HUGE(a)" - if sym.name.lower() != symbol.name.lower() and - # Discard dependencies that are not local - sym.name.lower() in local_lowered_names} - decln_inputs[symbol] = dependencies - - # We now iterate over the declarations, declaring those that have their - # inputs satisfied. Creating a declaration for a given symbol removes - # that symbol as a dependence from any outstanding declarations and - # adds it to the 'declared' set. - declared: set[Symbol] = set() - while local_constants: - for symbol in local_constants[:]: - inputs = decln_inputs[symbol] - if inputs.issubset(declared): - # All inputs are satisfied so this declaration can be added - declared.add(symbol) - local_constants.remove(symbol) - declarations += self.gen_vardecl( - symbol, include_visibility=is_module_scope) - break - else: - # We looped through all of the variables remaining to be - # declared and none had their dependencies satisfied. - raise VisitorError( - f"Unable to satisfy dependencies for the declarations of " - f"{[sym.name for sym in local_constants]}") - return declarations - def gen_decls(self, symbol_table: SymbolTable, is_module_scope: bool = False) -> str: '''Create and return the Fortran declarations for the supplied SymbolTable. + Declarations are ordered such that any given symbol is declared after + those upon which it depends. Stricly speaking, the Fortran standard + does not mandate this in the majority of cases but compiler + implementations do not always follow the standard. + :param symbol_table: the SymbolTable instance. :param is_module_scope: whether or not the declarations are in a module scoping unit. Default is False. @@ -953,6 +892,8 @@ def gen_decls(self, RoutineSymbols) in the supplied table that do not have an explicit declaration (UnresolvedInterface) and there are no wildcard imports or unknown interfaces. + :raises VisitorError: if there is no way of resolving interdependencies + between symbol declarations. ''' # pylint: disable=too-many-branches @@ -984,20 +925,18 @@ def gen_decls(self, # If the symbol table contains any symbols with an # UnresolvedInterface interface (they are not explicitly - # declared), we need to check that we have at least one - # wildcard import which could be bringing them into this - # scope, or an unknown interface which could be declaring - # them. + # declared), we need to check that we have at least one wildcard + # import which could be bringing them into this scope, or an + # unknown interface which could be declaring them. unresolved_symbols = [] for sym in all_symbols[:]: if isinstance(sym.interface, UnresolvedInterface): unresolved_symbols.append(sym) all_symbols.remove(sym) - try: - internal_interface_symbol = symbol_table.lookup( - "_psyclone_internal_interface") - except KeyError: - internal_interface_symbol = None + + internal_interface_symbol = symbol_table.lookup( + "_psyclone_internal_interface", otherwise=None) + if unresolved_symbols and not ( symbol_table.wildcard_imports() or internal_interface_symbol or @@ -1017,62 +956,77 @@ def gen_decls(self, raise VisitorError( f"Found a symbol '{sym.name}' with a name greater than " f"{self.MAX_VARIABLE_NAME_LENGTH} characters in length. " - "This is not standards-compliant Fortran.") - - # As a convention, we will declare the variables in the following - # order: - - # 1: Routine declarations and interfaces. (Note that accessibility - # statements are generated in gen_access_stmts().) - for sym in all_symbols[:]: - if not isinstance(sym, RoutineSymbol): - continue - # Interfaces can be GenericInterfaceSymbols or RoutineSymbols - # of UnsupportedFortranType. - if isinstance(sym, GenericInterfaceSymbol): - declarations += self.gen_interfacedecl(sym) - elif isinstance(sym.datatype, UnsupportedType): - declarations += self.gen_vardecl( - sym, include_visibility=is_module_scope) - elif not (sym.is_modulevar or sym.is_automatic): - raise VisitorError( - f"Routine symbol '{sym.name}' has '{sym.interface}'. " - f"This is not supported by the Fortran back-end.") - all_symbols.remove(sym) + f"This is not standards-compliant Fortran.") - # 2: Constants. - declarations += self._gen_parameter_decls(symbol_table, - is_module_scope) - for sym in all_symbols[:]: - if isinstance(sym, DataSymbol) and sym.is_constant: - all_symbols.remove(sym) + # There may be dependencies between the symbols so setup a dict + # holding a set of all their dependencies. The checks have to be done + # with case-insensitive name comparisons because the dependent symbols + # are not always created in the same scope. + local_lowered_names = [sym.name.lower() for sym in all_symbols] + decln_inputs: dict[str, Symbol] = {} + for symbol in all_symbols: + dependencies = symbol.get_all_accessed_symbols() + dependencies = {sym for sym in dependencies + # Discard self-dependencies: e.g. "a :: HUGE(a)" + if sym.name.lower() != symbol.name.lower() and + # Discard dependencies that are not local + sym.name.lower() in local_lowered_names and + # Discard dependencies on RoutineSymbols (but + # *not* interfaces) + not (isinstance(sym, RoutineSymbol) and + not isinstance(sym, GenericInterfaceSymbol))} + decln_inputs[symbol] = dependencies - # 3: Argument variable declarations + # Sanity check that we haven't got arguments if we're in a module scope if symbol_table.argument_datasymbols and is_module_scope: raise VisitorError( f"Arguments are not allowed in this context but this symbol " f"table contains argument(s): " f"'{[sym.name for sym in symbol_table.argument_datasymbols]}'." ) - # We use symbol_table.argument_datasymbols because it has the - # symbol order that we need - for symbol in symbol_table.argument_datasymbols: - declarations += self.gen_vardecl( - symbol, include_visibility=is_module_scope) - all_symbols.remove(symbol) - - # 4: Derived-type declarations. These must come before any declarations - # of symbols of these types. - for symbol in all_symbols[:]: - if isinstance(symbol, DataTypeSymbol): - declarations += self.gen_typedecl( - symbol, include_visibility=is_module_scope) - all_symbols.remove(symbol) - - # 5: The rest of the symbols - for symbol in all_symbols: - declarations += self.gen_vardecl( - symbol, include_visibility=is_module_scope) + + # We now iterate over the declarations, declaring those that have their + # inputs satisfied. Creating a declaration for a given symbol removes + # that symbol as a dependence from any outstanding declarations and + # adds it to the 'declared' set. + declared: set[Symbol] = set() + + while all_symbols: + for symbol in all_symbols[:]: + inputs = decln_inputs[symbol] + if inputs.issubset(declared): + # All inputs are satisfied so this declaration can be added + declared.add(symbol) + all_symbols.remove(symbol) + if isinstance(symbol, RoutineSymbol): + # Interfaces can be GenericInterfaceSymbols or + # RoutineSymbols of UnsupportedFortranType. + if isinstance(symbol, GenericInterfaceSymbol): + declarations += self.gen_interfacedecl(symbol) + elif isinstance(symbol.datatype, UnsupportedType): + declarations += self.gen_vardecl( + symbol, include_visibility=is_module_scope) + elif not (symbol.is_modulevar or symbol.is_automatic): + raise VisitorError( + f"Routine symbol '{symbol.name}' has " + f"'{symbol.interface}'. This is not supported " + f"by the Fortran back-end.") + elif isinstance(symbol, DataTypeSymbol): + declarations += self.gen_typedecl( + symbol, include_visibility=is_module_scope) + else: + declarations += self.gen_vardecl( + symbol, include_visibility=is_module_scope) + # Now that we've created a new declaration (and thus + # potentially resolved some dependencies) we go back to + # the start of the list of remaining symbols. + break + else: + # We looped through all of the variables remaining to be + # declared and none had their dependencies satisfied. + raise VisitorError( + f"Unable to satisfy dependencies for the declarations of " + f"{[sym.name for sym in all_symbols]}") return declarations diff --git a/src/psyclone/psyir/transformations/hoist_local_arrays_trans.py b/src/psyclone/psyir/transformations/hoist_local_arrays_trans.py index b9ff96bb99..d12661b56e 100644 --- a/src/psyclone/psyir/transformations/hoist_local_arrays_trans.py +++ b/src/psyclone/psyir/transformations/hoist_local_arrays_trans.py @@ -58,9 +58,9 @@ class HoistLocalArraysTrans(Transformation): contains subroutine test_sub(n) - integer :: n integer :: i integer :: j + integer :: n real, save :: value = 1.0 if (.not.allocated(a) .or. ubound(a, dim=1) /= n .or. \ diff --git a/src/psyclone/psyir/transformations/replace_reference_by_literal_trans.py b/src/psyclone/psyir/transformations/replace_reference_by_literal_trans.py index 019272bb98..703820764b 100644 --- a/src/psyclone/psyir/transformations/replace_reference_by_literal_trans.py +++ b/src/psyclone/psyir/transformations/replace_reference_by_literal_trans.py @@ -72,6 +72,10 @@ class ReplaceReferenceByLiteralTrans(Transformation): >>> print(written_code) program test use mymod + type(my_type) :: t1 + type(my_type) :: t2 + type(my_type) :: t3 + type(my_type) :: t4 integer, parameter :: x = 3 integer, parameter :: y = 12 integer, parameter :: z = 13 @@ -79,10 +83,6 @@ class ReplaceReferenceByLiteralTrans(Transformation): integer, parameter :: u2 = 2 integer, parameter :: u3 = 3 integer, parameter :: u4 = 4 - type(my_type) :: t1 - type(my_type) :: t2 - type(my_type) :: t3 - type(my_type) :: t4 integer :: i integer :: invariant integer :: ic1 diff --git a/src/psyclone/tests/domain/gocean/transformations/gocean_move_iteration_boundaries_inside_kernel_trans_test.py b/src/psyclone/tests/domain/gocean/transformations/gocean_move_iteration_boundaries_inside_kernel_trans_test.py index 113224df0b..8838bcf692 100644 --- a/src/psyclone/tests/domain/gocean/transformations/gocean_move_iteration_boundaries_inside_kernel_trans_test.py +++ b/src/psyclone/tests/domain/gocean/transformations/gocean_move_iteration_boundaries_inside_kernel_trans_test.py @@ -158,13 +158,13 @@ def test_go_move_iteration_boundaries_inside_kernel_two_kernels_apply_twice( assert "use time_smooth_mod" not in output expected = '''subroutine invoke_0(cu_fld, p_fld, u_fld, unew_fld, uold_fld) + integer :: j + integer :: i type(r2d_field), intent(inout) :: cu_fld type(r2d_field), intent(inout) :: p_fld type(r2d_field), intent(inout) :: u_fld type(r2d_field), intent(inout) :: unew_fld type(r2d_field), intent(inout) :: uold_fld - integer :: j - integer :: i integer :: xstart integer :: xstop integer :: ystart diff --git a/src/psyclone/tests/domain/lfric/dofkern_test.py b/src/psyclone/tests/domain/lfric/dofkern_test.py index 4bf0b2d97d..3b2c479614 100644 --- a/src/psyclone/tests/domain/lfric/dofkern_test.py +++ b/src/psyclone/tests/domain/lfric/dofkern_test.py @@ -243,6 +243,7 @@ def test_multi_invoke_cell_dof_builtin(tmpdir, monkeypatch, annexed, dist_mem): type(field_type), intent(in) :: f3 type(field_type), intent(in) :: f4 real(kind=r_def), intent(in) :: scalar_arg + integer(kind=i_def) :: cell real(kind=r_def), intent(in) :: a type(field_type), intent(in) :: m1 type(field_type), intent(in) :: m2 diff --git a/src/psyclone/tests/domain/lfric/lfric_field_codegen_test.py b/src/psyclone/tests/domain/lfric/lfric_field_codegen_test.py index 50d6e3ea57..28758de483 100644 --- a/src/psyclone/tests/domain/lfric/lfric_field_codegen_test.py +++ b/src/psyclone/tests/domain/lfric/lfric_field_codegen_test.py @@ -48,12 +48,12 @@ def test_field(tmpdir): " contains\n" " subroutine invoke_0_testkern_type(a, f1, f2, m1, m2)\n" " use constants_mod, only : i_def\n" + " integer(kind=i_def) :: cell\n" " real(kind=r_def), intent(in) :: a\n" " type(field_type), intent(in) :: f1\n" " type(field_type), intent(in) :: f2\n" " type(field_type), intent(in) :: m1\n" " type(field_type), intent(in) :: m2\n" - " integer(kind=i_def) :: cell\n" " real(kind=r_def), pointer, dimension(:) :: f1_data => null()\n" " real(kind=r_def), pointer, dimension(:) :: f2_data => null()\n" " real(kind=r_def), pointer, dimension(:) :: m1_data => null()\n" @@ -147,12 +147,12 @@ def test_field_deref(tmpdir, dist_mem): assert LFRicBuild(tmpdir).code_compiles(psy) output = ( + " integer(kind=i_def) :: cell\n" " real(kind=r_def), intent(in) :: a\n" " type(field_type), intent(in) :: f1\n" " type(field_type), intent(in) :: est_f2\n" " type(field_type), intent(in) :: m1\n" " type(field_type), intent(in) :: est_m2\n" - " integer(kind=i_def) :: cell\n" ) assert output in generated_code output = ( @@ -292,6 +292,7 @@ def test_field_fs(tmpdir): f6, m5, m6, m7) use mesh_mod, only : mesh_type use constants_mod, only : i_def + integer(kind=i_def) :: cell type(field_type), intent(in) :: f1 type(field_type), intent(in) :: f2 type(field_type), intent(in) :: m1 @@ -305,7 +306,6 @@ def test_field_fs(tmpdir): type(field_type), intent(in) :: m5 type(field_type), intent(in) :: m6 type(field_type), intent(in) :: m7 - integer(kind=i_def) :: cell type(mesh_type), pointer :: mesh => null() integer(kind=i_def) :: max_halo_depth_mesh real(kind=r_def), pointer, dimension(:) :: f1_data => null() @@ -637,8 +637,8 @@ def test_int_field_fs(tmpdir): contains subroutine invoke_0_testkern_fs_int_field_type({', '.join(fld_names)}) use mesh_mod, only : mesh_type -{decln_text} integer(kind=i_def) :: cell +{decln_text} type(mesh_type), pointer :: mesh => null() integer(kind=i_def) :: max_halo_depth_mesh {ptrs_text} diff --git a/src/psyclone/tests/domain/lfric/lfric_scalar_codegen_test.py b/src/psyclone/tests/domain/lfric/lfric_scalar_codegen_test.py index 3fb1fc5e70..d916a9f1b6 100644 --- a/src/psyclone/tests/domain/lfric/lfric_scalar_codegen_test.py +++ b/src/psyclone/tests/domain/lfric/lfric_scalar_codegen_test.py @@ -37,12 +37,12 @@ def test_real_scalar(tmpdir): " subroutine invoke_0_testkern_type(a, f1, f2, m1, m2)\n" " use mesh_mod, only : mesh_type\n" " use constants_mod, only : i_def\n" + " integer(kind=i_def) :: cell\n" " real(kind=r_def), intent(in) :: a\n" " type(field_type), intent(in) :: f1\n" " type(field_type), intent(in) :: f2\n" " type(field_type), intent(in) :: m1\n" " type(field_type), intent(in) :: m2\n" - " integer(kind=i_def) :: cell\n" " type(mesh_type), pointer :: mesh => null()\n" " integer(kind=i_def) :: max_halo_depth_mesh\n" " real(kind=r_def), pointer, dimension(:) :: f1_data => null()\n" @@ -141,12 +141,12 @@ def test_int_scalar(tmpdir): " subroutine invoke_0_testkern_one_int_scalar_type" "(f1, iflag, f2, m1, m2)\n" " use mesh_mod, only : mesh_type\n" + " integer(kind=i_def) :: cell\n" " type(field_type), intent(in) :: f1\n" " integer(kind=i_def), intent(in) :: iflag\n" " type(field_type), intent(in) :: f2\n" " type(field_type), intent(in) :: m1\n" " type(field_type), intent(in) :: m2\n" - " integer(kind=i_def) :: cell\n" " type(mesh_type), pointer :: mesh => null()\n" " integer(kind=i_def) :: max_halo_depth_mesh\n" " real(kind=r_def), pointer, dimension(:) :: f1_data => null()\n" @@ -247,13 +247,13 @@ def test_two_real_scalars(tmpdir): "m1, m2, b)\n" " use mesh_mod, only : mesh_type\n" " use constants_mod, only : i_def\n" + " integer(kind=i_def) :: cell\n" " real(kind=r_def), intent(in) :: a\n" " type(field_type), intent(in) :: f1\n" " type(field_type), intent(in) :: f2\n" " type(field_type), intent(in) :: m1\n" " type(field_type), intent(in) :: m2\n" " real(kind=r_def), intent(in) :: b\n" - " integer(kind=i_def) :: cell\n" " type(mesh_type), pointer :: mesh => null()\n" " integer(kind=i_def) :: max_halo_depth_mesh\n" " real(kind=r_def), pointer, dimension(:) :: f1_data => null()\n" @@ -352,13 +352,13 @@ def test_two_int_scalars(tmpdir): expected = ( " subroutine invoke_0(iflag, f1, f2, m1, m2, istep)\n" " use mesh_mod, only : mesh_type\n" + " integer(kind=i_def) :: cell\n" " integer(kind=i_def), intent(in) :: iflag\n" " type(field_type), intent(in) :: f1\n" " type(field_type), intent(in) :: f2\n" " type(field_type), intent(in) :: m1\n" " type(field_type), intent(in) :: m2\n" " integer(kind=i_def), intent(in) :: istep\n" - " integer(kind=i_def) :: cell\n" " type(mesh_type), pointer :: mesh => null()\n" " integer(kind=i_def) :: max_halo_depth_mesh\n" " real(kind=r_def), pointer, dimension(:) :: f1_data => null()\n" @@ -476,6 +476,7 @@ def test_three_scalars(tmpdir): " subroutine invoke_0_testkern_three_scalars_type(a, f1, f2, m1, " "m2, lswitch, istep)\n" " use mesh_mod, only : mesh_type\n" + " integer(kind=i_def) :: cell\n" " real(kind=r_def), intent(in) :: a\n" " type(field_type), intent(in) :: f1\n" " type(field_type), intent(in) :: f2\n" @@ -483,7 +484,6 @@ def test_three_scalars(tmpdir): " type(field_type), intent(in) :: m2\n" " logical(kind=l_def), intent(in) :: lswitch\n" " integer(kind=i_def), intent(in) :: istep\n" - " integer(kind=i_def) :: cell\n" " type(mesh_type), pointer :: mesh => null()\n" " integer(kind=i_def) :: max_halo_depth_mesh\n" " real(kind=r_def), pointer, dimension(:) :: f1_data => null()\n" @@ -589,7 +589,17 @@ def test_scalar_array(tmpdir, dist_mem): " type(field_type), intent(in) :: f2\n" " type(field_type), intent(in) :: f3\n" " type(field_type), intent(in) :: f4\n" - " integer(kind=i_def), intent(in) :: b\n" + " integer(kind=i_def), intent(in) :: b\n") + if dist_mem: + expected_declarations += ( + " type(mesh_type), pointer :: mesh => null()\n" + " integer(kind=i_def) :: max_halo_depth_mesh\n") + expected_declarations += ( + " real(kind=r_def), pointer, dimension(:) :: f1_data => null()\n" + " real(kind=r_def), pointer, dimension(:) :: f2_data => null()\n" + " real(kind=r_def), pointer, dimension(:) :: f3_data => null()\n" + " real(kind=r_def), pointer, dimension(:) :: f4_data => null()\n" + " integer(kind=i_def) :: nlayers_f1\n" " integer(kind=i_def), dimension(2), intent(in) :: " "dims_real_array\n" " real(kind=r_def), dimension(dims_real_array(1)," diff --git a/src/psyclone/tests/gocean1p0_test.py b/src/psyclone/tests/gocean1p0_test.py index 522b7c646c..b373df5748 100644 --- a/src/psyclone/tests/gocean1p0_test.py +++ b/src/psyclone/tests/gocean1p0_test.py @@ -56,11 +56,11 @@ def test_field(tmpdir, dist_mem): " public\n\n" " contains\n" " subroutine invoke_0_compute_cu(cu_fld, p_fld, u_fld)\n" + " integer :: j\n" + " integer :: i\n" " type(r2d_field), intent(inout) :: cu_fld\n" " type(r2d_field), intent(inout) :: p_fld\n" - " type(r2d_field), intent(inout) :: u_fld\n" - " integer :: j\n" - " integer :: i\n\n") + " type(r2d_field), intent(inout) :: u_fld\n\n") remaining_code = ( " do j = cu_fld%internal%ystart, cu_fld%internal%ystop, 1\n" " do i = cu_fld%internal%xstart, cu_fld%internal%xstop, 1\n" @@ -130,13 +130,13 @@ def test_two_kernels(tmpdir, dist_mem): " contains\n" " subroutine invoke_0(cu_fld, p_fld, u_fld, unew_fld, " "uold_fld)\n" + " integer :: j\n" + " integer :: i\n" " type(r2d_field), intent(inout) :: cu_fld\n" " type(r2d_field), intent(inout) :: p_fld\n" " type(r2d_field), intent(inout) :: u_fld\n" " type(r2d_field), intent(inout) :: unew_fld\n" - " type(r2d_field), intent(inout) :: uold_fld\n" - " integer :: j\n" - " integer :: i\n\n") + " type(r2d_field), intent(inout) :: uold_fld\n\n") first_kernel = ( " do j = cu_fld%internal%ystart, cu_fld%internal%ystop, 1\n" " do i = cu_fld%internal%xstart, cu_fld%internal%xstop, 1\n" @@ -184,11 +184,11 @@ def test_two_kernels_with_dependencies(tmpdir, dist_mem): " public\n\n" " contains\n" " subroutine invoke_0(cu_fld, p_fld, u_fld)\n" + " integer :: j\n" + " integer :: i\n" " type(r2d_field), intent(inout) :: cu_fld\n" " type(r2d_field), intent(inout) :: p_fld\n" - " type(r2d_field), intent(inout) :: u_fld\n" - " integer :: j\n" - " integer :: i\n\n") + " type(r2d_field), intent(inout) :: u_fld\n\n") first_kernel = ( " do j = cu_fld%internal%ystart, cu_fld%internal%ystop, 1\n" " do i = cu_fld%internal%xstart, cu_fld%internal%xstop, 1\n" @@ -242,12 +242,12 @@ def test_grid_property(tmpdir, dist_mem): " public\n\n" " contains\n" " subroutine invoke_0(cu_fld, u_fld, du_fld, d_fld)\n" + " integer :: j\n" + " integer :: i\n" " type(r2d_field), intent(inout) :: cu_fld\n" " type(r2d_field), intent(inout) :: u_fld\n" " type(r2d_field), intent(inout) :: du_fld\n" - " type(r2d_field), intent(inout) :: d_fld\n" - " integer :: j\n" - " integer :: i\n\n") + " type(r2d_field), intent(inout) :: d_fld\n\n") first_kernel = ( " do j = cu_fld%internal%ystart, cu_fld%internal%ystop, 1\n" " do i = cu_fld%internal%xstart, cu_fld%internal%xstop, 1\n" @@ -299,10 +299,10 @@ def test_scalar_int_arg(tmpdir, dist_mem): " public\n\n" " contains\n" " subroutine invoke_0_bc_ssh(ncycle, ssh_fld)\n" - " integer, intent(inout) :: ncycle\n" - " type(r2d_field), intent(inout) :: ssh_fld\n" " integer :: j\n" - " integer :: i\n\n") + " integer :: i\n" + " integer, intent(inout) :: ncycle\n" + " type(r2d_field), intent(inout) :: ssh_fld\n\n") first_kernel = ( " do j = ssh_fld%whole%ystart, ssh_fld%whole%ystop, 1\n" " do i = ssh_fld%whole%xstart, ssh_fld%whole%xstop, 1\n" @@ -343,10 +343,10 @@ def test_scalar_float_arg(tmpdir, dist_mem): " public\n\n" " contains\n" " subroutine invoke_0_bc_ssh(a_scalar, ssh_fld)\n" - " real(kind=go_wp), intent(inout) :: a_scalar\n" - " type(r2d_field), intent(inout) :: ssh_fld\n" " integer :: j\n" - " integer :: i\n\n") + " integer :: i\n" + " real(kind=go_wp), intent(inout) :: a_scalar\n" + " type(r2d_field), intent(inout) :: ssh_fld\n\n") first_kernel = ( " do j = ssh_fld%whole%ystart, ssh_fld%whole%ystop, 1\n" " do i = ssh_fld%whole%xstart, ssh_fld%whole%xstop, 1\n" @@ -405,6 +405,7 @@ def test_scalar_float_arg_from_module(): " type(r2d_field), intent(inout) :: ssh_fld\n" " integer :: j\n" " integer :: i\n" + " type(r2d_field), intent(inout) :: ssh_fld\n" " integer :: istop\n" " integer :: jstop\n\n" " ! Look-up loop bounds\n" @@ -452,12 +453,12 @@ def test_ne_offset_cf_points(tmpdir): " public\n\n" " contains\n" " subroutine invoke_0_compute_vort(vort_fld, p_fld, u_fld, v_fld)\n" + " integer :: j\n" + " integer :: i\n" " type(r2d_field), intent(inout) :: vort_fld\n" " type(r2d_field), intent(inout) :: p_fld\n" " type(r2d_field), intent(inout) :: u_fld\n" " type(r2d_field), intent(inout) :: v_fld\n" - " integer :: j\n" - " integer :: i\n" " integer :: istop\n" " integer :: jstop\n\n" " ! Look-up loop bounds\n" @@ -503,11 +504,11 @@ def test_ne_offset_ct_points(tmpdir): " public\n\n" " contains\n" " subroutine invoke_0_compute_vort(p_fld, u_fld, v_fld)\n" + " integer :: j\n" + " integer :: i\n" " type(r2d_field), intent(inout) :: p_fld\n" " type(r2d_field), intent(inout) :: u_fld\n" " type(r2d_field), intent(inout) :: v_fld\n" - " integer :: j\n" - " integer :: i\n" " integer :: istop\n" " integer :: jstop\n\n" " ! Look-up loop bounds\n" @@ -553,9 +554,9 @@ def test_ne_offset_all_cu_points(tmpdir): " public\n\n" " contains\n" " subroutine invoke_0_bc_solid_u(u_fld)\n" - " type(r2d_field), intent(inout) :: u_fld\n" " integer :: j\n" " integer :: i\n" + " type(r2d_field), intent(inout) :: u_fld\n" " integer :: istop\n" " integer :: jstop\n\n" " ! Look-up loop bounds\n" @@ -600,9 +601,9 @@ def test_ne_offset_all_cv_points(tmpdir): " public\n\n" " contains\n" " subroutine invoke_0_bc_solid_v(v_fld)\n" - " type(r2d_field), intent(inout) :: v_fld\n" " integer :: j\n" " integer :: i\n" + " type(r2d_field), intent(inout) :: v_fld\n" " integer :: istop\n" " integer :: jstop\n\n" " ! Look-up loop bounds\n" @@ -647,9 +648,9 @@ def test_ne_offset_all_cf_points(tmpdir): " public\n\n" " contains\n" " subroutine invoke_0_bc_solid_f(f_fld)\n" - " type(r2d_field), intent(inout) :: f_fld\n" " integer :: j\n" " integer :: i\n" + " type(r2d_field), intent(inout) :: f_fld\n" " integer :: istop\n" " integer :: jstop\n\n" " ! Look-up loop bounds\n" @@ -692,12 +693,12 @@ def test_sw_offset_cf_points(tmpdir): " public\n\n" " contains\n" " subroutine invoke_0_compute_z(z_fld, p_fld, u_fld, v_fld)\n" + " integer :: j\n" + " integer :: i\n" " type(r2d_field), intent(inout) :: z_fld\n" " type(r2d_field), intent(inout) :: p_fld\n" " type(r2d_field), intent(inout) :: u_fld\n" " type(r2d_field), intent(inout) :: v_fld\n" - " integer :: j\n" - " integer :: i\n" " integer :: istop\n" " integer :: jstop\n\n" " ! Look-up loop bounds\n" @@ -743,12 +744,12 @@ def test_sw_offset_all_cf_points(tmpdir): " public\n\n" " contains\n" " subroutine invoke_0_apply_bcs_f(z_fld, p_fld, u_fld, v_fld)\n" + " integer :: j\n" + " integer :: i\n" " type(r2d_field), intent(inout) :: z_fld\n" " type(r2d_field), intent(inout) :: p_fld\n" " type(r2d_field), intent(inout) :: u_fld\n" " type(r2d_field), intent(inout) :: v_fld\n" - " integer :: j\n" - " integer :: i\n" " integer :: istop\n" " integer :: jstop\n\n" " ! Look-up loop bounds\n" @@ -794,12 +795,12 @@ def test_sw_offset_ct_points(tmpdir): " public\n\n" " contains\n" " subroutine invoke_0_compute_h(h_fld, p_fld, u_fld, v_fld)\n" + " integer :: j\n" + " integer :: i\n" " type(r2d_field), intent(inout) :: h_fld\n" " type(r2d_field), intent(inout) :: p_fld\n" " type(r2d_field), intent(inout) :: u_fld\n" " type(r2d_field), intent(inout) :: v_fld\n" - " integer :: j\n" - " integer :: i\n" " integer :: istop\n" " integer :: jstop\n\n" " ! Look-up loop bounds\n" @@ -846,12 +847,12 @@ def test_sw_offset_all_ct_points(tmpdir): " public\n\n" " contains\n" " subroutine invoke_0_apply_bcs_h(hfld, pfld, ufld, vfld)\n" + " integer :: j\n" + " integer :: i\n" " type(r2d_field), intent(inout) :: hfld\n" " type(r2d_field), intent(inout) :: pfld\n" " type(r2d_field), intent(inout) :: ufld\n" " type(r2d_field), intent(inout) :: vfld\n" - " integer :: j\n" - " integer :: i\n" " integer :: istop\n" " integer :: jstop\n\n" " ! Look-up loop bounds\n" @@ -898,10 +899,10 @@ def test_sw_offset_all_cu_points(tmpdir): " public\n\n" " contains\n" " subroutine invoke_0_apply_bcs_u(ufld, vfld)\n" - " type(r2d_field), intent(inout) :: ufld\n" - " type(r2d_field), intent(inout) :: vfld\n" " integer :: j\n" " integer :: i\n" + " type(r2d_field), intent(inout) :: ufld\n" + " type(r2d_field), intent(inout) :: vfld\n" " integer :: istop\n" " integer :: jstop\n\n" " ! Look-up loop bounds\n" @@ -939,18 +940,11 @@ def test_sw_offset_all_cv_points(tmpdir): generated_code = str(psy.gen) expected_output = ( - "module psy_single_invoke_test\n" - " use field_mod\n" - " use kind_params_mod\n" - " use kernel_sw_offset_cv_mod, only : apply_bcs_v_code\n" - " implicit none\n" - " public\n\n" - " contains\n" " subroutine invoke_0_apply_bcs_v(vfld, ufld)\n" - " type(r2d_field), intent(inout) :: vfld\n" - " type(r2d_field), intent(inout) :: ufld\n" " integer :: j\n" " integer :: i\n" + " type(r2d_field), intent(inout) :: vfld\n" + " type(r2d_field), intent(inout) :: ufld\n" " integer :: istop\n" " integer :: jstop\n\n" " ! Look-up loop bounds\n" @@ -964,7 +958,7 @@ def test_sw_offset_all_cv_points(tmpdir): " end subroutine invoke_0_apply_bcs_v\n\n" "end module psy_single_invoke_test\n") - assert generated_code == expected_output + assert expected_output in generated_code assert GOceanBuild(tmpdir).code_compiles(psy) @@ -988,19 +982,12 @@ def test_offset_any_all_cu_points(tmpdir): generated_code = str(psy.gen) expected_output = ( - "module psy_single_invoke_test\n" - " use field_mod\n" - " use kind_params_mod\n" - " use kernel_any_offset_cu_mod, only : compute_u_code\n" - " implicit none\n" - " public\n\n" - " contains\n" " subroutine invoke_0_compute_u(ufld, vfld, hfld)\n" + " integer :: j\n" + " integer :: i\n" " type(r2d_field), intent(inout) :: ufld\n" " type(r2d_field), intent(inout) :: vfld\n" " type(r2d_field), intent(inout) :: hfld\n" - " integer :: j\n" - " integer :: i\n" " integer :: istop\n" " integer :: jstop\n\n" " ! Look-up loop bounds\n" @@ -1015,7 +1002,7 @@ def test_offset_any_all_cu_points(tmpdir): " end subroutine invoke_0_compute_u\n\n" "end module psy_single_invoke_test\n") - assert generated_code == expected_output + assert expected_output in generated_code assert GOceanBuild(tmpdir).code_compiles(psy) @@ -1039,18 +1026,11 @@ def test_offset_any_all_points(tmpdir): generated_code = str(psy.gen) expected_output = ( - "module psy_single_invoke_test\n" - " use field_mod\n" - " use kind_params_mod\n" - " use kernel_field_copy_mod, only : field_copy_code\n" - " implicit none\n" - " public\n\n" - " contains\n" " subroutine invoke_0_copy(voldfld, vfld)\n" - " type(r2d_field), intent(inout) :: voldfld\n" - " type(r2d_field), intent(inout) :: vfld\n" " integer :: j\n" " integer :: i\n" + " type(r2d_field), intent(inout) :: voldfld\n" + " type(r2d_field), intent(inout) :: vfld\n" " integer :: istop\n" " integer :: jstop\n\n" " ! Look-up loop bounds\n" @@ -1063,7 +1043,7 @@ def test_offset_any_all_points(tmpdir): " enddo\n\n" " end subroutine invoke_0_copy\n\n" "end module psy_single_invoke_test\n") - assert generated_code == expected_output + assert expected_output in generated_code assert GOceanBuild(tmpdir).code_compiles(psy) diff --git a/src/psyclone/tests/lfric_lma_test.py b/src/psyclone/tests/lfric_lma_test.py index 359c4b8f73..2fad6b39b9 100644 --- a/src/psyclone/tests/lfric_lma_test.py +++ b/src/psyclone/tests/lfric_lma_test.py @@ -487,10 +487,10 @@ def test_operator_different_spaces(tmpdir): use mesh_mod, only : mesh_type use function_space_mod, only : BASIS, DIFF_BASIS use constants_mod, only : i_def + integer(kind=i_def) :: cell type(operator_type), intent(in) :: mapping type(field_type), dimension(3), intent(in) :: coord type(quadrature_xyoz_type), intent(in) :: qr - integer(kind=i_def) :: cell type(mesh_type), pointer :: mesh => null() integer(kind=i_def) :: max_halo_depth_mesh real(kind=r_def), pointer, dimension(:) :: coord_1_data => null() diff --git a/src/psyclone/tests/lfric_multigrid_test.py b/src/psyclone/tests/lfric_multigrid_test.py index 6e9e627894..22a68157e3 100644 --- a/src/psyclone/tests/lfric_multigrid_test.py +++ b/src/psyclone/tests/lfric_multigrid_test.py @@ -262,9 +262,9 @@ def test_field_prolong(tmpdir, dist_mem): " use mesh_mod, only : mesh_type\n" " use mesh_map_mod, only : mesh_map_type\n" " use constants_mod, only : i_def\n" + " integer(kind=i_def) :: cell\n" " type(field_type), intent(in) :: field1\n" - " type(field_type), intent(in) :: field2\n" - " integer(kind=i_def) :: cell\n") + " type(field_type), intent(in) :: field2\n") assert expected in code assert "integer(kind=i_def) :: ncell_field1" in code @@ -369,6 +369,7 @@ def test_field_restrict(tmpdir, dist_mem, monkeypatch, annexed): " use mesh_mod, only : mesh_type\n" " use mesh_map_mod, only : mesh_map_type\n" " use constants_mod, only : i_def\n" + " integer(kind=i_def) :: cell\n" " type(field_type), intent(in) :: field1\n" " type(field_type), intent(in) :: field2\n") assert defs in output diff --git a/src/psyclone/tests/lfric_quadrature_test.py b/src/psyclone/tests/lfric_quadrature_test.py index acf0b8996f..fcdf129658 100644 --- a/src/psyclone/tests/lfric_quadrature_test.py +++ b/src/psyclone/tests/lfric_quadrature_test.py @@ -61,6 +61,7 @@ def test_field_xyoz(tmpdir): " use function_space_mod, only : BASIS, DIFF_BASIS\n" in generated_code) assert """ + integer(kind=i_def) :: cell type(field_type), intent(in) :: f1 type(field_type), intent(in) :: f2 type(field_type), intent(in) :: m1 @@ -68,7 +69,6 @@ def test_field_xyoz(tmpdir): type(field_type), intent(in) :: m2 integer(kind=i_def), intent(in) :: istp type(quadrature_xyoz_type), intent(in) :: qr - integer(kind=i_def) :: cell type(mesh_type), pointer :: mesh => null() integer(kind=i_def) :: max_halo_depth_mesh real(kind=r_def), pointer, dimension(:) :: f1_data => null() @@ -274,12 +274,12 @@ def test_face_qr(tmpdir, dist_mem): " use function_space_mod, only : BASIS, DIFF_BASIS\n") assert output_decls in generated_code assert """\ + integer(kind=i_def) :: cell type(field_type), intent(in) :: f1 type(field_type), intent(in) :: f2 type(field_type), intent(in) :: m1 type(field_type), intent(in) :: m2 type(quadrature_face_type), intent(in) :: qr - integer(kind=i_def) :: cell """ in generated_code if dist_mem: diff --git a/src/psyclone/tests/lfric_test.py b/src/psyclone/tests/lfric_test.py index 23b52b3440..a8923e106d 100644 --- a/src/psyclone/tests/lfric_test.py +++ b/src/psyclone/tests/lfric_test.py @@ -3867,6 +3867,7 @@ def test_mixed_precision_args(tmp_path): field_real32, operator_real32, scalar_real64, field_real64, operator_real64) use mesh_mod, only : mesh_type use constants_mod, only : i_def + integer(kind=i_def) :: cell real(kind=r_def), intent(in) :: scalar_r_def type(field_type), intent(in) :: field_r_def type(operator_type), intent(in) :: operator_r_def @@ -3884,7 +3885,6 @@ def test_mixed_precision_args(tmp_path): real(kind=real64), intent(in) :: scalar_real64 type(field_real64_type), intent(in) :: field_real64 type(operator_real64_type), intent(in) :: operator_real64 - integer(kind=i_def) :: cell type(mesh_type), pointer :: mesh => null() integer(kind=i_def) :: max_halo_depth_mesh real(kind=r_def), pointer, dimension(:) :: field_r_def_data => null() diff --git a/src/psyclone/tests/nemo/transformations/openacc/loop_directive_test.py b/src/psyclone/tests/nemo/transformations/openacc/loop_directive_test.py index b95b2a44da..30c2a3dafc 100644 --- a/src/psyclone/tests/nemo/transformations/openacc/loop_directive_test.py +++ b/src/psyclone/tests/nemo/transformations/openacc/loop_directive_test.py @@ -67,8 +67,8 @@ def test_explicit_loop(fortran_reader, fortran_writer): code = fortran_writer(psyir).lower() assert ("program do_loop\n" - " integer, parameter :: jpj = 13\n" " integer :: ji\n" + " integer, parameter :: jpj = 13\n" " real, dimension(jpj) :: sto_tmp\n" " real, dimension(jpj) :: sto_tmp2\n" "\n" diff --git a/src/psyclone/tests/nemo/transformations/openacc/parallel_directive_test.py b/src/psyclone/tests/nemo/transformations/openacc/parallel_directive_test.py index cabbf42b53..d40faa1560 100644 --- a/src/psyclone/tests/nemo/transformations/openacc/parallel_directive_test.py +++ b/src/psyclone/tests/nemo/transformations/openacc/parallel_directive_test.py @@ -39,8 +39,8 @@ def test_parallel_single_loop(fortran_reader, fortran_writer, tmpdir): code = fortran_writer(psyir).lower() assert ("program do_loop\n" - " integer, parameter :: jpj = 128\n" " integer :: ji\n" + " integer, parameter :: jpj = 128\n" " real, dimension(jpj) :: sto_tmp\n" "\n" " !$acc data copyout(sto_tmp)\n" @@ -72,8 +72,8 @@ def test_parallel_single_loop_with_no_default_present_clause( code = fortran_writer(psyir).lower() assert ("program do_loop\n" - " integer, parameter :: jpj = 128\n" " integer :: ji\n" + " integer, parameter :: jpj = 128\n" " real, dimension(jpj) :: sto_tmp\n" "\n" " !$acc parallel\n" @@ -90,8 +90,8 @@ def test_parallel_two_loops(fortran_reader, fortran_writer, tmpdir): ''' Check that we can enclose two loops within a parallel region. ''' psyir = fortran_reader.psyir_from_source( "program do_loop\n" - "integer :: ji\n" "integer, parameter :: jpi=11\n" + "integer :: ji\n" "real :: sto_tmp(jpi), sto_tmp2(jpi)\n" "do ji = 1,jpi\n" " sto_tmp(ji) = 1.0d0\n" diff --git a/src/psyclone/tests/nemo/transformations/openmp/openmp_test.py b/src/psyclone/tests/nemo/transformations/openmp/openmp_test.py index 13360f93bb..e2f500102b 100644 --- a/src/psyclone/tests/nemo/transformations/openmp/openmp_test.py +++ b/src/psyclone/tests/nemo/transformations/openmp/openmp_test.py @@ -40,12 +40,12 @@ def test_omp_explicit_gen(fortran_reader, fortran_writer): expected = ( "program explicit_do\n" - " integer, parameter :: jpi = 2\n" - " integer, parameter :: jpj = 4\n" - " integer, parameter :: jpk = 6\n" " integer :: ji\n" " integer :: jj\n" " integer :: jk\n" + " integer, parameter :: jpi = 2\n" + " integer, parameter :: jpj = 4\n" + " integer, parameter :: jpk = 6\n" " real :: r\n" " real, dimension(jpi,jpj,jpk) :: umask\n" "\n" diff --git a/src/psyclone/tests/psyGen_test.py b/src/psyclone/tests/psyGen_test.py index 6ef2a76426..46c1e47d26 100644 --- a/src/psyclone/tests/psyGen_test.py +++ b/src/psyclone/tests/psyGen_test.py @@ -621,6 +621,7 @@ def test_derived_type_deref_naming(tmpdir): "(a, f1_my_field, f1_my_field_1, m1, m2)\n" " use mesh_mod, only : mesh_type\n" " use constants_mod, only : i_def\n" + " integer(kind=i_def) :: cell\n" " real(kind=r_def), intent(in) :: a\n" " type(field_type), intent(in) :: f1_my_field\n" " type(field_type), intent(in) :: f1_my_field_1\n" diff --git a/src/psyclone/tests/psyad/domain/common/test_adjoint_utils.py b/src/psyclone/tests/psyad/domain/common/test_adjoint_utils.py index 4f429d560d..99a59b1a18 100644 --- a/src/psyclone/tests/psyad/domain/common/test_adjoint_utils.py +++ b/src/psyclone/tests/psyad/domain/common/test_adjoint_utils.py @@ -52,11 +52,11 @@ def test_create_real_comparison(fortran_writer): routine.children = stmt_list result = fortran_writer(routine) expected = ( - " real, parameter :: overall_tolerance = 1500.0\n" " real :: var1\n" " real :: var2\n" " real :: MachineTol\n" - " real :: relative_diff\n\n" + " real :: relative_diff\n" + " real, parameter :: overall_tolerance = 1500.0\n\n" " ! Test the inner-product values for equality, allowing for the " "precision of the active variables\n" " MachineTol = SPACING(MAX(ABS(var1), ABS(var2)))\n" @@ -90,11 +90,11 @@ def test_common_real_comparison(fortran_writer): routine.children = stmt_list result = fortran_writer(routine) expected = ( - " real, parameter :: overall_tolerance = 1500.0\n" " real :: var1\n" " real :: var2\n" " real :: MachineTol\n" - " real :: relative_diff\n\n" + " real :: relative_diff\n" + " real, parameter :: overall_tolerance = 1500.0\n\n" " ! Test the inner-product values for equality, allowing for the " "precision of the active variables\n" " MachineTol = SPACING(MAX(ABS(var1), ABS(var2)))\n" @@ -126,10 +126,10 @@ def test_common_write(fortran_writer): routine.children = stmt_list result = fortran_writer(routine) expected = ( - " real, parameter :: overall_tolerance = 1500.0\n" " real :: var1\n" " real :: var2\n" - " real :: relative_diff\n\n" + " real :: relative_diff\n" + " real, parameter :: overall_tolerance = 1500.0\n\n" " if (relative_diff < overall_tolerance) then\n" " ! PSyclone CodeBlock (unsupported code) reason:\n" " ! - Unsupported statement: Write_Stmt\n" diff --git a/src/psyclone/tests/psyad/domain/lfric/test_lfric_adjoint_harness.py b/src/psyclone/tests/psyad/domain/lfric/test_lfric_adjoint_harness.py index 09e7e375f1..304817b40d 100644 --- a/src/psyclone/tests/psyad/domain/lfric/test_lfric_adjoint_harness.py +++ b/src/psyclone/tests/psyad/domain/lfric/test_lfric_adjoint_harness.py @@ -423,11 +423,11 @@ def test_lfric_create_real_comparison(fortran_writer): expected = ( " use log_mod, only : log_event, log_level_error, log_level_info, " "log_scratch_space\n" - " real, parameter :: overall_tolerance = 1500.0\n" " real :: var1\n" " real :: var2\n" " real :: MachineTol\n" - " real :: relative_diff\n\n" + " real :: relative_diff\n" + " real, parameter :: overall_tolerance = 1500.0\n\n" " ! Test the inner-product values for equality, allowing for the " "precision of the active variables\n" " MachineTol = SPACING(MAX(ABS(var1), ABS(var2)))\n" @@ -465,11 +465,11 @@ def test_lfric_log_write(fortran_writer): expected = ( " use log_mod, only : log_event, log_level_error, log_level_info, " "log_scratch_space\n" - " real, parameter :: overall_tolerance = 1500.0\n" " real :: var1\n" " real :: var2\n" " real :: MachineTol\n" - " real :: relative_diff\n\n" + " real :: relative_diff\n" + " real, parameter :: overall_tolerance = 1500.0\n\n" " ! Test the inner-product values for equality, allowing for the " "precision of the active variables\n" " MachineTol = SPACING(MAX(ABS(var1), ABS(var2)))\n" diff --git a/src/psyclone/tests/psyad/main_test.py b/src/psyclone/tests/psyad/main_test.py index 5071e31c07..cc0c4c95e1 100644 --- a/src/psyclone/tests/psyad/main_test.py +++ b/src/psyclone/tests/psyad/main_test.py @@ -90,13 +90,13 @@ use my_mod, only : kern use adj_my_mod, only : adj_kern integer, parameter :: array_extent = 20 - real, parameter :: overall_tolerance = 1500.0 real :: inner1 real :: inner2 real :: field real :: field_input real :: machinetol real :: relative_diff + real, parameter :: overall_tolerance = 1500.0 ! initialise the kernel arguments and keep copies of them call random_number(field) diff --git a/src/psyclone/tests/psyad/transformations/test_assignment_trans.py b/src/psyclone/tests/psyad/transformations/test_assignment_trans.py index f91a39fb2d..bb45f610d9 100644 --- a/src/psyclone/tests/psyad/transformations/test_assignment_trans.py +++ b/src/psyclone/tests/psyad/transformations/test_assignment_trans.py @@ -163,11 +163,11 @@ def test_zero(tmpdir): " a%data(n) = 0.0\n\n") active_variables = ["a"] ad_fortran = ( - " integer, parameter :: n = 10\n" " type :: field_type\n" " real, dimension(10) :: data\n" " end type field_type\n" - " type(field_type) :: a\n\n" + " type(field_type) :: a\n" + " integer, parameter :: n = 10\n\n" " a%data(n) = 0.0\n\n") check_adjoint(tl_fortran, active_variables, ad_fortran, tmpdir) @@ -200,9 +200,10 @@ def test_single_assign(tmpdir): " a(2*i) = b(n-1)\n") active_variables = ["a", "b"] ad_fortran = ( - " integer, parameter :: n = 10\n integer, parameter :: i = 2\n" + " integer, parameter :: n = 10\n" " real, dimension(n) :: a\n" - " real, dimension(n) :: b\n\n" + " real, dimension(n) :: b\n" + " integer, parameter :: i = 2\n\n" " b(n - 1) = b(n - 1) + a(2 * i)\n" " a(2 * i) = 0.0\n\n") check_adjoint(tl_fortran, active_variables, ad_fortran, tmpdir) @@ -266,13 +267,13 @@ def test_single_assign_fail(tmpdir): " a%data(2*i) = b%data(n+1)\n") active_variables = ["a", "b"] ad_fortran = ( - " integer, parameter :: n = 2\n" - " integer, parameter :: i = 2\n" " type :: field_type\n" " real, dimension(10) :: data\n" " end type field_type\n" " type(field_type) :: a\n" - " type(field_type) :: b\n\n" + " type(field_type) :: b\n" + " integer, parameter :: n = 2\n" + " integer, parameter :: i = 2\n\n" " b%data(n + 1) = b%data(n + 1) + a%data(2 * i)\n" " a%data(2 * i) = 0.0\n\n") check_adjoint(tl_fortran, active_variables, ad_fortran, tmpdir) diff --git a/src/psyclone/tests/psyir/backend/fortran_gen_decls_test.py b/src/psyclone/tests/psyir/backend/fortran_gen_decls_test.py index 99d6ce28df..c89b70c01f 100644 --- a/src/psyclone/tests/psyir/backend/fortran_gen_decls_test.py +++ b/src/psyclone/tests/psyir/backend/fortran_gen_decls_test.py @@ -20,9 +20,10 @@ RoutineSymbol, ScalarType, Symbol, SymbolTable, UnresolvedType, StructureType, ImportInterface, UnresolvedInterface, ArgumentInterface, StaticInterface, PreprocessorInterface) +from psyclone.tests.utilities import Compile -def test_gen_param_decls_dependencies(fortran_writer): +def test_gen_decls_dependencies(fortran_writer): ''' Test that dependencies between parameter declarations are handled. ''' symbol_table = SymbolTable() rlg_sym = DataSymbol("rlg", ScalarType.integer_type(), is_constant=True, @@ -36,7 +37,7 @@ def test_gen_param_decls_dependencies(fortran_writer): symbol_table.add(var_sym) symbol_table.add(wp_sym) symbol_table.add(rlg_sym) - result = fortran_writer._gen_parameter_decls(symbol_table) + result = fortran_writer.gen_decls(symbol_table) assert (result == "integer, parameter :: rlg = 8\n" "integer, parameter :: wp = rlg\n" "integer, parameter :: var = rlg + wp\n") @@ -51,7 +52,7 @@ def test_gen_param_decls_dependencies(fortran_writer): # Now that we have the Symbol, update the initial value to refer to it. circ_sym.initial_value.arguments[0].replace_with(Reference(circ_sym)) symbol_table.add(circ_sym) - result = fortran_writer._gen_parameter_decls(symbol_table) + result = fortran_writer.gen_decls(symbol_table) assert (result == "integer, parameter :: rlg = 8\n" "integer, parameter :: wp = rlg\n" "integer, parameter :: var = rlg + wp\n" @@ -64,12 +65,12 @@ def test_gen_param_decls_dependencies(fortran_writer): initial_value=Reference(wp_sym)) symbol_table.add(rlg_sym) with pytest.raises(VisitorError) as err: - fortran_writer._gen_parameter_decls(symbol_table) + fortran_writer.gen_decls(symbol_table) assert ("Unable to satisfy dependencies for the declarations of ['var', " "'wp', 'rlg']" in str(err.value)) -def test_gen_param_decls_imported_dep(fortran_reader, fortran_writer): +def test_gen_decls_imported_dep(fortran_reader, fortran_writer): ''' Check that the dependency handling doesn't generate a false positive for a dependence on an imported symbol. ''' code = ("program my_prog\n" @@ -80,12 +81,12 @@ def test_gen_param_decls_imported_dep(fortran_reader, fortran_writer): "end program my_prog\n") psyir = fortran_reader.psyir_from_source(code) table = psyir.walk(Routine)[0].symbol_table - result = fortran_writer._gen_parameter_decls(table) + result = fortran_writer.gen_decls(table) assert result == ("integer, parameter :: fbdp = wp\n" "integer, parameter :: obdp = rdef\n") -def test_gen_param_decls_kind_dep(fortran_writer): +def test_gen_decls_kind_dep(fortran_writer): ''' Check that symbols defining precision are accounted for when allowing for dependencies between parameter declarations. ''' table = SymbolTable() @@ -103,17 +104,17 @@ def test_gen_param_decls_kind_dep(fortran_writer): table.add(var_sym) table.add(wp_sym) table.add(rdef_sym) - result = fortran_writer._gen_parameter_decls(table) + result = fortran_writer.gen_decls(table) assert result == ("integer, parameter :: r_def = 4\n" "integer, parameter :: wp = r_def\n" "real, parameter :: var2 = 1.0_wp\n" "real(kind=wp), parameter :: var = 1.0_wp\n") -def test_gen_param_decls_case_insensitive(fortran_reader, - fortran_writer): +def test_gen_decls_case_insensitive(fortran_reader, + fortran_writer): ''' - Checks that _gen_parameter_decls is not case sensitive. We have to + Checks that gen_decls is not case sensitive. We have to use the fortran frontend to exercise this. ''' @@ -128,7 +129,7 @@ def test_gen_param_decls_case_insensitive(fortran_reader, integer, parameter :: I_DEF = 4 end module my_mod''') container = psyir.walk(Container)[1] - result = fortran_writer._gen_parameter_decls(container.symbol_table) + result = fortran_writer.gen_decls(container.symbol_table) assert result == ( "integer, parameter :: an_int = 6\n" "integer, parameter :: i_def = 4\n" @@ -169,32 +170,32 @@ def test_gen_decls(fortran_writer): result = fortran_writer.gen_decls(symbol_table) # If derived type declaration is not inside a module then its components # cannot have accessibility attributes. - assert (result == "integer, parameter :: rlg = 8\n" + assert (result == "integer :: local\n" "type :: field\n" " integer :: flag\n" "end type field\n" - "integer :: local\n" - "type(grid_type) :: grid\n") + "type(grid_type) :: grid\n" + "integer, parameter :: rlg = 8\n") # Repeat but specify that these declarations are within a module. result = fortran_writer.gen_decls(symbol_table, is_module_scope=True) - assert (result == "integer, parameter, public :: rlg = 8\n" + assert (result == "integer, public :: local\n" "type, public :: field\n" " integer, public :: flag\n" "end type field\n" - "integer, public :: local\n" - "type(grid_type), public :: grid\n") + "type(grid_type), public :: grid\n" + "integer, parameter, public :: rlg = 8\n") # Add a Symbol with an argument interface. argument_variable = DataSymbol("arg", ScalarType.integer_type(), interface=ArgumentInterface()) symbol_table.add(argument_variable) result = fortran_writer.gen_decls(symbol_table) - assert (result == "integer, parameter :: rlg = 8\n" - "integer :: arg\n" + assert (result == "integer :: local\n" "type :: field\n" " integer :: flag\n" "end type field\n" - "integer :: local\n" - "type(grid_type) :: grid\n") + "type(grid_type) :: grid\n" + "integer, parameter :: rlg = 8\n" + "integer :: arg\n") result = fortran_writer.gen_decls(symbol_table) # Add a Symbol with PreprocessorInterface which has to be ignored by @@ -203,13 +204,13 @@ def test_gen_decls(fortran_writer): interface=PreprocessorInterface()) symbol_table.add(preprocessor_variable) result = fortran_writer.gen_decls(symbol_table) - assert (result == "integer, parameter :: rlg = 8\n" - "integer :: arg\n" + assert (result == "integer :: local\n" "type :: field\n" " integer :: flag\n" "end type field\n" - "integer :: local\n" - "type(grid_type) :: grid\n") + "type(grid_type) :: grid\n" + "integer, parameter :: rlg = 8\n" + "integer :: arg\n") # We can't have an argument if these declarations are in a module. with pytest.raises(VisitorError) as excinfo: @@ -499,7 +500,6 @@ def test_gen_interfacedecl(fortran_writer): procedure :: sub1 end interface subx ''') - # Check we get the preceding comment as expected isub.preceding_comment = "Here is my preceding comment" out = fortran_writer.gen_interfacedecl(isub) @@ -512,6 +512,162 @@ def test_gen_interfacedecl(fortran_writer): """) +def test_non_param_in_param_decln(fortran_reader, fortran_writer, tmp_path): + '''Check that declarations are ordered correctly when we have a + parameter declaration that depends upon a non-parameter symbol.''' + code = ''' + module mymod + integer, parameter :: x = 1 + integer, parameter :: j = 9 + integer, parameter :: k = 12 + integer :: i + real, parameter :: threshold_Wavelength(j, k) & + = reshape( [REAL :: & + 1.3, 1.5, 1.6, 1.7, & + (0.0, i=1, k-4), & + 1.2, 1.4, 1.2, & + (0.0, i=1, k-3), & + (0.0, i=1, k), & + (0.0, i=1, k), & + (0.0, i=1, k), & + (0.0, i=1, k), & + (0.0, i=1, k), & + (0.0, i=1, k), & + (0.0, i=1, k)], shape=[j, k] ) + end module +''' + psyir = fortran_reader.psyir_from_source(code) + output = fortran_writer(psyir) + assert """\ + integer, parameter, public :: x = 1 + integer, parameter, public :: j = 9 + integer, parameter, public :: k = 12 + integer, public :: i + real, dimension(j,k), parameter, public :: threshold_wavelength = \ +RESHAPE([REAL :: 1.3, 1.5, 1.6, 1.7, (0.0, i = 1, k - 4), 1.2, 1.4, 1.2, \ +(0.0, i = 1, k - 3), (0.0, i = 1, k), (0.0, i = 1, k), (0.0, i = 1, k), \ +(0.0, i = 1, k), (0.0, i = 1, k), (0.0, i = 1, k), (0.0, i = 1, k)], [j, k]) + public""" in output + assert Compile(tmp_path).string_compiles(output) + + +def test_abstract_interface_decln(fortran_reader, fortran_writer): + ''' Check that an abstract interface that depends on a previous type + declaration is output after it. + ''' + code = '''\ + module test_mod + use some_mod + + TYPE ftam_typ + TYPE(ftam_ctl_typ) :: fctl + TYPE(ftrj_typ) :: ftrj + TYPE(foce_typ) :: foce_b + TYPE(finc_typ) :: finc_tl, finc_ad + INTEGER :: itst_adj, itst_tan + INTEGER :: istart, iend + + PROCEDURE(rst_interface) , POINTER :: initialiseTL + PROCEDURE(model_interface), POINTER :: stepTL + PROCEDURE(fin_interface) , POINTER :: finaliseAD + + CONTAINS + PROCEDURE :: setup => tam_setup + PROCEDURE :: del => tam_del + PROCEDURE :: adj_test => tam_adj_test + END TYPE ftam_typ + + ABSTRACT INTERFACE + + SUBROUTINE rst_interface(self, piom_ctl, pvar_ctl) + IMPORT :: fiom_ctl_typ, fvar_ctl_typ + + CLASS(ftam_typ), INTENT(INOUT) :: self + TYPE(fiom_ctl_typ) :: piom_ctl + TYPE(fvar_ctl_type) :: pvar_ctl + END SUBROUTINE rst_interface + END INTERFACE + end module test_mod''' + psyir = fortran_reader.psyir_from_source(code) + output = fortran_writer(psyir) + assert """END TYPE ftam_typ + abstract interface + subroutine rst_interface(self, piom_ctl, pvar_ctl) + import :: fiom_ctl_typ, fvar_ctl_typ + class(ftam_typ), intent(inout) :: self""" in output + + +def test_arguments_with_deps(fortran_reader, fortran_writer): + ''' + Check that subroutine arguments that depend on other subroutine + arguments are declared after them. + ''' + code = """ + subroutine a_test(dims_real_array, real_array) + use kinds_mod, only: r_def, i_def + implicit none + ! gfortran 13.2.0 doesn't accept this ordering of declarations. + real(kind=r_def), dimension(dims_real_array(1),dims_real_array(2)), \ +intent(in) :: real_array + integer(kind=i_def), dimension(2), intent(in) :: dims_real_array + end subroutine a_test""" + psyir = fortran_reader.psyir_from_source(code) + output = fortran_writer(psyir) + assert """ + use kinds_mod, only : i_def, r_def + integer(kind=i_def), dimension(2), intent(in) :: dims_real_array + real(kind=r_def), dimension(dims_real_array(1),dims_real_array(2)), \ +intent(in) :: real_array""" in output + + +def test_unsupported_decl_with_deps(fortran_reader, fortran_writer): + ''' + Check that dependencies are respected when they occur within an + UnsupportedType. + ''' + code = """ + module test_mod + implicit none + integer, parameter :: ilenwmo = 58 + ! The 'pointer' attribute is not supported. + character(len = ilenwmo), dimension(:), pointer, public :: cdwmo + end module test_mod""" + psyir = fortran_reader.psyir_from_source(code) + output = fortran_writer(psyir) + assert """\ + integer, parameter, public :: ilenwmo = 58 + character(len = ilenwmo), """ in output + + +def test_complex_decl_with_deps(fortran_reader, fortran_writer, tmp_path): + ''' + Test that dependencies within a declaration of a complex variable are + handled OK. + + ''' + code = """ + module test_mod + implicit none + ! This ordering of declarations is not valid Fortran but fparser2 doesn't + ! check and this lets us mimic the fact that symbols can be added to + ! a SymbolTable in any order. + complex(kind=dp), dimension(np) :: myvar = i + complex, parameter :: i = (0,1) + integer :: a_var + integer, parameter :: np = 5 + integer, parameter :: dp = KIND(1.0d0) + end module test_mod""" + psyir = fortran_reader.psyir_from_source(code) + output = fortran_writer(psyir) + assert """\ + integer, parameter, public :: dp = KIND(1.0d0) + integer, parameter, public :: np = 5 + complex, parameter, public :: i = (0, 1) + complex(kind=dp), dimension(np), save, public :: myvar = i + integer, public :: a_var""" in output + assert Compile(tmp_path).string_compiles(output) + + def test_procedure_declaration_pointers(fortran_reader, fortran_writer): ''' Check that the procedure declarations are generated, and they have the required attributes added into them. @@ -556,10 +712,11 @@ def test_structure_initialiser(fortran_reader, fortran_writer): ''' Check a variable declaration with a structure intialiser.''' code = """ subroutine my_sub + use some_mod type(some_type), parameter :: x = some_type() end subroutine my_sub """ psyir = fortran_reader.psyir_from_source(code) table = psyir.walk(Routine)[0].symbol_table - result = fortran_writer._gen_parameter_decls(table) - assert result == "type(some_type), parameter :: x = some_type()\n" + result = fortran_writer.gen_decls(table) + assert "type(some_type), parameter :: x = some_type()\n" in result diff --git a/src/psyclone/tests/psyir/backend/fortran_routine_test.py b/src/psyclone/tests/psyir/backend/fortran_routine_test.py index 2efaaecbaa..ed8b5aece4 100644 --- a/src/psyclone/tests/psyir/backend/fortran_routine_test.py +++ b/src/psyclone/tests/psyir/backend/fortran_routine_test.py @@ -209,8 +209,8 @@ def test_fw_routine_function(fortran_reader, fortran_writer, tmpdir, assert ( f" contains\n" f" function tmp(b) result(val)\n" - f" real :: b\n" - f" {result_decl}\n\n" + f" {result_decl}\n" + f" real :: b\n\n" f" val = a + b\n\n" f" end function tmp\n" in result.lower()) assert Compile(tmpdir).string_compiles(result) diff --git a/src/psyclone/tests/psyir/frontend/fparser2_select_type_test.py b/src/psyclone/tests/psyir/frontend/fparser2_select_type_test.py index 6857a1e8ae..fabc1b9a87 100644 --- a/src/psyclone/tests/psyir/frontend/fparser2_select_type_test.py +++ b/src/psyclone/tests/psyir/frontend/fparser2_select_type_test.py @@ -379,35 +379,35 @@ def test_derived(fortran_reader, fortran_writer, tmpdir): code = ( "module select_mod\n" "contains\n" - "subroutine select_type(type)\n" - " class(*), target :: type\n" + "subroutine select_type(atype)\n" + " class(*), target :: atype\n" " type field_type\n" " integer :: x\n" " end type\n" " type(field_type) :: field_type_info\n" " integer :: branch1\n" - " SELECT TYPE (type)\n" + " SELECT TYPE (atype)\n" " TYPE IS (field_type)\n" " branch1 = 1\n" - " field_type_info = type\n" + " field_type_info = atype\n" " END SELECT\n" "end subroutine\n" "end module\n") expected1 = ( - " class(*), target :: type\n" " type :: field_type\n" " integer :: x\n" " end type field_type\n" + " class(*), target :: atype\n" " type(field_type) :: field_type_info\n" " integer :: branch1\n" " character(len=256) :: type_string\n" " type(field_type), pointer :: ptr_field_type => null()\n") expected2 = ( " type_string = ''\n" - " SELECT TYPE(type)\n" + " SELECT TYPE(atype)\n" " TYPE IS (field_type)\n" " type_string = \"field_type\"\n" - " ptr_field_type => type\n" + " ptr_field_type => atype\n" " END SELECT\n" " if (type_string == 'field_type') then\n" " branch1 = 1\n" diff --git a/src/psyclone/tests/psyir/frontend/fparser2_where_handler_test.py b/src/psyclone/tests/psyir/frontend/fparser2_where_handler_test.py index b3c42ace26..f6c86a9965 100644 --- a/src/psyclone/tests/psyir/frontend/fparser2_where_handler_test.py +++ b/src/psyclone/tests/psyir/frontend/fparser2_where_handler_test.py @@ -1419,8 +1419,8 @@ def test_where_with_empty_line_before(fortran_writer): assert len(psyir.walk(CodeBlock)) == 0 out = fortran_writer(psyir) correct = """subroutine x(arr2) - integer, dimension(:) :: arr2 integer, dimension(:) :: arr1 + integer, dimension(:) :: arr2 integer :: widx1 arr1(:) = arr2(:) diff --git a/src/psyclone/tests/psyir/transformations/hoist_local_arrays_trans_test.py b/src/psyclone/tests/psyir/transformations/hoist_local_arrays_trans_test.py index 86d705325a..8b2bfb7e59 100644 --- a/src/psyclone/tests/psyir/transformations/hoist_local_arrays_trans_test.py +++ b/src/psyclone/tests/psyir/transformations/hoist_local_arrays_trans_test.py @@ -713,9 +713,9 @@ def test_apply_with_allocatables(fortran_reader, fortran_writer, tmpdir): contains subroutine test(arg, var) + integer :: i real, allocatable, dimension(:), intent(in) :: arg integer, intent(in) :: var - integer :: i real, allocatable, dimension(:) :: d real, allocatable, dimension(:) :: e real, allocatable, dimension(:) :: unused diff --git a/src/psyclone/tests/psyir/transformations/intrinsics/dotproduct2code_trans_test.py b/src/psyclone/tests/psyir/transformations/intrinsics/dotproduct2code_trans_test.py index e32373f05b..88f0c9db40 100644 --- a/src/psyclone/tests/psyir/transformations/intrinsics/dotproduct2code_trans_test.py +++ b/src/psyclone/tests/psyir/transformations/intrinsics/dotproduct2code_trans_test.py @@ -480,8 +480,8 @@ def test_apply_explicit_range(fortran_reader, fortran_writer, tmpdir): "end subroutine\n") expected = ( "subroutine dot_product_test(basis_w1)\n" - " real, dimension(:) :: basis_w1\n" " real, dimension(3) :: wind\n" + " real, dimension(:) :: basis_w1\n" " integer :: result\n" " integer :: i\n" " real :: res_dot_product\n\n" diff --git a/src/psyclone/tests/psyir/transformations/intrinsics/matmul2code_trans_test.py b/src/psyclone/tests/psyir/transformations/intrinsics/matmul2code_trans_test.py index 8d1f9b6511..1bd49eae26 100644 --- a/src/psyclone/tests/psyir/transformations/intrinsics/matmul2code_trans_test.py +++ b/src/psyclone/tests/psyir/transformations/intrinsics/matmul2code_trans_test.py @@ -917,10 +917,10 @@ def test_apply_matvec_varexpr_index(tmpdir, fortran_reader, fortran_writer): trans.apply(assign.rhs) out = fortran_writer(psyir) assert ( - " integer, parameter :: arg = 0\n" " real, dimension(2,4,6) :: jac\n" " real, dimension(4,6,3) :: jac_inv\n" " real, dimension(2) :: result\n" + " integer, parameter :: arg = 0\n" " integer :: i\n" " integer :: j\n" "\n"