[flang-commits] [flang] bb59b38 - [flang] Any type can appear in a structure constructor for an unlimited polymorphic allocatable component

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2022-01-13T10:37:42-08:00
New Revision: bb59b38e87f86258f074bc14bff7e2b064ab048c

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

LOG: [flang] Any type can appear in a structure constructor for an unlimited polymorphic allocatable component

A bogus error message is appearing for structure constructors containing
values that correspond to unlimited polymorphic allocatable components.
A value of any type can actually be used.

Differential Revision: https://reviews.llvm.org/D117154

Added: 
    

Modified: 
    flang/lib/Semantics/expression.cpp
    flang/test/Semantics/structconst01.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 8ee8c9a9c9cea..cf4b5485362b4 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -1739,7 +1739,10 @@ MaybeExpr ExpressionAnalyzer::Analyze(
         } else if (IsAllocatable(*symbol) && IsBareNullPointer(&*value)) {
           // NULL() with no arguments allowed by 7.5.10 para 6 for ALLOCATABLE
         } else if (auto symType{DynamicType::From(symbol)}) {
-          if (valueType) {
+          if (IsAllocatable(*symbol) && symType->IsUnlimitedPolymorphic() &&
+              valueType) {
+            // ok
+          } else if (valueType) {
             AttachDeclaration(
                 Say(expr.source,
                     "Value in structure constructor of type %s is "

diff  --git a/flang/test/Semantics/structconst01.f90 b/flang/test/Semantics/structconst01.f90
index bdf400c777a97..f27dfa1a52528 100644
--- a/flang/test/Semantics/structconst01.f90
+++ b/flang/test/Semantics/structconst01.f90
@@ -66,5 +66,18 @@ subroutine errors
       k=2,m=3))
     !ERROR: ABSTRACT derived type 'abstract' may not be used in a structure constructor
     call abstractarg(abstract(0)(n=1))
+    !This case is ok
   end subroutine errors
+  subroutine polycomponent
+    type :: poly
+      class(*), allocatable :: p
+    end type poly
+    type(poly) :: x
+    ! These cases are not errors
+    x = poly(1)
+    x = poly('hello')
+    x = poly(type1(1)(123))
+    !ERROR: Value in structure constructor is incompatible with  component 'p' of type CLASS(*)
+    x = poly(z'feedface')
+  end subroutine
 end module module1