Commit 0c64cb6d authored by Pete Steinfeld's avatar Pete Steinfeld
Browse files

[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
parent bef00b24

flang/lib/Semantics/expression.cpp

+13 −2
Original line number Diff line number Diff line
@@ -1159,8 +1159,12 @@ public: 
  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));

            }

          },

flang/test/Semantics/resolve70.f90

+16 −0
Original line number Diff line number Diff line
@@ -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