diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md --- a/flang/docs/Intrinsics.md +++ b/flang/docs/Intrinsics.md @@ -751,7 +751,7 @@ | 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 | diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -1232,6 +1232,14 @@ {"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}, @@ -1373,7 +1381,7 @@ }; // 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. @@ -2761,7 +2769,8 @@ } } 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"); diff --git a/flang/test/Semantics/atomic11.f90 b/flang/test/Semantics/atomic11.f90 --- a/flang/test/Semantics/atomic11.f90 +++ b/flang/test/Semantics/atomic11.f90 @@ -1,10 +1,9 @@ ! 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 @@ -13,6 +12,7 @@ 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) @@ -27,13 +27,16 @@ !___ 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)' @@ -45,6 +48,9 @@ !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) @@ -57,9 +63,11 @@ !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