[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.

Author: JDPailleux

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:

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{

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