From 1ace40a0e00da2e8169e1100aee933b93e3d1958 Mon Sep 17 00:00:00 2001
From: Jean-Didier Pailleux <jean-didier.pailleux@sipearl.com>
Date: Wed, 3 Dec 2025 15:43:24 +0100
Subject: [PATCH] [flang][Evaluate] Add IntrinsicCall::impureFunction to RAND
 and IRAND

---
 flang/include/flang/Evaluate/intrinsics.h | 2 +-
 flang/lib/Evaluate/intrinsics.cpp         | 9 ++++++---
 flang/test/Semantics/doconcurrent01.f90   | 9 +++++++++
 3 files changed, 16 insertions(+), 4 deletions(-)

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