From 181e87834f4a97e2d51673ad0047d725cb09308c Mon Sep 17 00:00:00 2001 From: rupertford Date: Mon, 4 Dec 2023 10:28:09 +0000 Subject: [PATCH] pr #2396 towards fixing compilation errors. --- src/psyclone/psyir/frontend/fparser2.py | 30 ++++++++-- .../frontend/fparser2_select_type_test.py | 56 ++++++++++++++++--- 2 files changed, 73 insertions(+), 13 deletions(-) diff --git a/src/psyclone/psyir/frontend/fparser2.py b/src/psyclone/psyir/frontend/fparser2.py index 1f32f798c1..9daf6b56f3 100644 --- a/src/psyclone/psyir/frontend/fparser2.py +++ b/src/psyclone/psyir/frontend/fparser2.py @@ -3308,11 +3308,12 @@ def _type_construct_handler(self, node, parent): # Select_Type_Construct and extract the required # information. This makes for easier code generation later in # the routine. - select_idx = -1 # index of the current clause - default_idx = -1 # index of the default clause if it exists - guard_type = [] # type of guard (class is, type is default class) - clause_type = [] # name of the clause - stmts = [] # list of statements for each clause + select_idx = -1 # index of the current clause + default_idx = -1 # index of the default clause if it exists + guard_type = [] # type of guard (class is ...) + clause_type = [] # name of the clause + stmts = [] # list of statements for each clause + pointer_symbols = [] # list of pointers to the selector variable for idx, child in enumerate(node.children): if isinstance(child, Fortran2003.Select_Type_Stmt): @@ -3358,10 +3359,23 @@ def _type_construct_handler(self, node, parent): code += f"select type({selector})\n" for idx in range(select_idx+1): if idx == default_idx: + pointer_symbols.append(None) continue + pointer_name = parent.scope.symbol_table.next_available_name( + f"ptr_{guard_type[idx]}") + tmp = f"{guard_type[idx]}" + intrinsic_types = ["integer", "real", "character", "complex"] + if str(guard_type[idx]).lower() not in intrinsic_types: + tmp = f"type({tmp})" + pointer_type = UnknownFortranType( + f"{tmp}, pointer :: {pointer_name}\n") + pointer_symbol = DataSymbol(pointer_name, pointer_type) + parent.scope.symbol_table.add(pointer_symbol) + pointer_symbols.append(pointer_symbol) code += f" {clause_type[idx]} ({guard_type[idx]})\n" code += (f" {type_string_name} = " f"\"{guard_type[idx].string.lower()}\"\n") + code += (f" {pointer_name} => {selector}\n") code += "end select\n" code += "end program\n" parser = ParserFactory().create(std="f2008") @@ -3416,6 +3430,12 @@ def _type_construct_handler(self, node, parent): # Add If_body ifbody = Schedule(parent=ifblock) self.process_nodes(parent=ifbody, nodes=stmts[idx]) + # Replace references to the type selector variable with + # references to the appropriate pointer. + for reference in ifbody.walk(Reference): + symbol = reference.symbol + if symbol.name.lower() == selector.lower(): + reference.symbol = pointer_symbols[idx] ifblock.addchild(ifbody) currentparent = ifblock 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 15d52e199c..7b23075394 100644 --- a/src/psyclone/tests/psyir/frontend/fparser2_select_type_test.py +++ b/src/psyclone/tests/psyir/frontend/fparser2_select_type_test.py @@ -99,30 +99,40 @@ def test_type(fortran_reader, fortran_writer, tmpdir): "subroutine select_type(type_selector)\n" " class(*) :: type_selector\n" " integer :: branch1, branch2\n" + " integer :: iinfo\n" + " real :: rinfo\n" " SELECT TYPE (type_selector)\n" " TYPE IS (INTEGER)\n" " branch1 = 1\n" " branch2 = 0\n" + " iinfo = type_selector\n" " TYPE IS (REAL)\n" " branch2 = 1\n" + " rinfo = type_selector\n" " END SELECT\n" "end subroutine\n" "end module\n") expected = ( - " character(256) :: type_string\n\n\n" + " character(256) :: type_string\n\n" + " INTEGER, pointer :: ptr_INTEGER\n\n" + " REAL, pointer :: ptr_REAL\n\n\n" " type_string = ''\n" " SELECT TYPE(type_selector)\n" " TYPE IS (INTEGER)\n" " type_string = \"integer\"\n" + " ptr_INTEGER => type_selector\n" " TYPE IS (REAL)\n" " type_string = \"real\"\n" + " ptr_REAL => type_selector\n" "END SELECT\n" " if (type_string == 'integer') then\n" " branch1 = 1\n" " branch2 = 0\n" + " iinfo = ptr_INTEGER\n" " else\n" " if (type_string == 'real') then\n" " branch2 = 1\n" + " rinfo = ptr_REAL\n" " end if\n" " end if\n") psyir = fortran_reader.psyir_from_source(code) @@ -147,32 +157,42 @@ def test_default(fortran_reader, fortran_writer, tmpdir): "subroutine select_type(type)\n" " class(*) :: type\n" " integer :: branch1, branch2, branch3\n" + " integer :: iinfo\n" + " real :: rinfo\n" " SELECT TYPE (type)\n" " TYPE IS (INTEGER)\n" " branch1 = 1\n" " branch2 = 0\n" + " iinfo = type\n" " CLASS DEFAULT\n" " branch3 = 1\n" " TYPE IS (REAL)\n" " branch2 = 1\n" + " rinfo = type\n" " END SELECT\n" "end subroutine\n" "end module\n") expected = ( - " character(256) :: type_string\n\n\n" + " character(256) :: type_string\n\n" + " INTEGER, pointer :: ptr_INTEGER\n\n" + " REAL, pointer :: ptr_REAL\n\n\n" " type_string = ''\n" " SELECT TYPE(type)\n" " TYPE IS (INTEGER)\n" " type_string = \"integer\"\n" + " ptr_INTEGER => type\n" " TYPE IS (REAL)\n" " type_string = \"real\"\n" + " ptr_REAL => type\n" "END SELECT\n" " if (type_string == 'integer') then\n" " branch1 = 1\n" " branch2 = 0\n" + " iinfo = ptr_INTEGER\n" " else\n" " if (type_string == 'real') then\n" " branch2 = 1\n" + " rinfo = ptr_REAL\n" " else\n" " branch3 = 1\n" " end if\n" @@ -202,41 +222,59 @@ def test_class(fortran_reader, fortran_writer, tmpdir): " integer :: field\n" " end type\n" " integer :: branch0, branch1, branch2, branch3\n" + " type(type2) :: my_type2\n" + " type(type3) :: my_type3\n" + " integer :: iinfo\n" " SELECT TYPE (type)\n" " CLASS IS(type2)\n" - " branch0 = 1\n" + " branch0 = 1\n" + " my_type2 = type\n" " TYPE IS (INTEGER)\n" - " branch1 = 1\n" - " branch2 = 0\n" + " branch1 = 1\n" + " branch2 = 0\n" + " iinfo = type\n" " CLASS IS(type3)\n" - " branch2 = 1\n" + " branch2 = 1\n" + " my_type3 = type\n" " TYPE IS (REAL)\n" - " branch3 = 1\n" + " branch3 = 1\n" + " ! type not used here\n" " END SELECT\n" "end subroutine\n" "end module\n") expected = ( - " character(256) :: type_string\n\n\n" + " character(256) :: type_string\n\n" + " type(type2), pointer :: ptr_type2\n\n" + " INTEGER, pointer :: ptr_INTEGER\n\n" + " type(type3), pointer :: ptr_type3\n\n" + " REAL, pointer :: ptr_REAL\n\n\n" " type_string = ''\n" " SELECT TYPE(type)\n" " CLASS IS (type2)\n" " type_string = \"type2\"\n" + " ptr_type2 => type\n" " TYPE IS (INTEGER)\n" " type_string = \"integer\"\n" + " ptr_INTEGER => type\n" " CLASS IS (type3)\n" " type_string = \"type3\"\n" + " ptr_type3 => type\n" " TYPE IS (REAL)\n" " type_string = \"real\"\n" + " ptr_REAL => type\n" "END SELECT\n" " if (type_string == 'type2') then\n" " branch0 = 1\n" + " my_type2 = ptr_type2\n" " else\n" " if (type_string == 'integer') then\n" " branch1 = 1\n" " branch2 = 0\n" + " iinfo = ptr_INTEGER\n" " else\n" " if (type_string == 'type3') then\n" " branch2 = 1\n" + " my_type3 = ptr_type3\n" " else\n" " if (type_string == 'real') then\n" " branch3 = 1\n" @@ -246,6 +284,8 @@ def test_class(fortran_reader, fortran_writer, tmpdir): " end if\n") psyir = fortran_reader.psyir_from_source(code) result = fortran_writer(psyir) + print(result) + exit(1) assert expected in result if_blocks = psyir.walk(IfBlock) assert "was_class_type" in if_blocks[0].annotations