[flang] Emit errors and warnings about DIM= arguments to intrinsic functions

[klausler]

Summary

The semantics of many transformational intrinsic functions, especially
reductions like SUM(), are determined by the static presence or absence
of a DIM= argument. In the case of an actual DIM= argument that is
syntactically present but could be dynamically absent at execution time
(due to being OPTIONAL, POINTER, or ALLOCATABLE), f18 should emit some
kind of diagnostic message.

Other compilers either ignore this possibility or treat it as a hard
error; neither really seems correct, so let's do something more nuanced.

For cases where the dynamic absence of a value for DIM doesn't pose
as much of a risk because it lowering is going to assume that it's
equal to 1 anyway, emit only a portability warning.

For other cases where the generated code or runtime support library
will need the value of DIM= during execution, emit a warning that
the use of an OPTIONAL/POINTER/ALLOCATABLE variable or component
here is dicey and should be reconsidered.

While here, also catch bad constant DIM= values.

[jeanPerier]

Please make sure you run clang-format on flang/lib/Evaluate/intrinsics.cpp. Otherwise looks good to me.

flang/include/flang/Evaluate/fold.h

if (auto scalar{
     return scalar->ToInt64();
   } else {
     return std::nullopt;
   }
 }
 
 std::optional<std::int64_t> ToInt64(const Expr<SomeInteger> &);
 std::optional<std::int64_t> ToInt64(const Expr<SomeType> &);
+std::optional<std::int64_t> ToInt64(const ActualArgument &);
 
 template <typename A>
 std::optional<std::int64_t> ToInt64(const std::optional<A> &x) {
   if (x) {
     return ToInt64(*x);
   } else {
     return std::nullopt;
   }
 }
 
-template <typename A> std::optional<std::int64_t> ToInt64(const A *p) {
+template <typename A> std::optional<std::int64_t> ToInt64(A *p) {
   if (p) {
-    return ToInt64(*p);
+    return ToInt64(std::as_const(*p));
   } else {
     return std::nullopt;
   }
 }
+
 } // namespace Fortran::evaluate
 #endif // FORTRAN_EVALUATE_FOLD_H_

flang/include/flang/Evaluate/tools.h

std::optional<DataRef> ExtractDataRef(const std::optional<A> &x,
   if (x) {
     return ExtractDataRef(*x, intoSubstring, intoComplexPart);
   } else {
     return std::nullopt;
   }
 }
 template <typename A>
 std::optional<DataRef> ExtractDataRef(
-    const A *p, bool intoSubstring = false, bool intoComplexPart = false) {
+    A *p, bool intoSubstring = false, bool intoComplexPart = false) {
   if (p) {
-    return ExtractDataRef(*p, intoSubstring, intoComplexPart);
+    return ExtractDataRef(std::as_const(*p), intoSubstring, intoComplexPart);
   } else {
     return std::nullopt;
   }
 }
