Repository: stfc/PSyclone

Issue:
LFRic alg layer error when using PSyIR: select case/type
invoke's are not seen by the PSyIR if they are within `select case` or `select type` clauses so they are not processed. There are a lot of LFRic algorithm files that do this (as found when trying to compile gravity wave), including ... algorithm/transport/common/calc_dep_pts_alg_mod.x90, algorithm/transport/common/transport_runtime_alg_mod.x90, algorithm/transport/mol/wt_advective_update_alg_mod.x90, field/field_vector_mod.x90, algorithm/iterative_solvers/mass_matrix_operator_alg_mod.x90 and algorithm/iterative_solvers/diagonal_preconditioner_alg_mod.f90

Discussion:

Patch:
diff --git a/changelog b/changelog
index a50ee1a17..89988e7fd 100644
--- a/changelog
+++ b/changelog
@@ -41,6 +41,10 @@
 
 	16) PR #2549 for #2548. Update Codecov action.
 
+	17) PR #2396 for #2229. Add PSyIR support for select-type (the selector is
+	still a CodeBlock but the case bodies are transferred to a conditional
+	construct after the CodeBlock).
+
 release 2.5.0 14th of February 2024
 
 	1) PR #2199 for #2189. Fix bugs with missing maps in enter data
diff --git a/doc/developer_guide/psyir.rst b/doc/developer_guide/psyir.rst
index c29c80363..e00173bfa 100644
--- a/doc/developer_guide/psyir.rst
+++ b/doc/developer_guide/psyir.rst
@@ -381,23 +381,25 @@ with `return_type` set to `None` and `is_program` set to `False`.
 Control-Flow Nodes
 ------------------
 
-The PSyIR has four control flow nodes: `IfBlock`, `Loop`, `WhileLoop` and
-`Call`. These nodes represent the canonical structure with which
+The PSyIR has four control flow nodes: `IfBlock`, `Loop`, `WhileLoop`
+and `Call`. These nodes represent the canonical structure with which
 conditional branching constructs, iteration constructs and accesses to
 other blocks of code are built. Additional language-specific syntax
 for branching and iteration will be normalised to use these same
 constructs.  For example, Fortran has the additional branching
-constructs `ELSE IF` and `CASE`: when a Fortran code is translated
-into the PSyIR, PSyclone will build a semantically equivalent
-implementation using `IfBlock` nodes.  Similarly, Fortran also has the
-`WHERE` construct and statement which are represented in the PSyIR
-with a combination of `Loop` and `IfBlock` nodes. Such nodes in the
-new tree structure are annotated with information to enable the
-original language-specific syntax to be recreated if required (see
-below).  See the full `IfBlock` API in the :ref_guide:`IfBlock reference
-guide psyclone.psyir.nodes.html#psyclone.psyir.nodes.IfBlock`. The
-PSyIR also supports the concept of named arguments for `Call` nodes,
-see the :ref:`named_arguments-label` section for more details.
+constructs `ELSE IF`, `SELECT CASE` and `SELECT TYPE`: when a Fortran code is
+translated into the PSyIR, PSyclone will build a semantically
+equivalent implementation using `IfBlock` nodes (and an additional
+`CodeBlock` containing `SELECT TYPE` in the case of `SELECT TYPE`).
+Similarly, Fortran also has the `WHERE` construct and statement which
+are represented in the PSyIR with a combination of `Loop` and
+`IfBlock` nodes. Such nodes in the new tree structure are annotated
+with information to enable the original language-specific syntax to be
+recreated if required (see below).  See the full `IfBlock` API in the
+:ref_guide:`IfBlock reference guide
+psyclone.psyir.nodes.html#psyclone.psyir.nodes.IfBlock`. The PSyIR
+also supports the concept of named arguments for `Call` nodes, see the
+:ref:`named_arguments-label` section for more details.
 
 .. note:: A Call node (like the CodeBlock) inherits from both
           Statement and DataNode because it can be found in Schedules
@@ -425,6 +427,10 @@ Annotation           Node types         Origin
 `was_case`           `IfBlock`          Fortran `select case` construct
 `was_where`          `Loop`, `IfBlock`  Fortran `where` construct
 `was_unconditional`  `WhileLoop`        Fortran `do` loop with no condition
+`was_type_is`        `IfBlock`          Fortran `type is` construct within
+                                        a `select type` construct
+`was_class_is`       `IfBlock`          Fortran `class is` construct within
+                                        a `select type` construct
 ===================  =================  ===================================
 
 .. note:: A `Loop` may currently only be given the `was_single_stmt`
diff --git a/src/psyclone/psyir/backend/fortran.py b/src/psyclone/psyir/backend/fortran.py
index 4fc59d236..01433da23 100644
--- a/src/psyclone/psyir/backend/fortran.py
+++ b/src/psyclone/psyir/backend/fortran.py
@@ -1539,7 +1539,8 @@ class FortranWriter(LanguageWriter):
             for ast_node in node.get_ast_nodes:
                 # Using tofortran() ensures we get any label associated
                 # with this statement.
-                result += f"{self._nindent}{ast_node.tofortran()}\n"
+                for line in ast_node.tofortran().split("\n"):
+                    result += f"{self._nindent}{line}\n"
         elif node.structure == CodeBlock.Structure.EXPRESSION:
             for ast_node in node.get_ast_nodes:
                 result += str(ast_node)
diff --git a/src/psyclone/psyir/frontend/fparser2.py b/src/psyclone/psyir/frontend/fparser2.py
index 061aa033e..17e9931e1 100644
--- a/src/psyclone/psyir/frontend/fparser2.py
+++ b/src/psyclone/psyir/frontend/fparser2.py
@@ -41,9 +41,13 @@
     to transform each node into the equivalent PSyIR representation.'''
 
 from collections import OrderedDict
+from dataclasses import dataclass, field
 import os
+from typing import Optional, List
 
+from fparser.common.readfortran import FortranStringReader
 from fparser.two import C99Preprocessor, Fortran2003, utils
+from fparser.two.parser import ParserFactory
 from fparser.two.utils import walk, BlockBase, StmtBase
 
 from psyclone.configuration import Config
@@ -58,12 +62,13 @@ from psyclone.psyir.nodes.array_mixin import ArrayMixin
 from psyclone.psyir.nodes.array_of_structures_mixin import (
     ArrayOfStructuresMixin)
 from psyclone.psyir.symbols import (
-    ArgumentInterface, ArrayType, AutomaticInterface, CommonBlockInterface,
-    ContainerSymbol, DataSymbol, DataTypeSymbol, DefaultModuleInterface,
-    GenericInterfaceSymbol, ImportInterface, INTEGER_TYPE, NoType,
-    RoutineSymbol, ScalarType, StaticInterface, StructureType, Symbol,
-    SymbolError, SymbolTable, UnknownInterface, UnresolvedInterface,
-    UnresolvedType, UnsupportedFortranType, UnsupportedType)
+    ArgumentInterface, ArrayType, AutomaticInterface, CHARACTER_TYPE,
+    CommonBlockInterface, ContainerSymbol, DataSymbol, DataTypeSymbol,
+    DefaultModuleInterface, GenericInterfaceSymbol, ImportInterface,
+    INTEGER_TYPE, NoType, RoutineSymbol, ScalarType, StaticInterface,
+    StructureType, Symbol, SymbolError, SymbolTable, UnknownInterface,
+    UnresolvedInterface, UnresolvedType, UnsupportedFortranType,
+    UnsupportedType)
 
 # fparser dynamically generates classes which confuses pylint membership checks
 # pylint: disable=maybe-no-member
@@ -345,13 +350,13 @@ def _find_or_create_psyclone_internal_cmp(node):
             # pylint: disable=import-outside-toplevel
             from psyclone.psyir.frontend.fortran import FortranReader
             name_interface = node.scope.symbol_table.next_available_name(
-                                                       "psyclone_internal_cmp")
+                "psyclone_internal_cmp")
             name_f_int = node.scope.symbol_table.next_available_name(
-                                                       "psyclone_cmp_int")
+                "psyclone_cmp_int")
             name_f_logical = node.scope.symbol_table.next_available_name(
-                                                       "psyclone_cmp_logical")
+                "psyclone_cmp_logical")
             name_f_char = node.scope.symbol_table.next_available_name(
-                                                       "psyclone_cmp_char")
+                "psyclone_cmp_char")
             fortran_reader = FortranReader()
             dummymod = fortran_reader.psyir_from_source(f'''
             module dummy
