[flang] Emit errors on vector subscripts with duplicated elements whe…

…n object must be definable

When the left-hand side of an assignment, or any other context demanding
definability, comprises a designator with a vector subscript that is
known at compilation time to have one or more duplicated elements,
emit an error message.

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

flang/lib/Semantics/check-call.cpp

@@ -448,6 +448,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
   }
 
   // Definability
+  bool actualIsVariable{evaluate::IsVariable(actual)};
   const char *reason{nullptr};
   if (dummy.intent == common::Intent::Out) {
     reason = "INTENT(OUT)";
@@ -457,7 +458,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
   if (reason && scope) {
     // Problems with polymorphism are caught in the callee's definition.
     DefinabilityFlags flags{DefinabilityFlag::PolymorphicOkInPure};
-    if (isElemental || dummyIsValue) { // 15.5.2.4(21)
+    if (isElemental) { // 15.5.2.4(21)
       flags.set(DefinabilityFlag::VectorSubscriptIsOk);
     }
     if (actualIsPointer && dummyIsPointer) { // 19.6.8
@@ -475,7 +476,6 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
   // technically legal but worth emitting a warning
   // llvm-project issue #58973: constant actual argument passed in where dummy
   // argument is marked volatile
-  bool actualIsVariable{evaluate::IsVariable(actual)};
   if (dummyIsVolatile && !actualIsVariable &&
       context.ShouldWarn(common::UsageWarning::ExprPassedToVolatile)) {
     messages.Say(

flang/lib/Semantics/definable.cpp

@@ -244,6 +244,47 @@ std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
   return WhyNotDefinableLast(at, scope, flags, original);
 }
 
+class DuplicatedSubscriptFinder
+    : public evaluate::AnyTraverse<DuplicatedSubscriptFinder, bool> {
+  using Base = evaluate::AnyTraverse<DuplicatedSubscriptFinder, bool>;
+
+public:
+  explicit DuplicatedSubscriptFinder(evaluate::FoldingContext &foldingContext)
+      : Base{*this}, foldingContext_{foldingContext} {}
+  using Base::operator();
+  bool operator()(const evaluate::ActualArgument &) {
+    return false; // don't descend into argument expressions
+  }
+  bool operator()(const evaluate::ArrayRef &aRef) {
+    bool anyVector{false};
+    for (const auto &ss : aRef.subscript()) {
+      if (ss.Rank() > 0) {
+        anyVector = true;
+        if (const auto *vecExpr{
+                std::get_if<evaluate::IndirectSubscriptIntegerExpr>(&ss.u)}) {
+          auto folded{evaluate::Fold(foldingContext_,
+              evaluate::Expr<evaluate::SubscriptInteger>{vecExpr->value()})};
+          if (const auto *con{
+                  evaluate::UnwrapConstantValue<evaluate::SubscriptInteger>(
+                      folded)}) {
+            std::set<std::int64_t> values;
+            for (const auto &j : con->values()) {
+              if (auto pair{values.emplace(j.ToInt64())}; !pair.second) {
+                return true; // duplicate
+              }
+            }
+          }
+          return false;
+        }
+      }
+    }
+    return anyVector ? false : (*this)(aRef.base());
+  }
+
+private:
+  evaluate::FoldingContext &foldingContext_;
+};
+
 std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
     const Scope &scope, DefinabilityFlags flags,
     const evaluate::Expr<evaluate::SomeType> &expr) {
@@ -288,6 +329,11 @@ std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
             }
           }
         }
+        if (!flags.test(DefinabilityFlag::DuplicatesAreOk) &&
+            DuplicatedSubscriptFinder{scope.context().foldingContext()}(expr)) {
+          return parser::Message{at,
+              "Variable has a vector subscript with a duplicated element"_because_en_US};
+        }
       } else {
         return parser::Message{at,
             "Variable '%s' has a vector subscript"_because_en_US,

flang/lib/Semantics/definable.h

@@ -27,6 +27,7 @@ class Scope;
 
 ENUM_CLASS(DefinabilityFlag,
     VectorSubscriptIsOk, // a vector subscript may appear (i.e., assignment)
+    DuplicatesAreOk, // vector subscript may have duplicates
     PointerDefinition, // a pointer is being defined, not its target
     AcceptAllocatable, // treat allocatable as if it were a pointer
     PolymorphicOkInPure) // don't check for polymorphic type in pure subprogram

flang/test/Semantics/definable06.f90

@@ -0,0 +1,20 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+module m
+ contains
+  elemental subroutine inout(x)
+    integer, intent(inout) :: x
+  end
+  subroutine test
+    integer :: x(2)
+    !ERROR: Left-hand side of assignment is not definable
+    !BECAUSE: Variable has a vector subscript with a duplicated element
+    x([1,1]) = 0
+    !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
+    !BECAUSE: Variable has a vector subscript with a duplicated element
+    call inout(x([(mod(j-1,2)+1,j=1,10)]))
+    !ERROR: Input variable 'x' is not definable
+    !BECAUSE: Variable has a vector subscript with a duplicated element
+    read (*,*) x([2,2])
+  end
+end
+