[flang] Graceful handling of failure in LEN() (fixes crashes)
authorpeter klausler <pklausler@nvidia.com>
Wed, 3 Jul 2019 17:25:43 +0000 (10:25 -0700)
committerpeter klausler <pklausler@nvidia.com>
Wed, 3 Jul 2019 17:27:50 +0000 (10:27 -0700)
Original-commit: flang-compiler/f18@8bab36574dd9b926f1e425559c69ba2b07fb8308
Reviewed-on: https://github.com/flang-compiler/f18/pull/545

13 files changed:
flang/documentation/Extensions.md
flang/lib/evaluate/call.cc
flang/lib/evaluate/call.h
flang/lib/evaluate/descender.h
flang/lib/evaluate/expression.cc
flang/lib/evaluate/expression.h
flang/lib/evaluate/fold.cc
flang/lib/evaluate/intrinsics.cc
flang/lib/evaluate/variable.cc
flang/lib/evaluate/variable.h
flang/lib/semantics/expression.cc
flang/lib/semantics/resolve-names.cc
flang/test/semantics/symbol11.f90

index 6fc76e3..bf744a7 100644 (file)
@@ -103,8 +103,6 @@ Extensions and legacy features deliberately not supported
 * ALLOCATE(TYPE(derived)::...) as variant of correct ALLOCATE(derived::...) (PGI only)
 * Defining an explicit interface for a subprogram within itself (PGI only)
 * USE association of a procedure interface within that same procedure's definition
-* After "TYPE,EXTENDS(T1)::T2;...", the nonstandard structure constructor
-  T2(T1(x)) is accepted by PGI/GNU/Intel.  Use T2(T1=T1(x)) or T2(x) instead.
 * NULL() as a structure constructor expression for an ALLOCATABLE component (PGI).
 * Conversion of LOGICAL to INTEGER.
 * IF (integer expression) THEN ... END IF  (PGI/Intel)
@@ -112,3 +110,4 @@ Extensions and legacy features deliberately not supported
 * Procedure pointers in COMMON blocks (PGI/Intel)
 * Underindexing multi-dimensional arrays (e.g., A(1) rather than A(1,1)) (PGI only)
 * Legacy PGI `NCHARACTER` type and `NC` Kanji character literals
+* Using non-integer expressions for array bounds (e.g., A(3.14159)) (PGI/Intel)
index 9b3db13..59e9ad1 100644 (file)
@@ -155,7 +155,7 @@ std::string ProcedureDesignator::GetName() const {
       u);
 }
 
