[flang-commits] [flang] [flang] Fix proc ptr default initializers in structure constructors (PR #178897)

[via flang-commits]

llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

<details>
<summary>Changes</summary>

The default initializers for procedure pointer components are not being used for unspecificed components in structure constructors.

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

---
Full diff: https://github.com/llvm/llvm-project/pull/178897.diff


2 Files Affected:

- (modified) flang/lib/Semantics/expression.cpp (+14-14) 
- (added) flang/test/Semantics/bug178813.f90 (+8) 


``````````diff
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 725188c623868..7735ab728b2a8 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -2419,22 +2419,22 @@ MaybeExpr ExpressionAnalyzer::CheckStructureConstructor(
   for (const Symbol &symbol : components) {
     if (!symbol.test(Symbol::Flag::ParentComp) &&
         unavailable.find(symbol.name()) == unavailable.cend()) {
-      if (IsAllocatable(symbol)) {
-        // Set all remaining allocatables to explicit NULL().
+      if (const auto *object{
+              symbol.detailsIf<semantics::ObjectEntityDetails>()};
+          object && object->init()) {
+        result.Add(symbol, common::Clone(*object->init()));
+      } else if (const auto *proc{
+                     symbol.detailsIf<semantics::ProcEntityDetails>()};
+          proc && proc->init() && *proc->init()) {
+        result.Add(symbol, Expr<SomeType>{ProcedureDesignator{**proc->init()}});
+      } else if (IsAllocatableOrPointer(symbol)) {
         result.Add(symbol, Expr<SomeType>{NullPointer{}});
       } else {
-        const auto *object{symbol.detailsIf<semantics::ObjectEntityDetails>()};
-        if (object && object->init()) {
-          result.Add(symbol, common::Clone(*object->init()));
-        } else if (IsPointer(symbol)) {
-          result.Add(symbol, Expr<SomeType>{NullPointer{}});
-        } else if (object) { // C799
-          AttachDeclaration(
-              Say(typeName,
-                  "Structure constructor lacks a value for component '%s'"_err_en_US,
-                  symbol.name()),
-              symbol);
-        }
+        AttachDeclaration(
+            Say(typeName,
+                "Structure constructor lacks a value for component '%s'"_err_en_US,
+                symbol.name()),
+            symbol);
       }
     }
   }
diff --git a/flang/test/Semantics/bug178813.f90 b/flang/test/Semantics/bug178813.f90
new file mode 100644
index 0000000000000..0ada9055702ef
--- /dev/null
+++ b/flang/test/Semantics/bug178813.f90
@@ -0,0 +1,8 @@
+!RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
+external s
+type t
+  procedure(), nopass, pointer :: p => s
+end type
+!CHECK: TYPE(t) :: x = t(p=s)
+type(t) :: x = t()
+end

``````````

</details>


https://github.com/llvm/llvm-project/pull/178897