diff --git a/src/psyclone/psyir/backend/fortran.py b/src/psyclone/psyir/backend/fortran.py index 87f6c9abf6..97259d2349 100644 --- a/src/psyclone/psyir/backend/fortran.py +++ b/src/psyclone/psyir/backend/fortran.py @@ -233,8 +233,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() @@ -861,78 +861,17 @@ def gen_access_stmts(self, symbol_table): 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. @@ -952,6 +891,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 @@ -983,20 +924,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): symbols_txt = ", ".join( @@ -1014,62 +953,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/tests/domain/common/transformations/kernel_module_inline_trans_test.py b/src/psyclone/tests/domain/common/transformations/kernel_module_inline_trans_test.py index c8b6941924..45b4915712 100644 --- a/src/psyclone/tests/domain/common/transformations/kernel_module_inline_trans_test.py +++ b/src/psyclone/tests/domain/common/transformations/kernel_module_inline_trans_test.py @@ -541,7 +541,7 @@ def test_module_inline_apply_polymorphic_kernel_in_multiple_invokes(tmpdir): use quadrature_xyoz_mod, only : quadrature_xyoz_proxy_type, \ quadrature_xyoz_type use function_space_mod, only : basis, diff_basis - real""" in output + integer""" in output assert "mixed_kernel_mod" not in output assert LFRicBuild(tmpdir).code_compiles(psy) 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 3e4191f0c8..7a0a51c8c4 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 @@ -187,13 +187,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 04a720fef2..2f22cde27c 100644 --- a/src/psyclone/tests/domain/lfric/dofkern_test.py +++ b/src/psyclone/tests/domain/lfric/dofkern_test.py @@ -271,6 +271,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 5bc44ec427..3384598248 100644 --- a/src/psyclone/tests/domain/lfric/lfric_field_codegen_test.py +++ b/src/psyclone/tests/domain/lfric/lfric_field_codegen_test.py @@ -78,12 +78,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" @@ -177,12 +177,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 = ( @@ -322,6 +322,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 @@ -335,7 +336,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() @@ -655,6 +655,7 @@ def test_int_field_fs(tmpdir): subroutine invoke_0_testkern_fs_int_field_type(f1, f2, m1, m2, f3, f4, m3, \ m4, f5, f6, m5, m6, f7, f8, m7) use mesh_mod, only : mesh_type + integer(kind=i_def) :: cell type(integer_field_type), intent(in) :: f1 type(integer_field_type), intent(in) :: f2 type(integer_field_type), intent(in) :: m1 @@ -670,7 +671,6 @@ def test_int_field_fs(tmpdir): type(integer_field_type), intent(in) :: f7 type(integer_field_type), intent(in) :: f8 type(integer_field_type), intent(in) :: m7 - integer(kind=i_def) :: cell type(mesh_type), pointer :: mesh => null() integer(kind=i_def) :: max_halo_depth_mesh integer(kind=i_def), pointer, dimension(:) :: f1_data => null() 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 0445351c19..44728c3df4 100644 --- a/src/psyclone/tests/domain/lfric/lfric_scalar_codegen_test.py +++ b/src/psyclone/tests/domain/lfric/lfric_scalar_codegen_test.py @@ -68,12 +68,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" @@ -172,12 +172,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" @@ -278,13 +278,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" @@ -383,13 +383,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" @@ -507,6 +507,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" @@ -514,7 +515,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" @@ -620,7 +620,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 1c4f086570..40abd3e677 100644 --- a/src/psyclone/tests/gocean1p0_test.py +++ b/src/psyclone/tests/gocean1p0_test.py @@ -87,11 +87,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" @@ -161,13 +161,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" @@ -215,11 +215,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" @@ -273,12 +273,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" @@ -330,10 +330,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" @@ -374,10 +374,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" @@ -436,6 +436,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" @@ -483,12 +484,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" @@ -534,11 +535,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" @@ -584,9 +585,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" @@ -631,9 +632,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" @@ -678,9 +679,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" @@ -723,12 +724,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" @@ -774,12 +775,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" @@ -825,12 +826,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" @@ -877,12 +878,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" @@ -929,10 +930,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" @@ -970,18 +971,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" @@ -995,7 +989,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) @@ -1019,19 +1013,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" @@ -1046,7 +1033,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) @@ -1070,18 +1057,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" @@ -1094,7 +1074,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 4d64270c3f..cb4a704c08 100644 --- a/src/psyclone/tests/lfric_lma_test.py +++ b/src/psyclone/tests/lfric_lma_test.py @@ -517,10 +517,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 95addacc7e..27bbee95f1 100644 --- a/src/psyclone/tests/lfric_multigrid_test.py +++ b/src/psyclone/tests/lfric_multigrid_test.py @@ -292,9 +292,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 @@ -395,6 +395,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 cdd54c2dba..0db20f89ae 100644 --- a/src/psyclone/tests/lfric_quadrature_test.py +++ b/src/psyclone/tests/lfric_quadrature_test.py @@ -92,6 +92,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 @@ -99,7 +100,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() @@ -305,12 +305,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 38b806d502..7f814ac9bd 100644 --- a/src/psyclone/tests/lfric_test.py +++ b/src/psyclone/tests/lfric_test.py @@ -3778,6 +3778,7 @@ def test_mixed_precision_args(tmp_path): field_r_tran, operator_r_tran, scalar_r_bl, field_r_bl) 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 @@ -3789,7 +3790,6 @@ def test_mixed_precision_args(tmp_path): type(r_tran_operator_type), intent(in) :: operator_r_tran real(kind=r_bl), intent(in) :: scalar_r_bl type(r_bl_field_type), intent(in) :: field_r_bl - 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 f240c1348f..973937bf58 100644 --- a/src/psyclone/tests/nemo/transformations/openacc/loop_directive_test.py +++ b/src/psyclone/tests/nemo/transformations/openacc/loop_directive_test.py @@ -95,8 +95,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 e9537f258f..ae67252996 100644 --- a/src/psyclone/tests/nemo/transformations/openacc/parallel_directive_test.py +++ b/src/psyclone/tests/nemo/transformations/openacc/parallel_directive_test.py @@ -67,8 +67,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" @@ -100,8 +100,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" @@ -118,8 +118,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 e978081f69..298bcd945a 100644 --- a/src/psyclone/tests/nemo/transformations/openmp/openmp_test.py +++ b/src/psyclone/tests/nemo/transformations/openmp/openmp_test.py @@ -68,12 +68,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 293015946b..08a19cae5f 100644 --- a/src/psyclone/tests/psyGen_test.py +++ b/src/psyclone/tests/psyGen_test.py @@ -546,6 +546,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 7725cf38ec..92fb88171d 100644 --- a/src/psyclone/tests/psyad/domain/common/test_adjoint_utils.py +++ b/src/psyclone/tests/psyad/domain/common/test_adjoint_utils.py @@ -80,11 +80,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" @@ -118,11 +118,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" @@ -154,10 +154,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 f10465b818..52d5e5ad48 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 @@ -451,11 +451,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" @@ -493,11 +493,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 de30166114..e2f6e3e011 100644 --- a/src/psyclone/tests/psyad/main_test.py +++ b/src/psyclone/tests/psyad/main_test.py @@ -121,13 +121,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 d116476e9c..8b2b673446 100644 --- a/src/psyclone/tests/psyad/transformations/test_assignment_trans.py +++ b/src/psyclone/tests/psyad/transformations/test_assignment_trans.py @@ -193,11 +193,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) @@ -230,9 +230,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) @@ -296,13 +297,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 2eed1ca3f5..0493c4574e 100644 --- a/src/psyclone/tests/psyir/backend/fortran_gen_decls_test.py +++ b/src/psyclone/tests/psyir/backend/fortran_gen_decls_test.py @@ -50,9 +50,10 @@ StructureType, ImportInterface, UnresolvedInterface, ArgumentInterface, INTEGER_TYPE, REAL_TYPE, StaticInterface, PreprocessorInterface, CHARACTER_TYPE) +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", INTEGER_TYPE, is_constant=True, @@ -66,7 +67,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") @@ -80,7 +81,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" @@ -93,12 +94,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" @@ -109,12 +110,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() @@ -131,17 +132,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. ''' @@ -156,7 +157,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" @@ -196,32 +197,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", 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 @@ -230,13 +231,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: @@ -522,3 +523,156 @@ def test_gen_interfacedecl(fortran_writer): procedure :: sub1 end interface subx ''') + + +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 mimick 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) + complex(kind = dp), dimension(np), public :: myvar = i""" in output + assert Compile(tmp_path).string_compiles(output) diff --git a/src/psyclone/tests/psyir/backend/fortran_routine_test.py b/src/psyclone/tests/psyir/backend/fortran_routine_test.py index acaa2ebaf4..adb03af615 100644 --- a/src/psyclone/tests/psyir/backend/fortran_routine_test.py +++ b/src/psyclone/tests/psyir/backend/fortran_routine_test.py @@ -236,8 +236,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 51066c4a22..306467857c 100644 --- a/src/psyclone/tests/psyir/frontend/fparser2_select_type_test.py +++ b/src/psyclone/tests/psyir/frontend/fparser2_select_type_test.py @@ -420,35 +420,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/transformations/hoist_local_arrays_trans_test.py b/src/psyclone/tests/psyir/transformations/hoist_local_arrays_trans_test.py index ec7c5fdbdf..16eb4154d9 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 @@ -742,9 +742,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 a0405b2a5c..2f2dc37961 100644 --- a/src/psyclone/tests/psyir/transformations/intrinsics/dotproduct2code_trans_test.py +++ b/src/psyclone/tests/psyir/transformations/intrinsics/dotproduct2code_trans_test.py @@ -509,8 +509,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 a5162657c4..676cf215fb 100644 --- a/src/psyclone/tests/psyir/transformations/intrinsics/matmul2code_trans_test.py +++ b/src/psyclone/tests/psyir/transformations/intrinsics/matmul2code_trans_test.py @@ -945,10 +945,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"