[flang-commits] [flang] [flang] Add support for TYPEOF and CLASSOF type specifiers (PR #188804)
via flang-commits
flang-commits at lists.llvm.org
Mon Jun 1 04:36:30 PDT 2026
https://github.com/Ritanya-B-Bharadwaj updated https://github.com/llvm/llvm-project/pull/188804
>From 779319ae362b80d0585036f5c016ece0affb26f6 Mon Sep 17 00:00:00 2001
From: Ritanya B Bharadwaj <ritanya.b.bharadwaj at gmail.com>
Date: Thu, 26 Mar 2026 12:33:30 -0500
Subject: [PATCH 1/6] [flang]Adding initial support for type and classof
---
flang/include/flang/Parser/dump-parse-tree.h | 2 +
flang/include/flang/Parser/parse-tree.h | 7 +-
flang/lib/Parser/Fortran-parsers.cpp | 9 +-
flang/lib/Parser/unparse.cpp | 6 +
flang/lib/Semantics/resolve-names.cpp | 116 ++++++++++++++++++
flang/test/Parser/typeof-classof-attrs.f90 | 22 ++++
.../test/Semantics/typeof-classof-errors.f90 | 43 +++++++
flang/test/Semantics/typeof-classof.f90 | 38 ++++++
8 files changed, 240 insertions(+), 3 deletions(-)
create mode 100644 flang/test/Parser/typeof-classof-attrs.f90
create mode 100644 flang/test/Semantics/typeof-classof-errors.f90
create mode 100644 flang/test/Semantics/typeof-classof.f90
diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h
index 84c7b8d2a5349..dfb7fa30e20b6 100644
--- a/flang/include/flang/Parser/dump-parse-tree.h
+++ b/flang/include/flang/Parser/dump-parse-tree.h
@@ -284,9 +284,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 4aec99c80bdae..7bbcb7d04d25a 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -759,7 +759,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);
@@ -768,8 +769,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/Parser/Fortran-parsers.cpp b/flang/lib/Parser/Fortran-parsers.cpp
index e86b5e7f79c74..221cae453171c 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 9d01bb74d70d3..10d061cdbcec6 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 1155fff59a624..5e699794c3045 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1037,6 +1037,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 &);
@@ -1270,6 +1272,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();
}
@@ -6520,6 +6523,119 @@ 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::ArrayElement>>(
+ dataRef.u)) {
+ Say(currStmtSource().value(),
+ "The data-ref in %s must not have subscripts"_err_en_US, specName);
+ return false;
+ }
+ 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;
+ }
+
+ // C7115: 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(name->source, "'%s' in %s must be a data object"_err_en_US,
+ name->source, specName);
+ return false;
+ }
+
+ // C7114: data-ref shall not be a whole assumed-size array.
+ if (IsAssumedSizeArray(ultimate)) {
+ Say(name->source,
+ "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(name->source,
+ "Referenced object '%s' does not have a declared type"_err_en_US,
+ name->source);
+ return false;
+ }
+
+ switch (refType->category()) {
+ case DeclTypeSpec::Numeric:
+ case DeclTypeSpec::Logical:
+ case DeclTypeSpec::Character:
+ 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::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;
+ }
+ 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:
+ case DeclTypeSpec::ClassStar:
+ // If data-ref is unlimited polymorphic, TYPEOF gives TYPE(*) and
+ // CLASSOF gives CLASS(*).
+ if (isClassOf) {
+ SetDeclTypeSpec(context().globalScope().MakeClassStarType());
+ } else {
+ SetDeclTypeSpec(context().globalScope().MakeTypeStarType());
+ }
+ 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/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..3e7931446ba14
--- /dev/null
+++ b/flang/test/Semantics/typeof-classof-errors.f90
@@ -0,0 +1,43 @@
+! 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_typeof_subscript(a)
+ integer :: a(10)
+ !ERROR: The data-ref in TYPEOF must not have subscripts
+ typeof(a(1)) :: b
+ end subroutine
+
+ 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
+end module
diff --git a/flang/test/Semantics/typeof-classof.f90 b/flang/test/Semantics/typeof-classof.f90
new file mode 100644
index 0000000000000..79f7740c24606
--- /dev/null
+++ b/flang/test/Semantics/typeof-classof.f90
@@ -0,0 +1,38 @@
+! 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_classof(a)
+ class(base_type), intent(in) :: a
+ !UNPARSE: CLASSOF(a), ALLOCATABLE :: b
+ classof(a), allocatable :: b
+ end subroutine
+end module
>From 32faaaddcc09640875d5c5b4489252b6e466513b Mon Sep 17 00:00:00 2001
From: Ritanya B Bharadwaj <ritanya.b.bharadwaj at gmail.com>
Date: Mon, 6 Apr 2026 02:19:15 -0500
Subject: [PATCH 2/6] Adding test case for lowering
---
flang/docs/FortranStandardsSupport.md | 2 +-
flang/test/Lower/typeof-classof.f90 | 85 +++++++++++++++++++++++++++
2 files changed, 86 insertions(+), 1 deletion(-)
create mode 100644 flang/test/Lower/typeof-classof.f90
diff --git a/flang/docs/FortranStandardsSupport.md b/flang/docs/FortranStandardsSupport.md
index f57956cd6d6b8..19e86d7deb797 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 | N | |
diff --git a/flang/test/Lower/typeof-classof.f90 b/flang/test/Lower/typeof-classof.f90
new file mode 100644
index 0000000000000..a3d22d9db990c
--- /dev/null
+++ b/flang/test/Lower/typeof-classof.f90
@@ -0,0 +1,85 @@
+! RUN: bbc -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
>From c0197dacd4a3dd6ff140bb5616bef4cfc3271e80 Mon Sep 17 00:00:00 2001
From: Ritanya B Bharadwaj <ritanya.b.bharadwaj at gmail.com>
Date: Tue, 7 Apr 2026 05:55:30 -0500
Subject: [PATCH 3/6] Addressing review comments
---
flang/lib/Semantics/resolve-names.cpp | 20 ++++++++-----------
.../test/Semantics/typeof-classof-errors.f90 | 5 -----
2 files changed, 8 insertions(+), 17 deletions(-)
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 5e699794c3045..3dfe1c735e15f 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -6528,12 +6528,6 @@ bool DeclarationVisitor::ResolveTypeOfOrClassOf(
const parser::DataRef &dataRef, bool isClassOf) {
const char *specName{isClassOf ? "CLASSOF" : "TYPEOF"};
- if (std::holds_alternative<common::Indirection<parser::ArrayElement>>(
- dataRef.u)) {
- Say(currStmtSource().value(),
- "The data-ref in %s must not have subscripts"_err_en_US, specName);
- return false;
- }
if (std::holds_alternative<common::Indirection<parser::CoindexedNamedObject>>(
dataRef.u)) {
Say(currStmtSource().value(),
@@ -6547,18 +6541,20 @@ bool DeclarationVisitor::ResolveTypeOfOrClassOf(
return false;
}
- // C7115: data-ref shall be a data object, not a procedure or type name.
+ // 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(name->source, "'%s' in %s must be a data object"_err_en_US,
+ Say(currStmtSource().value(), "'%s' in %s must be a data object"_err_en_US,
name->source, specName);
return false;
}
- // C7114: data-ref shall not be a whole assumed-size array.
- if (IsAssumedSizeArray(ultimate)) {
- Say(name->source,
+ // 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;
@@ -6567,7 +6563,7 @@ bool DeclarationVisitor::ResolveTypeOfOrClassOf(
// Get the declared type of the referenced object.
const DeclTypeSpec *refType{ultimate.GetType()};
if (!refType) {
- Say(name->source,
+ Say(currStmtSource().value(),
"Referenced object '%s' does not have a declared type"_err_en_US,
name->source);
return false;
diff --git a/flang/test/Semantics/typeof-classof-errors.f90 b/flang/test/Semantics/typeof-classof-errors.f90
index 3e7931446ba14..b11ba6bb5fd33 100644
--- a/flang/test/Semantics/typeof-classof-errors.f90
+++ b/flang/test/Semantics/typeof-classof-errors.f90
@@ -10,11 +10,6 @@ module m
integer :: x
end type
contains
- subroutine test_typeof_subscript(a)
- integer :: a(10)
- !ERROR: The data-ref in TYPEOF must not have subscripts
- typeof(a(1)) :: b
- end subroutine
subroutine test_classof_intrinsic(a)
integer :: a
>From 8977e8f83861a43f695ae5d3444ca1e2dc5b4ae1 Mon Sep 17 00:00:00 2001
From: Ritanya B Bharadwaj <ritanya.b.bharadwaj at gmail.com>
Date: Wed, 8 Apr 2026 08:57:54 -0500
Subject: [PATCH 4/6] Adding more constraints
---
flang/lib/Semantics/resolve-names.cpp | 69 +++++++++++++++++--
.../test/Semantics/typeof-classof-errors.f90 | 29 ++++++++
flang/test/Semantics/typeof-classof.f90 | 18 +++++
3 files changed, 109 insertions(+), 7 deletions(-)
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 3dfe1c735e15f..d8e26a42cdb26 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -6569,10 +6569,33 @@ bool DeclarationVisitor::ResolveTypeOfOrClassOf(
return false;
}
+ // 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)) {
+ bool hasAssumedOrDeferred{false};
+ if (refType->category() == DeclTypeSpec::Character) {
+ const auto &len{refType->characterTypeSpec().length()};
+ hasAssumedOrDeferred = len.isAssumed() || len.isDeferred();
+ } else if (refType->category() == DeclTypeSpec::TypeDerived ||
+ refType->category() == DeclTypeSpec::ClassDerived) {
+ for (const auto &[_, value] : refType->derivedTypeSpec().parameters()) {
+ if (value.isAssumed() || value.isDeferred()) {
+ hasAssumedOrDeferred = true;
+ break;
+ }
+ }
+ }
+ if (hasAssumedOrDeferred) {
+ 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:
- case DeclTypeSpec::Character:
if (isClassOf) {
Say(currStmtSource().value(),
"CLASSOF may not be used with an intrinsic-type object"_err_en_US);
@@ -6580,6 +6603,28 @@ bool DeclarationVisitor::ResolveTypeOfOrClassOf(
}
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) {
+ SetDeclTypeSpec(currScope().MakeCharacterType(
+ ParamValue{
+ SomeIntExpr{std::move(*lenExpr)}, common::TypeParamAttr::Len},
+ KindExpr{charSpec.kind()}));
+ } else {
+ SetDeclTypeSpec(*refType);
+ }
+ } else {
+ SetDeclTypeSpec(*refType);
+ }
+ break;
+ }
case DeclTypeSpec::TypeDerived:
case DeclTypeSpec::ClassDerived: {
const DerivedTypeSpec &derived{refType->derivedTypeSpec()};
@@ -6607,14 +6652,24 @@ bool DeclarationVisitor::ResolveTypeOfOrClassOf(
break;
}
case DeclTypeSpec::TypeStar:
- case DeclTypeSpec::ClassStar:
- // If data-ref is unlimited polymorphic, TYPEOF gives TYPE(*) and
- // CLASSOF gives CLASS(*).
if (isClassOf) {
- SetDeclTypeSpec(context().globalScope().MakeClassStarType());
- } else {
- SetDeclTypeSpec(context().globalScope().MakeTypeStarType());
+ // 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) {
+ // 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;
diff --git a/flang/test/Semantics/typeof-classof-errors.f90 b/flang/test/Semantics/typeof-classof-errors.f90
index b11ba6bb5fd33..82cd329125563 100644
--- a/flang/test/Semantics/typeof-classof-errors.f90
+++ b/flang/test/Semantics/typeof-classof-errors.f90
@@ -35,4 +35,33 @@ subroutine test_typeof_assumed_size(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
end module
diff --git a/flang/test/Semantics/typeof-classof.f90 b/flang/test/Semantics/typeof-classof.f90
index 79f7740c24606..dea58c1c1091b 100644
--- a/flang/test/Semantics/typeof-classof.f90
+++ b/flang/test/Semantics/typeof-classof.f90
@@ -30,9 +30,27 @@ subroutine test_typeof_intrinsic(a, b, c)
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
>From df88232571c215e5818ae45471ee16b377c59a22 Mon Sep 17 00:00:00 2001
From: Ritanya B Bharadwaj <ritanya.b.bharadwaj at gmail.com>
Date: Tue, 5 May 2026 04:55:26 -0500
Subject: [PATCH 5/6] Addressing futher review comments
---
flang/include/flang/Evaluate/type.h | 1 +
flang/lib/Evaluate/type.cpp | 13 ++++++
flang/lib/Semantics/resolve-names.cpp | 46 +++++++++----------
.../test/Semantics/typeof-classof-errors.f90 | 6 +++
4 files changed, 42 insertions(+), 24 deletions(-)
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/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/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index d8e26a42cdb26..24dcf92ff4926 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -6569,23 +6569,11 @@ bool DeclarationVisitor::ResolveTypeOfOrClassOf(
return false;
}
- // C713: If the data-ref has the OPTIONAL attribute, it shall not have
+ // 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)) {
- bool hasAssumedOrDeferred{false};
- if (refType->category() == DeclTypeSpec::Character) {
- const auto &len{refType->characterTypeSpec().length()};
- hasAssumedOrDeferred = len.isAssumed() || len.isDeferred();
- } else if (refType->category() == DeclTypeSpec::TypeDerived ||
- refType->category() == DeclTypeSpec::ClassDerived) {
- for (const auto &[_, value] : refType->derivedTypeSpec().parameters()) {
- if (value.isAssumed() || value.isDeferred()) {
- hasAssumedOrDeferred = true;
- break;
- }
- }
- }
- if (hasAssumedOrDeferred) {
+ 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);
@@ -6612,14 +6600,16 @@ bool DeclarationVisitor::ResolveTypeOfOrClassOf(
const auto &charSpec{refType->characterTypeSpec()};
if (charSpec.length().isAssumed()) {
auto lenExpr{evaluate::NamedEntity{ultimate}.LEN()};
- if (lenExpr) {
- SetDeclTypeSpec(currScope().MakeCharacterType(
- ParamValue{
- SomeIntExpr{std::move(*lenExpr)}, common::TypeParamAttr::Len},
- KindExpr{charSpec.kind()}));
- } else {
- SetDeclTypeSpec(*refType);
+ 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);
}
@@ -6633,6 +6623,14 @@ bool DeclarationVisitor::ResolveTypeOfOrClassOf(
"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{
@@ -6653,7 +6651,7 @@ bool DeclarationVisitor::ResolveTypeOfOrClassOf(
}
case DeclTypeSpec::TypeStar:
if (isClassOf) {
- // C712: CLASSOF shall not be used with assumed-type
+ // 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;
@@ -6663,7 +6661,7 @@ bool DeclarationVisitor::ResolveTypeOfOrClassOf(
break;
case DeclTypeSpec::ClassStar:
if (!isClassOf) {
- // C711: TYPEOF shall not be used with unlimited polymorphic
+ // 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;
diff --git a/flang/test/Semantics/typeof-classof-errors.f90 b/flang/test/Semantics/typeof-classof-errors.f90
index 82cd329125563..bfc9cbe500c7b 100644
--- a/flang/test/Semantics/typeof-classof-errors.f90
+++ b/flang/test/Semantics/typeof-classof-errors.f90
@@ -64,4 +64,10 @@ 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
>From 459ab61624f26cb00e6a7712d0ac14328b813e03 Mon Sep 17 00:00:00 2001
From: Ritanya B Bharadwaj <ritanya.b.bharadwaj at gmail.com>
Date: Mon, 1 Jun 2026 06:35:26 -0500
Subject: [PATCH 6/6] Changing bbc to flang_fc1 in typeof-classof.f90
---
flang/test/Lower/typeof-classof.f90 | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/flang/test/Lower/typeof-classof.f90 b/flang/test/Lower/typeof-classof.f90
index a3d22d9db990c..1a9dbb187e4f9 100644
--- a/flang/test/Lower/typeof-classof.f90
+++ b/flang/test/Lower/typeof-classof.f90
@@ -1,4 +1,4 @@
-! RUN: bbc -emit-hlfir %s -o - | FileCheck %s
+! 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
More information about the flang-commits
mailing list