[flang] Define ATOMIC_ADD as an intrinsic procedure

klausler · klausler · commit 44819b56e136 · 2025-01-14T16:45:24.000-08:00
This one appears to have been omitted when other ATOMIC_xxx intrinsic
procedures were defined.  There's already tests for it, but they
apparently work even when ATOMIC_ADD must be interpreted as an
external procedure with an implicit interface.  Extend the tests
with INTRINSIC NONE(EXTERNAL, TYPE) statements to ensure that they
require the intrinsic interpretation.
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
@@ -1311,6 +1311,14 @@ static const SpecificIntrinsicInterface specificIntrinsicFunction[]{
 
 static const IntrinsicInterface intrinsicSubroutine[]{
     {"abort", {}, {}, Rank::elemental, IntrinsicClass::impureSubroutine},
+    {"atomic_add",
+        {{"atom", AtomicInt, Rank::atom, Optionality::required,
+             common::Intent::InOut},
+            {"value", AnyInt, Rank::scalar, Optionality::required,
+                common::Intent::In},
+            {"stat", AnyInt, Rank::scalar, Optionality::optional,
+                common::Intent::Out}},
+        {}, Rank::elemental, IntrinsicClass::atomicSubroutine},
     {"atomic_and",
         {{"atom", AtomicInt, Rank::atom, Optionality::required,
              common::Intent::InOut},
@@ -1585,7 +1593,6 @@ static const IntrinsicInterface intrinsicSubroutine[]{
 };
 
 // TODO: Intrinsic subroutine EVENT_QUERY
-// TODO: Atomic intrinsic subroutines: ATOMIC_ADD
 // TODO: Collective intrinsic subroutines: co_reduce
 
 // Finds a built-in derived type and returns it as a DynamicType.
@@ -3232,8 +3239,8 @@ static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
           arg ? arg->sourceLocation() : context.messages().at(),
           "Argument of ALLOCATED() must be an ALLOCATABLE object or component"_err_en_US);
     }
-  } else if (name == "atomic_and" || name == "atomic_or" ||
-      name == "atomic_xor") {
+  } else if (name == "atomic_add" || name == "atomic_and" ||
+      name == "atomic_or" || name == "atomic_xor") {
     return CheckForCoindexedObject(
         context.messages(), call.arguments[2], name, "stat");
   } else if (name == "atomic_cas") {
diff --git a/flang/test/Semantics/atomic01.f90 b/flang/test/Semantics/atomic01.f90
@@ -5,7 +5,7 @@
 
 program test_atomic_add
   use iso_fortran_env, only : atomic_int_kind
-  implicit none
+  implicit none(external, type)
 
   integer(kind=atomic_int_kind) atom_object[*], atom_array(2)[*], quantity, array(1), coarray[*], non_coarray
   integer non_atom_object[*], non_atom, non_scalar(1), status, stat_array(1), coindexed[*]
diff --git a/flang/test/Semantics/atomic02.f90 b/flang/test/Semantics/atomic02.f90
@@ -4,7 +4,7 @@
 
 program test_atomic_and
   use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind
-  implicit none
+  implicit none(external, type)
 
   integer(kind=atomic_int_kind) :: scalar_coarray[*], non_scalar_coarray(10)[*], val, non_coarray
   integer(kind=atomic_int_kind) :: repeated_atom[*], repeated_val, array(10)
diff --git a/flang/test/Semantics/atomic03.f90 b/flang/test/Semantics/atomic03.f90
@@ -4,7 +4,7 @@
 
 program test_atomic_cas
   use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind
-  implicit none
+  implicit none(external, type)
 
   integer(kind=atomic_int_kind) :: int_scalar_coarray[*], non_scalar_coarray(10)[*], non_coarray
   integer(kind=atomic_int_kind) :: repeated_atom[*], array(10)
diff --git a/flang/test/Semantics/atomic04.f90 b/flang/test/Semantics/atomic04.f90
@@ -4,7 +4,7 @@
 
 program test_atomic_define
   use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind
-  implicit none
+  implicit none(external, type)
 
   integer(kind=atomic_int_kind) :: scalar_coarray[*], non_scalar_coarray(10)[*], val, non_coarray
   integer(kind=atomic_int_kind) :: repeated_atom[*], repeated_val, array(10)
diff --git a/flang/test/Semantics/atomic05.f90 b/flang/test/Semantics/atomic05.f90
@@ -4,7 +4,7 @@
 
 program test_atomic_fetch_add
   use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind
-  implicit none
+  implicit none(external, type)
 
   integer(kind=atomic_int_kind) :: scalar_coarray[*], non_scalar_coarray(10)[*], val, old_val, non_coarray
   integer(kind=atomic_int_kind) :: repeated_atom[*], repeated_old, repeated_val, array(10)
diff --git a/flang/test/Semantics/atomic06.f90 b/flang/test/Semantics/atomic06.f90
@@ -4,7 +4,7 @@
 
 program test_atomic_fetch_and
   use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind
-  implicit none
+  implicit none(external, type)
 
   integer(kind=atomic_int_kind) :: scalar_coarray[*], non_scalar_coarray(10)[*], val, old_val, non_coarray
   integer(kind=atomic_int_kind) :: repeated_atom[*], repeated_old, repeated_val, array(10)
diff --git a/flang/test/Semantics/atomic07.f90 b/flang/test/Semantics/atomic07.f90
@@ -4,7 +4,7 @@
 
 program test_atomic_fetch_or
   use iso_fortran_env, only: atomic_int_kind
-  implicit none
+  implicit none(external, type)
 
   integer(kind=atomic_int_kind) :: scalar_coarray[*], non_scalar_coarray(10)[*], val, old_val, non_coarray
   integer(kind=atomic_int_kind) :: repeated_atom[*], repeated_old, repeated_val, array(10), val_coarray[*], old_val_coarray[*]
diff --git a/flang/test/Semantics/atomic08.f90 b/flang/test/Semantics/atomic08.f90
@@ -4,7 +4,7 @@
 
 program test_atomic_fetch_xor
   use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind
-  implicit none
+  implicit none(external, type)
 
   integer(kind=atomic_int_kind) :: scalar_coarray[*], non_scalar_coarray(10)[*], val, old_val, non_coarray
   integer(kind=atomic_int_kind) :: repeated_atom[*], repeated_old, repeated_val, array(10)
diff --git a/flang/test/Semantics/atomic09.f90 b/flang/test/Semantics/atomic09.f90
@@ -4,7 +4,7 @@
 
 program test_atomic_or
   use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind
-  implicit none
+  implicit none(external, type)
 
   integer(kind=atomic_int_kind) :: scalar_coarray[*], non_scalar_coarray(10)[*], val, non_coarray
   integer(kind=atomic_int_kind) :: repeated_atom[*], repeated_val, array(10)
diff --git a/flang/test/Semantics/atomic10.f90 b/flang/test/Semantics/atomic10.f90
@@ -4,7 +4,7 @@
 
 program test_atomic_ref
   use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind
-  implicit none
+  implicit none(external, type)
 
   integer(kind=atomic_int_kind) :: scalar_coarray[*], non_scalar_coarray(10)[*], val, non_coarray
   integer(kind=atomic_int_kind) :: repeated_atom[*], repeated_val, array(10)
diff --git a/flang/test/Semantics/atomic11.f90 b/flang/test/Semantics/atomic11.f90
@@ -4,7 +4,7 @@
 
 program test_atomic_xor
   use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind
-  implicit none
+  implicit none(external, type)
 
   integer(kind=atomic_int_kind) :: scalar_coarray[*], non_scalar_coarray(10)[*], val, non_coarray
   integer(kind=atomic_int_kind) :: repeated_atom[*], repeated_val, array(10)
