[flang][Evaluate] Add IntrinsicCall::impureFunction to RAND and IRAND

[JDPailleux]

This PR adds the impureFunction intrinsicClass for intrinsics wich are function such as RAND and IRAND, which are not PURE functions in the GNU extension and therefore cannot be called in a DO CONCURRENT (see test-suite::gfortran-regression-compile-regression__pr119836_2_f90.test ). The Pure attribute will not be added for these intrinsics.

Should I open a PR to disable the test in llvm-test-suite since the error is different in Flang ?

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Jean-Didier PAILLEUX (JDPailleux)

Changes

This PR adds the impureFunction intrinsicClass for intrinsics wich are function such as RAND and IRAND, which are not PURE functions in the GNU extension and therefore cannot be called in a DO CONCURRENT (see test-suite::gfortran-regression-compile-regression__pr119836_2_f90.test ). The Pure attribute will not be added for these intrinsics.

Should I open a PR to disable the test in llvm-test-suite since the error is different in Flang ?

---

Full diff: https://github.com/llvm/llvm-project/pull/170492.diff

3 Files Affected:

• (modified) flang/include/flang/Evaluate/intrinsics.h (+1-1)
• (modified) flang/lib/Evaluate/intrinsics.cpp (+6-3)
• (modified) flang/test/Semantics/doconcurrent01.f90 (+9)

diff --git a/flang/include/flang/Evaluate/intrinsics.h b/flang/include/flang/Evaluate/intrinsics.h
index fc1c8b2ba6ab7..8bece0831cf18 100644
--- a/flang/include/flang/Evaluate/intrinsics.h
+++ b/flang/include/flang/Evaluate/intrinsics.h
@@ -63,7 +63,7 @@ struct SpecificIntrinsicFunctionInterface : public characteristics::Procedure {
 // Generic intrinsic classes from table 16.1
 ENUM_CLASS(IntrinsicClass, atomicSubroutine, collectiveSubroutine,
     elementalFunction, elementalSubroutine, inquiryFunction, pureSubroutine,
-    impureSubroutine, transformationalFunction, noClass)
+    impureFunction, impureSubroutine, transformationalFunction, noClass)
 
 class IntrinsicProcTable {
 private:
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index bbcb766274e7f..747a5a9359220 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -657,7 +657,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
     {"irand",
         {{"i", TypePattern{IntType, KindCode::exactKind, 4}, Rank::scalar,
             Optionality::optional}},
-        TypePattern{IntType, KindCode::exactKind, 4}, Rank::scalar},
+        TypePattern{IntType, KindCode::exactKind, 4}, Rank::scalar,
+        IntrinsicClass::impureFunction},
     {"ishft", {{"i", SameIntOrUnsigned}, {"shift", AnyInt}}, SameIntOrUnsigned},
     {"ishftc",
         {{"i", SameIntOrUnsigned}, {"shift", AnyInt},
@@ -879,7 +880,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
     {"rand",
         {{"i", TypePattern{IntType, KindCode::exactKind, 4}, Rank::scalar,
             Optionality::optional}},
-        TypePattern{RealType, KindCode::exactKind, 4}, Rank::scalar},
+        TypePattern{RealType, KindCode::exactKind, 4}, Rank::scalar,
+        IntrinsicClass::impureFunction},
     {"range",
         {{"x", AnyNumeric, Rank::anyOrAssumedRank, Optionality::required,
             common::Intent::In,
@@ -2834,7 +2836,8 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
             name, characteristics::Procedure{std::move(dummyArgs), attrs}},
         std::move(rearranged)};
   } else {
-    attrs.set(characteristics::Procedure::Attr::Pure);
+    if (intrinsicClass != IntrinsicClass::impureFunction /* RAND and IRAND */)
+      attrs.set(characteristics::Procedure::Attr::Pure);
     characteristics::TypeAndShape typeAndShape{resultType.value(), resultRank};
     characteristics::FunctionResult funcResult{std::move(typeAndShape)};
     characteristics::Procedure chars{
diff --git a/flang/test/Semantics/doconcurrent01.f90 b/flang/test/Semantics/doconcurrent01.f90
index ab14d970b8501..fddb91639ee51 100644
--- a/flang/test/Semantics/doconcurrent01.f90
+++ b/flang/test/Semantics/doconcurrent01.f90
@@ -211,6 +211,7 @@ end function ipf
   type(procTypeNotPure) :: procVarNotPure
   type(procTypePure) :: procVarPure
   integer :: ivar
+  real :: rvar
 
   procVarPure%pureProcComponent => pureFunc
 
@@ -239,6 +240,14 @@ end function ipf
     ivar = generic()
   end do
 
+  ! This should generate an error
+  do concurrent (i = 1:10)
+!ERROR: Impure procedure 'irand' may not be referenced in DO CONCURRENT
+    ivar = irand()
+!ERROR: Impure procedure 'rand' may not be referenced in DO CONCURRENT
+    rvar = rand()
+  end do
+
   contains
     integer function notPureFunc()
       notPureFunc = 2

[antmox]

looks like there are no more failures with this