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 @@ -1216,6 +1216,14 @@ {"stat", AnyInt, Rank::scalar, Optionality::optional, common::Intent::Out}}, {}, Rank::elemental, IntrinsicClass::atomicSubroutine}, + {"atomic_or", + {{"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_ref", {{"value", AnyIntOrLogical, Rank::scalar, Optionality::required, common::Intent::Out}, @@ -2753,7 +2761,7 @@ } } else if (name == "associated") { return CheckAssociated(call, context); - } else if (name == "atomic_and") { + } else if (name == "atomic_and" || name == "atomic_or") { 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/atomic09.f90 b/flang/test/Semantics/atomic09.f90 --- a/flang/test/Semantics/atomic09.f90 +++ b/flang/test/Semantics/atomic09.f90 @@ -1,10 +1,9 @@ ! RUN: %python %S/test_errors.py %s %flang_fc1 -! XFAIL: * ! This test checks for semantic errors in atomic_or subroutine calls based on ! the interface defined in section 16.9.28 of the Fortran 2018 standard. program test_atomic_or - 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_or(scalar_coarray, val) @@ -27,13 +27,16 @@ !___ non-standard-conforming calls ___ - !ERROR: 'atom=' argument must be a scalar coarray for intrinsic 'atomic_or' + !ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_or' call atomic_or(non_scalar_coarray, val) - !ERROR: 'atom=' argument must be a coarray or a coindexed object for intrinsic 'atomic_or' + !ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_or' + call atomic_or(non_scalar_coarray[1], val) + + !ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_or' call atomic_or(non_coarray, val) - !ERROR: 'atom=' argument must be a coarray or a coindexed object for intrinsic 'atomic_or' + !ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_or' call atomic_or(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_or(non_integer_coarray, val) + !ERROR: Actual argument for 'atom=' has bad type 'LOGICAL(8)' + call atomic_or(atomic_logical, val) + !ERROR: 'value=' argument has unacceptable rank 1 call atomic_or(scalar_coarray, array) @@ -57,9 +63,11 @@ !ERROR: 'stat=' argument has unacceptable rank 1 call atomic_or(scalar_coarray, val, status_array) + !ERROR: 'stat' argument to 'atomic_or' may not be a coindexed object call atomic_or(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_or(scalar_coarray, val, 1) !ERROR: missing mandatory 'atom=' argument