[flang] Diagnose known out-of-range subscripts in more circumstances

[klausler]

Summary

Semantics can catch out-of-range subscript values already when they
appear in DATA statement objects and constant folding of name constant
array indexing; this patch fills the gap by checking known constant
subscript values in other contexts.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/include/flang/Semantics/expression.h

public:
   explicit ExpressionAnalyzer(semantics::SemanticsContext &sc) : context_{sc} {}
   ExpressionAnalyzer(semantics::SemanticsContext &sc, FoldingContext &fc)
       : context_{sc}, foldingContext_{fc} {}
   ExpressionAnalyzer(const ExpressionAnalyzer &) = default;
 
   semantics::SemanticsContext &context() const { return context_; }
   bool inWhereBody() const { return inWhereBody_; }
   void set_inWhereBody(bool yes = true) { inWhereBody_ = yes; }
+  bool inDataStmtObject() const { return inDataStmtObject_; }
+  void set_inDataStmtObject(bool yes = true) { inDataStmtObject_ = yes; }
 
   FoldingContext &GetFoldingContext() const { return foldingContext_; }
 
   parser::ContextualMessages &GetContextualMessages() {
     return foldingContext_.messages();
   }
 
   template <typename... A> parser::Message *Say(A &&...args) {
private:
   std::optional<Subscript> AnalyzeSectionSubscript(
       const parser::SectionSubscript &);
   std::vector<Subscript> AnalyzeSectionSubscripts(
       const std::list<parser::SectionSubscript> &);
   std::optional<Component> CreateComponent(
       DataRef &&, const Symbol &, const semantics::Scope &);
   MaybeExpr CompleteSubscripts(ArrayRef &&);
   MaybeExpr ApplySubscripts(DataRef &&, std::vector<Subscript> &&);
+  void CheckConstantSubscripts(ArrayRef &);
   bool CheckRanks(const DataRef &); // Return false if error exists.
   bool CheckPolymorphic(const DataRef &); // ditto
   bool CheckDataRef(const DataRef &); // ditto
   std::optional<Expr<SubscriptInteger>> GetSubstringBound(
       const std::optional<parser::ScalarIntExpr> &);
   MaybeExpr AnalyzeDefinedOp(const parser::Name &, ActualArguments &&);
   MaybeExpr FixMisparsedSubstring(const parser::Designator &);
 
private:
 
   semantics::SemanticsContext &context_;
   FoldingContext &foldingContext_{context_.foldingContext()};
   std::map<parser::CharBlock, int> impliedDos_; // values are INTEGER kinds
   bool isWholeAssumedSizeArrayOk_{false};
   bool isNullPointerOk_{false};
   bool useSavedTypedExprs_{true};
   bool inWhereBody_{false};
+  bool inDataStmtObject_{false};
   bool inDataStmtConstant_{false};
   bool inStmtFunctionDefinition_{false};
   friend class ArgumentAnalyzer;
 };
 
 inline bool AreConformable(int leftRank, int rightRank) {
   return leftRank == 0 || rightRank == 0 || leftRank == rightRank;
 }
public:
   bool Pre(const parser::AllocateObject &x) {
     exprAnalyzer_.Analyze(x);
     return false;
   }
   bool Pre(const parser::PointerObject &x) {
     exprAnalyzer_.Analyze(x);
     return false;
   }
+  bool Pre(const parser::DataStmtObject &);
+  void Post(const parser::DataStmtObject &);
   bool Pre(const parser::DataImpliedDo &);
 
   bool Pre(const parser::CallStmt &x) {
     exprAnalyzer_.Analyze(x);
     return false;
   }
   bool Pre(const parser::AssignmentStmt &x) {
     exprAnalyzer_.Analyze(x);

flang/lib/Semantics/data-to-inits.cpp

if (const auto *expr{GetExpr(exprAnalyzer_.context(), var)}) {
     }
   }
   return false;
 }
 
 template <typename DSV>
 bool DataInitializationCompiler<DSV>::Scan(
     const parser::Designator &designator) {
-  if (auto expr{exprAnalyzer_.Analyze(designator)}) {
+  MaybeExpr expr;
+  { // The out-of-range subscript errors from the designator folder are a
+    // more specific than the default ones from expression semantics, so
+    // disable those to avoid piling on.
+    auto restorer{exprAnalyzer_.GetContextualMessages().DiscardMessages()};
+    expr = exprAnalyzer_.Analyze(designator);
+  }
+  if (expr) {
     parser::CharBlock at{parser::FindSourceLocation(designator)};
     exprAnalyzer_.GetFoldingContext().messages().SetLocation(at);
     scope_ = &exprAnalyzer_.context().FindScope(at);
     if (InitDesignator(*expr)) {
       return true;
     }
   }
   return false;

flang/lib/Semantics/expression.cpp

if (Triplet *last{std::get_if<Triplet>(&ref.subscript().back().u)}) {
       }
     }
   } else {
     // Shouldn't get here from Analyze(ArrayElement) without a valid base,
     // which, if not an object, must be a construct entity from
     // SELECT TYPE/RANK or ASSOCIATE.
     CHECK(symbol.has<semantics::AssocEntityDetails>());
   }
