[flang-commits] [flang] bca1317 - [flang] Accept structure constructor value for polymorphic component

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2022-02-14T16:00:34-08:00
New Revision: bca13174bc77e7a986bfaba6c384073b4e9fa8cf

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

LOG: [flang] Accept structure constructor value for polymorphic component

Semantic analysis was emitting a bogus error message when a structure
constructor contains a monomorphic value for a (limited) polymorphic
component of a derived type.  The type compatibility test was too
strict; this patch relaxes it a little to allow values that could
be assigned or passed to a variable or dummy argument with that type.
Also add some quotes to an error message that was sometimes confusing
without them, and remove a repeated space character from another.

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

Added: 
    

Modified: 
    flang/lib/Evaluate/tools.cpp
    flang/lib/Semantics/expression.cpp
    flang/test/Semantics/data02.f90
    flang/test/Semantics/structconst01.f90
    flang/test/Semantics/structconst02.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 00b9769befe85..65dd5e938d07d 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -653,7 +653,9 @@ std::optional<Expr<SomeType>> ConvertToType(
     break;
   case TypeCategory::Derived:
     if (auto fromType{x.GetType()}) {
-      if (type == *fromType) {
+      if (type.IsTkCompatibleWith(*fromType)) {
+        // "x" could be assigned or passed to "type", or appear in a
+        // structure constructor as a value for a component with "type"
         return std::move(x);
       }
     }

diff  --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 405ca251fa86b..409ece4be110c 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -1754,8 +1754,8 @@ MaybeExpr ExpressionAnalyzer::Analyze(
           } else if (valueType) {
             AttachDeclaration(
                 Say(expr.source,
-                    "Value in structure constructor of type %s is "
-                    "incompatible with component '%s' of type %s"_err_en_US,
+                    "Value in structure constructor of type '%s' is "
+                    "incompatible with component '%s' of type '%s'"_err_en_US,
                     valueType->AsFortran(), symbol->name(),
                     symType->AsFortran()),
                 *symbol);
@@ -1763,7 +1763,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(
             AttachDeclaration(
                 Say(expr.source,
                     "Value in structure constructor is incompatible with "
-                    " component '%s' of type %s"_err_en_US,
+                    "component '%s' of type %s"_err_en_US,
                     symbol->name(), symType->AsFortran()),
                 *symbol);
           }

diff  --git a/flang/test/Semantics/data02.f90 b/flang/test/Semantics/data02.f90
index 11235a751c732..e98343f8aea23 100644
--- a/flang/test/Semantics/data02.f90
+++ b/flang/test/Semantics/data02.f90
@@ -6,7 +6,7 @@ subroutine s1
     character(1) :: c
   end type
   type(t) :: x
-  !ERROR: Value in structure constructor of type INTEGER(4) is incompatible with component 'c' of type CHARACTER(KIND=1,LEN=1_8)
+  !ERROR: Value in structure constructor of type 'INTEGER(4)' is incompatible with component 'c' of type 'CHARACTER(KIND=1,LEN=1_8)'
   data x /t(1)/
 end
 

diff  --git a/flang/test/Semantics/structconst01.f90 b/flang/test/Semantics/structconst01.f90
index f27dfa1a52528..7df6cfc4231ef 100644
--- a/flang/test/Semantics/structconst01.f90
+++ b/flang/test/Semantics/structconst01.f90
@@ -73,11 +73,18 @@ subroutine polycomponent
       class(*), allocatable :: p
     end type poly
     type(poly) :: x
+    type :: poly2
+      class(type1(1)), allocatable :: p1
+      type(type1(1)), allocatable :: p2
+    end type poly2
+    type(type1(1)) :: t1val
+    type(poly2) :: x2
     ! 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(*)
+    x2 = poly2(t1val, t1val)
+    !ERROR: Value in structure constructor is incompatible with component 'p' of type CLASS(*)
     x = poly(z'feedface')
   end subroutine
 end module module1

diff  --git a/flang/test/Semantics/structconst02.f90 b/flang/test/Semantics/structconst02.f90
index c3494b2e2261c..e5ccc0f005df3 100644
--- a/flang/test/Semantics/structconst02.f90
+++ b/flang/test/Semantics/structconst02.f90
@@ -32,9 +32,9 @@ subroutine errors
 !    call scalararg(scalar(4)(5.,6,(7._8,8._2),4_'b',.true._4))
     call scalararg(scalar(4)(ix=5.,rx=6,zx=(7._8,8._2),cx=4_'b',lx=.true.))
     call scalararg(scalar(4)(5.,6,(7._8,8._2),4_'b',.true.))
-    !ERROR: Value in structure constructor of type CHARACTER(1) is incompatible with component 'ix' of type INTEGER(4)
+    !ERROR: Value in structure constructor of type 'CHARACTER(1)' is incompatible with component 'ix' of type 'INTEGER(4)'
     call scalararg(scalar(4)(ix='a'))
-    !ERROR: Value in structure constructor of type LOGICAL(4) is incompatible with component 'ix' of type INTEGER(4)
+    !ERROR: Value in structure constructor of type 'LOGICAL(4)' is incompatible with component 'ix' of type 'INTEGER(4)'
     call scalararg(scalar(4)(ix=.false.))
     !ERROR: Rank-1 array value is not compatible with scalar component 'ix'
     call scalararg(scalar(4)(ix=[1]))