Skip to content

Commit

Permalink
#2642 More tests.
Browse files Browse the repository at this point in the history
  • Loading branch information
JulienRemy committed Nov 29, 2024
1 parent ff993ea commit 8c789b7
Show file tree
Hide file tree
Showing 6 changed files with 338 additions and 99 deletions.
120 changes: 56 additions & 64 deletions src/psyclone/psyir/frontend/fparser2.py
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1589,10 +1589,6 @@ def _process_type_spec(self, parent, type_spec):

elif isinstance(type_spec, Fortran2003.Declaration_Type_Spec):
# This is a variable of derived type
if type_spec.children[0].lower() not in ("type", "class"):
raise NotImplementedError(
f"Could not process {type_spec} - declarations "
f"other than 'type' or 'class' are not yet supported.")
if isinstance(type_spec.items[1], Fortran2003.Type_Name):
type_name = str(type_spec.items[1].string).lower()
else:
Expand Down Expand Up @@ -2032,68 +2028,64 @@ def _process_derived_type_decln(self, parent, decl, visibility_map):
contains = contains_blocks[0]
# Get all procedures in the CONTAINS section.
procedures = walk(contains, Fortran2003.Specific_Binding)
if procedures is None:
# The CONTAINS statement is empty.
raise NotImplementedError(
"Derived-type definition contains an empty "
"CONTAINS statement.")
# Process each procedure.
for procedure in procedures:
supported = True
# We do not support interfaces.
if procedure.items[0] is not None:
supported = False
# We do not support 'pass', 'nopass', etc.
if procedure.items[1] is not None:
supported = False

# Get the name, look it up in the symbol table and
# get its datatype or create it if it does not exist.
procedure_name = procedure.items[3].string
if procedure_name in parent.symbol_table and supported:
procedure_symbol = parent.symbol_table.\
lookup(procedure_name)
procedure_datatype = procedure_symbol.datatype
else:
procedure_datatype = UnsupportedFortranType(
procedure.string,
None)

# Get the visibility of the procedure.
procedure_vis = dtype_symbol_vis
if procedure.items[1] is not None:
access_spec = walk(procedure.items[1],
Fortran2003.Access_Spec)
if access_spec:
procedure_vis = _process_access_spec(
access_spec[0])

# Deal with the optional initial value.
if procedure.items[4] is not None:
initial_value_name = procedure.items[4].string
# Look it up in the symbol table and get its datatype
# or create it if it does not exist.
if initial_value_name in parent.symbol_table:
initial_value_symbol = parent.symbol_table.lookup(
initial_value_name)
if (isinstance(procedure_datatype,
UnsupportedFortranType)
and supported):
procedure_datatype = initial_value_symbol.\
datatype
if len(procedures) > 0:
# Process each procedure.
for procedure in procedures:
supported = True
# We do not support interfaces.
if procedure.items[0] is not None:
supported = False
# We do not support 'pass', 'nopass', 'deferred', etc.
if procedure.items[1] is not None:
supported = False

# Get the name, look it up in the symbol table and
# get its datatype or create it if it does not exist.
procedure_name = procedure.items[3].string
if procedure_name in parent.symbol_table and supported:
procedure_symbol = parent.symbol_table.\
lookup(procedure_name)
procedure_datatype = procedure_symbol.datatype
else:
initial_value_symbol = RoutineSymbol(
initial_value_name,
UnresolvedType())
initial_value = Reference(initial_value_symbol)
else:
initial_value = None
procedure_datatype = UnsupportedFortranType(
procedure.string,
None)

# Get the visibility of the procedure.
procedure_vis = dtype_symbol_vis
if procedure.items[1] is not None:
access_spec = walk(procedure.items[1],
Fortran2003.Access_Spec)
if access_spec:
procedure_vis = _process_access_spec(
access_spec[0])

# Deal with the optional initial value.
if procedure.items[4] is not None:
initial_value_name = procedure.items[4].string
# Look it up in the symbol table and get its
# datatype or create it if it does not exist.
if initial_value_name in parent.symbol_table:
initial_value_symbol = parent.symbol_table.\
lookup(initial_value_name)
if (isinstance(procedure_datatype,
UnsupportedFortranType)
and supported):
procedure_datatype = initial_value_symbol.\
datatype
else:
initial_value_symbol = RoutineSymbol(
initial_value_name,
UnresolvedType())
initial_value = Reference(initial_value_symbol)
else:
initial_value = None

# Add this procedure as a component of the derived type.
dtype.add_procedure_component(procedure_name,
procedure_datatype,
procedure_vis,
initial_value)
# Add this procedure as a component of the derived type
dtype.add_procedure_component(procedure_name,
procedure_datatype,
procedure_vis,
initial_value)

