Skip to content

Commit

Permalink
pr #2396 towards fixing compilation errors.
Browse files Browse the repository at this point in the history
  • Loading branch information
@rupertford
rupertford committed Dec 4, 2023
1 parent 4a75de2 commit 181e878
Show file tree
Hide file tree
Showing 2 changed files with 73 additions and 13 deletions.
30 changes: 25 additions & 5 deletions src/psyclone/psyir/frontend/fparser2.py
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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):
Expand Down Expand Up @@ -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")
Expand Down Expand Up @@ -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

Expand Down
56 changes: 48 additions & 8 deletions src/psyclone/tests/psyir/frontend/fparser2_select_type_test.py
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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"
Expand Down Expand Up @@ -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"
Expand All @@ -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
Expand Down

0 comments on commit 181e878

Please sign in to comment.