[flang-commits] [flang] c8a7a3a - [flang][Evaluate] Add IntrinsicCall::impureFunction to RAND and IRAND (#170492)

[via flang-commits]

Author: Jean-Didier PAILLEUX
Date: 2025-12-04T07:57:18+01:00
New Revision: c8a7a3a70d607eee2cf134e43fc717d317a605e8

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

LOG: [flang][Evaluate] Add IntrinsicCall::impureFunction to RAND and IRAND (#170492)

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.

Added: 
    

Modified: 
    flang/include/flang/Evaluate/intrinsics.h
    flang/lib/Evaluate/intrinsics.cpp
    flang/test/Semantics/doconcurrent01.f90

Removed: 
    


################################################################################
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