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

Peter Klausler via flang-commits flang-commits at lists.llvm.org
Sun Dec 4 13:04:50 PST 2022


Author: Peter Klausler
Date: 2022-12-04T13:04:36-08:00
New Revision: af54b676e4712e81216eea66e92baa7ffba19a46

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

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

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.

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

Added: 
    flang/test/Semantics/dim01.f90

Modified: 
    flang/include/flang/Evaluate/fold.h
    flang/include/flang/Evaluate/tools.h
    flang/lib/Evaluate/fold-implementation.h
    flang/lib/Evaluate/fold-integer.cpp
    flang/lib/Evaluate/fold.cpp
    flang/lib/Evaluate/intrinsics.cpp
    flang/lib/Evaluate/tools.cpp
    flang/test/Lower/transformational-intrinsics.f90

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Evaluate/fold.h b/flang/include/flang/Evaluate/fold.h
index 24fb54761962c..d2a153fb7919e 100644
--- a/flang/include/flang/Evaluate/fold.h
+++ b/flang/include/flang/Evaluate/fold.h
@@ -92,6 +92,7 @@ constexpr std::optional<std::int64_t> ToInt64(
 
 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) {
@@ -102,12 +103,13 @@ std::optional<std::int64_t> ToInt64(const std::optional<A> &x) {
   }
 }
 
-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_

diff  --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index 4d3f8b760e6bb..a8b783e3719fa 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -312,15 +312,15 @@ std::optional<DataRef> ExtractDataRef(const std::optional<A> &x,
 }
 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 &);
 

diff  --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h
index 79bea7805f30d..bff0f52f0881f 100644
--- a/flang/lib/Evaluate/fold-implementation.h
+++ b/flang/lib/Evaluate/fold-implementation.h
@@ -533,7 +533,6 @@ Expr<TR> FoldElementalIntrinsic(FoldingContext &context,
       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);
 
@@ -900,8 +899,8 @@ 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)};
   }

diff  --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp
index 603c4a46f9b52..0aaf5b182635e 100644
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -119,7 +119,7 @@ Expr<Type<TypeCategory::Integer, KIND>> LBOUND(FoldingContext &context,
       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,
@@ -173,7 +173,7 @@ Expr<Type<TypeCategory::Integer, KIND>> UBOUND(FoldingContext &context,
       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,
@@ -1014,7 +1014,7 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
       }
     }
   } 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" ||
@@ -1073,7 +1073,7 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
   } 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])};
@@ -1190,11 +1190,11 @@ std::optional<std::int64_t> ToInt64(const Expr<SomeInteger> &expr) {
 }
 
 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

diff  --git a/flang/lib/Evaluate/fold.cpp b/flang/lib/Evaluate/fold.cpp
index 9a4240f433567..c78a0aa4c9ad3 100644
--- a/flang/lib/Evaluate/fold.cpp
+++ b/flang/lib/Evaluate/fold.cpp
@@ -205,24 +205,9 @@ ComplexPart FoldOperation(FoldingContext &context, ComplexPart &&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(

diff  --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 948c72af10519..865aae574d99e 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1624,7 +1624,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
   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) {
@@ -1655,7 +1655,8 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
       } 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;
@@ -1764,7 +1765,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
       break;
     case KindCode::dimArg:
       CHECK(type->category() == TypeCategory::Integer);
-      hasDimArg = true;
+      dimArg = j;
       argOk = true;
       break;
     case KindCode::same:
@@ -1854,7 +1855,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
   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(),
@@ -1934,7 +1935,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
         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)) {
@@ -2141,6 +2142,49 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
     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};
@@ -2163,11 +2207,11 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
     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);
@@ -2178,7 +2222,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
     resultRank = *shapeArgSize;
     break;
   case Rank::scalarIfDim:
-    resultRank = hasDimArg ? 0 : 1;
+    resultRank = dimArg ? 0 : 1;
     break;
   case Rank::elementalOrBOZ:
   case Rank::shape:
@@ -2197,7 +2241,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
   // 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);
     }
   }
@@ -2602,7 +2646,7 @@ 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 "
@@ -2896,7 +2940,7 @@ static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
     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,
@@ -2916,7 +2960,7 @@ static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
     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);
         }
       }

diff  --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 46caf9e705ca9..278a40e8be3ef 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -60,12 +60,8 @@ Expr<SomeType> Parenthesize(Expr<SomeType> &&expr) {
 }
 
 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) {

diff  --git a/flang/test/Lower/transformational-intrinsics.f90 b/flang/test/Lower/transformational-intrinsics.f90
index f75654b26e808..2b57d45fd1bc6 100644
--- a/flang/test/Lower/transformational-intrinsics.f90
+++ b/flang/test/Lower/transformational-intrinsics.f90
@@ -141,7 +141,7 @@ subroutine in_elem_expr(x, y, z)
   ! 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>>
@@ -224,7 +224,7 @@ subroutine cshift_test()
   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
 

diff  --git a/flang/test/Semantics/dim01.f90 b/flang/test/Semantics/dim01.f90
new file mode 100644
index 0000000000000..48c0291b58f9e
--- /dev/null
+++ b/flang/test/Semantics/dim01.f90
@@ -0,0 +1,68 @@
+! 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
+


        


More information about the flang-commits mailing list