-Expr<SubscriptInteger> ProcedureRef::LEN() const {
+std::optional<Expr<SubscriptInteger>> ProcedureRef::LEN() const {
   if (const auto *intrinsic{std::get_if<SpecificIntrinsic>(&proc_.u)}) {
     if (intrinsic->name == "repeat") {
       // LEN(REPEAT(ch,n)) == LEN(ch) * n
@@ -165,18 +165,14 @@ Expr<SubscriptInteger> ProcedureRef::LEN() const {
       const auto *nCopiesArg{
           UnwrapExpr<Expr<SomeInteger>>(arguments_[1].value())};
       CHECK(stringArg != nullptr && nCopiesArg != nullptr);
-      auto stringLen{stringArg->LEN()};
-      return std::move(stringLen) *
-          ConvertTo(stringLen, common::Clone(*nCopiesArg));
-    }
-    if (intrinsic->name == "trim") {
-      // LEN(TRIM(ch)) is unknown without execution.
-      CHECK(arguments_.size() == 1);
-      const auto *stringArg{
-          UnwrapExpr<Expr<SomeCharacter>>(arguments_[0].value())};
-      CHECK(stringArg != nullptr);
-      return stringArg->LEN();
+      if (auto stringLen{stringArg->LEN()}) {
+        auto converted{ConvertTo(*stringLen, common::Clone(*nCopiesArg))};
+        return *std::move(stringLen) * std::move(converted);
+      }
     }
+    // Some other cases (e.g., LEN(CHAR(...))) are handled in
+    // ProcedureDesignator::LEN() because they're independent of the
+    // lengths of the actual arguments.
   }
   return proc_.LEN();
 }
index 74785da..6bcf808 100644 (file)
@@ -152,7 +152,7 @@ struct ProcedureDesignator {
   std::optional<DynamicType> GetType() const;
   int Rank() const;
   bool IsElemental() const;
-  Expr<SubscriptInteger> LEN() const;
+  std::optional<Expr<SubscriptInteger>> LEN() const;
   std::ostream &AsFortran(std::ostream &) const;
 
   // TODO: When calling X%F, pass X as PASS argument unless NOPASS
@@ -172,7 +172,7 @@ public:
   ActualArguments &arguments() { return arguments_; }
   const ActualArguments &arguments() const { return arguments_; }
 
-  Expr<SubscriptInteger> LEN() const;
+  std::optional<Expr<SubscriptInteger>> LEN() const;
   int Rank() const { return proc_.Rank(); }
   bool IsElemental() const { return proc_.IsElemental(); }
   bool operator==(const ProcedureRef &) const;
index 3746bdb..69497f3 100644 (file)
@@ -308,9 +308,10 @@ public:
     auto lx{ss.lower()};
     Visit(lx);
     ss.set_lower(std::move(lx));
-    auto ux{ss.upper()};
-    Visit(ux);
-    ss.set_lower(std::move(ux));
+    if (auto ux{ss.upper()}) {
+      Visit(ux);
+      ss.set_upper(std::move(*ux));
+    }
   }
 
   template<typename T> void Descend(const Designator<T> &designator) {
index 944f460..7a91f37 100644 (file)
@@ -27,28 +27,40 @@ using namespace Fortran::parser::literals;
 namespace Fortran::evaluate {
 
 template<int KIND>
-Expr<SubscriptInteger> Expr<Type<TypeCategory::Character, KIND>>::LEN() const {
+std::optional<Expr<SubscriptInteger>>
+Expr<Type<TypeCategory::Character, KIND>>::LEN() const {
+  using T = std::optional<Expr<SubscriptInteger>>;
   return std::visit(
       common::visitors{
-          [](const Constant<Result> &c) {
+          [](const Constant<Result> &c) -> T {
             return AsExpr(Constant<SubscriptInteger>{c.LEN()});
           },
-          [](const ArrayConstructor<Result> &a) { return a.LEN(); },
+          [](const ArrayConstructor<Result> &a) -> T { return a.LEN(); },
           [](const Parentheses<Result> &x) { return x.left().LEN(); },
           [](const Convert<Result> &x) {
             return std::visit(
                 [&](const auto &kx) { return kx.LEN(); }, x.left().u);
           },
-          [](const Concat<KIND> &c) {
-            return c.left().LEN() + c.right().LEN();
+          [](const Concat<KIND> &c) -> T {
+            if (auto llen{c.left().LEN()}) {
+              if (auto rlen{c.right().LEN()}) {
+                return *std::move(llen) + *std::move(rlen);
+              }
+            }
+            return std::nullopt;
           },
-          [](const Extremum<Result> &c) {
-            return Expr<SubscriptInteger>{
-                Extremum<SubscriptInteger>{c.left().LEN(), c.right().LEN()}};
+          [](const Extremum<Result> &c) -> T {
+            if (auto llen{c.left().LEN()}) {
+              if (auto rlen{c.right().LEN()}) {
+                return Expr<SubscriptInteger>{Extremum<SubscriptInteger>{
+                    *std::move(llen), *std::move(rlen)}};
+              }
+            }
+            return std::nullopt;
           },
           [](const Designator<Result> &dr) { return dr.LEN(); },
           [](const FunctionRef<Result> &fr) { return fr.LEN(); },
-          [](const SetLength<KIND> &x) { return x.right(); },
+          [](const SetLength<KIND> &x) -> T { return x.right(); },
       },
       u);
 }
@@ -175,7 +187,7 @@ int Expr<SomeCharacter>::GetKind() const {
       u);
 }
 
-Expr<SubscriptInteger> Expr<SomeCharacter>::LEN() const {
+std::optional<Expr<SubscriptInteger>> Expr<SomeCharacter>::LEN() const {
   return std::visit([](const auto &kx) { return kx.LEN(); }, u);
 }
 
index 1c43c1d..636ba1e 100644 (file)
@@ -502,7 +502,8 @@ public:
   ArrayConstructor(Expr<SubscriptInteger> &&len, Base &&v)
     : Base{std::move(v)}, length_{std::move(len)} {}
   template<typename A>
-  explicit ArrayConstructor(const A &prototype) : length_{prototype.LEN()} {}
+  explicit ArrayConstructor(const A &prototype)
+    : length_{prototype.LEN().value()} {}
   bool operator==(const ArrayConstructor &) const;
   static constexpr Result result() { return Result{}; }
   static constexpr DynamicType GetType() { return Result::GetType(); }
@@ -624,7 +625,7 @@ public:
   explicit Expr(const Scalar<Result> &x) : u{Constant<Result>{x}} {}
   explicit Expr(Scalar<Result> &&x) : u{Constant<Result>{std::move(x)}} {}
 
-  Expr<SubscriptInteger> LEN() const;
+  std::optional<Expr<SubscriptInteger>> LEN() const;
 
   std::variant<Constant<Result>, ArrayConstructor<Result>, Designator<Result>,
       FunctionRef<Result>, Parentheses<Result>, Convert<Result>, Concat<KIND>,
@@ -794,7 +795,7 @@ public:
   using Result = SomeCharacter;
   EVALUATE_UNION_CLASS_BOILERPLATE(Expr)
   int GetKind() const;
-  Expr<SubscriptInteger> LEN() const;
+  std::optional<Expr<SubscriptInteger>> LEN() const;
   common::MapTemplate<Expr, CategoryTypes<TypeCategory::Character>> u;
 };
 
index 950cc9b..a3b86d0 100644 (file)
@@ -487,7 +487,13 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldOperation(FoldingContext &context,
     } else if (name == "len") {
       if (auto *charExpr{UnwrapExpr<Expr<SomeCharacter>>(args[0])}) {
         return std::visit(
-            [&](auto &kx) { return Fold(context, ConvertToType<T>(kx.LEN())); },
+            [&](auto &kx) {
+              if (auto len{kx.LEN()}) {
+                return Fold(context, ConvertToType<T>(*std::move(len)));
+              } else {
+                return Expr<T>{std::move(funcRef)};
+              }
+            },
             charExpr->u);
       } else {
         common::die("len() argument must be of character type");
index 786a1f2..4c96170 100644 (file)
@@ -772,9 +772,9 @@ static const SpecificIntrinsicInterface specificIntrinsicFunction[]{
     {{"idnint", {{"a", DoublePrecision}}, DefaultInt}, "nint"},
     {{"ifix", {{"a", DefaultReal}}, DefaultInt}, "int", true},
     {{"index", {{"string", DefaultChar}, {"substring", DefaultChar}},
-        DefaultInt}},
+        SubscriptInt}},
     {{"isign", {{"a", DefaultInt}, {"b", DefaultInt}}, DefaultInt}, "sign"},
-    {{"len", {{"string", DefaultChar, Rank::anyOrAssumedRank}}, DefaultInt,
+    {{"len", {{"string", DefaultChar, Rank::anyOrAssumedRank}}, SubscriptInt,
         Rank::scalar}},
     {{"lge", {{"string_a", DefaultChar}, {"string_b", DefaultChar}},
         DefaultLogical}},
index 9b868e6..8e187b4 100644 (file)
@@ -149,14 +149,15 @@ Substring &Substring::set_lower(Expr<SubscriptInteger> &&expr) {
   return *this;
 }
 
-Expr<SubscriptInteger> Substring::upper() const {
+std::optional<Expr<SubscriptInteger>> Substring::upper() const {
   if (upper_.has_value()) {
     return upper_.value().value();
   } else {
     return std::visit(
         common::visitors{
             [](const DataRef &dataRef) { return dataRef.LEN(); },
-            [](const StaticDataObject::Pointer &object) {
+            [](const StaticDataObject::Pointer &object)
+                -> std::optional<Expr<SubscriptInteger>> {
               return AsExpr(Constant<SubscriptInteger>{object->data().size()});
             },
         },
@@ -259,36 +260,46 @@ DescriptorInquiry::DescriptorInquiry(NamedEntity &&base, Field field, int dim)
 }
 
 // LEN()
-static Expr<SubscriptInteger> SymbolLEN(const Symbol &sym) {
-  return AsExpr(Constant<SubscriptInteger>{0});  // TODO
+static std::optional<Expr<SubscriptInteger>> SymbolLEN(const Symbol &sym) {
+  if (auto dyType{DynamicType::From(sym)}) {
+    if (const semantics::ParamValue * len{dyType->charLength()}) {
+      if (auto intExpr{len->GetExplicit()}) {
+        return ConvertToType<SubscriptInteger>(*std::move(intExpr));
+      }
+    }
+  }
+  return std::nullopt;
 }
 
-Expr<SubscriptInteger> BaseObject::LEN() const {
+std::optional<Expr<SubscriptInteger>> BaseObject::LEN() const {
   return std::visit(
       common::visitors{
           [](const Symbol *symbol) { return SymbolLEN(*symbol); },
-          [](const StaticDataObject::Pointer &object) {
+          [](const StaticDataObject::Pointer &object)
+              -> std::optional<Expr<SubscriptInteger>> {
             return AsExpr(Constant<SubscriptInteger>{object->data().size()});
           },
       },
       u);
 }
 
-Expr<SubscriptInteger> Component::LEN() const {
+std::optional<Expr<SubscriptInteger>> Component::LEN() const {
   return SymbolLEN(GetLastSymbol());
 }
 
-Expr<SubscriptInteger> NamedEntity::LEN() const {
+std::optional<Expr<SubscriptInteger>> NamedEntity::LEN() const {
   return SymbolLEN(GetLastSymbol());
 }
 
-Expr<SubscriptInteger> ArrayRef::LEN() const { return base_.LEN(); }
+std::optional<Expr<SubscriptInteger>> ArrayRef::LEN() const {
+  return base_.LEN();
+}
 
-Expr<SubscriptInteger> CoarrayRef::LEN() const {
+std::optional<Expr<SubscriptInteger>> CoarrayRef::LEN() const {
   return SymbolLEN(GetLastSymbol());
 }
 
-Expr<SubscriptInteger> DataRef::LEN() const {
+std::optional<Expr<SubscriptInteger>> DataRef::LEN() const {
   return std::visit(
       common::visitors{
           [](const Symbol *s) { return SymbolLEN(*s); },
@@ -297,40 +308,47 @@ Expr<SubscriptInteger> DataRef::LEN() const {
       u);
 }
 
-Expr<SubscriptInteger> Substring::LEN() const {
-  return AsExpr(
-      Extremum<SubscriptInteger>{AsExpr(Constant<SubscriptInteger>{0}),
-          upper() - lower() + AsExpr(Constant<SubscriptInteger>{1})});
+std::optional<Expr<SubscriptInteger>> Substring::LEN() const {
+  if (auto top{upper()}) {
+    return AsExpr(
+        Extremum<SubscriptInteger>{AsExpr(Constant<SubscriptInteger>{0}),
+            *std::move(top) - lower() + AsExpr(Constant<SubscriptInteger>{1})});
+  } else {
+    return std::nullopt;
+  }
 }
 
-template<typename T> Expr<SubscriptInteger> Designator<T>::LEN() const {
-  if constexpr (Result::category == TypeCategory::Character) {
+template<typename T>
+std::optional<Expr<SubscriptInteger>> Designator<T>::LEN() const {
+  if constexpr (T::category == TypeCategory::Character) {
     return std::visit(
         common::visitors{
             [](const Symbol *s) { return SymbolLEN(*s); },
-            [](const Component &c) { return c.LEN(); },
             [](const auto &x) { return x.LEN(); },
         },
         u);
   } else {
-    CHECK(!"LEN() on non-character Designator");
-    return AsExpr(Constant<SubscriptInteger>{0});
+    common::die("Designator<non-char>::LEN() called");
+    return std::nullopt;
   }
 }
 
-Expr<SubscriptInteger> ProcedureDesignator::LEN() const {
-  // TODO: this needs more thought for assumed-length
-  // character functions, intrinsics, &c.
+std::optional<Expr<SubscriptInteger>> ProcedureDesignator::LEN() const {
+  using T = std::optional<Expr<SubscriptInteger>>;
   return std::visit(
       common::visitors{
-          [](const Symbol *s) { return SymbolLEN(*s); },
-          [](const common::CopyableIndirection<Component> &c) {
+          [](const Symbol *s) -> T { return SymbolLEN(*s); },
+          [](const common::CopyableIndirection<Component> &c) -> T {
             return c.value().LEN();
           },
-          [](const auto &) {
-            // TODO: intrinsics
-            CRASH_NO_CASE;
-            return AsExpr(Constant<SubscriptInteger>{0});
+          [](const SpecificIntrinsic &i) -> T {
+            if (i.name == "char") {
+              return Expr<SubscriptInteger>{1};
+            }
+            // Some other cases whose results' lengths can be determined
+            // from the lengths of their arguments are handled in
+            // ProcedureRef::LEN().
+            return std::nullopt;
           },
       },
       u);
index 47afff0..e8feb9a 100644 (file)
@@ -53,7 +53,7 @@ struct BaseObject {
   explicit BaseObject(const Symbol &symbol) : u{&symbol} {}
   explicit BaseObject(StaticDataObject::Pointer &&p) : u{std::move(p)} {}
   int Rank() const;
-  Expr<SubscriptInteger> LEN() const;
+  std::optional<Expr<SubscriptInteger>> LEN() const;
   bool operator==(const BaseObject &) const;
   std::ostream &AsFortran(std::ostream &) const;
   const Symbol *symbol() const {
@@ -86,7 +86,7 @@ public:
   int Rank() const;
   const Symbol &GetFirstSymbol() const;
   const Symbol &GetLastSymbol() const { return *symbol_; }
-  Expr<SubscriptInteger> LEN() const;
+  std::optional<Expr<SubscriptInteger>> LEN() const;
   bool operator==(const Component &) const;
   std::ostream &AsFortran(std::ostream &) const;
 
@@ -114,7 +114,7 @@ public:
   Component *UnwrapComponent();
 
   int Rank() const;
-  Expr<SubscriptInteger> LEN() const;
+  std::optional<Expr<SubscriptInteger>> LEN() const;
   bool operator==(const NamedEntity &) const;
   std::ostream &AsFortran(std::ostream &) const;
 
@@ -219,7 +219,7 @@ public:
   int Rank() const;
   const Symbol &GetFirstSymbol() const;
   const Symbol &GetLastSymbol() const;
-  Expr<SubscriptInteger> LEN() const;
+  std::optional<Expr<SubscriptInteger>> LEN() const;
   bool operator==(const ArrayRef &) const;
   std::ostream &AsFortran(std::ostream &) const;
 
@@ -267,7 +267,7 @@ public:
   const Symbol &GetFirstSymbol() const;
   const Symbol &GetLastSymbol() const;
   NamedEntity GetBase() const;
-  Expr<SubscriptInteger> LEN() const;
+  std::optional<Expr<SubscriptInteger>> LEN() const;
   bool operator==(const CoarrayRef &) const;
   std::ostream &AsFortran(std::ostream &) const;
 
@@ -291,7 +291,7 @@ struct DataRef {
   int Rank() const;
   const Symbol &GetFirstSymbol() const;
   const Symbol &GetLastSymbol() const;
-  Expr<SubscriptInteger> LEN() const;
+  std::optional<Expr<SubscriptInteger>> LEN() const;
   std::ostream &AsFortran(std::ostream &) const;
 
   std::variant<const Symbol *, Component, ArrayRef, CoarrayRef> u;
@@ -320,7 +320,7 @@ public:
 
   Expr<SubscriptInteger> lower() const;
   Substring &set_lower(Expr<SubscriptInteger> &&);
-  Expr<SubscriptInteger> upper() const;
+  std::optional<Expr<SubscriptInteger>> upper() const;
   Substring &set_upper(Expr<SubscriptInteger> &&);
   const Parent &parent() const { return parent_; }
   Parent &parent() { return parent_; }
@@ -331,7 +331,7 @@ public:
   }
   BaseObject GetBaseObject() const;
   const Symbol *GetLastSymbol() const;
-  Expr<SubscriptInteger> LEN() const;
+  std::optional<Expr<SubscriptInteger>> LEN() const;
   bool operator==(const Substring &) const;
   std::ostream &AsFortran(std::ostream &) const;
 
@@ -393,7 +393,7 @@ public:
   int Rank() const;
   BaseObject GetBaseObject() const;
   const Symbol *GetLastSymbol() const;
-  Expr<SubscriptInteger> LEN() const;
+  std::optional<Expr<SubscriptInteger>> LEN() const;
   std::ostream &AsFortran(std::ostream &o) const;
 
   Variant u;
index 787fbd8..a328032 100644 (file)
@@ -699,8 +699,9 @@ MaybeExpr ExpressionAnalyzer::Analyze(
       GetSubstringBound(std::get<1>(range.t))};
   if (MaybeExpr string{Analyze(std::get<parser::CharLiteralConstant>(x.t))}) {
     if (auto *charExpr{std::get_if<Expr<SomeCharacter>>(&string->u)}) {
-      Expr<SubscriptInteger> length{std::visit(
-          [](const auto &ckExpr) { return ckExpr.LEN(); }, charExpr->u)};
+      Expr<SubscriptInteger> length{
+          std::visit([](const auto &ckExpr) { return ckExpr.LEN().value(); },
+              charExpr->u)};
       if (!lower.has_value()) {
         lower = Expr<SubscriptInteger>{1};
       }
@@ -1149,8 +1150,10 @@ struct ArrayConstructorTypeVisitor {
             type.GetDerivedTypeSpec(), MakeSpecific<T>(std::move(values))});
       } else if (type.kind() == T::kind) {
         if constexpr (T::category == TypeCategory::Character) {
-          return AsMaybeExpr(ArrayConstructor<T>{
-              type.LEN().value(), MakeSpecific<T>(std::move(values))});
+          if (auto len{type.LEN()}) {
+            return AsMaybeExpr(ArrayConstructor<T>{
+                *std::move(len), MakeSpecific<T>(std::move(values))});
+          }
         } else {
           return AsMaybeExpr(
               ArrayConstructor<T>{MakeSpecific<T>(std::move(values))});
index 43c8f97..e576e4f 100644 (file)
@@ -970,7 +970,7 @@ private:
   void CheckRef(const std::optional<parser::Name> &);
   const DeclTypeSpec &ToDeclTypeSpec(evaluate::DynamicType &&);
   const DeclTypeSpec &ToDeclTypeSpec(
-      evaluate::DynamicType &&, SubscriptIntExpr &&length);
+      evaluate::DynamicType &&, MaybeSubscriptIntExpr &&length);
   Symbol *MakeAssocEntity();
   void SetTypeFromAssociation(Symbol &);
   void SetAttrsFromAssociation(Symbol &);
@@ -4334,10 +4334,15 @@ const DeclTypeSpec &ConstructVisitor::ToDeclTypeSpec(
 }
 
 const DeclTypeSpec &ConstructVisitor::ToDeclTypeSpec(
-    evaluate::DynamicType &&type, SubscriptIntExpr &&length) {
+    evaluate::DynamicType &&type, MaybeSubscriptIntExpr &&length) {
   CHECK(type.category() == common::TypeCategory::Character);
-  return currScope().MakeCharacterType(
-      ParamValue{SomeIntExpr{std::move(length)}}, KindExpr{type.kind()});
+  if (length.has_value()) {
+    return currScope().MakeCharacterType(
+        ParamValue{SomeIntExpr{*std::move(length)}}, KindExpr{type.kind()});
+  } else {
+    return currScope().MakeCharacterType(
+        ParamValue::Deferred(), KindExpr{type.kind()});
+  }
 }
 
 // ResolveNamesVisitor implementation
index e3586f2..c35f338 100644 (file)
@@ -49,7 +49,7 @@ subroutine s2
   print *, "z:", z
  end associate
  !TODO: need correct length for z
- !DEF: /s2/Block2/z AssocEntity CHARACTER(0_8,1)
+ !DEF: /s2/Block2/z AssocEntity CHARACTER(8_8,1)
  !REF: /s2/x
  !REF: /s2/y
  associate (z => x//y)