[flang-commits] [flang] 10cc4a5 - [flang] More support for anonymous parent components in struct constr… (#102642)

[via flang-commits]

Author: Peter Klausler
Date: 2024-08-20T12:02:52-07:00
New Revision: 10cc4a5fab3ad8da7a64ba784007b99a039134c1

URL: https://github.com/llvm/llvm-project/commit/10cc4a5fab3ad8da7a64ba784007b99a039134c1
DIFF: https://github.com/llvm/llvm-project/commit/10cc4a5fab3ad8da7a64ba784007b99a039134c1.diff

LOG: [flang] More support for anonymous parent components in struct constr… (#102642)

…uctors

A non-conforming extension to Fortran present in a couple other
compilers is allowing a anonymous component in a structure constructor
to initialize a parent (or greater ancestor) component. This was working
in this compiler only for direct parents, and only when the type was not
use-associated.

Fixes https://github.com/llvm/llvm-project/issues/102557.

Added: 
    flang/test/Semantics/structconst10.f90

Modified: 
    flang/lib/Semantics/expression.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 4f1c53f1bb53fc..4f8632a2055d99 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -2015,6 +2015,15 @@ MaybeExpr ExpressionAnalyzer::Analyze(
   // initialize X or A by name, but not both.
   auto components{semantics::OrderedComponentIterator{spec}};
   auto nextAnonymous{components.begin()};
+  auto afterLastParentComponentIter{components.end()};
+  if (parentComponent) {
+    for (auto iter{components.begin()}; iter != components.end(); ++iter) {
+      if (iter->test(Symbol::Flag::ParentComp)) {
+        afterLastParentComponentIter = iter;
+        ++afterLastParentComponentIter;
+      }
+    }
+  }
 
   std::set<parser::CharBlock> unavailable;
   bool anyKeyword{false};
@@ -2060,20 +2069,22 @@ MaybeExpr ExpressionAnalyzer::Analyze(
       }
       // Here's a regrettably common extension of the standard: anonymous
       // initialization of parent components, e.g., T(PT(1)) rather than
-      // T(1) or T(PT=PT(1)).
-      if (nextAnonymous == components.begin() && parentComponent &&
-          valueType == DynamicType::From(*parentComponent) &&
+      // T(1) or T(PT=PT(1)).  There may be multiple parent components.
+      if (nextAnonymous == components.begin() && parentComponent && valueType &&
           context().IsEnabled(LanguageFeature::AnonymousParents)) {
-        auto iter{
-            std::find(components.begin(), components.end(), *parentComponent)};
-        if (iter != components.end()) {
-          symbol = parentComponent;
-          nextAnonymous = ++iter;
-          if (context().ShouldWarn(LanguageFeature::AnonymousParents)) {
-            Say(source,
-                "Whole parent component '%s' in structure "
-                "constructor should not be anonymous"_port_en_US,
-                symbol->name());
+        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;
+            if (context().ShouldWarn(LanguageFeature::AnonymousParents)) {
+              Say(source,
+                  "Whole parent component '%s' in structure constructor should not be anonymous"_port_en_US,
+                  symbol->name());
+            }
+            break;
           }
         }
       }

diff  --git a/flang/test/Semantics/structconst10.f90 b/flang/test/Semantics/structconst10.f90
new file mode 100644
index 00000000000000..582f8fc15704f4
--- /dev/null
+++ b/flang/test/Semantics/structconst10.f90
@@ -0,0 +1,25 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic -Werror
+module m1
+  type a1
+     integer ::x1=1
+  end type a1
+  type,extends(a1)::a2
+     integer ::x2=3
+  end type a2
+  type,extends(a2)::a3
+     integer   ::x3=3
+  end type a3
+end module m1
+
+program test
+  use m1
+  type(a3) v
+  !PORTABILITY: Whole parent component 'a2' in structure constructor should not be anonymous
+  v=a3(a2(x1=18,x2=6),x3=6)
+  !PORTABILITY: Whole parent component 'a1' in structure constructor should not be anonymous
+  v=a3(a1(x1=18),x2=6,x3=6)
+  !PORTABILITY: Whole parent component 'a2' in structure constructor should not be anonymous
+  !PORTABILITY: Whole parent component 'a1' in structure constructor should not be anonymous
+  v=a3(a2(a1(x1=18),x2=6),x3=6)
+  v=a3(a2=a2(a1=a1(x1=18),x2=6),x3=6) ! ok
+end