@@ -1051,6 +1056,60 @@ class Fparser2Reader():
         ('.and.', BinaryOperation.Operator.AND),
         ('.or.', BinaryOperation.Operator.OR)])
 
+    @dataclass
+    class SelectTypeInfo:
+        """Class for storing required information from an fparser2
+        Select_Type_Construct.
+
+        :param guard_type: the guard types used by 'type is' and 'class is'
+            select-type clauses e.g. 'REAL', 'REAL(KIND = 4), or 'mytype'
+            in 'type_is(REAL)' 'type_is(REAL(KIND = 4)' and 'class
+            is(mytype)' respectively. These are stored as a list of
+            str, ordered as found within the select-type
+            construct's 'type is', 'class is' and 'class default'
+            clauses with None indicating the 'class default' clause.
+        :param guard_type_name: a string representation of the guard types used
+            by 'type is' and 'class is' select-type clauses e.g. 'REAL',
+            'REAL(KIND = 4)', or 'mytype' are stored as
+            'REAL', 'REAL_4' and 'mytype' respectively. These are
+            designed to be used as base variable names in
+            the code. These are ordered as they are found in the
+            the select type construct 'type is, 'class is'
+            and 'class default' clauses with None representing the
+            'class default'.
+        :param intrinsic_type_name: the base intrinsic string name for the
+            particular clause or None if there is no intrinsic type. e.g.
+            'type is(REAL*4)' becomes 'REAL' and 'type is(mytype)' becomes
+            None. These are ordered as they occur in the select-type
+            construct's clauses.
+        :param clause_type: the name of the clause in the select-type construct
+            i.e. one of 'type is', 'class is' and 'class default'. These are
+            ordered as they occur within the select-type construct.
+        :param stmts: a list of fparser2 statements holding the content of each
+            of the select-type construct 'type is, 'class is' and
+            'class default' clauses. These are ordered as they occur within the
+            select-type construct.
+        :param selector: the name of the select-type construct selector e.g.
+            'selector' in 'select type(selector)'.
+        :param num_clauses: the number of 'type is', 'class is' and
+            'class default' clauses in the select type construct.
+        :param default_idx: index of the 'default' clause as it appears within
+            the select-type construct's 'type is, 'class is' and
+            'class default' clauses, or -1 if no default clause is found.
+
+        """
+        # 'str | None' syntax is only supported in Python >=3.10 so use
+        # 'typing.Optional[]'. Similarly, 'list[str]' is only valid in
+        # Python >=3.9 so use 'typing.List[str]'.
+        guard_type: List[Optional[str]] = field(default_factory=list)
+        guard_type_name: List[Optional[str]] = field(default_factory=list)
+        intrinsic_type_name: List[Optional[str]] = field(default_factory=list)
+        clause_type: List[str] = field(default_factory=list)
+        stmts: List[List[StmtBase]] = field(default_factory=list)
+        selector: str = ""
+        num_clauses: int = -1
+        default_idx: int = -1
+
     def __init__(self):
         # Map of fparser2 node types to handlers (which are class methods)
         self.handlers = {
@@ -1076,6 +1135,8 @@ class Fparser2Reader():
             Fortran2003.End_Subroutine_Stmt: self._ignore_handler,
             Fortran2003.If_Construct: self._if_construct_handler,
             Fortran2003.Case_Construct: self._case_construct_handler,
+            Fortran2003.Select_Type_Construct:
+                self._select_type_construct_handler,
             Fortran2003.Return_Stmt: self._return_handler,
             Fortran2003.UnaryOpBase: self._unary_op_handler,
             Fortran2003.Block_Nonlabel_Do_Construct:
@@ -3348,8 +3409,10 @@ class Fparser2Reader():
         :type node: :py:class:`fparser.two.Fortran2003.If_Stmt`
         :param parent: Parent node of the PSyIR node we are constructing.
         :type parent: :py:class:`psyclone.psyir.nodes.Node`
+
         :returns: PSyIR representation of node
         :rtype: :py:class:`psyclone.psyir.nodes.IfBlock`
+
         '''
         ifblock = IfBlock(parent=parent, annotations=['was_single_stmt'])
         ifblock.ast = node
@@ -3359,21 +3422,490 @@ class Fparser2Reader():
         self.process_nodes(parent=ifbody, nodes=[node.items[1]])
         return ifblock
 
+    @staticmethod
+    def _add_target_attribute(var_name, table):
+        '''Ensure that the datatype of the symbol with the supplied name has a
+        pointer or target attribute and if not, add the target attribute.
+
+        The datatype is stored as text within an UnsupportedFortranType. We
+        therefore re-create the datatype as an fparser2 ast, add the attribute
+        if required and update the UnsupportedFortranType with the new text.
+
+        :param str var_name: the name of the symbol for which we attempt to
+                             modify the datatype.
+        :param table: a SymbolTable in which to search for the symbol.
+        :type table: :py:class:`psyclone.psyir.symbols.SymbolTable`
+
+        :raises NotImplementedError: if the variable cannot be found, is
+            unresolved or is not a DataSymbol.
+        :raises NotImplementedError: if the variable needs to be given
+            the target attribute but represents a symbol defined externally
+            (e.g. a routine argument or an imported symbol).
+
+        '''
+        try:
+            symbol = table.lookup(var_name)
+        except KeyError as err:
+            raise NotImplementedError(
+                f"Cannot add TARGET attribute to variable '{var_name}' "
+                f"because it is unresolved") from err
+        if symbol.is_unresolved or not isinstance(symbol, DataSymbol):
+            raise NotImplementedError(
+                f"Cannot add TARGET attribute to symbol '{symbol}': it must "
+                f"be resolved and a DataSymbol")
+
+        datatype = symbol.datatype
+        # Create Fortran text for the supplied datatype from the
+        # supplied UnsupportedFortranType text, then parse this into an
+        # fparser2 tree and store the fparser2 representation of the
+        # datatype in type_decl_stmt.
+        dummy_code = (
+            f"subroutine dummy()\n"
+            f"  {datatype.declaration}\n"
+            f"end subroutine\n")
+        parser = ParserFactory().create(std="f2008")
+        reader = FortranStringReader(dummy_code)
+        fp2_ast = parser(reader)
+        type_decl_stmt = fp2_ast.children[0].children[1].children[0]
+
+        # Look for a preexisting target or pointer attribute and if
+        # one does not exist add a target attribute as this allows the
+        # created pointers to point at the supplied datatype.
+        attr_spec_list = type_decl_stmt.children[1]
+        attr_spec_str_list = []
+
+        if attr_spec_list:
+            for attr_spec in attr_spec_list.children:
+                attr_spec_str = attr_spec.string
+                attr_spec_str_list.append(attr_spec_str)
+                if attr_spec_str.upper() in ["TARGET", "POINTER"]:
+                    # There is already a target or pointer attribute
+                    return
+
+        # TARGET needs to be added as an additional attribute. We cannot
+        # do this if the Symbol has an interface that means it is defined
+        # externally.
+        if not (symbol.is_automatic or symbol.is_modulevar):
+            raise NotImplementedError(
+                f"Type-selector variable '{symbol.name}' is defined externally"
+                f" (has interface '{symbol.interface}') and thus cannot be "
+                f"given the TARGET attribute")
+
+        if attr_spec_str_list:
+            # At least one attribute already exists but it is/they are not
+            # the 'target' or 'pointer' attributes.
+            attr_spec_str_list.append("TARGET")
+            attr_spec_list = Fortran2003.Attr_Spec_List(
+                ", ".join(attr_spec_str_list))
+        else:
+            # There are no pre-existing attributes
+            attr_spec_list = Fortran2003.Attr_Spec_List("TARGET")
+        type_decl_stmt.items = (
+            type_decl_stmt.items[0], attr_spec_list,
+            type_decl_stmt.items[2])
+        attr_spec_list.parent = type_decl_stmt
+        # pylint: disable=protected-access
+        datatype._declaration = str(type_decl_stmt)
+
+    def _create_ifblock_for_select_type_content(
+            self, parent, select_type, type_string_symbol, pointer_symbols):
+        '''Use the contents of the supplied SelectTypeInfo instance
+        to create an if nest to capture the content of the associated
+        select type construct.
+
+        This allows the PSyIR to 'see' the content of the select type
+        despite not supporting the select type clause directly in
+        PSyIR. A Codeblock preceding this condition will capture the
+        conditional logic of the select type and the chosen type will
+        be communicated to the if nest at runtime via the
+        'type_string_symbol'. The if nest created here captures the
+        content of each branch of the original select type.
+
+        :param parent: the PSyIR parent to which we are going to add
+            the PSyIR ifblock and any required symbols.
+        :type parent: :py:class:`psyclone.psyir.nodes.Node`
+        :param select_type: information on the select type construct.
+        :type select_type: :py:class:\
+            `psyclone.psyir.frontend.fparser2.Fparser2Reader.SelectTypeInfo`
+        :param type_string_symbol: a run-time symbol capturing (as a string)
+            the value chosen by the select type construct.
+        :type type_string_symbol: :py:class:`psyclone.psyir.type.DataSymbol`
+        :param pointer_symbols: a list of symbols that point to the
+            different select-type types within the select type codeblock.
+        :type pointer_symbols:
+            list[Optional[:py:class:`psyclone.psyir.symbols.Symbol`]]
+
+        :returns: the newly created PSyIR IfBlock.
+        :rtype: :py:class:`psyclone.psyir.nodes.IfBlock`
+
+        :raises NotImplementedError: if there is a CodeBlock that contains a
+            reference to the type-selector variable.
+
+        '''
+        outer_ifblock = None
+        ifblock = None
+        currentparent = parent
+        for idx in range(select_type.num_clauses):
+            if idx == select_type.default_idx:
+                # This is the index of the 'class default' clause so
+                # skip this until the end of the if blocks.
+                continue
+
+            annotation = (
+                "was_class_is" if select_type.clause_type[idx].upper() ==
+                "CLASS IS" else "was_type_is")
+            if ifblock:
+                # We already have an if so this is an else if.
+                elsebody = Schedule(parent=currentparent)
+                ifblock = IfBlock(annotations=[annotation], parent=elsebody)
+                elsebody.addchild(ifblock)
+                currentparent.addchild(elsebody)
+            else:
+                # We do not yet have an if so this is the 'outer' if block.
+                ifblock = IfBlock(parent=currentparent,
+                                  annotations=[annotation])
+                outer_ifblock = ifblock
+
+            # Create an if hierarchy that uses the string (stored in
+            # type_string_symbol) set in an earlier select type
+            # codeblock to choose the appropriate content in the
+            # original select type clauses.
+            clause = BinaryOperation.create(
+                BinaryOperation.Operator.EQ, Reference(type_string_symbol),
+                Literal(select_type.guard_type_name[idx], CHARACTER_TYPE))
+
+            ifblock.addchild(clause)
+            # Add If_body
+            ifbody = Schedule(parent=ifblock)
+            self.process_nodes(parent=ifbody, nodes=select_type.stmts[idx])
+            # Check that there are no CodeBlocks with references to the type
+            # selector variable.
+            for cblock in ifbody.walk(CodeBlock):
+                names = cblock.get_symbol_names()
+                if select_type.selector in names:
+                    raise NotImplementedError(
+                        f"CodeBlock contains reference to type-selector "
+                        f"variable '{select_type.selector}'")
+            # 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() == select_type.selector:
+                    reference.symbol = pointer_symbols[idx]
+            ifblock.addchild(ifbody)
+            currentparent = ifblock
+
+        if select_type.default_idx >= 0:
+            # There is a class default clause so add this on as an
+            # else at the end of the IfBlock.
+            elsebody = Schedule(parent=currentparent)
+            currentparent.addchild(elsebody)
+            self.process_nodes(
+                parent=elsebody, nodes=select_type.stmts[
+                    select_type.default_idx])
+
+        return outer_ifblock
+
+    @staticmethod
+    def _create_select_type(
+            parent, select_type, type_string_name=None):
+        '''Use the contents of the supplied SelectTypeInfo, `select_type`,
+        to create a CodeBlock containing a select type to capture its control
+        logic without capturing its content.
+
+        The 'output' of this CodeBlock is a character variable containing the
+        'name' of the type that was provided, thus identifying which branch of
+        the code would be executed. A pointer is also created and assigned
+        to the type-selection of the 'type is' or 'class is' clause.
+
+        :param parent: the PSyIR parent to which we are going to add
+            the PSyIR codeblock and any required symbols.
+        :type parent: :py:class:`psyclone.psyir.nodes.Node`
+        :param select_type: instance of the SelectTypeInfo dataclass
+            containing information about the select type construct.
+        :type select_type: :py:class:`Self.SelectTypeInfo`
+        :param Optional[str] type_string_name: the base name to use
+            for the newly created type_string symbol.
+
+        :returns: the DataSymbol representing the character variable which
+                  will hold the 'name' of the type and a list of symbols that
+                  point to the different select-type types within the select
+                  type codeblock.
+        :rtype: tuple[:py:class:`psyclone.psyir.symbols.DataSymbol`,
+            list[Optional[:py:class:`psyclone.psyir.symbols.Symbol`]]]
+
+        '''
+        pointer_symbols = []
+        # Create a symbol from the supplied base name. Store as an
+        # UnsupportedFortranType in the symbol table as we do not natively
+        # support character strings (as opposed to scalars) in the PSyIR at
+        # the moment.
+        # TODO #2550 will improve this by using an integer instead.
+        type_string_name = parent.scope.symbol_table.next_available_name(
+            type_string_name)
+        # Length is hardcoded here so could potentially be too short.
+        # TODO #2550 will improve this by using an integer instead.
+        type_string_type = UnsupportedFortranType(
+            f"character(256) :: {type_string_name}")
+        type_string_symbol = DataSymbol(type_string_name, type_string_type)
+        parent.scope.symbol_table.add(type_string_symbol)
+
+        # Create text for a select type construct using the information
+        # captured in the `select_type` SelectTypeInfo instance.
+        # Also add any required pointer symbols to the symbol table as
+        # UnsupportedFortranType, as pointers are not natively supported in the
+        # PSyIR at the moment.
+        code = "program dummy\n"
+        code += f"select type({select_type.selector})\n"
+        for idx in range(select_type.num_clauses):
+            if idx == select_type.default_idx:
+                # This is the index of the 'class default' clause so no pointer
+                # symbol is required (as there is no type selection).
+                pointer_symbols.append(None)
+                continue
+            # Create pointer symbol for the content of this 'type is'
+            # or 'class is' clause.
+            pointer_name = parent.scope.symbol_table.next_available_name(
+                f"ptr_{select_type.guard_type_name[idx]}")
+            if (select_type.intrinsic_type_name[idx] and
+                    select_type.intrinsic_type_name[idx].upper() ==
+                    "CHARACTER"):
+                # This is a character string pointer which we always
+                # declare with a fixed length to allow it to be
+                # declared locally (otherwise it must be a parameter
+                # or passed by argument). As length is hardcoded here,
+                # the string could potentially be too short.
+
+                tmp_type = "CHARACTER(LEN=256)"
+                # The type spec for a character intrinsic within the
+                # type is and class is clauses must always be assumed
+                type_spec = "CHARACTER(LEN = *)"
+            else:
+                # Declare pointer in the usual way using the
+                # guard_type string
+                tmp_type = f"{select_type.guard_type[idx]}"
+                if not select_type.intrinsic_type_name[idx]:
+                    # This is a type declaration
+                    tmp_type = f"type({tmp_type})"
+                # Use the variable declaration for the type spec in
+                # the type is and class is clauses
+                type_spec = select_type.guard_type[idx]
+
+            # Create a pointer that points to the specific type from
+            # the appropriate select type clause so that the specific
+            # type can be used in a subsequent if block hierarchy
+            # (otherwise Fortran complains that the type is generic).
+            pointer_type = UnsupportedFortranType(
+                f"{tmp_type}, pointer :: {pointer_name} => null()")
+            pointer_symbol = DataSymbol(pointer_name, pointer_type)
+            parent.scope.symbol_table.add(pointer_symbol)
+            pointer_symbols.append(pointer_symbol)
+            # The situation where 'clause_type' is 'class default' is
+            # handled separately, so we can assume 'clause_type' is
+            # either 'type is' or 'class is' which means it will
+            # always have a valid 'type_spec' value.
+            code += f"  {select_type.clause_type[idx]} ({type_spec})\n"
+            code += (f"    {type_string_name} = "
+                     f"\"{select_type.guard_type_name[idx].lower()}\"\n")
+            code += (f"    {pointer_name} => {select_type.selector}\n")
+        code += "end select\n"
+        code += "end program\n"
+
+        # Parse the the created Fortran text to an fparser2 tree and
+        # store the resulting tree in a PSyIR CodeBlock.
+        parser = ParserFactory().create(std="f2008")
+        reader = FortranStringReader(code)
+        fp2_program = parser(reader)
+        # Ignore the program part of the fparser2 tree
+        exec_part = walk(fp2_program, Fortran2003.Execution_Part)
+        code_block = CodeBlock(exec_part, CodeBlock.Structure.STATEMENT,
+                               parent=parent)
+
+        # Handlers assume a single node is returned and in this
+        # implementation we create an assignment (see below), a
+        # CodeBlock (see above) and a nested if statement (see
+        # later). Therefore we add the assignment and codeblock to the
+        # parent here and compute and return the if statement in a
+        # subsequent routine (using the type_string_symbol).
+        parent.addchild(Assignment.create(
+            Reference(type_string_symbol), Literal("", CHARACTER_TYPE)))
+        parent.addchild(code_block)
+
+        return (type_string_symbol, pointer_symbols)
+
+    @staticmethod
+    def _create_select_type_info(node):
+        '''Create and return a SelectTypeInfo instance that stores the required
+        information for a select-type construct to be used by
+        subsequent methods.
+
+        :param node: fparser2 node from which to extract the select-type
+            information.
+        :type node: :py:class:`fparser2.Fortran2003.Select_Type_Construct`
+
+        :returns: instance of the SelectTypeInfo dataclass containing
+            information about the select-type construct.
+        :rtype: :py:class:`Self.SelectTypeInfo`
+
+        '''
+        select_type = Fparser2Reader.SelectTypeInfo()
+
+        select_idx = -1
+        for child in node.children:
+            if isinstance(child, Fortran2003.Select_Type_Stmt):
+                # Found the select type stmt clause ('select type
+                # (x)')
+                if child.children[0]:
+                    # The selector variable ('x') is renamed and this
+                    # is not yet supported.
+                    raise NotImplementedError(
+                        f"The selector variable '{child.children[1]}' is "
+                        f"renamed to '{child.children[0]}' in the select "
+                        f"clause '{str(node)}'. This is not yet supported in "
+                        f"the PSyIR.")
+                # Store the name of the selector variable in our
+                # dataclass instance.
+                select_type.selector = child.children[1].string.lower()
+            elif isinstance(child, Fortran2003.Type_Guard_Stmt):
+                # Found one of the type stmt guard clauses ('type is',
+                # 'class is', or 'class default').
+                select_idx += 1
+                select_type.stmts.append([])
+                # Extract the fparser2 Type_Specification
+                # e.g. 'real(kind=4)'
+                type_spec = child.children[1]
+                # Default the intrinsic base name to None
+                intrinsic_base_name = None
+                if type_spec is None:
+                    # There is no type information so this is the
+                    # default clause
+                    type_name = None
+                elif isinstance(type_spec, Fortran2003.Intrinsic_Type_Spec):
+                    # The guard type selector is an intrinsic type
+                    # e.g. 'type is(REAL)'. Set the intrinsic base name
+                    # as there is a base intrinsic type.
+                    intrinsic_base_name = str(type_spec.children[0]).lower()
+                    # Determine type_name for all the different cases
+                    # (must return a string that can be used as a
+                    # variable name).
+                    type_name = intrinsic_base_name
+                    if isinstance(
+                            type_spec.children[1], Fortran2003.Kind_Selector):
+                        # This is a non-character intrinsic type with
+                        # a kind specification
+                        kind_spec_value = type_spec.children[1].children[1]
+                        type_name = f"{type_name}_{kind_spec_value}".lower()
+                    elif walk(type_spec, Fortran2003.Length_Selector):
+                        # This is a character intrinsic type so must
+                        # have an assumed length ('*') which we
+                        # tranform to 'star to allow the creation of a
+                        # valid symbol name.
+                        type_name = f"{type_name}_star".lower()
+                else:
+                    # The guard type selector is a Class type ('class
+                    # is (mytype)')
+                    type_name = str(type_spec).lower()
+                select_type.guard_type_name.append(type_name)
+                if type_spec:
+                    select_type.guard_type.append(str(type_spec).lower())
+                else:
+                    select_type.guard_type.append(None)
+                select_type.intrinsic_type_name.append(intrinsic_base_name)
+
+                # Store the index of the class default information
+                select_type.clause_type.append(child.children[0])
+                if child.children[0].lower() == "class default":
+                    select_type.default_idx = select_idx
+            elif isinstance(child, Fortran2003.End_Select_Type_Stmt):
+                pass
+            else:
+                # The next content must be a statement as the content within
+                # select case or select type clauses in fparser2 are *siblings*
+                # of the various select case or select-type statements, rather
+                # than children of them (as one might expect).
+                select_type.stmts[select_idx].append(child)
+        select_type.num_clauses = select_idx + 1
+
+        return select_type
+
+    def _select_type_construct_handler(self, node, parent):
+        '''
+        Transforms an fparser2 Select_Type_Construct to the PSyIR
+        representation (consisting of an Assignment, a CodeBlock
+        and an IfBlock).
+
+        :param node: node in fparser2 tree.
+        :type node: :py:class:`fparser.two.Fortran2003.Select_Type_Construct`
+        :param parent: parent node of the PSyIR node we are constructing.
+        :type parent: :py:class:`psyclone.psyir.nodes.Node`
+
+        :returns: PSyIR representation of the node.
+        :rtype: :py:class:`psyclone.psyir.nodes.IfBlock`
+
+        :raises NotImplementedError: if the symbol representing the type-
+            selector variable is not resolved or is not a DataSymbol.
+
+        '''
+        # Step 1: Search for all the TYPE IS and CLASS IS clauses in
+        # the Select_Type_Construct and extract the required
+        # information. This makes for easier code generation later in
+        # the routine.
+        insert_index = len(parent.children) - 1
+        # Create the required type information in a dataclass instance.
+        select_type = self._create_select_type_info(node)
+
+        # We don't immediately add our new nodes into the PSyIR tree in
+        # case we encounter something we don't support (in which case
+        # an exception will be raised and a CodeBlock created).
+        tmp_parent = Schedule(parent=parent)
+
+        # Step 2: Recreate the select type clause within a CodeBlock
+        # with the content of the clauses being replaced by a string
+        # capturing the name of the type or class clauses
+        # ('type_string'). The string symbol is returned for use in
+        # step 3, as is the list of any pointers to the selector variable.
+        # TODO #2550 - use an integer instead of a string to encode
+        # which branch is chosen at run-time.
+        type_string_symbol, pointer_symbols = self._create_select_type(
+            tmp_parent, select_type, type_string_name="type_string")
+
+        # Step 3: Create the (potentially nested) if statement that
+        # replicates the content of the select type options (as select
+        # type is not supported directly in the PSyIR) allowing the
+        # PSyIR to 'see' the select type content.
+        outer_ifblock = self._create_ifblock_for_select_type_content(
+            parent, select_type, type_string_symbol, pointer_symbols)
+
+        # Step 4: Ensure that the type selector variable declaration
+        # has the pointer or target attribute as we need to create
+        # pointers that point to it to get the specific type.
+        self._add_target_attribute(select_type.selector,
+                                   outer_ifblock.scope.symbol_table)
+
+        # Step 5: We didn't encounter any problems so finally attach our new
+        # nodes to the PSyIR tree in the location we saved earlier.
+        for child in reversed(tmp_parent.pop_all_children()):
+            parent.addchild(child, index=insert_index)
+        # Ensure any Symbols are moved over too.
+        parent.scope.symbol_table.merge(tmp_parent.symbol_table)
+
+        return outer_ifblock
+
     def _case_construct_handler(self, node, parent):
         '''
         Transforms an fparser2 Case_Construct to the PSyIR representation.
 
         :param node: node in fparser2 tree.
         :type node: :py:class:`fparser.two.Fortran2003.Case_Construct`
-        :param parent: Parent node of the PSyIR node we are constructing.
+        :param parent: parent node of the PSyIR node we are constructing.
         :type parent: :py:class:`psyclone.psyir.nodes.Node`
 
         :returns: PSyIR representation of node
         :rtype: :py:class:`psyclone.psyir.nodes.IfBlock`
 
-        :raises InternalError: If the fparser2 tree has an unexpected \
+        :raises InternalError: If the fparser2 tree has an unexpected
             structure.
-        :raises NotImplementedError: If the fparser2 tree contains an \
+        :raises NotImplementedError: If the fparser2 tree contains an
             unsupported structure and should be placed in a CodeBlock.
 
         '''
@@ -4047,7 +4579,7 @@ class Fparser2Reader():
                                              annotations=annotations)
                         elsebody.addchild(newifblock)
 
-                        # Keep pointer to fpaser2 AST
+                        # Keep pointer to fparser2 AST
                         elsebody.ast = node.content[start_idx]
                         newifblock.ast = node.content[start_idx]
 
diff --git a/src/psyclone/psyir/nodes/if_block.py b/src/psyclone/psyir/nodes/if_block.py
index be4d52915..bba9bd979 100644
--- a/src/psyclone/psyir/nodes/if_block.py
+++ b/src/psyclone/psyir/nodes/if_block.py
@@ -60,8 +60,14 @@ class IfBlock(Statement):
     # with the Fortran 'case' or C 'switch' syntactic constructs;
     # 'was_where' - a conditional structure originally implied by a Fortran
     # WHERE construct.
+    # 'was_type_is' to tag a conditional structure originally
+    # written with the Fortran 'select type' construct with a 'type
+    # is' clause.
+    # 'was_class_is' to tag a conditional structure originally
+    # written with the Fortran 'select type' construct with a 'class
+    # is' clause.
     valid_annotations = ('was_elseif', 'was_single_stmt', 'was_case',
-                         'was_where')
+                         'was_where', 'was_type_is', 'was_class_is')
     # Textual description of the node.
     _children_valid_format = "DataNode, Schedule [, Schedule]"
     _text_name = "If"


Test patch:
diff --git a/src/psyclone/tests/psyir/frontend/fparser2_select_type_test.py b/src/psyclone/tests/psyir/frontend/fparser2_select_type_test.py
new file mode 100644
index 000000000..4d494bdee
--- /dev/null
+++ b/src/psyclone/tests/psyir/frontend/fparser2_select_type_test.py
@@ -0,0 +1,801 @@
+# -----------------------------------------------------------------------------
+# BSD 3-Clause License
+#
+# Copyright (c) 2023-2024, Science and Technology Facilities Council.
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions are met:
+#
+# * Redistributions of source code must retain the above copyright notice, this
+#   list of conditions and the following disclaimer.
+#
+# * Redistributions in binary form must reproduce the above copyright notice,
+#   this list of conditions and the following disclaimer in the documentation
+#   and/or other materials provided with the distribution.
+#
+# * Neither the name of the copyright holder nor the names of its
+#   contributors may be used to endorse or promote products derived from
+#   this software without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+# FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+# COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+# BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+# ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+# POSSIBILITY OF SUCH DAMAGE.
+# -----------------------------------------------------------------------------
+# Authors: R. W. Ford, STFC Daresbury Lab
+#          A. R. Porter, STFC Daresbury Lab
+
+'''Module containing pytest tests for the handling of select type
+construction for the Fparser->PSyIR frontend.
+
+'''
+import pytest
+
+from psyclone.psyir.frontend.fparser2 import Fparser2Reader
+from psyclone.psyir.nodes import CodeBlock, IfBlock, Routine
+from psyclone.psyir.symbols import (AutomaticInterface, UnsupportedFortranType,
+                                    DataSymbol)
+from psyclone.tests.utilities import Compile
+
+
+def test_type(fortran_reader, fortran_writer, tmpdir):
+    '''Check that the correct code is output with a basic select type
+    construct. Also check that the appropriate annotation is added to
+    the if nodes.
+
+    '''
+    code = (
+        "module select_mod\n"
+        "contains\n"
+        "subroutine select_type(type_selector)\n"
+        "  class(*), target :: 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")
+    expected1 = "CLASS(*), TARGET :: type_selector"
+    expected2 = (
+        "    character(256) :: type_string\n"
+        "    INTEGER, pointer :: ptr_INTEGER => null()\n"
+        "    REAL, pointer :: ptr_REAL => null()\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)
+    result = fortran_writer(psyir).lower()
+    assert expected1.lower() in result
+    assert expected2.lower() in result
+    if_blocks = psyir.walk(IfBlock)
+    assert "was_type_is" in if_blocks[0].annotations
+    assert "was_type_is" in if_blocks[1].annotations
+    assert Compile(tmpdir).string_compiles(result)
+
+
+def test_default(fortran_reader, fortran_writer, tmpdir):
+    '''Check that the correct code is output when select type has a
+    default clause. The output of the default clause should be output
+    under the final else of the generated if hierarchy irrespective of
+    where it appears in the select type clauses.
+
+    '''
+    code = (
+        "module select_mod\n"
+        "contains\n"
+        "subroutine select_type(type)\n"
+        "  class(*), target :: 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"
+        "    INTEGER, pointer :: ptr_INTEGER => null()\n"
+        "    REAL, pointer :: ptr_REAL => null()\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"
+        "    end if\n\n"
+        "  end subroutine select_type\n").lower()
+    psyir = fortran_reader.psyir_from_source(code)
+    result = fortran_writer(psyir).lower()
+    assert expected in result
+    assert Compile(tmpdir).string_compiles(result)
+
+
+def test_class(fortran_reader, fortran_writer, tmpdir):
+    '''Check that the correct code is output when select type has a 'class
+    is' clause. Place one as the first clause and one later for
+    coverage. Also check that the appropriate annotation is added to
+    the if nodes related to the 'class is' clause.
+
+    '''
+    code = (
+        "module select_mod\n"
+        "contains\n"
+        "subroutine select_type(type)\n"
+        "  class(*), pointer :: type\n"
+        "  type type2\n"
+        "    integer :: scalar\n"
+        "  end type\n"
+        "  type type3\n"
+        "    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"
+        "      my_type2 = type\n"
+        "    TYPE IS (INTEGER)\n"
+        "      branch1 = 1\n"
+        "      branch2 = 0\n"
+        "      iinfo = type\n"
+        "    CLASS IS(type3)\n"
+        "      branch2 = 1\n"
+        "      my_type3 = type\n"
+        "    TYPE IS (REAL)\n"
+        "      branch3 = 1\n"
+        "      ! type not used here\n"
+        "  END SELECT\n"
+        "end subroutine\n"
+        "end module\n")
+    expected1 = "class(*), pointer :: type"
+    expected2 = (
+        "    character(256) :: type_string\n"
+        "    type(type2), pointer :: ptr_type2 => null()\n"
+        "    INTEGER, pointer :: ptr_INTEGER => null()\n"
+        "    type(type3), pointer :: ptr_type3 => null()\n"
+        "    REAL, pointer :: ptr_REAL => null()\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"
+        "          end if\n"
+        "        end if\n"
+        "      end if\n"
+        "    end if\n").lower()
+    psyir = fortran_reader.psyir_from_source(code)
+    result = fortran_writer(psyir).lower()
+    assert expected1 in result
+    assert expected2 in result
+    if_blocks = psyir.walk(IfBlock)
+    assert "was_class_is" in if_blocks[0].annotations
+    assert "was_class_is" in if_blocks[2].annotations
+    assert Compile(tmpdir).string_compiles(result)
+
+
+def test_class_with_codeblock(fortran_reader, fortran_writer, tmpdir):
+    '''Check that the handler copes with the case where we have a CodeBlock
+    that refers to the type-selector variable inside a 'class is' clause.'''
+    code = (
+        "module select_mod\n"
+        "contains\n"
+        "subroutine select_type(type)\n"
+        "  class(*) :: type\n"
+        "  type type2\n"
+        "    integer :: scalar\n"
+        "  end type\n"
+        "  type type3\n"
+        "    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"
+        "      my_type2 = type\n"
+        "      write(*,*) 'This is a CodeBlock', print_me(type)\n"
+        "    TYPE IS (INTEGER)\n"
+        "      branch1 = 1\n"
+        "      branch2 = 0\n"
+        "      iinfo = type\n"
+        "  END SELECT\n"
+        "end subroutine\n"
+        "function print_me(var)\n"
+        "  class(*) :: var\n"
+        "  character(len=10) :: print_me\n"
+        "  print_me = 'hello'\n"
+        "end function print_me\n"
+        "end module\n")
+    psyir = fortran_reader.psyir_from_source(code)
+    routine = psyir.walk(Routine)[0]
+    assert isinstance(routine.children[0], CodeBlock)
+    result = fortran_writer(psyir)
+    assert Compile(tmpdir).string_compiles(result)
+
+
+@pytest.mark.parametrize("use_stmt", ["use some_mod",
+                                      "use some_mod, only: my_ptr"])
+def test_unresolved_selector_symbol(fortran_reader, use_stmt):
+    '''Test the case where the Symbol representing the type-selector variable
+    is unresolved or of unknown type.'''
+    code = f'''\
+    module my_mod
+      {use_stmt}
+      implicit none
+    contains
+      subroutine my_sub()
+        select type (my_ptr)
+          type is (type1)
+            write(*,*) "yes"
+        end select
+      end subroutine my_sub
+    end module my_mod'''
+    psyir = fortran_reader.psyir_from_source(code)
+    routine = psyir.walk(Routine)[0]
+    assert isinstance(routine.children[0], CodeBlock)
+
+
+def test_select_rename(fortran_reader, fortran_writer, tmpdir):
+    '''Check that a CodeBlock is created when the type in select type is
+    renamed (i.e. the code is not modified). This is done as we are
+    not yet able to rename the variables inside the select type
+    clause.
+
+    '''
+    code = (
+        "module select_mod\n"
+        "contains\n"
+        "subroutine select_type(type)\n"
+        "  class(*) :: type\n"
+        "  SELECT TYPE (newtype => type)\n"
+        "    TYPE IS (INTEGER)\n"
+        "        print *, newtype\n"
+        "  END SELECT\n"
+        "end subroutine\n"
+        "end module\n")
+    expected = (
+        "    SELECT TYPE(newtype=>type)\n"
+        "      TYPE IS (INTEGER)\n"
+        "      PRINT *, newtype\n"
+        "    END SELECT\n")
+    psyir = fortran_reader.psyir_from_source(code)
+    assert isinstance(psyir.children[0].children[0].children[0], CodeBlock)
+    result = fortran_writer(psyir)
+    assert expected in result
+    assert Compile(tmpdir).string_compiles(result)
+
+
+def test_kind(fortran_reader, fortran_writer, tmpdir):
+    '''Check that the correct code is output when the TYPE IS intrinsic
+    content includes precision. REAL*16 (quad precision) is not
+    supported by the nvidia compiler at the moment so we limit the
+    test to 4 and 8 here
+
+    '''
+    code = (
+        "module select_mod\n"
+        "contains\n"
+        "subroutine select_type(type)\n"
+        "  class(*), target :: type\n"
+        "  integer :: branch1, branch2\n"
+        "  real(kind=4) :: rinfo1\n"
+        "  real(kind=8) :: rinfo2\n"
+        "  SELECT TYPE (type)\n"
+        "    TYPE IS (REAL(kind=4))\n"
+        "      branch1 = 1\n"
+        "      branch2 = 0\n"
+        "      rinfo1 = type\n"
+        "    TYPE IS (REAL(8))\n"
+        "      branch2 = 1\n"
+        "      rinfo2 = type\n"
+        "  END SELECT\n"
+        "end subroutine\n"
+        "end module\n")
+    expected1 = (
+        "    CLASS(*), TARGET :: type\n"
+        "    integer :: branch1\n"
+        "    integer :: branch2\n"
+        "    REAL(KIND = 4) :: rinfo1\n"
+        "    REAL(KIND = 8) :: rinfo2\n"
+        "    character(256) :: type_string\n"
+        "    REAL(KIND = 4), pointer :: ptr_REAL_4 => null()\n"
+        "    REAL(KIND = 8), pointer :: ptr_REAL_8 => null()\n").lower()
+    expected2 = (
+        "    type_string = ''\n"
+        "    SELECT TYPE(type)\n"
+        "      TYPE IS (REAL(KIND = 4))\n"
+        "      type_string = \"real_4\"\n"
+        "      ptr_REAL_4 => type\n"
+        "      TYPE IS (REAL(KIND = 8))\n"
+        "      type_string = \"real_8\"\n"
+        "      ptr_REAL_8 => type\n"
+        "    END SELECT\n"
+        "    if (type_string == 'real_4') then\n"
+        "      branch1 = 1\n"
+        "      branch2 = 0\n"
+        "      rinfo1 = ptr_REAL_4\n"
+        "    else\n"
+        "      if (type_string == 'real_8') then\n"
+        "        branch2 = 1\n"
+        "        rinfo2 = ptr_REAL_8\n"
+        "      end if\n"
+        "    end if\n").lower()
+    psyir = fortran_reader.psyir_from_source(code)
+    result = fortran_writer(psyir).lower()
+    assert expected1 in result
+    assert expected2 in result
+    assert Compile(tmpdir).string_compiles(result)
+
+
+def test_derived(fortran_reader, fortran_writer, tmpdir):
+    '''Check that the expected code is produced when 'TYPE IS type' is a
+    derived type.
+
+    '''
+    code = (
+        "module select_mod\n"
+        "contains\n"
+        "subroutine select_type(type)\n"
+        "  class(*), target :: type\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"
+        "    TYPE IS (field_type)\n"
+        "      branch1 = 1\n"
+        "      field_type_info = type\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"
+        "    type(field_type) :: field_type_info\n"
+        "    integer :: branch1\n"
+        "    character(256) :: type_string\n"
+        "    type(field_type), pointer :: ptr_field_type => null()\n")
+    expected2 = (
+        "    type_string = ''\n"
+        "    SELECT TYPE(type)\n"
+        "      TYPE IS (field_type)\n"
+        "      type_string = \"field_type\"\n"
+        "      ptr_field_type => type\n"
+        "    END SELECT\n"
+        "    if (type_string == 'field_type') then\n"
+        "      branch1 = 1\n"
+        "      field_type_info = ptr_field_type\n"
+        "    end if\n")
+    psyir = fortran_reader.psyir_from_source(code)
+    result = fortran_writer(psyir)
+    assert expected1 in result
+    assert expected2 in result
+    assert Compile(tmpdir).string_compiles(result)
+
+
+def test_datatype(fortran_reader, fortran_writer, tmpdir):
+    '''Check that the correct code is output with different intrinsic
+    datatypes. REAL and INTEGER have already been tested so are not
+    included here. CHARACTER must be assumed size in a 'TYPE IS'
+    clause i.e. 'CHARACTER(*)' or 'CHARACTER(LEN=*)'.
+
+    '''
+    code = (
+        "module select_mod\n"
+        "contains\n"
+        "subroutine select_type(type_selector)\n"
+        "  class(*), target :: type_selector\n"
+        "  integer :: branch1, branch2, branch3\n"
+        "  logical :: logical_type\n"
+        "  character(len = 256) :: character_type\n"
+        "  complex :: complex_type\n"
+        "  SELECT TYPE (type_selector)\n"
+        "    TYPE IS (LOGICAL)\n"
+        "      branch1 = 1\n"
+        "      branch2 = 0\n"
+        "      logical_type = type_selector\n"
+        "    TYPE IS (CHARACTER(len = *))\n"
+        "      branch2 = 1\n"
+        "      character_type = type_selector\n"
+        "    TYPE IS (COMPLEX)\n"
+        "      branch3 = 1\n"
+        "      complex_type = type_selector\n"
+        "  END SELECT\n"
+        "end subroutine\n"
+        "end module\n")
+    expected1 = (
+        "    CLASS(*), TARGET :: type_selector\n"
+        "    integer :: branch1\n"
+        "    integer :: branch2\n"
+        "    integer :: branch3\n"
+        "    logical :: logical_type\n"
+        "    CHARACTER(LEN = 256) :: character_type\n"
+        "    COMPLEX :: complex_type\n"
+        "    character(256) :: type_string\n"
+        "    LOGICAL, pointer :: ptr_LOGICAL => null()\n"
+        "    CHARACTER(LEN=256), pointer :: ptr_CHARACTER_star => null()\n"
+        "    COMPLEX, pointer :: ptr_COMPLEX => null()\n").lower()
+    expected2 = (
+        "    type_string = ''\n"
+        "    SELECT TYPE(type_selector)\n"
+        "      TYPE IS (LOGICAL)\n"
+        "      type_string = \"logical\"\n"
+        "      ptr_LOGICAL => type_selector\n"
+        "      TYPE IS (CHARACTER(LEN = *))\n"
+        "      type_string = \"character_star\"\n"
+        "      ptr_CHARACTER_star => type_selector\n"
+        "      TYPE IS (COMPLEX)\n"
+        "      type_string = \"complex\"\n"
+        "      ptr_COMPLEX => type_selector\n"
+        "    END SELECT\n"
+        "    if (type_string == 'logical') then\n"
+        "      branch1 = 1\n"
+        "      branch2 = 0\n"
+        "      logical_type = ptr_LOGICAL\n"
+        "    else\n"
+        "      if (type_string == 'character_star') then\n"
+        "        branch2 = 1\n"
+        "        character_type = ptr_CHARACTER_star\n"
+        "      else\n"
+        "        if (type_string == 'complex') then\n"
+        "          branch3 = 1\n"
+        "          complex_type = ptr_COMPLEX\n"
+        "        end if\n"
+        "      end if\n"
+        "    end if\n").lower()
+    psyir = fortran_reader.psyir_from_source(code)
+    result = fortran_writer(psyir).lower()
+    assert expected1 in result
+    assert expected2 in result
+    assert Compile(tmpdir).string_compiles(result)
+
+
+@pytest.mark.parametrize(
+    "char_type_in, char_type_out",
+    (["*256", "*256"], ["(256)", "(LEN = 256)"],
+     ["(LEN = 256)", "(LEN = 256)"]))
+def test_character(fortran_reader, fortran_writer, tmpdir, char_type_in,
+                   char_type_out):
+    '''Check that the correct code is output with literal and implicit
+    character formats. An implicit format requires the character to be
+    passed by argument or specified as a pointer. Here we pass it by
+    argument.
+
+    '''
+    code = (
+        f"module select_mod\n"
+        f"contains\n"
+        f"subroutine select_type(type_selector)\n"
+        f"  class(*), target :: type_selector\n"
+        f"  character{char_type_in} :: character_type\n"
+        f"  SELECT TYPE (type_selector)\n"
+        f"    TYPE IS (CHARACTER(len = *))\n"
+        f"      character_type = type_selector\n"
+        f"  END SELECT\n"
+        f"end subroutine\n"
+        f"end module\n")
+    expected1 = (
+        f"  subroutine select_type(type_selector)\n"
+        f"    CLASS(*), TARGET :: type_selector\n"
+        f"    CHARACTER{char_type_out} :: character_type\n"
+        f"    character(256) :: type_string\n"
+        f"    CHARACTER(LEN=256), pointer :: ptr_CHARACTER_star => "
+        f"null()\n").lower()
+    expected2 = (
+        "    type_string = ''\n"
+        "    SELECT TYPE(type_selector)\n"
+        "      TYPE IS (CHARACTER(LEN = *))\n"
+        "      type_string = \"character_star\"\n"
+        "      ptr_CHARACTER_star => type_selector\n"
+        "    END SELECT\n"
+        "    if (type_string == 'character_star') then\n"
+        "      character_type = ptr_CHARACTER_star\n"
+        "    end if\n").lower()
+    psyir = fortran_reader.psyir_from_source(code)
+    result = fortran_writer(psyir).lower()
+    assert expected1 in result
+    assert expected2 in result
+    assert Compile(tmpdir).string_compiles(result)
+
+
+@pytest.mark.parametrize(
+    "char_type_in, char_type_out",
+    (["(:)", "(LEN = :)"], ["(LEN = :)", "(LEN = :)"], ["*(:)", "*(:)"]))
+def test_character_assumed_len(fortran_reader, fortran_writer, tmpdir,
+                               char_type_in, char_type_out):
+    '''Check that the correct code is output with different assumed-length
+    specifications for intrinsic character formats.
+
+    '''
+    code = (
+        f"module select_mod\n"
+        f"contains\n"
+        f"subroutine select_type(type_selector)\n"
+        f"  class(*), target :: type_selector\n"
+        f"  character{char_type_in}, pointer :: character_type => null()\n"
+        f"  SELECT TYPE (type_selector)\n"
+        f"    TYPE IS (CHARACTER(len = *))\n"
+        f"      character_type = type_selector\n"
+        f"  END SELECT\n"
+        f"end subroutine\n"
+        f"end module\n")
+    expected1 = (
+        f"  subroutine select_type(type_selector)\n"
+        f"    CLASS(*), TARGET :: type_selector\n"
+        f"    CHARACTER{char_type_out}, POINTER :: character_type => null()\n"
+        f"    character(256) :: type_string\n"
+        f"    CHARACTER(LEN=256), pointer :: ptr_CHARACTER_star => "
+        f"null()\n").lower()
+    expected2 = (
+        "    type_string = ''\n"
+        "    SELECT TYPE(type_selector)\n"
+        "      TYPE IS (CHARACTER(LEN = *))\n"
+        "      type_string = \"character_star\"\n"
+        "      ptr_CHARACTER_star => type_selector\n"
+        "    END SELECT\n"
+        "    if (type_string == 'character_star') then\n"
+        "      character_type = ptr_CHARACTER_star\n"
+        "    end if\n").lower()
+    psyir = fortran_reader.psyir_from_source(code)
+    result = fortran_writer(psyir).lower()
+    assert expected1 in result
+    assert expected2 in result
+    assert Compile(tmpdir).string_compiles(result)
+
+
+@pytest.mark.parametrize(
+    "char_type_in, char_type_out, pointer",
+    (["(LEN=*, KIND=1)", "(LEN = *, KIND = 1)", ""],
+     ["(LEN=*, KIND=1*1)", "(LEN = *, KIND = 1 * 1)", ""],
+     ["(LEN=1*2, KIND=1*1)", "(LEN = 1 * 2, KIND = 1 * 1)", ""],
+     ["(*, KIND=1*1)", "(LEN = *, KIND = 1 * 1)", ""],
+     ["(256*1, KIND=1*1)", "(LEN = 256 * 1, KIND = 1 * 1)", ""],
+     ["(*, 1*1)", "(LEN = *, KIND = 1 * 1)", ""],
+     ["(256*1, 1*1)", "(LEN = 256 * 1, KIND = 1 * 1)", ""],
+     ["(KIND=1*1, LEN=*)", "(LEN = *, KIND = 1 * 1)", ""],
+     ["(KIND=1*1, LEN=256*1)", "(LEN = 256 * 1, KIND = 1 * 1)", ""],
+     ["(KIND=1*1)", "(KIND = 1 * 1)", ""],
+     ["(LEN=:, KIND=1*1)", "(LEN = :, KIND = 1 * 1)", ", POINTER"],
+     ["(:, KIND=1*1)", "(LEN = :, KIND = 1 * 1)", ", POINTER"],
+     ["(:, 1*1)", "(LEN = :, KIND = 1 * 1)", ", POINTER"],
+     ["(KIND=1*1, LEN=:)", "(LEN = :, KIND = 1 * 1)", ", POINTER"]))
+def test_character_kind(
+        fortran_reader, fortran_writer, tmpdir, char_type_in, char_type_out,
+        pointer):
+    '''Test that characters with kind clauses in various formats are
+    supported.
+
+    '''
+    code = (
+        f"module select_mod\n"
+        f"  contains\n"
+        f"  subroutine select_type(type_selector, character_type)\n"
+        f"    class(*), target :: type_selector\n"
+        f"    character{char_type_in}{pointer} :: character_type\n"
+        f"    select type(type_selector)\n"
+        f"      type is (character(len = *))\n"
+        f"        character_type = type_selector\n"
+        f"    end select\n"
+        f"  end subroutine select_type\n"
+        f"end module select_mod\n")
+    expected = (
+        f"module select_mod\n"
+        f"  implicit none\n"
+        f"  public\n\n"
+        f"  contains\n"
+        f"  subroutine select_type(type_selector, character_type)\n"
+        f"    class(*), target :: type_selector\n"
+        f"    character{char_type_out}{pointer} :: character_type\n"
+        f"    character(256) :: type_string\n"
+        f"    character(len=256), pointer :: ptr_character_star => null()\n\n"
+        f"    type_string = ''\n"
+        f"    select type(type_selector)\n"
+        f"      type is (character(len = *))\n"
+        f"      type_string = \"character_star\"\n"
+        f"      ptr_character_star => type_selector\n"
+        f"    end select\n"
+        f"    if (type_string == 'character_star') then\n"
+        f"      character_type = ptr_character_star\n"
+        f"    end if\n\n"
+        f"  end subroutine select_type\n\n"
+        f"end module select_mod\n").lower()
+    psyir = fortran_reader.psyir_from_source(code)
+    result = fortran_writer(psyir).lower()
+    assert result == expected
+    assert Compile(tmpdir).string_compiles(result)
+
+
+@pytest.mark.parametrize(
+    "pre_attribute, post_attribute",
+    (["TARGET", "TARGET"],
+     ["POINTER", "POINTER"],
+     ["ALLOCATABLE", "ALLOCATABLE, TARGET"]))
+def test_class_target(
+        fortran_reader, fortran_writer, tmpdir, pre_attribute, post_attribute):
+    '''Test that the type_selector remains unchanged if it already has the
+    target or pointer attribute and that target is added if there is a
+    pre-existing unrelated atttribute.
+
+    '''
+    code = (
+        f"module select_mod\n"
+        f"  contains\n"
+        f"  subroutine select_type(type_selector, character_type)\n"
+        f"    class(*), {pre_attribute} :: type_selector\n"
+        f"    character(len=*) :: character_type\n"
+        f"    select type(type_selector)\n"
+        f"      type is (character(len = *))\n"
+        f"        character_type = type_selector\n"
+        f"    end select\n"
+        f"  end subroutine select_type\n"
+        f"end module select_mod\n")
+    expected = (
+        f"module select_mod\n"
+        f"  implicit none\n"
+        f"  public\n\n"
+        f"  contains\n"
+        f"  subroutine select_type(type_selector, character_type)\n"
+        f"    CLASS(*), {post_attribute} :: type_selector\n"
+        f"    CHARACTER(LEN = *) :: character_type\n"
+        f"    character(256) :: type_string\n"
+        f"    CHARACTER(LEN=256), pointer :: ptr_CHARACTER_star => null()\n\n"
+        f"    type_string = ''\n"
+        f"    SELECT TYPE(type_selector)\n"
+        f"      TYPE IS (CHARACTER(LEN = *))\n"
+        f"      type_string = \"character_star\"\n"
+        f"      ptr_CHARACTER_star => type_selector\n"
+        f"    END SELECT\n"
+        f"    if (type_string == 'character_star') then\n"
+        f"      character_type = ptr_CHARACTER_star\n"
+        f"    end if\n\n"
+        f"  end subroutine select_type\n\n"
+        f"end module select_mod\n").lower()
+    psyir = fortran_reader.psyir_from_source(code)
+    if pre_attribute == "ALLOCATABLE":
+        # If the argument doesn't already have a POINTER/TARGET attribute
+        # then we can't handle it and should get a CodeBlock.
+        routine = psyir.walk(Routine)[0]
+        assert len(routine.children) == 1
+        assert isinstance(routine.children[0], CodeBlock)
+        # The reason for the CodeBlock should be in a comment.
+        output = fortran_writer(routine)
+        assert ("Type-selector variable 'type_selector' is defined externally "
+                "(has interface 'Argument(Access.UNKNOWN)') and thus cannot "
+                "be given the TARGET attribute" in output)
+    else:
+        result = fortran_writer(psyir).lower()
+        assert result == expected
+        assert Compile(tmpdir).string_compiles(result)
+
+
+def test_add_target_attribute(fortran_reader):
+    '''Check that _add_target_attribute works when a declaration either has
+    or has no existing attributes.
+
+    This is complicated because it appears that the only way for
+    something that is not an argument to have a dynamic type is for it
+    to be class(*). The fparser2 frontend cannot handle this and we
+    end up with an UnsupportedFortranType with an UnknownInterface. We
+    therefore have to explicitly fix the interface before we can test the
+    functionality.
+
+    '''
+    code = '''\
+module my_mod
+  implicit none
+contains
+
+  subroutine my_sub()
+    ! class(*) must have the ALLOCATABLE or POINTER attribute if it is not
+    ! a dummy argument.
+    class(*), allocatable, dimension(:) :: something
+  end subroutine my_sub
+end module my_mod
+'''
+    psyir = fortran_reader.psyir_from_source(code)
+    table = psyir.children[0].children[0].symbol_table
+    sym = table.lookup("something")
+    # Fix the interface of the symbol.
+    sym.interface = AutomaticInterface()
+    fp2reader = Fparser2Reader()
+    # Test that _add_target_attribute now works for this Symbol.
+    fp2reader._add_target_attribute("something", table)
+    assert ("CLASS(*), ALLOCATABLE, DIMENSION(:), TARGET :: something"
+            in str(sym.datatype))
+    # Test in the absence of any attributes on the original declaration.
+    # This is probably not reachable in normal use (but we want to make sure
+    # that the code handles it in case it happens) so create our own
+    # UnsupportedFortranType using a simple declaration.
+    new_type = UnsupportedFortranType("integer :: a_local")
+    sym2 = DataSymbol("a_local", datatype=new_type)
+    table.add(sym2)
+    fp2reader._add_target_attribute("a_local", table)
+    assert "INTEGER, TARGET :: a_local" in str(sym2.datatype)
diff --git a/src/psyclone/tests/psyir/frontend/fparser2_test.py b/src/psyclone/tests/psyir/frontend/fparser2_test.py
index f8f62b1ac..164cc506d 100644
--- a/src/psyclone/tests/psyir/frontend/fparser2_test.py
+++ b/src/psyclone/tests/psyir/frontend/fparser2_test.py
@@ -2599,11 +2599,11 @@ def test_handling_unaryopbase():
     tree structure.
     '''
     reader = FortranStringReader("x=-4")
-    fp2unaryop = Execution_Part.match(reader)[0][0]
+    assign_stmt = Execution_Part.match(reader)[0][0]
 
     fake_parent = Schedule()
     processor = Fparser2Reader()
-    processor.process_nodes(fake_parent, [fp2unaryop])
+    processor.process_nodes(fake_parent, [assign_stmt])
     # Check a new node was generated and connected to parent
     assert len(fake_parent.children) == 1
     new_node = fake_parent[0].rhs
@@ -2621,10 +2621,10 @@ def test_handling_unaryopbase():
         # Manipulate the fparser2 ParseTree so that it contains the operator
         # under test
         reader = FortranStringReader("x=" + opstring + "4")
-        fp2unaryop = Execution_Part.match(reader)[0][0]
+        assign_stmt = Execution_Part.match(reader)[0][0]
         # And then translate it to PSyIR again.
         fake_parent = Schedule()
-        processor.process_nodes(fake_parent, [fp2unaryop])
+        processor.process_nodes(fake_parent, [assign_stmt])
         assert len(fake_parent.children) == 1
         assert isinstance(fake_parent[0].rhs, UnaryOperation), \
             "Fails when parsing '" + opstring + "'"
@@ -2632,10 +2632,10 @@ def test_handling_unaryopbase():
             "Fails when parsing '" + opstring + "'"
 
     # Test that an unsupported unary operator creates a CodeBlock
-    fp2unaryop.items = (fp2unaryop.items[0], fp2unaryop.items[1],
-                        ('unsupported', fp2unaryop.items[2].items[1]))
+    fp2unaryop = assign_stmt.children[2]
+    fp2unaryop.items = ('unsupported', fp2unaryop.children[1])
     fake_parent = Schedule()
-    processor.process_nodes(fake_parent, [fp2unaryop])
+    processor.process_nodes(fake_parent, [assign_stmt])
 
     assert len(fake_parent.children) == 1
     new_node = fake_parent[0].rhs