[flang] Relax constraints on PURE/ELEMENTAL dummy arguments

flang/docs/Extensions.md

@@ -118,6 +118,12 @@ end
   procedure interface.  This compiler accepts it, since there is otherwise
   no way to declare an interoperable dummy procedure with an arbitrary
   interface like `void (*)()`.
+* `PURE` functions are allowed to have dummy arguments that are
+  neither `INTENT(IN)` nor `VALUE`, similar to `PURE` subroutines,
+  with a warning.
+  This enables atomic memory operations to be naturally represented
+  as `PURE` functions, which allows their use in parallel constructs
+  and `DO CONCURRENT`.
 
 ## Extensions, deletions, and legacy features supported by default
 

flang/include/flang/Common/Fortran-features.h

@@ -50,7 +50,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
     EmptySequenceType, NonSequenceCrayPointee, BranchIntoConstruct,
     BadBranchTarget, ConvertedArgument, HollerithPolymorphic, ListDirectedSize,
     NonBindCInteroperability, CudaManaged, CudaUnified,
-    PolymorphicActualAllocatableOrPointerToMonomorphicDummy)
+    PolymorphicActualAllocatableOrPointerToMonomorphicDummy, RelaxedPureDummy)
 
 // Portability and suspicious usage warnings
 ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,

flang/lib/Semantics/check-declarations.cpp

@@ -704,29 +704,48 @@ void CheckHelper::CheckObjectEntity(
     if (InPure() && !IsStmtFunction(DEREF(innermostSymbol_)) &&
         !IsPointer(symbol) && !IsIntentIn(symbol) &&
         !symbol.attrs().test(Attr::VALUE)) {
-      if (InFunction()) { // C1583
-        messages_.Say(
-            "non-POINTER dummy argument of pure function must be INTENT(IN) or VALUE"_err_en_US);
-      } else if (IsIntentOut(symbol)) {
+      const char *what{InFunction() ? "function" : "subroutine"};
+      bool ok{true};
+      if (IsIntentOut(symbol)) {
         if (type && type->IsPolymorphic()) { // C1588
           messages_.Say(
-              "An INTENT(OUT) dummy argument of a pure subroutine may not be polymorphic"_err_en_US);
+              "An INTENT(OUT) dummy argument of a pure %s may not be polymorphic"_err_en_US,
+              what);
+          ok = false;
         } else if (derived) {
           if (FindUltimateComponent(*derived, [](const Symbol &x) {
                 const DeclTypeSpec *type{x.GetType()};
                 return type && type->IsPolymorphic();
               })) { // C1588
             messages_.Say(
-                "An INTENT(OUT) dummy argument of a pure subroutine may not have a polymorphic ultimate component"_err_en_US);
+                "An INTENT(OUT) dummy argument of a pure %s may not have a polymorphic ultimate component"_err_en_US,
+                what);
+            ok = false;
           }
           if (HasImpureFinal(symbol)) { // C1587
             messages_.Say(
-                "An INTENT(OUT) dummy argument of a pure subroutine may not have an impure FINAL subroutine"_err_en_US);
+                "An INTENT(OUT) dummy argument of a pure %s may not have an impure FINAL subroutine"_err_en_US,
+                what);
+            ok = false;
           }
         }
       } else if (!IsIntentInOut(symbol)) { // C1586
         messages_.Say(
-            "non-POINTER dummy argument of pure subroutine must have INTENT() or VALUE attribute"_err_en_US);
+            "non-POINTER dummy argument of pure %s must have INTENT() or VALUE attribute"_warn_en_US,
+            what);
+        ok = false;
+      }
+      if (ok && InFunction()) {
+        if (context_.IsEnabled(common::LanguageFeature::RelaxedPureDummy)) {
+          if (context_.ShouldWarn(common::LanguageFeature::RelaxedPureDummy) &&
+              !InModuleFile() && !InElemental()) {
+            messages_.Say(
+                "non-POINTER dummy argument of pure function should be INTENT(IN) or VALUE"_warn_en_US);
+          }
+        } else {
+          messages_.Say(
+              "non-POINTER dummy argument of pure function must be INTENT(IN) or VALUE"_err_en_US);
+        }
       }
     }
     if (auto ignoreTKR{GetIgnoreTKR(symbol)}; !ignoreTKR.empty()) {
@@ -798,7 +817,7 @@ void CheckHelper::CheckObjectEntity(
             "A dummy argument of an ELEMENTAL procedure may not be a POINTER"_err_en_US);
       }
       if (!symbol.attrs().HasAny(Attrs{Attr::VALUE, Attr::INTENT_IN,
-              Attr::INTENT_INOUT, Attr::INTENT_OUT})) { // C15102
+              Attr::INTENT_INOUT, Attr::INTENT_OUT})) { // F'2023 C15120
         messages_.Say(
             "A dummy argument of an ELEMENTAL procedure must have an INTENT() or VALUE attribute"_err_en_US);
       }

flang/test/Semantics/call10.f90

@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
 ! Test 15.7 (C1583-C1590, C1592-C1599) constraints and restrictions
 ! for pure procedures.
 ! (C1591 is tested in call11.f90; C1594 in call12.f90.)
@@ -53,14 +53,14 @@ pure real function f02(a)
     real, value :: a ! ok
   end function
   pure real function f03(a) ! C1583
-    !ERROR: non-POINTER dummy argument of pure function must be INTENT(IN) or VALUE
+    !ERROR: non-POINTER dummy argument of pure function must have INTENT() or VALUE attribute
     real :: a
   end function
   pure real function f03a(a)
     real, pointer :: a ! ok
   end function
   pure real function f04(a) ! C1583
-    !ERROR: non-POINTER dummy argument of pure function must be INTENT(IN) or VALUE
+    !WARNING: non-POINTER dummy argument of pure function should be INTENT(IN) or VALUE
     real, intent(out) :: a
   end function
   pure real function f04a(a)

flang/test/Semantics/elemental01.f90

@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
 ! Tests ELEMENTAL subprogram constraints C15100-15102
 
 !ERROR: An ELEMENTAL subroutine may not have an alternate return dummy argument