[flang] Fix bugs detecting impure calls

Change Traverse to visit the actual arguments of structure constructors.

Change FindImpureCallHelper to visit the actual arguments of a call to a
pure procedure in case one of them makes a call to an impure function.

Original-commit: flang-compiler/f18@81a5488ee62b4324d002c348464712c930095a32
Reviewed-on: https://github.com/flang-compiler/f18/pull/951

diff --git a/flang/lib/evaluate/tools.cc b/flang/lib/evaluate/tools.cc
index 2ea4719..2b1b907 100644 (file)
--- a/flang/lib/evaluate/tools.cc
+++ b/flang/lib/evaluate/tools.cc
@@ -828,7 +828,7 @@ public:
     if (auto chars{characteristics::Procedure::Characterize(
             call.proc(), intrinsics_)}) {
       if (chars->attrs.test(characteristics::Procedure::Attr::Pure)) {
-        return std::nullopt;
+        return (*this)(call.arguments());
       }
     }
     return call.proc().GetName();

diff --git a/flang/lib/evaluate/traverse.h b/flang/lib/evaluate/traverse.h
index 9300c9d..2fa8995 100644 (file)
--- a/flang/lib/evaluate/traverse.h
+++ b/flang/lib/evaluate/traverse.h
@@ -85,8 +85,21 @@ public:
     return visitor_.Default();
   }
   Result operator()(const NullPointer &) const { return visitor_.Default(); }
-  template<typename T> Result operator()(const Constant<T> &) const {
-    return visitor_.Default();
+  template<typename T> Result operator()(const Constant<T> &x) const {
+    if constexpr (T::category == TypeCategory::Derived) {
+      std::optional<Result> result;
+      for (const StructureConstructorValues &map : x.values()) {
+        for (const auto &pair : map) {
+          auto value{visitor_(pair.second.value())};
+          result = result
+              ? visitor_.Combine(std::move(*result), std::move(value))
+              : std::move(value);
+        }
+      }
+      return result ? *result : visitor_.Default();
+    } else {
+      return visitor_.Default();
+    }
   }
   Result operator()(const Symbol &) const { return visitor_.Default(); }
   Result operator()(const StaticDataObject &) const {

diff --git a/flang/test/semantics/call11.f90 b/flang/test/semantics/call11.f90
index 2ff18a0..061b73d 100644 (file)
--- a/flang/test/semantics/call11.f90
+++ b/flang/test/semantics/call11.f90
@@ -32,12 +32,17 @@ module m
       !ERROR: Impure procedure 'impure' may not be referenced in a FORALL
       a(j) = impure(j) ! C1037
     end forall
+    forall (j=1:1)
+      !ERROR: Impure procedure 'impure' may not be referenced in a FORALL
+      a(j) = pure(impure(j)) ! C1037
+    end forall
     !ERROR: Concurrent-header mask expression cannot reference an impure procedure
     do concurrent (j=1:1, impure(j) /= 0) ! C1121
       !ERROR: Call to an impure procedure is not allowed in DO CONCURRENT
       a(j) = impure(j) ! C1139
     end do
   end subroutine
+
   subroutine test2
     type(t) :: x
     real :: a(x%tbp_pure(1)) ! ok
@@ -59,4 +64,19 @@ module m
       a(j) = x%tbp_impure(j) ! C1139
     end do
   end subroutine
+
+  subroutine test3
+    type :: t
+      integer :: i
+    end type
+    type(t) :: a(10), b
+    forall (i=1:10)
+      a(i) = t(pure(i))  ! OK
+    end forall
+    forall (i=1:10)
+      !ERROR: Impure procedure 'impure' may not be referenced in a FORALL
+      a(i) = t(impure(i))  ! C1037
+    end forall
+  end subroutine
+
 end module