[flang] Accept structure constructor value for polymorphic component

[klausler]

Summary

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.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/lib/Evaluate/tools.cpp

std::optional<Expr<SomeType>> ConvertToType(
   case TypeCategory::Logical:
     if (auto *cx{UnwrapExpr<Expr<SomeLogical>>(x)}) {
       return Expr<SomeType>{
           ConvertToKind<TypeCategory::Logical>(type.kind(), std::move(*cx))};
     }
     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);
       }
     }
     break;
   }
   return std::nullopt;
 }
 

flang/lib/Semantics/expression.cpp

if (symbol) {
           // NULL() with no arguments allowed by 7.5.10 para 6 for ALLOCATABLE
         } else if (auto symType{DynamicType::From(symbol)}) {
           if (IsAllocatable(*symbol) && symType->IsUnlimitedPolymorphic() &&
               valueType) {
             // ok
           } 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);
           } else {
             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);
           }
         }
       }
     }
   }
 

flang/test/Semantics/data02.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! Check that expressions are analyzed in data statements
 
 subroutine s1
   type :: t
     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
 
 subroutine s2
   real :: x1, x2
   integer :: i1, i2
   !ERROR: Unsupported REAL(KIND=99)
   data x1 /1.0_99/

flang/test/Semantics/structconst01.f90

subroutine errors
     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
+    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

flang/test/Semantics/structconst02.f90

contains
   end subroutine scalararg
   subroutine errors
     call scalararg(scalar(4)(ix=1,rx=2.,zx=(3.,4.),cx='a',lx=.true.))
     call scalararg(scalar(4)(1,2.,(3.,4.),'a',.true.))
 !    call scalararg(scalar(4)(ix=5.,rx=6,zx=(7._8,8._2),cx=4_'b',lx=.true._4))
 !    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]))
     !TODO more!
   end subroutine errors
 end module module1