[flang] Add atomic_xor to list of intrinsics

[ktras]

Summary

Add the atomic subroutine, atomic_xor, to the list of
intrinsic subroutines, add its last dummy argument to a check
for a coindexed-object, and update test.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/docs/Intrinsics.md

 
 | Intrinsic Category | Intrinsic Procedures Lacking Support |
 | --- | --- |
 | Coarray intrinsic functions | IMAGE_INDEX, COSHAPE |
 | Object characteristic inquiry functions | ALLOCATED, ASSOCIATED, EXTENDS_TYPE_OF, IS_CONTIGUOUS, PRESENT, RANK, SAME_TYPE, STORAGE_SIZE |
 | Type inquiry intrinsic functions | BIT_SIZE, DIGITS, EPSILON, HUGE, KIND, MAXEXPONENT, MINEXPONENT, NEW_LINE, PRECISION, RADIX, RANGE, TINY|
 | Non-standard intrinsic functions | AND, OR, XOR, LSHIFT, RSHIFT, SHIFT, ZEXT, IZEXT, COSD, SIND, TAND, ACOSD, ASIND, ATAND, ATAN2D, COMPL, DCMPLX, EQV, NEQV, INT8, JINT, JNINT, KNINT, LOC, QCMPLX, DREAL, DFLOAT, QEXT, QFLOAT, QREAL, DNUM, NUM, JNUM, KNUM, QNUM, RNUM, RAN, RANF, ILEN, SIZEOF, MCLOCK, SECNDS, COTAN, IBCHNG, ISHA, ISHC, ISHL, IXOR, IARG, IARGC, NARGS, NUMARG, BADDRESS, IADDR, CACHESIZE, EOF, FP_CLASS, INT_PTR_KIND, ISNAN, MALLOC |
 | Intrinsic subroutines |MVBITS (elemental), CPU_TIME, DATE_AND_TIME, EVENT_QUERY, EXECUTE_COMMAND_LINE, GET_COMMAND, GET_COMMAND_ARGUMENT, GET_ENVIRONMENT_VARIABLE, MOVE_ALLOC, RANDOM_INIT, RANDOM_NUMBER, RANDOM_SEED, SYSTEM_CLOCK |
-| Atomic intrinsic subroutines | ATOMIC_ADD &al. |
+| Atomic intrinsic subroutines | ATOMIC_ADD |
 | Collective intrinsic subroutines | CO_REDUCE |
 
 
 ### Intrinsic Function Folding
 Fortran Constant Expressions can contain references to a certain number of
 intrinsic functions (see Fortran 2018 standard section 10.1.12 for more details).
 Constant Expressions may be used to define kind arguments. Therefore, the semantic
 expression analysis phase must be able to fold references to intrinsic functions

flang/lib/Evaluate/intrinsics.cpp

