[flang-commits] [flang] [flang] Don't misinterpret valid component value for ancestor type (PR #161910)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Fri Oct 3 14:15:14 PDT 2025
https://github.com/klausler created https://github.com/llvm/llvm-project/pull/161910
As a common language extension, this compiler accepts a structure constructor whose first value has no keyword and whose type matches an ancestral type as if the constructor had had a keyword whose name was the ancestral type. For example, given
TYPE PARENT; REAL X; END TYPE
TYPE, EXTENDS(PARENT) :: CHILD; END TYPE
we accept the nonconforming constructor "child(parent(1.))" as if it had been the conforming "child(1.)" or "child(parent=parent(1.))".
The detection of this case needs to be constrained a bit to avoid a false positive misinterpretation of conforming code in the case where the actual first component of the derived type is a POINTER or ALLOCATABLE whose type and rank would allow it to correspond with the keywordless first value in the component value list.
Fixes https://github.com/llvm/llvm-project/issues/161887.
>From 7a989fa08ab2b9fa4fc6da69dde07335d3987684 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Fri, 3 Oct 2025 14:05:41 -0700
Subject: [PATCH] [flang] Don't misinterpret valid component value for ancestor
type
As a common language extension, this compiler accepts a structure
constructor whose first value has no keyword and whose type matches
an ancestral type as if the constructor had had a keyword whose
name was the ancestral type. For example, given
TYPE PARENT; REAL X; END TYPE
TYPE, EXTENDS(PARENT) :: CHILD; END TYPE
we accept the nonconforming constructor "child(parent(1.))" as if it
had been the conforming "child(1.)" or "child(parent=parent(1.))".
The detection of this case needs to be constrained a bit to avoid
a false positive misinterpretation of conforming code in the case
where the actual first component of the derived type is a POINTER
or ALLOCATABLE whose type and rank would allow it to correspond
with the keywordless first value in the component value list.
Fixes https://github.com/llvm/llvm-project/issues/161887.
---
flang/lib/Semantics/expression.cpp | 34 ++++++----
flang/test/Semantics/structconst11.f90 | 89 ++++++++++++++++++++++++++
2 files changed, 112 insertions(+), 11 deletions(-)
create mode 100644 flang/test/Semantics/structconst11.f90
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index fc268886c5feb..126dc4c3c62d0 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -2171,17 +2171,29 @@ MaybeExpr ExpressionAnalyzer::CheckStructureConstructor(
// T(1) or T(PT=PT(1)). There may be multiple parent components.
if (nextAnonymous == components.begin() && parentComponent && valueType &&
context().IsEnabled(LanguageFeature::AnonymousParents)) {
- for (auto parent{components.begin()};
- parent != afterLastParentComponentIter; ++parent) {
- if (auto parentType{DynamicType::From(*parent)}; parentType &&
- parent->test(Symbol::Flag::ParentComp) &&
- valueType->IsEquivalentTo(*parentType)) {
- symbol = &*parent;
- nextAnonymous = ++parent;
- Warn(LanguageFeature::AnonymousParents, source,
- "Whole parent component '%s' in structure constructor should not be anonymous"_port_en_US,
- symbol->name());
- break;
+ auto parent{components.begin()};
+ if (!parent->test(Symbol::Flag::ParentComp)) {
+ // Ensure that the first value can't initialize the first actual
+ // component.
+ if (auto firstComponentType{DynamicType::From(*parent)}) {
+ if (firstComponentType->IsTkCompatibleWith(*valueType) &&
+ value.Rank() == parent->Rank()) {
+ parent = afterLastParentComponentIter; // skip next loop
+ }
+ }
+ }
+ for (; parent != afterLastParentComponentIter; ++parent) {
+ if (auto parentType{DynamicType::From(*parent)}) {
+ if (parent->test(Symbol::Flag::ParentComp) &&
+ valueType->IsEquivalentTo(*parentType) &&
+ value.Rank() == 0 /* scalar only */) {
+ symbol = &*parent;
+ nextAnonymous = ++parent;
+ Warn(LanguageFeature::AnonymousParents, source,
+ "Whole parent component '%s' in structure constructor should not be anonymous"_port_en_US,
+ symbol->name());
+ break;
+ }
}
}
}
diff --git a/flang/test/Semantics/structconst11.f90 b/flang/test/Semantics/structconst11.f90
new file mode 100644
index 0000000000000..8cf4e6a4cda29
--- /dev/null
+++ b/flang/test/Semantics/structconst11.f90
@@ -0,0 +1,89 @@
+!RUN: %flang_fc1 -fdebug-unparse %s | FileCheck %s
+program test
+
+ type t1p
+ type(t1p), pointer :: arr(:)
+ end type
+ type, extends(t1p) :: t1c
+ end type
+ type t2p
+ type(t2p), pointer :: scalar
+ end type
+ type, extends(t2p) :: t2c
+ end type
+ type t3p
+ type(t3p), allocatable :: arr(:)
+ end type
+ type, extends(t3p) :: t3c
+ end type
+ type t4p
+ type(t4p), allocatable :: scalar
+ end type
+ type, extends(t4p) :: t4c
+ end type
+ type t5p
+ class(*), pointer :: arr(:)
+ end type
+ type, extends(t5p) :: t5c
+ end type
+ type t6p
+ class(*), pointer :: scalar
+ end type
+ type, extends(t6p) :: t6c
+ end type
+ type t7p
+ class(*), allocatable :: arr(:)
+ end type
+ type, extends(t7p) :: t7c
+ end type
+ type t8p
+ class(*), allocatable :: scalar
+ end type
+ type, extends(t8p) :: t8c
+ end type
+
+ type(t1p), target :: t1pt(1)
+ type(t1p), pointer :: t1pp(:)
+ type(t2p), target :: t2pt
+ type(t2p), pointer :: t2pp
+ type(t3p) t3pa(1)
+ type(t4p) t4ps
+
+ type(t1c) x1
+ type(t2c) x2
+ type(t3c) x3
+ type(t4c) x4
+ type(t5c) x5
+ type(t6c) x6
+ type(t7c) x7
+ type(t8c) x8
+
+!CHECK: x1=t1c(arr=t1pt)
+ x1 = t1c(t1pt)
+!CHECK: x1=t1c(arr=t1pp)
+ x1 = t1c(t1pp)
+!CHECK: x2=t2c(scalar=t2pt)
+ x2 = t2c(t2pt)
+!CHECK: x2=t2c(scalar=t2pp)
+ x2 = t2c(t2pp)
+!CHECK: x3=t3c(arr=t3pa)
+ x3 = t3c(t3pa)
+!CHECK: x4=t4c(scalar=t4ps)
+ x4 = t4c(t4ps)
+!CHECK: x4=t4c(scalar=t4p(scalar=NULL()))
+ x4 = t4c(t4p())
+!CHECK: x5=t5c(arr=t1pt)
+ x5 = t5c(t1pt)
+!CHECK: x5=t5c(arr=t1pp)
+ x5 = t5c(t1pp)
+!CHECK: x6=t6c(scalar=t2pt)
+ x6 = t6c(t2pt)
+!CHECK: x6=t6c(scalar=t2pp)
+ x6 = t6c(t2pp)
+!CHECK: x7=t7c(arr=t3pa)
+ x7 = t7c(t3pa)
+!CHECK: x8=t8c(scalar=t4ps)
+ x8 = t8c(t4ps)
+!CHECK: x8=t8c(scalar=t4p(scalar=NULL()))
+ x8 = t8c(t4p())
+end
More information about the flang-commits
mailing list