[flang-commits] [flang] 1433381 - [flang] Add support for TYPEOF and CLASSOF type specifiers (#188804)
via flang-commits
flang-commits at lists.llvm.org
Mon Jun 1 06:36:43 PDT 2026
Author: Ritanya-B-Bharadwaj
Date: 2026-06-01T19:06:37+05:30
New Revision: 143338131f0e8f1586f7f9aacb7d94dfde169b08
URL: https://github.com/llvm/llvm-project/commit/143338131f0e8f1586f7f9aacb7d94dfde169b08
DIFF: https://github.com/llvm/llvm-project/commit/143338131f0e8f1586f7f9aacb7d94dfde169b08.diff
LOG: [flang] Add support for TYPEOF and CLASSOF type specifiers (#188804)
Implements parsing, semantics and lowering for the Fortran 2023 TYPEOF and CLASSOF type specifiers (R703). TYPEOF produces the declared type of a data-ref; CLASSOF produces a polymorphic version. Includes constraint
checks (C709–C713) and tests.
Semantics resolves TYPEOF/CLASSOF to the concrete underlying type in the symbol table, so no lowering code changes were needed. Added a lowering test to verify FIR/HLFIR generation works correctly for intrinsic types,
derived types, extended types, and polymorphic CLASSOF with allocatable/pointer.
Fixes - https://github.com/llvm/llvm-project/issues/185635
Added:
flang/test/Lower/typeof-classof.f90
flang/test/Parser/typeof-classof-attrs.f90
flang/test/Semantics/typeof-classof-errors.f90
flang/test/Semantics/typeof-classof.f90
Modified:
flang/docs/FortranStandardsSupport.md
flang/include/flang/Evaluate/type.h
flang/include/flang/Parser/dump-parse-tree.h
flang/include/flang/Parser/parse-tree.h
flang/lib/Evaluate/type.cpp
flang/lib/Parser/Fortran-parsers.cpp
flang/lib/Parser/unparse.cpp
flang/lib/Semantics/resolve-names.cpp
Removed:
################################################################################
diff --git a/flang/docs/FortranStandardsSupport.md b/flang/docs/FortranStandardsSupport.md
index a52d123183b59..5c303feacfa5e 100644
--- a/flang/docs/FortranStandardsSupport.md
+++ b/flang/docs/FortranStandardsSupport.md
@@ -36,7 +36,7 @@ status of all important Fortran 2023 features. The table entries are based on th
|------------------------------------------------------------|--------|---------------------------------------------------------|
| Allow longer statement lines and overall statement length | Y | |
| Automatic allocation of lengths of character variables | N | |
-| The specifiers typeof and classof | N | |
+| The specifiers typeof and classof | Y | |
| Conditional expressions and arguments | N | |
| More use of boz constants | P | All usages other than enum are supported |
| Intrinsics for extracting tokens from a string | Y | |
diff --git a/flang/include/flang/Evaluate/type.h b/flang/include/flang/Evaluate/type.h
index 222018bb452a0..e25122d873f2c 100644
--- a/flang/include/flang/Evaluate/type.h
+++ b/flang/include/flang/Evaluate/type.h
@@ -170,6 +170,7 @@ class DynamicType {
bool RequiresDescriptor() const;
bool HasDeferredTypeParameter() const;
+ bool HasDeferredOrAssumedTypeParameter() const;
// 7.3.2.3 & 15.5.2.4 type compatibility.
// x.IsTkCompatibleWith(y) is true if "x => y" or passing actual y to
diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h
index 218b2acfbe8f3..b4680e1cb656d 100644
--- a/flang/include/flang/Parser/dump-parse-tree.h
+++ b/flang/include/flang/Parser/dump-parse-tree.h
@@ -291,9 +291,11 @@ class ParseTreeDumper {
NODE(parser, DeclarationConstruct)
NODE(parser, DeclarationTypeSpec)
NODE(DeclarationTypeSpec, Class)
+ NODE(DeclarationTypeSpec, ClassOf)
NODE(DeclarationTypeSpec, ClassStar)
NODE(DeclarationTypeSpec, Record)
NODE(DeclarationTypeSpec, Type)
+ NODE(DeclarationTypeSpec, TypeOf)
NODE(DeclarationTypeSpec, TypeStar)
NODE(parser, Default)
NODE(parser, DeferredCoshapeSpecList)
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 2ffd068ccb44e..4efae0c9772b3 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -761,7 +761,8 @@ struct TypeSpec {
// R703 declaration-type-spec ->
// intrinsic-type-spec | TYPE ( intrinsic-type-spec ) |
// TYPE ( derived-type-spec ) | CLASS ( derived-type-spec ) |
-// CLASS ( * ) | TYPE ( * )
+// CLASS ( * ) | TYPE ( * ) |
+// TYPEOF ( data-ref ) | CLASSOF ( data-ref )
// Legacy extension: RECORD /struct/
struct DeclarationTypeSpec {
UNION_CLASS_BOILERPLATE(DeclarationTypeSpec);
@@ -770,8 +771,10 @@ struct DeclarationTypeSpec {
EMPTY_CLASS(ClassStar);
EMPTY_CLASS(TypeStar);
WRAPPER_CLASS(Record, Name);
+ WRAPPER_CLASS(TypeOf, common::Indirection<DataRef>);
+ WRAPPER_CLASS(ClassOf, common::Indirection<DataRef>);
std::variant<IntrinsicTypeSpec, Type, Class, ClassStar, TypeStar, Record,
- VectorTypeSpec>
+ VectorTypeSpec, TypeOf, ClassOf>
u;
};
diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp
index 99dc8b1e5c676..988be5673ad05 100644
--- a/flang/lib/Evaluate/type.cpp
+++ b/flang/lib/Evaluate/type.cpp
@@ -776,6 +776,19 @@ bool DynamicType::HasDeferredTypeParameter() const {
return charLengthParamValue_ && charLengthParamValue_->isDeferred();
}
+bool DynamicType::HasDeferredOrAssumedTypeParameter() const {
+ if (derived_) {
+ for (const auto &pair : derived_->parameters()) {
+ if (pair.second.isDeferred() || pair.second.isAssumed()) {
+ return true;
+ }
+ }
+ }
+ return charLengthParamValue_ &&
+ (charLengthParamValue_->isDeferred() ||
+ charLengthParamValue_->isAssumed());
+}
+
bool SomeKind<TypeCategory::Derived>::operator==(
const SomeKind<TypeCategory::Derived> &that) const {
return PointeeComparison(derivedTypeSpec_, that.derivedTypeSpec_);
diff --git a/flang/lib/Parser/Fortran-parsers.cpp b/flang/lib/Parser/Fortran-parsers.cpp
index 4c57a13a64f74..a86b3cb37a91f 100644
--- a/flang/lib/Parser/Fortran-parsers.cpp
+++ b/flang/lib/Parser/Fortran-parsers.cpp
@@ -167,7 +167,8 @@ TYPE_CONTEXT_PARSER("type spec"_en_US,
// R703 declaration-type-spec ->
// intrinsic-type-spec | TYPE ( intrinsic-type-spec ) |
// TYPE ( derived-type-spec ) | CLASS ( derived-type-spec ) |
-// CLASS ( * ) | TYPE ( * )
+// CLASS ( * ) | TYPE ( * ) |
+// TYPEOF ( data-ref ) | CLASSOF ( data-ref )
// N.B. It is critical to distribute "parenthesized()" over the alternatives
// for TYPE (...), rather than putting the alternatives within it, which
// would fail on "TYPE(real_derived)" with a misrecognition of "real" as an
@@ -176,6 +177,12 @@ TYPE_CONTEXT_PARSER("type spec"_en_US,
// type (BYTE or DOUBLECOMPLEX), not the extension intrinsic type.
TYPE_CONTEXT_PARSER("declaration type spec"_en_US,
construct<DeclarationTypeSpec>(intrinsicTypeSpec) ||
+ "TYPEOF" >>
+ parenthesized(construct<DeclarationTypeSpec>(
+ construct<DeclarationTypeSpec::TypeOf>(indirect(dataRef)))) ||
+ "CLASSOF" >>
+ parenthesized(construct<DeclarationTypeSpec>(
+ construct<DeclarationTypeSpec::ClassOf>(indirect(dataRef)))) ||
"TYPE" >>
(parenthesized(construct<DeclarationTypeSpec>(
!"DOUBLECOMPLEX"_tok >> !"BYTE"_tok >> intrinsicTypeSpec)) ||
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index eb30f6c9a0d63..fd9fcaa0405b2 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -152,6 +152,12 @@ class UnparseVisitor {
void Unparse(const DeclarationTypeSpec::Record &x) {
Word("RECORD/"), Walk(x.v), Put('/');
}
+ void Unparse(const DeclarationTypeSpec::TypeOf &x) {
+ Word("TYPEOF("), Walk(x.v), Put(')');
+ }
+ void Unparse(const DeclarationTypeSpec::ClassOf &x) {
+ Word("CLASSOF("), Walk(x.v), Put(')');
+ }
void Before(const IntrinsicTypeSpec::Real &) { // R704
Word("REAL");
}
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 26fd702e248ae..46a1302b444c3 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1042,6 +1042,8 @@ class DeclarationVisitor : public ArraySpecVisitor,
bool Pre(const parser::DeclarationTypeSpec::Class &);
void Post(const parser::DeclarationTypeSpec::Class &);
void Post(const parser::DeclarationTypeSpec::Record &);
+ bool Pre(const parser::DeclarationTypeSpec::TypeOf &);
+ bool Pre(const parser::DeclarationTypeSpec::ClassOf &);
void Post(const parser::DerivedTypeSpec &);
bool Pre(const parser::DerivedTypeDef &);
bool Pre(const parser::DerivedTypeStmt &);
@@ -1275,6 +1277,7 @@ class DeclarationVisitor : public ArraySpecVisitor,
const parser::Name &name, Symbol &symbol, Symbol::Flag flag);
bool CheckForHostAssociatedImplicit(const parser::Name &);
bool HasCycle(const Symbol &, const Symbol *interface);
+ bool ResolveTypeOfOrClassOf(const parser::DataRef &, bool isClassOf);
bool MustBeScalar(const Symbol &symbol) const {
return mustBeScalar_.find(symbol) != mustBeScalar_.end();
}
@@ -6646,6 +6649,168 @@ void DeclarationVisitor::Post(const parser::DeclarationTypeSpec::Record &rec) {
}
}
+// TYPEOF and CLASSOF type specifiers
+bool DeclarationVisitor::ResolveTypeOfOrClassOf(
+ const parser::DataRef &dataRef, bool isClassOf) {
+ const char *specName{isClassOf ? "CLASSOF" : "TYPEOF"};
+
+ if (std::holds_alternative<common::Indirection<parser::CoindexedNamedObject>>(
+ dataRef.u)) {
+ Say(currStmtSource().value(),
+ "The data-ref in %s must not have an image-selector"_err_en_US,
+ specName);
+ return false;
+ }
+
+ const parser::Name *name{ResolveDataRef(dataRef)};
+ if (!name || !name->symbol) {
+ return false;
+ }
+
+ // data-ref shall be a data object, not a procedure or type name.
+ const Symbol &ultimate{name->symbol->GetUltimate()};
+ if (!ultimate.has<ObjectEntityDetails>() &&
+ !ultimate.has<AssocEntityDetails>() && !ultimate.has<EntityDetails>()) {
+ Say(currStmtSource().value(), "'%s' in %s must be a data object"_err_en_US,
+ name->source, specName);
+ return false;
+ }
+
+ // data-ref shall not be a whole assumed-size array.
+ if (!std::holds_alternative<common::Indirection<parser::ArrayElement>>(
+ dataRef.u) &&
+ IsAssumedSizeArray(ultimate)) {
+ Say(currStmtSource().value(),
+ "The data-ref in %s must not be a whole assumed-size array"_err_en_US,
+ specName);
+ return false;
+ }
+
+ // Get the declared type of the referenced object.
+ const DeclTypeSpec *refType{ultimate.GetType()};
+ if (!refType) {
+ Say(currStmtSource().value(),
+ "Referenced object '%s' does not have a declared type"_err_en_US,
+ name->source);
+ return false;
+ }
+
+ // F2023 C713: If the data-ref has the OPTIONAL attribute, it shall not have
+ // a deferred or assumed type parameter.
+ if (ultimate.attrs().test(Attr::OPTIONAL)) {
+ if (auto dyType{evaluate::DynamicType::From(ultimate)};
+ dyType && dyType->HasDeferredOrAssumedTypeParameter()) {
+ Say(currStmtSource().value(),
+ "The OPTIONAL data-ref in %s must not have assumed or deferred type parameters"_err_en_US,
+ specName);
+ return false;
+ }
+ }
+
+ switch (refType->category()) {
+ case DeclTypeSpec::Numeric:
+ case DeclTypeSpec::Logical:
+ if (isClassOf) {
+ Say(currStmtSource().value(),
+ "CLASSOF may not be used with an intrinsic-type object"_err_en_US);
+ return false;
+ }
+ SetDeclTypeSpec(*refType);
+ break;
+ case DeclTypeSpec::Character: {
+ if (isClassOf) {
+ Say(currStmtSource().value(),
+ "CLASSOF may not be used with an intrinsic-type object"_err_en_US);
+ return false;
+ }
+ const auto &charSpec{refType->characterTypeSpec()};
+ if (charSpec.length().isAssumed()) {
+ auto lenExpr{evaluate::NamedEntity{ultimate}.LEN()};
+ if (!lenExpr) {
+ Say(currStmtSource().value(),
+ "Could not determine the length of '%s' in %s"_err_en_US,
+ name->source, specName);
+ return false;
+ }
+ SetDeclTypeSpec(currScope().MakeCharacterType(
+ ParamValue{
+ SomeIntExpr{std::move(*lenExpr)}, common::TypeParamAttr::Len},
+ KindExpr{charSpec.kind()}));
+ } else {
+ SetDeclTypeSpec(*refType);
+ }
+ break;
+ }
+ case DeclTypeSpec::TypeDerived:
+ case DeclTypeSpec::ClassDerived: {
+ const DerivedTypeSpec &derived{refType->derivedTypeSpec()};
+ if (isClassOf && !IsExtensibleType(&derived)) {
+ Say(currStmtSource().value(),
+ "CLASSOF requires a data-ref of extensible type"_err_en_US);
+ return false;
+ }
+ for (const auto &[paramName, paramValue] : derived.parameters()) {
+ if (paramValue.isAssumed()) {
+ Say(currStmtSource().value(),
+ "%s with parameterized derived type that has assumed LEN parameter '%s' is not yet implemented"_todo_en_US,
+ specName, paramName.ToString());
+ return false;
+ }
+ }
+ auto category{
+ isClassOf ? DeclTypeSpec::ClassDerived : DeclTypeSpec::TypeDerived};
+ if (const DeclTypeSpec *extant{
+ currScope().FindInstantiatedDerivedType(derived, category)}) {
+ SetDeclTypeSpec(*extant);
+ } else {
+ DeclTypeSpec &type{
+ currScope().MakeDerivedType(category, DerivedTypeSpec{derived})};
+ DerivedTypeSpec &newDerived{type.derivedTypeSpec()};
+ newDerived.CookParameters(GetFoldingContext());
+ newDerived.EvaluateParameters(context());
+ if (!newDerived.IsForwardReferenced()) {
+ newDerived.Instantiate(currScope());
+ }
+ SetDeclTypeSpec(type);
+ }
+ break;
+ }
+ case DeclTypeSpec::TypeStar:
+ if (isClassOf) {
+ // F2023 C712: CLASSOF shall not be used with assumed-type
+ Say(currStmtSource().value(),
+ "The data-ref in CLASSOF must not be assumed-type"_err_en_US);
+ return false;
+ }
+ // TYPEOF of TYPE(*) is valid, produces TYPE(*)
+ SetDeclTypeSpec(context().globalScope().MakeTypeStarType());
+ break;
+ case DeclTypeSpec::ClassStar:
+ if (!isClassOf) {
+ // F2023 C711: TYPEOF shall not be used with unlimited polymorphic
+ Say(currStmtSource().value(),
+ "The data-ref in TYPEOF must not be unlimited polymorphic"_err_en_US);
+ return false;
+ }
+ // CLASSOF of CLASS(*) is valid, produces CLASS(*)
+ SetDeclTypeSpec(context().globalScope().MakeClassStarType());
+ break;
+ }
+ return true;
+}
+
+bool DeclarationVisitor::Pre(
+ const parser::DeclarationTypeSpec::TypeOf &typeOf) {
+ ResolveTypeOfOrClassOf(typeOf.v.value(), /*isClassOf=*/false);
+ return false;
+}
+
+bool DeclarationVisitor::Pre(
+ const parser::DeclarationTypeSpec::ClassOf &classOf) {
+ ResolveTypeOfOrClassOf(classOf.v.value(), /*isClassOf=*/true);
+ return false;
+}
+
// The descendents of DerivedTypeDef in the parse tree are visited directly
// in this Pre() routine so that recursive use of the derived type can be
// supported in the components.
diff --git a/flang/test/Lower/typeof-classof.f90 b/flang/test/Lower/typeof-classof.f90
new file mode 100644
index 0000000000000..1a9dbb187e4f9
--- /dev/null
+++ b/flang/test/Lower/typeof-classof.f90
@@ -0,0 +1,85 @@
+! RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s
+
+! Test that TYPEOF and CLASSOF type specifiers from F2023 lower correctly.
+! Semantics resolves TYPEOF/CLASSOF to the concrete type of the referenced
+! object, so lowering should produce the same FIR types as explicit type
+! declarations.
+
+module typeof_classof_types
+ type :: base_t
+ integer :: x
+ end type
+ type, extends(base_t) :: child_t
+ integer :: y
+ end type
+contains
+
+! Test TYPEOF with intrinsic types
+ subroutine test_typeof_integer(a)
+ integer :: a
+ typeof(a) :: b
+ b = a
+ end subroutine
+! CHECK-LABEL: func.func @_QMtypeof_classof_typesPtest_typeof_integer(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<i32>
+! CHECK: %[[B:.*]] = fir.alloca i32 {bindc_name = "b"
+! CHECK: hlfir.declare %[[B]]
+
+ subroutine test_typeof_real8(a)
+ real(8) :: a
+ typeof(a) :: b
+ b = a
+ end subroutine
+! CHECK-LABEL: func.func @_QMtypeof_classof_typesPtest_typeof_real8(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<f64>
+! CHECK: %[[B:.*]] = fir.alloca f64 {bindc_name = "b"
+
+ subroutine test_typeof_logical(a)
+ logical :: a
+ typeof(a) :: b
+ b = a
+ end subroutine
+! CHECK-LABEL: func.func @_QMtypeof_classof_typesPtest_typeof_logical(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.logical<4>>
+! CHECK: %[[B:.*]] = fir.alloca !fir.logical<4> {bindc_name = "b"
+
+! Test TYPEOF with derived types
+ subroutine test_typeof_derived(a)
+ type(base_t) :: a
+ typeof(a) :: b
+ b = a
+ end subroutine
+! CHECK-LABEL: func.func @_QMtypeof_classof_typesPtest_typeof_derived(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.type<_QMtypeof_classof_typesTbase_t{x:i32}>>
+! CHECK: %[[B:.*]] = fir.alloca !fir.type<_QMtypeof_classof_typesTbase_t{x:i32}> {bindc_name = "b"
+
+ subroutine test_typeof_child(a)
+ type(child_t) :: a
+ typeof(a) :: b
+ b = a
+ end subroutine
+! CHECK-LABEL: func.func @_QMtypeof_classof_typesPtest_typeof_child(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.type<_QMtypeof_classof_typesTchild_t{base_t:!fir.type<_QMtypeof_classof_typesTbase_t{x:i32}>,y:i32}>>
+! CHECK: %[[B:.*]] = fir.alloca !fir.type<_QMtypeof_classof_typesTchild_t{base_t:!fir.type<_QMtypeof_classof_typesTbase_t{x:i32}>,y:i32}> {bindc_name = "b"
+
+! Test CLASSOF with allocatable (polymorphic)
+ subroutine test_classof_allocatable(a)
+ class(base_t), intent(in) :: a
+ classof(a), allocatable :: b
+ allocate(b, source=a)
+ end subroutine
+! CHECK-LABEL: func.func @_QMtypeof_classof_typesPtest_classof_allocatable(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.class<!fir.type<_QMtypeof_classof_typesTbase_t{x:i32}>>
+! CHECK: %[[B:.*]] = fir.alloca !fir.class<!fir.heap<!fir.type<_QMtypeof_classof_typesTbase_t{x:i32}>>> {bindc_name = "b"
+
+! Test CLASSOF with pointer (polymorphic)
+ subroutine test_classof_pointer(a)
+ class(base_t), target, intent(in) :: a
+ classof(a), pointer :: b
+ b => a
+ end subroutine
+! CHECK-LABEL: func.func @_QMtypeof_classof_typesPtest_classof_pointer(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.class<!fir.type<_QMtypeof_classof_typesTbase_t{x:i32}>>
+! CHECK: %[[B:.*]] = fir.alloca !fir.class<!fir.ptr<!fir.type<_QMtypeof_classof_typesTbase_t{x:i32}>>> {bindc_name = "b"
+
+end module
diff --git a/flang/test/Parser/typeof-classof-attrs.f90 b/flang/test/Parser/typeof-classof-attrs.f90
new file mode 100644
index 0000000000000..d1be75dad8682
--- /dev/null
+++ b/flang/test/Parser/typeof-classof-attrs.f90
@@ -0,0 +1,22 @@
+! RUN: %flang_fc1 -fdebug-unparse-no-sema %s 2>&1 | FileCheck %s
+! Test TYPEOF and CLASSOF with spaces and attributes.
+
+program test_program
+ implicit none
+
+ TYPE :: matrix
+ INTEGER :: v
+ END TYPE
+
+ TYPE(matrix) :: MAT
+
+ !CHECK: TYPEOF(mat), POINTER :: tmat_ptr
+ TYPEOF(MAT), POINTER :: TMAT_PTR
+ !CHECK: TYPEOF(mat), ALLOCATABLE, TARGET :: tmat_allocatable
+ TYPEOF(MAT), ALLOCATABLE, TARGET :: TMAT_ALLOCATABLE
+
+ !CHECK: CLASSOF(mat), POINTER :: cmat_ptr
+ CLASSOF(MAT), POINTER :: CMAT_PTR
+ !CHECK: CLASSOF(mat), ALLOCATABLE, TARGET :: cmat_allocatable
+ CLASSOF(MAT), ALLOCATABLE, TARGET :: CMAT_ALLOCATABLE
+end program
diff --git a/flang/test/Semantics/typeof-classof-errors.f90 b/flang/test/Semantics/typeof-classof-errors.f90
new file mode 100644
index 0000000000000..bfc9cbe500c7b
--- /dev/null
+++ b/flang/test/Semantics/typeof-classof-errors.f90
@@ -0,0 +1,73 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Test semantic errors for F2023 TYPEOF and CLASSOF type specifiers.
+
+module m
+ type :: base_type
+ integer :: x
+ end type
+ type :: non_extensible_type
+ sequence
+ integer :: x
+ end type
+contains
+
+ subroutine test_classof_intrinsic(a)
+ integer :: a
+ !ERROR: CLASSOF may not be used with an intrinsic-type object
+ classof(a) :: b
+ end subroutine
+
+ subroutine test_typeof_not_found()
+ implicit none
+ !ERROR: No explicit type declared for 'nonexistent'
+ !ERROR: No explicit type declared for 'b'
+ typeof(nonexistent) :: b
+ end subroutine
+
+ subroutine test_classof_non_extensible(a)
+ type(non_extensible_type) :: a
+ !ERROR: CLASSOF requires a data-ref of extensible type
+ classof(a) :: b
+ end subroutine
+
+ subroutine test_typeof_assumed_size(a)
+ integer :: a(*)
+ !ERROR: The data-ref in TYPEOF must not be a whole assumed-size array
+ typeof(a) :: b
+ end subroutine
+
+ subroutine test_typeof_unlimited_poly(a)
+ class(*), intent(in) :: a
+ !ERROR: The data-ref in TYPEOF must not be unlimited polymorphic
+ typeof(a) :: b
+ end subroutine
+
+ subroutine test_classof_assumed_type(a)
+ type(*), intent(in) :: a
+ !ERROR: The data-ref in CLASSOF must not be assumed-type
+ classof(a) :: b
+ end subroutine
+
+ subroutine test_typeof_optional_assumed_char(a)
+ character(*), optional :: a
+ !ERROR: The OPTIONAL data-ref in TYPEOF must not have assumed or deferred type parameters
+ typeof(a) :: b
+ end subroutine
+
+ subroutine test_typeof_optional_deferred_char(a)
+ character(:), allocatable, optional :: a
+ !ERROR: The OPTIONAL data-ref in TYPEOF must not have assumed or deferred type parameters
+ typeof(a) :: b
+ end subroutine
+
+ subroutine test_typeof_optional_ok(a)
+ integer, optional :: a
+ typeof(a) :: b
+ end subroutine
+
+ subroutine test_typeof_deferred_char_local(c)
+ character(:), allocatable :: c
+ !ERROR: 'localc' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable nor an object pointer
+ typeof(c) :: localc
+ end subroutine
+end module
diff --git a/flang/test/Semantics/typeof-classof.f90 b/flang/test/Semantics/typeof-classof.f90
new file mode 100644
index 0000000000000..dea58c1c1091b
--- /dev/null
+++ b/flang/test/Semantics/typeof-classof.f90
@@ -0,0 +1,56 @@
+! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s --check-prefix=UNPARSE
+! Test semantics of F2023 TYPEOF and CLASSOF type specifiers.
+
+module m
+ type :: base_type
+ integer :: x
+ end type
+ type, extends(base_type) :: child_type
+ integer :: y
+ end type
+contains
+ subroutine test_typeof_derived(a, b)
+ type(base_type) :: a
+ type(child_type) :: b
+ !UNPARSE: TYPEOF(a) :: c
+ typeof(a) :: c
+ !UNPARSE: TYPEOF(b) :: d
+ typeof(b) :: d
+ end subroutine
+
+ subroutine test_typeof_intrinsic(a, b, c)
+ integer :: a
+ real(8) :: b
+ logical :: c
+ !UNPARSE: TYPEOF(a) :: d
+ typeof(a) :: d
+ !UNPARSE: TYPEOF(b) :: e
+ typeof(b) :: e
+ !UNPARSE: TYPEOF(c) :: f
+ typeof(c) :: f
+ end subroutine
+
+ subroutine test_typeof_assumed_char(a)
+ character(*) :: a
+ !UNPARSE: TYPEOF(a) :: b
+ typeof(a) :: b
+ end subroutine
+
+ subroutine test_classof(a)
+ class(base_type), intent(in) :: a
+ !UNPARSE: CLASSOF(a), ALLOCATABLE :: b
+ classof(a), allocatable :: b
+ end subroutine
+
+ subroutine test_typeof_assumed_type(a, b)
+ type(*), intent(in) :: a
+ !UNPARSE: TYPEOF(a) :: b
+ typeof(a) :: b
+ end subroutine
+
+ subroutine test_classof_unlimited_poly(a)
+ class(*), intent(in) :: a
+ !UNPARSE: CLASSOF(a), ALLOCATABLE :: b
+ classof(a), allocatable :: b
+ end subroutine
+end module
More information about the flang-commits
mailing list