[flang-commits] [flang] 78d6009 - [flang] Deal with negative character lengths in semantics

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2021-11-17T09:49:15-08:00
New Revision: 78d60094c741ef96927424ad92d4ffcf4b025531

URL: https://github.com/llvm/llvm-project/commit/78d60094c741ef96927424ad92d4ffcf4b025531
DIFF: https://github.com/llvm/llvm-project/commit/78d60094c741ef96927424ad92d4ffcf4b025531.diff

LOG: [flang] Deal with negative character lengths in semantics

Fortran defines LEN(X) = 0 after CHARACTER(LEN=-1)::X so
apply MAX(0, ...) to character length expressions.

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

Added: 
    

Modified: 
    flang/include/flang/Evaluate/tools.h
    flang/lib/Evaluate/variable.cpp
    flang/lib/Semantics/runtime-type-info.cpp

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index a8e25df4e5f66..a3d70b6c46308 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -236,7 +236,7 @@ auto UnwrapConvertedExpr(B &x) -> common::Constify<A, B> * {
 // a pointer to the Symbol with TypeParamDetails.
 template <typename A> const Symbol *ExtractBareLenParameter(const A &expr) {
   if (const auto *typeParam{
-          evaluate::UnwrapConvertedExpr<evaluate::TypeParamInquiry>(expr)}) {
+          UnwrapConvertedExpr<evaluate::TypeParamInquiry>(expr)}) {
     if (!typeParam->base()) {
       const Symbol &symbol{typeParam->parameter()};
       if (const auto *tpd{symbol.detailsIf<semantics::TypeParamDetails>()}) {

diff  --git a/flang/lib/Evaluate/variable.cpp b/flang/lib/Evaluate/variable.cpp
index 6a9fced879e08..5885a41705f8e 100644
--- a/flang/lib/Evaluate/variable.cpp
+++ b/flang/lib/Evaluate/variable.cpp
@@ -264,14 +264,19 @@ static std::optional<Expr<SubscriptInteger>> SymbolLEN(const Symbol &symbol) {
     if (const auto *chExpr{UnwrapExpr<Expr<SomeCharacter>>(assoc->expr())}) {
       return chExpr->LEN();
     }
-  } else if (auto dyType{DynamicType::From(ultimate)}) {
+  }
+  if (auto dyType{DynamicType::From(ultimate)}) {
     if (auto len{dyType->GetCharLength()}) {
-      return len;
-    } else if (IsDescriptor(ultimate) && !ultimate.owner().IsDerivedType()) {
-      return Expr<SubscriptInteger>{DescriptorInquiry{
-          NamedEntity{symbol}, DescriptorInquiry::Field::Len}};
+      if (ultimate.owner().IsDerivedType() || IsScopeInvariantExpr(*len)) {
+        return AsExpr(Extremum<SubscriptInteger>{
+            Ordering::Greater, Expr<SubscriptInteger>{0}, std::move(*len)});
+      }
     }
   }
+  if (IsDescriptor(ultimate) && !ultimate.owner().IsDerivedType()) {
+    return Expr<SubscriptInteger>{
+        DescriptorInquiry{NamedEntity{symbol}, DescriptorInquiry::Field::Len}};
+  }
   return std::nullopt;
 }
 

diff  --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp
index bc6a889fa9d86..aa375a0ab74de 100644
--- a/flang/lib/Semantics/runtime-type-info.cpp
+++ b/flang/lib/Semantics/runtime-type-info.cpp
@@ -679,6 +679,14 @@ evaluate::StructureConstructor RuntimeTableBuilder::DescribeComponent(
     len = Fold(foldingContext, std::move(len));
   }
   if (dyType.category() == TypeCategory::Character && len) {
+    // Ignore IDIM(x) (represented as MAX(0, x))
+    if (const auto *clamped{evaluate::UnwrapExpr<
+            evaluate::Extremum<evaluate::SubscriptInteger>>(*len)}) {
+      if (clamped->ordering == evaluate::Ordering::Greater &&
+          clamped->left() == evaluate::Expr<evaluate::SubscriptInteger>{0}) {
+        len = clamped->right();
+      }
+    }
     AddValue(values, componentSchema_, "characterlen"s,
         evaluate::AsGenericExpr(GetValue(len, parameters)));
   } else {