-std::optional<DataRef> ExtractDataRef(
-    const ActualArgument &, bool intoSubstring = false);
+std::optional<DataRef> ExtractDataRef(const ActualArgument &,
+    bool intoSubstring = false, bool intoComplexPart = false);
 
 std::optional<DataRef> ExtractSubstringBase(const Substring &);
 
 // Predicate: is an expression is an array element reference?
 template <typename T>
 bool IsArrayElement(const Expr<T> &expr, bool intoSubstring = true,
     bool skipComponents = false) {
   if (auto dataRef{ExtractDataRef(expr, intoSubstring)}) {

flang/lib/Evaluate/fold-implementation.h

 }
 template <typename TR, typename... TA>
 Expr<TR> FoldElementalIntrinsic(FoldingContext &context,
     FunctionRef<TR> &&funcRef, ScalarFuncWithContext<TR, TA...> func) {
   return FoldElementalIntrinsicHelper<ScalarFuncWithContext, TR, TA...>(
       context, std::move(funcRef), func, std::index_sequence_for<TA...>{});
 }
 
-std::optional<std::int64_t> GetInt64Arg(const std::optional<ActualArgument> &);
 std::optional<std::int64_t> GetInt64ArgOr(
     const std::optional<ActualArgument> &, std::int64_t defaultValue);
 
 template <typename A, typename B>
 std::optional<std::vector<A>> GetIntegerVector(const B &x) {
   static_assert(std::is_integral_v<A>);
   if (const auto *someInteger{UnwrapExpr<Expr<SomeInteger>>(x)}) {
     return common::visit(
template <typename T> Expr<T> Folder<T>::RESHAPE(FunctionRef<T> &&funcRef) {
   // Invalid, prevent re-folding
   return MakeInvalidIntrinsic(std::move(funcRef));
 }
 
 template <typename T> Expr<T> Folder<T>::SPREAD(FunctionRef<T> &&funcRef) {
   auto args{funcRef.arguments()};
   CHECK(args.size() == 3);
   const Constant<T> *source{UnwrapConstantValue<T>(args[0])};
-  auto dim{GetInt64Arg(args[1])};
-  auto ncopies{GetInt64Arg(args[2])};
+  auto dim{ToInt64(args[1])};
+  auto ncopies{ToInt64(args[2])};
   if (!source || !dim) {
     return Expr<T>{std::move(funcRef)};
   }
   int sourceRank{source->Rank()};
   if (sourceRank >= common::maxRank) {
     context_.messages().Say(
         "SOURCE= argument to SPREAD has rank %d but must have rank less than %d"_err_en_US,
         sourceRank, common::maxRank);

flang/lib/Evaluate/fold-integer.cpp

Expr<Type<TypeCategory::Integer, KIND>> LBOUND(FoldingContext &context,
     FunctionRef<Type<TypeCategory::Integer, KIND>> &&funcRef) {
   using T = Type<TypeCategory::Integer, KIND>;
   ActualArguments &args{funcRef.arguments()};
   if (const auto *array{UnwrapExpr<Expr<SomeType>>(args[0])}) {
     if (int rank{array->Rank()}; rank > 0) {
       std::optional<int> dim;
       if (funcRef.Rank() == 0) {
         // Optional DIM= argument is present: result is scalar.
-        if (auto dim64{GetInt64Arg(args[1])}) {
+        if (auto dim64{ToInt64(args[1])}) {
           if (*dim64 < 1 || *dim64 > rank) {
             context.messages().Say("DIM=%jd dimension is out of range for "
                                    "rank-%d array"_err_en_US,
                 *dim64, rank);
             return MakeInvalidIntrinsic<T>(std::move(funcRef));
           } else {
             dim = *dim64 - 1; // 1-based to 0-based
           }
Expr<Type<TypeCategory::Integer, KIND>> UBOUND(FoldingContext &context,
     FunctionRef<Type<TypeCategory::Integer, KIND>> &&funcRef) {
   using T = Type<TypeCategory::Integer, KIND>;
   ActualArguments &args{funcRef.arguments()};
   if (auto *array{UnwrapExpr<Expr<SomeType>>(args[0])}) {
     if (int rank{array->Rank()}; rank > 0) {
       std::optional<int> dim;
       if (funcRef.Rank() == 0) {
         // Optional DIM= argument is present: result is scalar.
-        if (auto dim64{GetInt64Arg(args[1])}) {
+        if (auto dim64{ToInt64(args[1])}) {
           if (*dim64 < 1 || *dim64 > rank) {
             context.messages().Say("DIM=%jd dimension is out of range for "
                                    "rank-%d array"_err_en_US,
                 *dim64, rank);
             return MakeInvalidIntrinsic<T>(std::move(funcRef));
           } else {
             dim = *dim64 - 1; // 1-based to 0-based
           }
#endif // _MSC_VER
     if (const auto *chCon{UnwrapExpr<Constant<TypeOf<std::string>>>(args[0])}) {
       if (std::optional<std::string> value{chCon->GetScalarValue()}) {
         int defaultKind{
             context.defaults().GetDefaultKind(TypeCategory::Character)};
         return Expr<T>{SelectedCharKind(*value, defaultKind)};
       }
     }
   } else if (name == "selected_int_kind") {
-    if (auto p{GetInt64Arg(args[0])}) {
+    if (auto p{ToInt64(args[0])}) {
       return Expr<T>{context.targetCharacteristics().SelectedIntKind(*p)};
     }
   } else if (name == "selected_real_kind" ||
       name == "__builtin_ieee_selected_real_kind") {
     if (auto p{GetInt64ArgOr(args[0], 0)}) {
       if (auto r{GetInt64ArgOr(args[1], 0)}) {
         if (auto radix{GetInt64ArgOr(args[2], 2)}) {
           return Expr<T>{
return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
             context.messages().Say(
                 "sign(integer(kind=%d)) folding overflowed"_warn_en_US, KIND);
           }
           return result.value;
         }));
   } else if (name == "size") {
     if (auto shape{GetContextFreeShape(context, args[0])}) {
       if (auto &dimArg{args[1]}) { // DIM= is present, get one extent
-        if (auto dim{GetInt64Arg(args[1])}) {
+        if (auto dim{ToInt64(args[1])}) {
           int rank{GetRank(*shape)};
           if (*dim >= 1 && *dim <= rank) {
             const Symbol *symbol{UnwrapWholeSymbolDataRef(args[0])};
             if (symbol && IsAssumedSizeArray(*symbol) && *dim == rank) {
               context.messages().Say(
                   "size(array,dim=%jd) of last dimension is not available for rank-%d assumed-size array dummy argument"_err_en_US,
                   *dim, rank);
               return MakeInvalidIntrinsic<T>(std::move(funcRef));

 }
 
 std::optional<std::int64_t> ToInt64(const Expr<SomeInteger> &expr) {
   return common::visit(
       [](const auto &kindExpr) { return ToInt64(kindExpr); }, expr.u);
 }
 
 std::optional<std::int64_t> ToInt64(const Expr<SomeType> &expr) {
-  if (const auto *intExpr{UnwrapExpr<Expr<SomeInteger>>(expr)}) {
-    return ToInt64(*intExpr);
-  } else {
-    return std::nullopt;
-  }
+  return ToInt64(UnwrapExpr<Expr<SomeInteger>>(expr));
+
+std::optional<std::int64_t> ToInt64(const ActualArgument &arg) {
+  return ToInt64(arg.UnwrapExpr());
 }
 
 #ifdef _MSC_VER // disable bogus warning about missing definitions
 #pragma warning(disable : 4661)
 #endif
 FOR_EACH_INTEGER_KIND(template class ExpressionBase, )
 template class ExpressionBase<SomeInteger>;
 } // namespace Fortran::evaluate

flang/lib/Evaluate/fold.cpp

 }
 
 ComplexPart FoldOperation(FoldingContext &context, ComplexPart &&complexPart) {
   DataRef complex{complexPart.complex()};
   return ComplexPart{
       FoldOperation(context, std::move(complex)), complexPart.part()};
 }
 
-std::optional<std::int64_t> GetInt64Arg(
-    const std::optional<ActualArgument> &arg) {
-  if (const auto *intExpr{UnwrapExpr<Expr<SomeInteger>>(arg)}) {
-    return ToInt64(*intExpr);
-  } else {
-    return std::nullopt;
-  }
-}
-
 std::optional<std::int64_t> GetInt64ArgOr(
     const std::optional<ActualArgument> &arg, std::int64_t defaultValue) {
-  if (!arg) {
-    return defaultValue;
-  } else if (const auto *intExpr{UnwrapExpr<Expr<SomeInteger>>(arg)}) {
-    return ToInt64(*intExpr);
-  } else {
-    return std::nullopt;
-  }
+  return arg ? ToInt64(*arg) : defaultValue;
 }
 
 Expr<ImpliedDoIndex::Result> FoldOperation(
     FoldingContext &context, ImpliedDoIndex &&iDo) {
   if (std::optional<ConstantSubscript> value{context.GetImpliedDo(iDo.name)}) {
     return Expr<ImpliedDoIndex::Result>{*value};
   } else {
     return Expr<ImpliedDoIndex::Result>{std::move(iDo)};

flang/lib/Evaluate/intrinsics.cpp

std::optional<SpecificCall> IntrinsicInterface::Match(
   // Check types and kinds of the actual arguments against the intrinsic's
   // interface.  Ensure that two or more arguments that have to have the same
   // (or compatible) type and kind do so.  Check for missing non-optional
   // arguments now, too.
   const ActualArgument *sameArg{nullptr};
   const ActualArgument *operandArg{nullptr};
   const IntrinsicDummyArgument *kindDummyArg{nullptr};
   const ActualArgument *kindArg{nullptr};
-  bool hasDimArg{false};
+  std::optional<int> dimArg;
   for (std::size_t j{0}; j < dummies; ++j) {
     const IntrinsicDummyArgument &d{dummy[std::min(j, dummyArgPatterns - 1)]};
     if (d.typePattern.kindCode == KindCode::kindArg) {
       CHECK(!kindDummyArg);
       kindDummyArg = &d;
     }
     const ActualArgument *arg{actualForDummy[j]};
     if (!arg) {
if (!arg) {
         } else {
           messages.Say(
               "missing mandatory '%s=' argument"_err_en_US, kw.c_str());
         }
         return std::nullopt; // missing non-OPTIONAL argument
       } else {
         continue;
       }
-    } else if (d.optionality == Optionality::missing) {
+    }
+    if (d.optionality == Optionality::missing) {
       messages.Say(arg->sourceLocation(), "unexpected '%s=' argument"_err_en_US,
           d.keyword);
       return std::nullopt;
     }
     if (!d.flags.test(ArgFlag::canBeNull)) {
       // NULL() is rarely an acceptable intrinsic argument.
       if (const auto *expr{arg->UnwrapExpr()}) {
         if (IsNullPointer(*expr)) {
for (std::size_t j{0}; j < dummies; ++j) {
     case KindCode::kindArg:
       CHECK(type->category() == TypeCategory::Integer);
       CHECK(!kindArg);
       kindArg = arg;
       argOk = true;
       break;
     case KindCode::dimArg:
       CHECK(type->category() == TypeCategory::Integer);
-      hasDimArg = true;
+      dimArg = j;
       argOk = true;
       break;
     case KindCode::same:
       if (!sameArg) {
         sameArg = arg;
       }
       argOk = type->IsTkLenCompatibleWith(sameArg->GetType().value());
       break;
std::optional<SpecificCall> IntrinsicInterface::Match(
   // Check the ranks of the arguments against the intrinsic's interface.
   const ActualArgument *arrayArg{nullptr};
   const char *arrayArgName{nullptr};
   const ActualArgument *knownArg{nullptr};
   std::optional<int> shapeArgSize;
   int elementalRank{0};
   for (std::size_t j{0}; j < dummies; ++j) {
     const IntrinsicDummyArgument &d{dummy[std::min(j, dummyArgPatterns - 1)]};
-    if (const ActualArgument * arg{actualForDummy[j]}) {
+    if (const ActualArgument *arg{actualForDummy[j]}) {
       bool isAssumedRank{IsAssumedRank(*arg)};
       if (isAssumedRank && d.rank != Rank::anyOrAssumedRank) {
         messages.Say(arg->sourceLocation(),
             "Assumed-rank array cannot be forwarded to '%s=' argument"_err_en_US,
             d.keyword);
         return std::nullopt;
       }
       int rank{arg->Rank()};
if (const ActualArgument *arg{actualForDummy[j]}) {
         break;
       case Rank::known:
         if (!knownArg) {
           knownArg = arg;
         }
         argOk = rank == knownArg->Rank();
         break;
       case Rank::anyOrAssumedRank:
-        if (!hasDimArg && rank > 0 && !isAssumedRank &&
+        if (!dimArg && rank > 0 && !isAssumedRank &&
             (std::strcmp(name, "shape") == 0 ||
                 std::strcmp(name, "size") == 0 ||
                 std::strcmp(name, "ubound") == 0)) {
           // Check for a whole assumed-size array argument.
           // These are disallowed for SHAPE, and require DIM= for
           // SIZE and UBOUND.
           // (A previous error message for UBOUND will take precedence
           // over this one, as this error is caught by the second entry
if (auto category{result.categorySet.LeastElement()}) {
     }
   } else {
     if (!call.isSubroutineCall) {
       return std::nullopt;
     }
     CHECK(result.kindCode == KindCode::none);
   }
 
+  // Emit warnings when the syntactic presence of a DIM= argument determines
+  // the semantics of the call but the associated actual argument may not be
+  // present at execution time.
+  if (dimArg) {
+    std::optional<int> arrayRank;
+    if (arrayArg) {
+      arrayRank = arrayArg->Rank();
+      if (auto dimVal{ToInt64(actualForDummy[*dimArg])}) {
+        if (*dimVal < 1) {
+          messages.Say(
+              "The value of DIM= (%jd) may not be less than 1"_err_en_US,
+              static_cast<std::intmax_t>(*dimVal));
+        } else if (*dimVal > *arrayRank) {
+          messages.Say(
+              "The value of DIM= (%jd) may not be greater than %d"_err_en_US,
+              static_cast<std::intmax_t>(*dimVal), *arrayRank);
+        }
+      }
+    }
+    switch (rank) {
+    case Rank::dimReduced:
+    case Rank::dimRemovedOrScalar:
+    case Rank::locReduced:
+    case Rank::scalarIfDim:
+      if (dummy[*dimArg].optionality == Optionality::required) {
+        if (const Symbol *whole{
+                UnwrapWholeSymbolOrComponentDataRef(actualForDummy[*dimArg])}) {
+          if (IsOptional(*whole) || IsAllocatableOrPointer(*whole)) {
+            if (rank == Rank::scalarIfDim || arrayRank.value_or(-1) == 1) {
+              messages.Say(
+                  "The actual argument for DIM= is optional, pointer, or allocatable, and it is assumed to be present and equal to 1 at execution time"_port_en_US);
+            } else {
+              messages.Say(
+                  "The actual argument for DIM= is optional, pointer, or allocatable, and may not be absent during execution; parenthesize to silence this warning"_warn_en_US);
+            }
+          }
+        }
+      }
+      break;
+    default:;
+    }
+  }
+
   // At this point, the call is acceptable.
   // Determine the rank of the function result.
   int resultRank{0};
   switch (rank) {
   case Rank::elemental:
     resultRank = elementalRank;
     break;
   case Rank::scalar:
     resultRank = 0;
     break;
   case Rank::vector:
     resultRank = 1;
     break;
   case Rank::matrix:
     resultRank = 2;
     break;
   case Rank::conformable:
     CHECK(arrayArg);
     resultRank = arrayArg->Rank();
     break;
   case Rank::dimReduced:
     CHECK(arrayArg);
-    resultRank = hasDimArg ? arrayArg->Rank() - 1 : 0;
+    resultRank = dimArg ? arrayArg->Rank() - 1 : 0;
     break;
   case Rank::locReduced:
     CHECK(arrayArg);
-    resultRank = hasDimArg ? arrayArg->Rank() - 1 : 1;
+    resultRank = dimArg ? arrayArg->Rank() - 1 : 1;
     break;
   case Rank::rankPlus1:
     CHECK(knownArg);
     resultRank = knownArg->Rank() + 1;
     break;
   case Rank::shaped:
     CHECK(shapeArgSize);
     resultRank = *shapeArgSize;
     break;
   case Rank::scalarIfDim:
-    resultRank = hasDimArg ? 0 : 1;
+    resultRank = dimArg ? 0 : 1;
     break;
   case Rank::elementalOrBOZ:
   case Rank::shape:
   case Rank::array:
   case Rank::coarray:
   case Rank::atom:
   case Rank::known:
   case Rank::anyOrAssumedRank:
   case Rank::reduceOperation:
   case Rank::dimRemovedOrScalar:
     common::die("INTERNAL: bad Rank code on intrinsic '%s' result", name);
     break;
   }
   CHECK(resultRank >= 0);
 
   // Rearrange the actual arguments into dummy argument order.
   ActualArguments rearranged(dummies);
   for (std::size_t j{0}; j < dummies; ++j) {
-    if (ActualArgument * arg{actualForDummy[j]}) {
+    if (ActualArgument *arg{actualForDummy[j]}) {
       rearranged[j] = std::move(*arg);
     }
   }
 
   // Characterize the specific intrinsic procedure.
   characteristics::DummyArguments dummyArgs;
   std::optional<int> sameDummyArg;
 
if (dummies.size() == 2) {
     return std::nullopt;
   }
 }
 
 static bool CheckAssociated(SpecificCall &call, FoldingContext &context) {
   bool ok{true};
   if (const auto &pointerArg{call.arguments[0]}) {
     if (const auto *pointerExpr{pointerArg->UnwrapExpr()}) {
-      if (const Symbol * pointerSymbol{GetLastSymbol(*pointerExpr)}) {
+      if (const Symbol *pointerSymbol{GetLastSymbol(*pointerExpr)}) {
         if (!pointerSymbol->attrs().test(semantics::Attr::POINTER)) {
           AttachDeclaration(context.messages().Say(pointerArg->sourceLocation(),
                                 "POINTER= argument of ASSOCIATED() must be a "
                                 "POINTER"_err_en_US),
               *pointerSymbol);
         } else {
           if (const auto &targetArg{call.arguments[1]}) {
             if (const auto *targetExpr{targetArg->UnwrapExpr()}) {
if (name == "allocated") {
     }
   } else if (name == "move_alloc") {
     ok &= CheckForCoindexedObject(context, call.arguments[0], name, "from");
     ok &= CheckForCoindexedObject(context, call.arguments[1], name, "to");
     ok &= CheckForCoindexedObject(context, call.arguments[2], name, "stat");
     ok &= CheckForCoindexedObject(context, call.arguments[3], name, "errmsg");
     if (call.arguments[0] && call.arguments[1]) {
       for (int j{0}; j < 2; ++j) {
-        if (const Symbol * last{GetLastSymbol(call.arguments[j])};
+        if (const Symbol *last{GetLastSymbol(call.arguments[j])};
             last && !IsAllocatable(last->GetUltimate())) {
           context.messages().Say(call.arguments[j]->sourceLocation(),
               "Argument #%d to MOVE_ALLOC must be allocatable"_err_en_US,
               j + 1);
           ok = false;
         }
       }
       auto type0{call.arguments[0]->GetType()};
       auto type1{call.arguments[1]->GetType()};
       if (type0 && type1 && type0->IsPolymorphic() && !type1->IsPolymorphic()) {
         context.messages().Say(call.arguments[1]->sourceLocation(),
             "When MOVE_ALLOC(FROM=) is polymorphic, TO= must also be polymorphic"_err_en_US);
         ok = false;
       }
     }
   } else if (name == "present") {
     const auto &arg{call.arguments[0]};
     if (arg) {
       if (const auto *expr{arg->UnwrapExpr()}) {
-        if (const Symbol * symbol{UnwrapWholeSymbolDataRef(*expr)}) {
+        if (const Symbol *symbol{UnwrapWholeSymbolDataRef(*expr)}) {
           ok = symbol->attrs().test(semantics::Attr::OPTIONAL);
         }
       }
     }
     if (!ok) {
       context.messages().Say(
           arg ? arg->sourceLocation() : context.messages().at(),
           "Argument of PRESENT() must be the name of an OPTIONAL dummy argument"_err_en_US);

flang/lib/Evaluate/tools.cpp

return common::visit(
               },
               std::move(x.u));
         }
       },
       std::move(expr.u));
 }
 
 std::optional<DataRef> ExtractDataRef(
-    const ActualArgument &arg, bool intoSubstring) {
-  if (const Expr<SomeType> *expr{arg.UnwrapExpr()}) {
-    return ExtractDataRef(*expr, intoSubstring);
-  } else {
-    return std::nullopt;
-  }
+    const ActualArgument &arg, bool intoSubstring, bool intoComplexPart) {
+  return ExtractDataRef(arg.UnwrapExpr(), intoSubstring, intoComplexPart);
 }
 
 std::optional<DataRef> ExtractSubstringBase(const Substring &substring) {
   return common::visit(
       common::visitors{
           [&](const DataRef &x) -> std::optional<DataRef> { return x; },
           [&](const StaticDataObject::Pointer &) -> std::optional<DataRef> {
             return std::nullopt;

flang/test/Lower/transformational-intrinsics.f90

! CSHIFT
   ! CHECK:         %[[VAL_9:.*]] = arith.constant 3 : index
   ! CHECK:         %[[VAL_10:.*]] = fir.alloca !fir.array<3xi32> {bindc_name = "shift", uniq_name = "_QMtest2Fcshift_testEshift"}
   ! CHECK:         %[[VAL_11:.*]] = arith.constant 6 : index
   ! CHECK:         %[[VAL_12:.*]] = fir.alloca !fir.array<6xi32> {bindc_name = "vector", uniq_name = "_QMtest2Fcshift_testEvector"}
   ! CHECK:         %[[VAL_13:.*]] = arith.constant 6 : index
   ! CHECK:         %[[VAL_14:.*]] = fir.alloca !fir.array<6xi32> {bindc_name = "vectorresult", uniq_name = "_QMtest2Fcshift_testEvectorresult"}
   ! CHECK:         %[[VAL_15:.*]] = fir.shape %[[VAL_6]], %[[VAL_7]] : (index, index) -> !fir.shape<2>
   ! CHECK:         %[[VAL_16:.*]] = fir.array_load %[[VAL_8]](%[[VAL_15]]) : (!fir.ref<!fir.array<3x3xi32>>, !fir.shape<2>) -> !fir.array<3x3xi32>
-  ! CHECK:         %[[VAL_17:.*]] = arith.constant -2 : i32
+  ! CHECK:         %[[VAL_17:.*]] = arith.constant 2 : i32
   ! CHECK:         %[[VAL_18:.*]] = fir.shape %[[VAL_3]], %[[VAL_4]] : (index, index) -> !fir.shape<2>
   ! CHECK:         %[[VAL_19:.*]] = fir.embox %[[VAL_5]](%[[VAL_18]]) : (!fir.ref<!fir.array<3x3xi32>>, !fir.shape<2>) -> !fir.box<!fir.array<3x3xi32>>
   ! CHECK:         %[[VAL_20:.*]] = fir.zero_bits !fir.heap<!fir.array<?x?xi32>>
   ! CHECK:         %[[VAL_21:.*]] = arith.constant 0 : index
   ! CHECK:         %[[VAL_22:.*]] = fir.shape %[[VAL_21]], %[[VAL_21]] : (index, index) -> !fir.shape<2>
   ! CHECK:         %[[VAL_23:.*]] = fir.embox %[[VAL_20]](%[[VAL_22]]) : (!fir.heap<!fir.array<?x?xi32>>, !fir.shape<2>) -> !fir.box<!fir.heap<!fir.array<?x?xi32>>>
   ! CHECK:         fir.store %[[VAL_23]] to %[[VAL_2]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x?xi32>>>>
   ! CHECK:         %[[VAL_24:.*]] = fir.shape %[[VAL_9]] : (index) -> !fir.shape<1>
! CSHIFT
   ! CHECK:       }
 
 subroutine cshift_test()
   integer, dimension (3, 3) :: array
   integer, dimension(3) :: shift
   integer, dimension(3, 3) :: result
   integer, dimension(6) :: vectorResult
   integer, dimension (6) :: vector
-  result = cshift(array, shift, -2) ! non-vector case
+  result = cshift(array, shift, 2) ! non-vector case
   vectorResult = cshift(vector, 3) ! vector case
 end subroutine cshift_test
 
 ! UNPACK
 ! CHECK-LABEL: func @_QMtest2Punpack_test
 subroutine unpack_test()
   integer, dimension(3) :: vector
   integer, dimension (3,3) :: field

flang/test/Semantics/dim01.f90

+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Test warnings and errors about DIM= arguments to transformational intrinsics
+
+module m
+ contains
+  function f0a(a)
+    real, intent(in) :: a(:)
+    !ERROR: The value of DIM= (-1) may not be less than 1
+    f0a = sum(a,dim=-1)
+  end function
+  function f0b(a)
+    real, intent(in) :: a(:)
+    !ERROR: The value of DIM= (2) may not be greater than 1
+    f0b = sum(a,dim=2)
+  end function
+  function f1(a,d)
+    real, intent(in) :: a(:)
+    integer, optional, intent(in) :: d
+    !PORTABILITY: The actual argument for DIM= is optional, pointer, or allocatable, and it is assumed to be present and equal to 1 at execution time
+    f1 = sum(a,dim=d)
+  end function
+  function f2(a,d)
+    real, intent(in) :: a(:)
+    integer, pointer, intent(in) :: d
+    !PORTABILITY: The actual argument for DIM= is optional, pointer, or allocatable, and it is assumed to be present and equal to 1 at execution time
+    f2 = sum(a,dim=d)
+  end function
+  function f3(a,d)
+    real, intent(in) :: a(:)
+    integer, allocatable, intent(in) :: d
+    !PORTABILITY: The actual argument for DIM= is optional, pointer, or allocatable, and it is assumed to be present and equal to 1 at execution time
+    f3 = sum(a,dim=d)
+  end function
+  function f10a(a)
+    real, intent(in) :: a(:,:)
+    real, allocatable :: f10a(:)
+    !ERROR: The value of DIM= (-1) may not be less than 1
+    f10a = sum(a,dim=-1)
+  end function
+  function f10b(a)
+    real, intent(in) :: a(:,:)
+    real, allocatable :: f10b(:)
+    !ERROR: The value of DIM= (3) may not be greater than 2
+    f10b = sum(a,dim=3)
+  end function
+  function f11(a,d)
+    real, intent(in) :: a(:,:)
+    integer, optional, intent(in) :: d
+    real, allocatable :: f11(:)
+    !WARNING: The actual argument for DIM= is optional, pointer, or allocatable, and may not be absent during execution; parenthesize to silence this warning
+    f11 = sum(a,dim=d)
+  end function
+  function f12(a,d)
+    real, intent(in) :: a(:,:)
+    integer, pointer, intent(in) :: d
+    real, allocatable :: f12(:)
+    !WARNING: The actual argument for DIM= is optional, pointer, or allocatable, and may not be absent during execution; parenthesize to silence this warning
+    f12 = sum(a,dim=d)
+  end function
+  function f13(a,d)
+    real, intent(in) :: a(:,:)
+    integer, allocatable, intent(in) :: d
+    real, allocatable :: f13(:)
+    !WARNING: The actual argument for DIM= is optional, pointer, or allocatable, and may not be absent during execution; parenthesize to silence this warning
+    f13 = sum(a,dim=d)
+  end function
+end module
+