+  if (!semantics::IsNamedConstant(symbol) && !inDataStmtObject_) {
+    // Subscripts of named constants are checked in folding.
+    // Subscripts of DATA statement objects are checked in data statement
+    // conversion to initializers.
+    CheckConstantSubscripts(ref);
+  }
   return Designate(DataRef{std::move(ref)});
 }
 
 // Applies subscripts to a data reference.
 MaybeExpr ExpressionAnalyzer::ApplySubscripts(
     DataRef &&dataRef, std::vector<Subscript> &&subscripts) {
   if (subscripts.empty()) {
     return std::nullopt; // error recovery
return common::visit(
           [&](auto &&) -> MaybeExpr {
             DIE("bad base for ArrayRef");
             return std::nullopt;
           },
       },
       std::move(dataRef.u));
 }
 
+void ExpressionAnalyzer::CheckConstantSubscripts(ArrayRef &ref) {
+  // Fold subscript expressions and check for an empty triplet.
+  Shape lb{GetLBOUNDs(foldingContext_, ref.base())};
+  Shape ub{GetUBOUNDs(foldingContext_, ref.base())};
+  bool anyPossiblyEmptyDim{false};
+  int dim{0};
+  for (Subscript &ss : ref.subscript()) {
+    if (Triplet * triplet{std::get_if<Triplet>(&ss.u)}) {
+      auto expr{Fold(triplet->stride())};
+      auto stride{ToInt64(expr)};
+      triplet->set_stride(std::move(expr));
+      if (stride) {
+        if (*stride == 0) {
+          Say("Stride of triplet must not be zero"_err_en_US);
+          return;
+        }
+        std::optional<ConstantSubscript> lower, upper;
+        if (auto expr{triplet->lower()}) {
+          *expr = Fold(std::move(*expr));
+          lower = ToInt64(*expr);
+          triplet->set_lower(std::move(*expr));
+        } else {
+          lower = ToInt64(lb[dim]);
+        }
+        if (auto expr{triplet->upper()}) {
+          *expr = Fold(std::move(*expr));
+          upper = ToInt64(*expr);
+          triplet->set_upper(std::move(*expr));
+        } else {
+          upper = ToInt64(ub[dim]);
+        }
+        if (lower && upper) {
+          if (*stride > 0) {
+            anyPossiblyEmptyDim |= *lower > *upper;
+          } else {
+            anyPossiblyEmptyDim |= *lower < *upper;
+          }
+        } else {
+          anyPossiblyEmptyDim = true;
+        }
+      } else {
+        anyPossiblyEmptyDim = true;
+      }
+    } else { // not triplet
+      auto &expr{std::get<IndirectSubscriptIntegerExpr>(ss.u).value()};
+      expr = Fold(std::move(expr));
+      anyPossiblyEmptyDim |= expr.Rank() > 0; // vector subscript
+    }
+    ++dim;
+  }
+  if (anyPossiblyEmptyDim) {
+    return;
+  }
+  dim = 0;
+  for (Subscript &ss : ref.subscript()) {
+    auto dimLB{ToInt64(lb[dim])};
+    auto dimUB{ToInt64(ub[dim])};
+    std::optional<ConstantSubscript> val[2];
+    int vals{0};
+    if (auto *triplet{std::get_if<Triplet>(&ss.u)}) {
+      auto stride{ToInt64(triplet->stride())};
+      std::optional<ConstantSubscript> lower, upper;
+      if (const auto *lowerExpr{triplet->GetLower()}) {
+        lower = ToInt64(*lowerExpr);
+      } else if (lb[dim]) {
+        lower = ToInt64(*lb[dim]);
+      }
+      if (const auto *upperExpr{triplet->GetUpper()}) {
+        upper = ToInt64(*upperExpr);
+      } else if (ub[dim]) {
+        upper = ToInt64(*ub[dim]);
+      }
+      if (stride && *stride != 0 && lower && upper) {
+        // Normalize upper bound for non-unit stride
+        // 1:10:2 -> 1:9:2, 10:1:-2 -> 10:2:-2
+        *upper = *lower + *stride * ((*upper - *lower) / *stride);
+        val[vals++] = lower;
+        val[vals++] = upper;
+      }
+    } else {
+      val[vals++] =
+          ToInt64(std::get<IndirectSubscriptIntegerExpr>(ss.u).value());
+    }
+    for (int j{0}; j < vals; ++j) {
+      if (val[j]) {
+        if (dimLB && *val[j] < *dimLB) {
+          AttachDeclaration(
+              Say("Subscript %jd is less than lower bound %jd for dimension %d of array"_err_en_US,
+                  static_cast<std::intmax_t>(*val[j]),
+                  static_cast<std::intmax_t>(*dimLB), dim + 1),
+              ref.base().GetLastSymbol());
+        }
+        if (dimUB && *val[j] > *dimUB) {
+          AttachDeclaration(
+              Say("Subscript %jd is greater than upper bound %jd for dimension %d of array"_err_en_US,
+                  static_cast<std::intmax_t>(*val[j]),
+                  static_cast<std::intmax_t>(*dimUB), dim + 1),
+              ref.base().GetLastSymbol());
+        }
+      }
+    }
+    ++dim;
+  }
+}
+
 // C919a - only one part-ref of a data-ref may have rank > 0
 bool ExpressionAnalyzer::CheckRanks(const DataRef &dataRef) {
   return common::visit(
       common::visitors{
           [this](const Component &component) {
             const Symbol &symbol{component.GetLastSymbol()};
             if (int componentRank{symbol.Rank()}; componentRank > 0) {
               if (int baseRank{component.base().Rank()}; baseRank > 0) {
evaluate::Expr<evaluate::SubscriptInteger> AnalyzeKindSelector(
   evaluate::ExpressionAnalyzer analyzer{context};
   auto restorer{
       analyzer.GetContextualMessages().SetLocation(context.location().value())};
   return analyzer.AnalyzeKindSelector(category, selector);
 }
 
 ExprChecker::ExprChecker(SemanticsContext &context) : context_{context} {}
 
+bool ExprChecker::Pre(const parser::DataStmtObject &obj) {
+  exprAnalyzer_.set_inDataStmtObject(true);
+  return true;
+}
+
+void ExprChecker::Post(const parser::DataStmtObject &obj) {
+  exprAnalyzer_.set_inDataStmtObject(false);
+}
+
 bool ExprChecker::Pre(const parser::DataImpliedDo &ido) {
   parser::Walk(std::get<parser::DataImpliedDo::Bounds>(ido.t), *this);
   const auto &bounds{std::get<parser::DataImpliedDo::Bounds>(ido.t)};
   auto name{bounds.name.thing.thing};
   int kind{evaluate::ResultType<evaluate::ImpliedDoIndex>::kind};
   if (const auto dynamicType{evaluate::DynamicType::From(*name.symbol)}) {
     if (dynamicType->category() == TypeCategory::Integer) {
       kind = dynamicType->kind();

flang/lib/Semantics/type.cpp

void DerivedTypeSpec::Instantiate(Scope &containingScope) {
   ReplaceScope(newScope);
   auto restorer{foldingContext.WithPDTInstance(*this)};
   std::string desc{typeSymbol_.name().ToString()};
   char sep{'('};
   for (const Symbol &symbol : OrderParameterDeclarations(typeSymbol_)) {
     const SourceName &name{symbol.name()};
     if (typeScope.find(symbol.name()) != typeScope.end()) {
       // This type parameter belongs to the derived type itself, not to
-      // one of its ancestors.  Put the type parameter expression value
-      // into the new scope as the initialization value for the parameter.
+      // one of its ancestors.  Put the type parameter expression value,
+      // when there is one, into the new scope as the initialization value
+      // for the parameter.  And when there is no explicit value, add an
+      // uninitialized type parameter to forestall use of any default.
       if (ParamValue * paramValue{FindParameter(name)}) {
         const TypeParamDetails &details{symbol.get<TypeParamDetails>()};
         paramValue->set_attr(details.attr());
-        if (MaybeIntExpr expr{paramValue->GetExplicit()}) {
-          if (auto folded{evaluate::NonPointerInitializationExpr(symbol,
-                  SomeExpr{std::move(*expr)}, foldingContext, &newScope)}) {
-            desc += sep;
-            desc += name.ToString();
-            desc += '=';
-            desc += folded->AsFortran();
-            sep = ',';
-            TypeParamDetails instanceDetails{details.attr()};
-            if (const DeclTypeSpec * type{details.type()}) {
-              instanceDetails.set_type(*type);
-            }
+        desc += sep;
+        desc += name.ToString();
+        desc += '=';
+        sep = ',';
+        if (MaybeIntExpr expr{paramValue->GetExplicit()}) {
+          if (auto folded{evaluate::NonPointerInitializationExpr(symbol,
+                  SomeExpr{std::move(*expr)}, foldingContext, &newScope)}) {
+            desc += folded->AsFortran();
             instanceDetails.set_init(
                 std::move(DEREF(evaluate::UnwrapExpr<SomeIntExpr>(*folded))));
-            newScope.try_emplace(name, std::move(instanceDetails));
           }
         }
+        if (!instanceDetails.init()) {
+          desc += '*';
+        }
+        newScope.try_emplace(name, std::move(instanceDetails));
       }
     }
   }
   parser::Message *contextMessage{nullptr};
   if (sep != '(') {
     desc += ')';
     contextMessage = new parser::Message{foldingContext.messages().at(),
         "instantiation of parameterized derived type '%s'"_en_US, desc};

flang/test/Lower/OpenACC/acc-data-operands.f90

subroutine acc_operand_array_section()
 
   !$acc data copyin(a(1:50)) copyout(a(51:100))
   !$acc end data
 
   !CHECK-LABEL: func.func @_QMacc_data_operandPacc_operand_array_section
 
   !CHECK: %[[ARR:.*]] = fir.alloca !fir.array<100xf32>
 
-  !CHECK: %[[C1:.*]] = fir.convert %c1_i32 : (i32) -> i64
+  !CHECK: %[[C1:.*]] = arith.constant 1 : i64
   !CHECK: %[[LB1:.*]] = fir.convert %[[C1]] : (i64) -> index
   !CHECK: %[[C1_I64:.*]] = arith.constant 1 : i64
   !CHECK: %[[STEP1:.*]] = fir.convert %[[C1_I64]] : (i64) -> index
-  !CHECK: %[[C50:.*]] = arith.constant 50 : i32
-  !CHECK: %[[C50_I64:.*]] = fir.convert %[[C50]] : (i32) -> i64
+  !CHECK: %[[C50_I64:.*]] = arith.constant 50 : i64
   !CHECK: %[[UB1:.*]] = fir.convert %[[C50_I64]] : (i64) -> index
   !CHECK: %[[SHAPE1:.*]] = fir.shape %{{.*}} : (index) -> !fir.shape<1>
   !CHECK: %[[SLICE1:.*]] = fir.slice %[[LB1]], %[[UB1]], %[[STEP1]] : (index, index, index) -> !fir.slice<1>
   !CHECK: %[[ARR_SECTION1:.*]] = fir.embox %[[ARR]](%[[SHAPE1]]) [%[[SLICE1]]] : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.array<50xf32>>
   !CHECK: %[[MEM1:.*]] = fir.alloca !fir.box<!fir.array<50xf32>>
   !CHECK: fir.store %[[ARR_SECTION1]] to %[[MEM1]] : !fir.ref<!fir.box<!fir.array<50xf32>>>
 
-  !CHECK: %[[C51:.*]] = arith.constant 51 : i32
-  !CHECK: %[[C51_I64:.*]] = fir.convert %[[C51]] : (i32) -> i64
+  !CHECK: %[[C51_I64:.*]] = arith.constant 51 : i64
   !CHECK: %[[LB2:.*]] = fir.convert %[[C51_I64]] : (i64) -> index
   !CHECK: %[[C1_I64:.*]] = arith.constant 1 : i64
   !CHECK: %[[STEP2:.*]] = fir.convert %[[C1_I64]] : (i64) -> index
-  !CHECK: %[[C100:.*]] = arith.constant 100 : i32
-  !CHECK: %[[C100_I64:.*]] = fir.convert %[[C100]] : (i32) -> i64
+  !CHECK: %[[C100_I64:.*]] = arith.constant 100 : i64
   !CHECK: %[[UB2:.*]] = fir.convert %[[C100_I64]] : (i64) -> index
   !CHECK: %[[SHAPE2:.*]] = fir.shape %{{.*}} : (index) -> !fir.shape<1>
   !CHECK: %[[SLICE2:.*]] = fir.slice %[[LB2]], %[[UB2]], %[[STEP2]] : (index, index, index) -> !fir.slice<1>
   !CHECK: %[[ARR_SECTION2:.*]] = fir.embox %[[ARR]](%[[SHAPE2]]) [%[[SLICE2]]] : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.array<50xf32>>
   !CHECK: %[[MEM2:.*]] = fir.alloca !fir.box<!fir.array<50xf32>>
   !CHECK: fir.store %[[ARR_SECTION2]] to %[[MEM2]] : !fir.ref<!fir.box<!fir.array<50xf32>>>
 
   !CHECK: acc.data copyin(%[[MEM1]] : !fir.ref<!fir.box<!fir.array<50xf32>>>) copyout(%[[MEM2]] : !fir.ref<!fir.box<!fir.array<50xf32>>>)
 
 end subroutine
 
 ! Testing array sections of a derived-type component
 subroutine acc_operand_array_section_component()
 
   type(wrapper) :: w
 
   !$acc data copy(w%data(1:20))
   !$acc end data
 
   !CHECK-LABEL: func.func @_QMacc_data_operandPacc_operand_array_section_component
   !CHECK: %[[W:.*]] = fir.alloca !fir.type<_QMacc_data_operandTwrapper{data:!fir.array<100xf32>}>
   !CHECK: %[[FIELD_INDEX:.*]] = fir.field_index data, !fir.type<_QMacc_data_operandTwrapper{data:!fir.array<100xf32>}>
   !CHECK: %[[DATA_COORD:.*]] = fir.coordinate_of %[[W]], %[[FIELD_INDEX]] : (!fir.ref<!fir.type<_QMacc_data_operandTwrapper{data:!fir.array<100xf32>}>>, !fir.field) -> !fir.ref<!fir.array<100xf32>>
-  !CHECK: %[[C1:.*]] = arith.constant 1 : i32
-  !CHECK: %[[C1_I64:.*]] = fir.convert %[[C1]] : (i32) -> i64
-  !CHECK: %[[LB:.*]] = fir.convert %3 : (i64) -> index
-  !CHECK: %[[C1_I64:.*]] = arith.constant 1 : i64
-  !CHECK: %[[STEP:.*]] = fir.convert %[[C1_I64]] : (i64) -> index
-  !CHECK: %[[C20:.*]] = arith.constant 20 : i32
-  !CHECK: %[[C20_I64:.*]] = fir.convert %[[C20]] : (i32) -> i64
+  !CHECK: %[[C1_I64_1:.*]] = arith.constant 1 : i64
+  !CHECK: %[[LB:.*]] = fir.convert %[[C1_I64_1]] : (i64) -> index
+  !CHECK: %[[C1_I64_2:.*]] = arith.constant 1 : i64
+  !CHECK: %[[STEP:.*]] = fir.convert %[[C1_I64_2]] : (i64) -> index
+  !CHECK: %[[C20_I64:.*]] = arith.constant 20 : i64
   !CHECK: %[[UB:.*]] = fir.convert %[[C20_I64]] : (i64) -> index
   !CHECK: %[[SHAPE:.*]] = fir.shape %{{.*}} : (index) -> !fir.shape<1>
   !CHECK: %[[SLICE:.*]] = fir.slice %[[LB]], %[[UB]], %[[STEP]] : (index, index, index) -> !fir.slice<1>
   !CHECK: %[[ARR_SECTION:.*]] = fir.embox %[[DATA_COORD]](%[[SHAPE]]) [%[[SLICE]]] : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.array<20xf32>>
   !CHECK: %[[MEM:.*]] = fir.alloca !fir.box<!fir.array<20xf32>> 
   !CHECK: fir.store %[[ARR_SECTION]] to %[[MEM]] : !fir.ref<!fir.box<!fir.array<20xf32>>> 
   !CHECK: acc.data copy(%[[MEM]] : !fir.ref<!fir.box<!fir.array<20xf32>>>)
 

 subroutine acc_operand_array_derived_type_component()
   type(wrapper) :: w(10)
 
   !$acc data copy(w(1)%data)
   !$acc end data
 
   !CHECK-LABEL: func.func @_QMacc_data_operandPacc_operand_array_derived_type_component
   !CHECK: %[[W:.*]] = fir.alloca !fir.array<10x!fir.type<_QMacc_data_operandTwrapper{data:!fir.array<100xf32>}>>
-  !CHECK: %[[IDX:.*]] = arith.subi %{{.*}}, %c1_i64 : i64
+  !CHECK: %[[C1_I64_1:.*]] = arith.constant 1 : i64
+  !CHECK: %[[C1_I64_2:.*]] = arith.constant 1 : i64
+  !CHECK: %[[IDX:.*]] = arith.subi %[[C1_I64_1]], %[[C1_I64_2]] : i64
   !CHECK: %[[COORD1:.*]] = fir.coordinate_of %[[W]], %[[IDX]] : (!fir.ref<!fir.array<10x!fir.type<_QMacc_data_operandTwrapper{data:!fir.array<100xf32>}>>>, i64) -> !fir.ref<!fir.type<_QMacc_data_operandTwrapper{data:!fir.array<100xf32>}>>
   !CHECK: %[[COORD2:.*]] = fir.field_index data, !fir.type<_QMacc_data_operandTwrapper{data:!fir.array<100xf32>}>
   !CHECK: %[[COORD_OF:.*]] = fir.coordinate_of %[[COORD1]], %[[COORD2]] : (!fir.ref<!fir.type<_QMacc_data_operandTwrapper{data:!fir.array<100xf32>}>>, !fir.field) -> !fir.ref<!fir.array<100xf32>>
   !CHECK: acc.data copy(%[[COORD_OF]] : !fir.ref<!fir.array<100xf32>>)
 
 end subroutine
 
 ! Testing array sections on allocatable array
 subroutine acc_operand_array_section_allocatable()
   real, allocatable :: a(:)
 
   allocate(a(100))
 
   !$acc data copyin(a(1:50)) copyout(a(51:100))
   !$acc end data
 
   !CHECK: %[[ARR_HEAP:.*]] = fir.alloca !fir.heap<!fir.array<?xf32>> {uniq_name = "_QMacc_data_operandFacc_operand_array_section_allocatableEa.addr"}
 
   !CHECK: %[[LOAD_ARR0:.*]] = fir.load %[[ARR_HEAP]] : !fir.ref<!fir.heap<!fir.array<?xf32>>>
-  !CHECK: %[[C1_I32:.*]] = arith.constant 1 : i32
-  !CHECK: %[[C1_I64:.*]] = fir.convert %[[C1_I32]] : (i32) -> i64
+  !CHECK: %[[C1_I64:.*]] = arith.constant 1 : i64
   !CHECK: %[[LB0:.*]] = fir.convert %[[C1_I64]] : (i64) -> index
   !CHECK: %[[C1_STEP:.*]] = arith.constant 1 : i64
   !CHECK: %[[STEP0:.*]] = fir.convert %[[C1_STEP]] : (i64) -> index
-  !CHECK: %[[C50_I32:.*]] = arith.constant 50 : i32
-  !CHECK: %[[C50_I64:.*]] = fir.convert %[[C50_I32]] : (i32) -> i64
+  !CHECK: %[[C50_I64:.*]] = arith.constant 50 : i64
   !CHECK: %[[UB0:.*]] = fir.convert %[[C50_I64]] : (i64) -> index
   !CHECK: %[[SHAPE_SHIFT0:.*]] = fir.shape_shift %{{.*}}, %{{.*}} : (index, index) -> !fir.shapeshift<1>
   !CHECK: %[[SLICE0:.*]] = fir.slice %[[LB0]], %[[UB0]], %[[STEP0]] : (index, index, index) -> !fir.slice<1>
   !CHECK: %[[ARR_SECTION0:.*]] = fir.embox %[[LOAD_ARR0]](%[[SHAPE_SHIFT0]]) [%[[SLICE0]]] : (!fir.heap<!fir.array<?xf32>>, !fir.shapeshift<1>, !fir.slice<1>) -> !fir.box<!fir.array<50xf32>>
   !CHECK: %[[MEM0:.*]] = fir.alloca !fir.box<!fir.array<50xf32>>
   !CHECK: fir.store %[[ARR_SECTION0]] to %[[MEM0]] : !fir.ref<!fir.box<!fir.array<50xf32>>>
 
   !CHECK: %[[LOAD_ARR1:.*]] = fir.load %[[ARR_HEAP]] : !fir.ref<!fir.heap<!fir.array<?xf32>>>
-  !CHECK: %[[C51_I32:.*]] = arith.constant 51 : i32
-  !CHECK: %[[C51_I64:.*]] = fir.convert %[[C51_I32]] : (i32) -> i64
+  !CHECK: %[[C51_I64:.*]] = arith.constant 51 : i64
   !CHECK: %[[LB1:.*]] = fir.convert %[[C51_I64]] : (i64) -> index
   !CHECK: %[[C1_STEP:.*]] = arith.constant 1 : i64
   !CHECK: %[[STEP1:.*]] = fir.convert %[[C1_STEP]] : (i64) -> index
-  !CHECK: %[[C100_I32:.*]] = arith.constant 100 : i32
-  !CHECK: %[[C100_I64:.*]] = fir.convert %[[C100_I32]] : (i32) -> i64
+  !CHECK: %[[C100_I64:.*]] = arith.constant 100 : i64
   !CHECK: %[[UB1:.*]] = fir.convert %[[C100_I64]] : (i64) -> index
   !CHECK: %[[SHAPE_SHIFT1:.*]] = fir.shape_shift %{{.*}}, %{{.*}} : (index, index) -> !fir.shapeshift<1>
   !CHECK: %[[SLICE1:.*]] = fir.slice %[[LB1]], %[[UB1]], %[[STEP1]] : (index, index, index) -> !fir.slice<1>
   !CHECK: %[[ARR_SECTION1:.*]] = fir.embox %[[LOAD_ARR1]](%[[SHAPE_SHIFT1]]) [%[[SLICE1]]] : (!fir.heap<!fir.array<?xf32>>, !fir.shapeshift<1>, !fir.slice<1>) -> !fir.box<!fir.array<50xf32>>
   !CHECK: %[[MEM1:.*]] = fir.alloca !fir.box<!fir.array<50xf32>>
   !CHECK: fir.store %[[ARR_SECTION1]] to %[[MEM1]] : !fir.ref<!fir.box<!fir.array<50xf32>>>
 
   !CHECK: acc.data copyin(%[[MEM0]] : !fir.ref<!fir.box<!fir.array<50xf32>>>) copyout(%[[MEM1]] : !fir.ref<!fir.box<!fir.array<50xf32>>>)
subroutine acc_operand_array_section_pointer()
   !CHECK: %[[ARR:.*]] = fir.alloca !fir.array<100xf32> {bindc_name = "a", fir.target, uniq_name = "_QMacc_data_operandFacc_operand_array_section_pointerEa"}
   !CHECK: %[[PTR:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xf32>>> {bindc_name = "p", uniq_name = "_QMacc_data_operandFacc_operand_array_section_pointerEp"}
   !CHECK: %[[SHAPE0:.*]] = fir.shape %[[C100]] : (index) -> !fir.shape<1>
   !CHECK: %[[EMBOX0:.*]] = fir.embox %[[ARR]](%[[SHAPE0]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
   !CHECK: fir.store %[[EMBOX0]] to %[[PTR]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
   !CHECK: %[[PTR_LOAD:.*]] = fir.load %[[PTR]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
   !CHECK: %[[C0:.*]] = arith.constant 0 : index
   !CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %[[PTR_LOAD]], %[[C0]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
-  !CHECK: %[[C1_I32:.*]] = arith.constant 1 : i32
-  !CHECK: %[[C1_I64:.*]] = fir.convert %[[C1_I32]] : (i32) -> i64
+  !CHECK: %[[C1_I64:.*]] = arith.constant 1 : i64
   !CHECK: %[[LB0:.*]] = fir.convert %[[C1_I64]] : (i64) -> index
   !CHECK: %[[C1_STEP:.*]] = arith.constant 1 : i64
   !CHECK: %[[STEP0:.*]] = fir.convert %[[C1_STEP]] : (i64) -> index
-  !CHECK: %[[C50_I32:.*]] = arith.constant 50 : i32
-  !CHECK: %[[C50_I64:.*]] = fir.convert %[[C50_I32]] : (i32) -> i64
+  !CHECK: %[[C50_I64:.*]] = arith.constant 50 : i64
   !CHECK: %[[UB0:.*]] = fir.convert %[[C50_I64]] : (i64) -> index
   !CHECK: %[[SHIFT0:.*]] = fir.shift %[[BOX_DIMS]]#0 : (index) -> !fir.shift<1>
   !CHECK: %[[SLICE0:.*]] = fir.slice %[[LB0]], %[[UB0]], %[[STEP0]] : (index, index, index) -> !fir.slice<1>
   !CHECK: %[[REBOX0:.*]] = fir.rebox %7(%[[SHIFT0]]) [%[[SLICE0]]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, !fir.shift<1>, !fir.slice<1>) -> !fir.box<!fir.array<50xf32>>
   !CHECK: %[[MEM0:.*]] = fir.alloca !fir.box<!fir.array<50xf32>>
   !CHECK: fir.store %[[REBOX0]] to %[[MEM0]] : !fir.ref<!fir.box<!fir.array<50xf32>>>
   
   !CHECK: acc.data copyin(%[[MEM0]] : !fir.ref<!fir.box<!fir.array<50xf32>>>) {
 
 end subroutine
 
 end module

flang/test/Lower/explicit-interface-results.f90

function test_recursion(n) result(res)
   integer(8) :: n
   character(n) :: res
   ! some_local is here to verify that local symbols that are visible in the
   ! function interface are not instantiated by accident (that only the
   ! symbols needed for the result are instantiated before the call).
   ! CHECK: fir.alloca !fir.array<?xi32>, {{.*}}some_local
   ! CHECK-NOT: fir.alloca !fir.array<?xi32>
   integer :: some_local(n)
-  some_local(0) = n + 64
+  some_local(1) = n + 64
   if (n.eq.1) then
-    res = char(some_local(0))
+    res = char(some_local(1))
   ! CHECK: else
   else 
     ! CHECK-NOT: fir.alloca !fir.array<?xi32>
 
     ! verify that the actual argument for symbol n ("n-1") is used to allocate
     ! the result, and not the local value of symbol n.
 
     ! CHECK: %[[nLoad:.*]] = fir.load %[[n]] : !fir.ref<i64>
     ! CHECK: %[[sub:.*]] = arith.subi %[[nLoad]], %c1{{.*}} : i64
     ! CHECK: fir.store %[[sub]] to %[[nInCall:.*]] : !fir.ref<i64>
 
     ! CHECK-NOT: fir.alloca !fir.array<?xi32>
 
     ! CHECK: %[[nInCallLoad:.*]] = fir.load %[[nInCall]] : !fir.ref<i64>
     ! CHECK: %[[nInCallCast:.*]] = fir.convert %[[nInCallLoad]] : (i64) -> index
     ! CHECK: %[[cmpi:.*]] = arith.cmpi sgt, %[[nInCallCast]], %{{.*}} : index
     ! CHECK: %[[select:.*]] = arith.select %[[cmpi]], %[[nInCallCast]], %{{.*}} : index
     ! CHECK: %[[tmp:.*]] = fir.alloca !fir.char<1,?>(%[[select]] : index)
 
     ! CHECK-NOT: fir.alloca !fir.array<?xi32>
     ! CHECK: fir.call @_QPtest_recursion(%[[tmp]], {{.*}}
-    res = char(some_local(0)) // test_recursion(n-1)
+    res = char(some_local(1)) // test_recursion(n-1)
 
     ! Verify that symbol n was not remapped to the actual argument passed
     ! to n in the call (that the temporary mapping was cleaned-up).
 
     ! CHECK: %[[nLoad2:.*]] = fir.load %[[n]] : !fir.ref<i64>
     ! CHECK: OutputInteger64(%{{.*}}, %[[nLoad2]])
     print *, n
   end if

flang/test/Semantics/allocate10.f90

  !ERROR: The number of shape specifications, when they appear, must match the rank of allocatable object
  allocate(x1(5), x2(2,4), a1%x(5), a2(1,2)%x(4))
 
  !ERROR: The number of shape specifications, when they appear, must match the rank of allocatable object
  allocate(x1(2), a1%x(2,5), a2(1,2)%x(2))
 
  ! Test the check is not influenced by SOURCE
  !ERROR: The number of shape specifications, when they appear, must match the rank of allocatable object
- allocate(a1%x(5, 4, 3), SOURCE=xsrc2a(1:5, 1:4, 1:3))
+ allocate(a1%x(5, 4, 3), SOURCE=xsrc2a(4:8, 1:4, 1:3))
  !ERROR: The number of shape specifications, when they appear, must match the rank of allocatable object
  allocate(x2(5), MOLD=xsrc1a(1:5))
  !ERROR: The number of shape specifications, when they appear, must match the rank of allocatable object
  allocate(a1%x(5, 4, 3), MOLD=xsrc1b)
  !ERROR: The number of shape specifications, when they appear, must match the rank of allocatable object
  allocate(x2(5), SOURCE=xsrc2b)
 
  ! C945b: If SOURCE= appears, source-expr shall be a scalar or have the same

flang/test/Semantics/allocate11.f90

!  ! Valid constructs
   allocate(varok, varok2(2), SOURCE=my_team)
   allocate(varok, varok2(2), MOLD=fptr)
 
   !ERROR: SOURCE or MOLD expression type must not be TEAM_TYPE from ISO_FORTRAN_ENV when an allocatable object is a coarray
   allocate(var[5:*], SOURCE=my_team)
   !ERROR: SOURCE or MOLD expression type must not be C_PTR or C_FUNPTR from ISO_C_BINDING when an allocatable object is a coarray
   allocate(var[5:*], SOURCE=ptr)
   !ERROR: SOURCE or MOLD expression type must not be C_PTR or C_FUNPTR from ISO_C_BINDING when an allocatable object is a coarray
-  allocate(varok, var[5:*], MOLD=ptr2(1))
+  allocate(varok, var[5:*], MOLD=ptr2(2))
   !ERROR: SOURCE or MOLD expression type must not be C_PTR or C_FUNPTR from ISO_C_BINDING when an allocatable object is a coarray
   allocate(var[5:*], MOLD=fptr)
   !ERROR: SOURCE or MOLD expression type must not be TEAM_TYPE from ISO_FORTRAN_ENV when an allocatable object is a coarray
   allocate(var2(2)[5:*], MOLD=my_team)
   !ERROR: SOURCE or MOLD expression type must not be C_PTR or C_FUNPTR from ISO_C_BINDING when an allocatable object is a coarray
   allocate(var2(2)[5:*], MOLD=ptr)
   !ERROR: SOURCE or MOLD expression type must not be C_PTR or C_FUNPTR from ISO_C_BINDING when an allocatable object is a coarray
   allocate(var2(2)[5:*], SOURCE=ptr2)
   !ERROR: SOURCE or MOLD expression type must not be C_PTR or C_FUNPTR from ISO_C_BINDING when an allocatable object is a coarray
   allocate(varok2(2), var2(2)[5:*], SOURCE=fptr)
 
 end subroutine

flang/test/Semantics/data04.f90

function f(i)
       !C876
       !ERROR: Procedure 'g' must not be initialized in a DATA statement
       DATA g /1/
       !C876
       !ERROR: Allocatable 'a' must not be initialized in a DATA statement
       DATA a /1/
       !C876
       !ERROR: Automatic variable 'b' must not be initialized in a DATA statement
-      DATA b(0) /1/
+      DATA b(1) /1/
       !C876
       !Ok: As charPtr is a pointer, it is not an automatic object
       DATA charPtr / NULL() /
       !C876
       !ERROR: Allocatable 'charalloc' must not be initialized in a DATA statement
       DATA charAlloc / 'abc' /
       f = i *1024
     end

flang/test/Semantics/expr-errors06.f90

+! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror
+! Check out-of-range subscripts
+real a(10)
+integer, parameter :: n(2) = [1, 2]
+!ERROR: DATA statement designator 'a(0_8)' is out of range
+!ERROR: DATA statement designator 'a(11_8)' is out of range
+data a(0)/0./, a(10+1)/0./
+!ERROR: Subscript 0 is less than lower bound 1 for dimension 1 of array
+print *, a(0)
+!ERROR: Subscript 0 is less than lower bound 1 for dimension 1 of array
+print *, a(1-1)
+!ERROR: Subscript 11 is greater than upper bound 10 for dimension 1 of array
+print *, a(11)
+!ERROR: Subscript 11 is greater than upper bound 10 for dimension 1 of array
+print *, a(10+1)
+!ERROR: Subscript value (0) is out of range on dimension 1 in reference to a constant array value
+print *, n(0)
+!ERROR: Subscript value (3) is out of range on dimension 1 in reference to a constant array value
+print *, n(4-1)
+print *, a(1:12:3) ! ok
+!ERROR: Subscript 13 is greater than upper bound 10 for dimension 1 of array
+print *, a(1:13:3)
+print *, a(10:-1:-3) ! ok
+!ERROR: Subscript -2 is less than lower bound 1 for dimension 1 of array
+print *, a(10:-2:-3)
+print *, a(-1:-2) ! empty section is ok
+print *, a(0:11:-1) ! empty section is ok
+end
+