[flang] Fix a crash when an array constructor contains an unlimited polymorphic value

[PeteSteinfeld]

Summary

C7113 States that "An ac-value shall not be unlimited polymorphic." We failed
to detect this situation which resulted in a crash when trying to get the
underlying derived type specification of the unlimited polymorphic value.

I added code to avoid the crash, code to emit an error message, and a test.

[klausler]

Looks great to me; thanks for the fix!

flang/lib/Semantics/expression.cpp

public:
   // These interfaces allow *this to be used as a type visitor argument to
   // common::SearchTypes() to convert the array constructor to a typed
   // expression in ToExpr().
   using Result = MaybeExpr;
   using Types = AllTypes;
   template <typename T> Result Test() {
     if (type_ && type_->category() == T::category) {
       if constexpr (T::category == TypeCategory::Derived) {
-        return AsMaybeExpr(ArrayConstructor<T>{
-            type_->GetDerivedTypeSpec(), MakeSpecific<T>(std::move(values_))});
+        if (type_->IsUnlimitedPolymorphic()) {
+          return std::nullopt;
+        } else {
+          return AsMaybeExpr(ArrayConstructor<T>{type_->GetDerivedTypeSpec(),
+              MakeSpecific<T>(std::move(values_))});
+        }
       } else if (type_->kind() == T::kind) {
         if constexpr (T::category == TypeCategory::Character) {
           if (auto len{type_->LEN()}) {
             return AsMaybeExpr(ArrayConstructor<T>{
                 *std::move(len), MakeSpecific<T>(std::move(values_))});
           }
         } else {
           return AsMaybeExpr(
std::visit(
               values_.Push(ImpliedDo<SomeType>{anonymous, std::move(*lower),
                   std::move(*upper), std::move(*stride), std::move(v)});
             }
           },
           [&](const common::Indirection<parser::Expr> &expr) {
             auto restorer{exprAnalyzer_.GetContextualMessages().SetLocation(
                 expr.value().source)};
             if (MaybeExpr v{exprAnalyzer_.Analyze(expr.value())}) {
+              if (auto exprType{v->GetType()}) {
+                if (exprType->IsUnlimitedPolymorphic()) {
+                  exprAnalyzer_.Say(
+                      "Cannot have an unlimited polymorphic value in an "
+                      "array constructor"_err_en_US);
+                }
+              }
               Push(std::move(*v));
             }
           },
           [&](const common::Indirection<parser::AcImpliedDo> &impliedDo) {
             const auto &control{
                 std::get<parser::AcImpliedDoControl>(impliedDo.value().t)};
             const auto &bounds{
                 std::get<parser::AcImpliedDoControl::Bounds>(control.t)};

flang/test/Semantics/resolve70.f90

subroutine s1()
   end type
 
   ! This one's OK
   class(extensible), allocatable :: y
 
   !ERROR: Non-extensible derived type 'inextensible' may not be used with CLASS keyword
   class(inextensible), allocatable :: x
 end subroutine s1
+
+subroutine s2()
+  type t
+    integer i
+  end type t
+  type, extends(t) :: t2
+    real x
+  end type t2
+contains
+  function f1(dummy)
+    class(*) dummy
+    type(t) f1(1)
+    !ERROR: Cannot have an unlimited polymorphic value in an array constructor
+    f1 = [ (dummy) ]
+  end function f1
+end subroutine s2