static const IntrinsicInterface intrinsicSubroutine[]{
     {"atomic_ref",
         {{"value", AnyIntOrLogical, Rank::scalar, Optionality::required,
              common::Intent::Out},
             {"atom", AtomicIntOrLogical, Rank::atom, Optionality::required,
                 common::Intent::In},
             {"stat", AnyInt, Rank::scalar, Optionality::optional,
                 common::Intent::Out}},
         {}, Rank::elemental, IntrinsicClass::atomicSubroutine},
+    {"atomic_xor",
+        {{"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},
     {"co_broadcast",
         {{"a", AnyData, Rank::anyOrAssumedRank, Optionality::required,
              common::Intent::InOut},
             {"source_image", AnyInt, Rank::scalar, Optionality::required,
                 common::Intent::In},
             {"stat", AnyInt, Rank::scalar, Optionality::optional,
                 common::Intent::Out},
             {"errmsg", DefaultChar, Rank::scalar, Optionality::optional,
static const IntrinsicInterface intrinsicSubroutine[]{
             {"count_rate", AnyIntOrReal, Rank::scalar, Optionality::optional,
                 common::Intent::Out},
             {"count_max", AnyInt, Rank::scalar, Optionality::optional,
                 common::Intent::Out}},
         {}, Rank::elemental, IntrinsicClass::impureSubroutine},
 };
 
 // TODO: Intrinsic subroutine EVENT_QUERY
-// TODO: Atomic intrinsic subroutines: ATOMIC_ADD &al.
+// TODO: Atomic intrinsic subroutines: ATOMIC_ADD
 // TODO: Collective intrinsic subroutines: co_reduce
 
 // Finds a built-in derived type and returns it as a DynamicType.
 static DynamicType GetBuiltinDerivedType(
     const semantics::Scope *builtinsScope, const char *which) {
   if (!builtinsScope) {
     common::die("INTERNAL: The __fortran_builtins module was not found, and "
                 "the type '%s' was required",
if (name == "allocated") {
     }
     if (!ok) {
       context.messages().Say(
           arg ? arg->sourceLocation() : context.messages().at(),
           "Argument of ALLOCATED() must be an ALLOCATABLE object or component"_err_en_US);
     }
   } else if (name == "associated") {
     return CheckAssociated(call, context);
-  } else if (name == "atomic_and" || name == "atomic_or") {
+  } else if (name == "atomic_and" || name == "atomic_or" ||
+      name == "atomic_xor") {
     return CheckForCoindexedObject(context, call.arguments[2], name, "stat");
   } else if (name == "atomic_cas") {
     return CheckForCoindexedObject(context, call.arguments[4], name, "stat");
   } else if (name == "atomic_define") {
     return CheckAtomicDefineAndRef(
         context, call.arguments[0], call.arguments[1], call.arguments[2], name);
   } else if (name == "atomic_fetch_add" || name == "atomic_fetch_and" ||
       name == "atomic_fetch_or" || name == "atomic_fetch_xor") {

flang/test/Semantics/atomic11.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
-! XFAIL: *
 ! This test checks for semantic errors in atomic_xor subroutine calls based on
 ! the interface defined in section 16.9.30 of the Fortran 2018 standard.
 
 program test_atomic_xor
-  use iso_fortran_env, only: atomic_int_kind
+  use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind
   implicit none
 
   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)
   integer :: status, default_kind_coarray[*], coindexed_status[*], extra_arg, repeated_status, status_array(10)
   integer(kind=1) :: kind1_coarray[*]
   real :: non_integer_coarray[*]
   logical :: non_integer
+  logical(atomic_logical_kind) :: atomic_logical[*]
 
   !___ standard-conforming calls ___
   call atomic_xor(scalar_coarray, val)
   call atomic_xor(scalar_coarray[1], val)
   call atomic_xor(scalar_coarray, val, status)
   call atomic_xor(scalar_coarray[1], val, status)
   call atomic_xor(scalar_coarray, val, stat=status)
   call atomic_xor(scalar_coarray, value=val, stat=status)
   call atomic_xor(atom=scalar_coarray, value=val)
   call atomic_xor(atom=scalar_coarray, value=val, stat=status)
   call atomic_xor(stat=status, value=val, atom=scalar_coarray)
 
   !___ non-standard-conforming calls ___
 
-  !ERROR: 'atom=' argument must be a scalar coarray for intrinsic 'atomic_xor'
+  !ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_xor'
   call atomic_xor(non_scalar_coarray, val)
 
-  !ERROR: 'atom=' argument must be a coarray or a coindexed object for intrinsic 'atomic_xor'
+  !ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_xor'
+  call atomic_xor(non_scalar_coarray[1], val)
+
+  !ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_xor'
   call atomic_xor(non_coarray, val)
 
-  !ERROR: 'atom=' argument must be a coarray or a coindexed object for intrinsic 'atomic_xor'
+  !ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_xor'
   call atomic_xor(array, val)
 
   !ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind, but is 'INTEGER(4)'
   call atomic_xor(default_kind_coarray, val)
 
   !ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind, but is 'INTEGER(1)'
   call atomic_xor(kind1_coarray, val)
 
   !ERROR: Actual argument for 'atom=' has bad type 'REAL(4)'
   call atomic_xor(non_integer_coarray, val)
 
+  !ERROR: Actual argument for 'atom=' has bad type 'LOGICAL(8)'
+  call atomic_xor(atomic_logical, val)
+
   !ERROR: 'value=' argument has unacceptable rank 1
   call atomic_xor(scalar_coarray, array)
 
   !ERROR: Actual argument for 'value=' has bad type 'LOGICAL(4)'
   call atomic_xor(scalar_coarray, non_integer)
 
   !ERROR: Actual argument for 'stat=' has bad type 'LOGICAL(4)'
   call atomic_xor(scalar_coarray, val, non_integer)
 
   !ERROR: 'stat=' argument has unacceptable rank 1
   call atomic_xor(scalar_coarray, val, status_array)
 
+  !ERROR: 'stat' argument to 'atomic_xor' may not be a coindexed object
   call atomic_xor(scalar_coarray, val, coindexed_status[1])
 
-  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' must be definable
+  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' is not definable
+  !BECAUSE: '1_4' is not a variable or pointer
   call atomic_xor(scalar_coarray, val, 1)
 
   !ERROR: missing mandatory 'atom=' argument
   call atomic_xor()
 
   !ERROR: missing mandatory 'atom=' argument
   call atomic_xor(value=val, stat=status)