[flang-commits] [flang] 0c64cb6 - [flang] Fix a crash when an array constructor contains an unlimited polymorphic value

[Pete Steinfeld via flang-commits]

Author: Pete Steinfeld
Date: 2020-07-14T15:22:33-07:00
New Revision: 0c64cb6d08964b576cd95f5532ea4016fcd27943

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

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

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.

Reviewers: klausler, tskeith, DavidTruby

Subscribers: llvm-commits

Tags: #llvm

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

Added: 
    

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

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index f22f8a966924..4cb43a91ef09 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -1159,8 +1159,12 @@ class ArrayConstructorContext {
   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()}) {
@@ -1295,6 +1299,13 @@ void ArrayConstructorContext::Add(const parser::AcValue &x) {
             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));
             }
           },

diff  --git a/flang/test/Semantics/resolve70.f90 b/flang/test/Semantics/resolve70.f90
index 564805a12408..d86016e76f9d 100644
--- a/flang/test/Semantics/resolve70.f90
+++ b/flang/test/Semantics/resolve70.f90
@@ -57,3 +57,19 @@ subroutine s1()
   !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