# Re-use the existing code for processing symbols. This needs to
# be able to find any symbols declared in an outer scope but
Expand Down
12 changes: 6 additions & 6 deletions src/psyclone/psyir/symbols/datatypes.py
View file
Original file line number Diff line number Diff line change
Expand Up @@ -973,7 +973,7 @@ def create(components, procedure_components=None, extends=None):
stype.add_component(*component)
if procedure_components:
for procedure_component in procedure_components:
if len(procedure_components) != 4:
if len(procedure_component) != 4:
raise TypeError(
f"Each procedure component must be specified using a "
f"4-tuple of (name, type, visibility, initial_value) "
Expand Down Expand Up @@ -1123,15 +1123,15 @@ def add_procedure_component(self, name, datatype, visibility,
f"be a 'StructureType' but got '{type(datatype).__name__}'")
if not isinstance(visibility, Symbol.Visibility):
raise TypeError(
f"The visibility of a component of a StructureType must be "
f"an instance of 'Symbol.Visibility' but got "
f"The visibility of a procedure component of a StructureType "
f"must be an instance of 'Symbol.Visibility' but got "
f"'{type(visibility).__name__}'")
if (initial_value is not None and
not isinstance(initial_value, DataNode)):
raise TypeError(
f"The initial value of a component of a StructureType must "
f"be None or an instance of 'DataNode', but got "
f"'{type(initial_value).__name__}'.")
f"The initial value of a procedure component of a "
f"StructureType must be None or an instance of 'DataNode', "
f"but got '{type(initial_value).__name__}'.")

self._procedure_components[name] = self.ComponentType(
name, datatype, visibility, initial_value)
Expand Down
58 changes: 57 additions & 1 deletion src/psyclone/tests/psyir/backend/fortran_test.py
View file
Original file line number Diff line number Diff line change
Expand Up @@ -761,7 +761,63 @@ def test_fw_gen_vardecl_visibility(fortran_writer):


def test_fw_gen_proceduredecl(fortran_writer):
pass
'''Test the FortranWriter class gen_proceduredecl method produces the
expected declarations and raises the expected exceptions.
'''
with pytest.raises(VisitorError) as err:
fortran_writer.gen_proceduredecl(None)
assert ("gen_proceduredecl() expects a 'DataSymbol' or "
"'StructureType.ComponentType' as its first "
"argument but got 'NoneType'" in str(err.value))

# A DataSymbol of UnupportedFortranType
symbol = DataSymbol("my_sub", UnsupportedFortranType(
"procedure, private :: my_unsupported_procedure"))
assert (fortran_writer.gen_proceduredecl(symbol) ==
"procedure, private :: my_unsupported_procedure\n")

# A StructureType.ComponentType with 'public' visibility and no initial
# value
dtype = StructureType.ComponentType("my_procedure", REAL_TYPE,
Symbol.Visibility.PUBLIC, None)
assert (fortran_writer.gen_proceduredecl(dtype) ==
"procedure, public :: my_procedure\n")

# A StructureType.ComponentType with 'public' visibility and an initial
# value
dtype = StructureType.ComponentType("my_procedure", REAL_TYPE,
Symbol.Visibility.PUBLIC,
Reference(RoutineSymbol("other",
REAL_TYPE)))
assert (fortran_writer.gen_proceduredecl(dtype) ==
"procedure, public :: my_procedure => other\n")

# A StructureType.ComponentType with 'private' visibility and no initial
# value
dtype = StructureType.ComponentType("my_procedure", REAL_TYPE,
Symbol.Visibility.PRIVATE, None)
assert fortran_writer.gen_proceduredecl(dtype) == (
"procedure, private :: my_procedure\n")

# A StructureType.ComponentType with 'private' visibility and an initial
# value
dtype = StructureType.ComponentType("my_procedure", REAL_TYPE,
Symbol.Visibility.PRIVATE,
Reference(RoutineSymbol("other",
REAL_TYPE)))
assert fortran_writer.gen_proceduredecl(dtype) == (
"procedure, private :: my_procedure => other\n")

# Check that visibility is not included in the output if include_visibility
# is False
dtype = StructureType.ComponentType("my_procedure", REAL_TYPE,
Symbol.Visibility.PUBLIC, None)
assert (fortran_writer.gen_proceduredecl(dtype, include_visibility=False)
== ("procedure :: my_procedure\n"))
dtype = StructureType.ComponentType("my_procedure", REAL_TYPE,
Symbol.Visibility.PRIVATE, None)
assert (fortran_writer.gen_proceduredecl(dtype, include_visibility=False)
== ("procedure :: my_procedure\n"))


def test_gen_default_access_stmt(fortran_writer):
Expand Down
Loading

0 comments on commit 8c789b7

Please sign in to comment.