[flang-commits] [flang] 512b44d - [flang] Define ATOMIC_ADD as an intrinsic procedure (#122993)
via flang-commits
flang-commits at lists.llvm.org
Mon Jan 27 08:44:43 PST 2025
Author: Peter Klausler
Date: 2025-01-27T08:44:39-08:00
New Revision: 512b44d5e1534ef60b5db7a99818e1021cf6064c
URL: https://github.com/llvm/llvm-project/commit/512b44d5e1534ef60b5db7a99818e1021cf6064c
DIFF: https://github.com/llvm/llvm-project/commit/512b44d5e1534ef60b5db7a99818e1021cf6064c.diff
LOG: [flang] Define ATOMIC_ADD as an intrinsic procedure (#122993)
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.
Added:
Modified:
flang/lib/Evaluate/intrinsics.cpp
flang/test/Semantics/atomic01.f90
flang/test/Semantics/atomic02.f90
flang/test/Semantics/atomic03.f90
flang/test/Semantics/atomic04.f90
flang/test/Semantics/atomic05.f90
flang/test/Semantics/atomic06.f90
flang/test/Semantics/atomic07.f90
flang/test/Semantics/atomic08.f90
flang/test/Semantics/atomic09.f90
flang/test/Semantics/atomic10.f90
flang/test/Semantics/atomic11.f90
Removed:
################################################################################
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index f234241cfe14a6..77d37d40bbddc0 100644
--- 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.
@@ -1713,8 +1720,8 @@ static bool CheckAndPushMinMaxArgument(ActualArgument &arg,
}
static bool CheckAtomicKind(const ActualArgument &arg,
- const semantics::Scope *builtinsScope,
- parser::ContextualMessages &messages) {
+ const semantics::Scope *builtinsScope, parser::ContextualMessages &messages,
+ const char *keyword) {
std::string atomicKindStr;
std::optional<DynamicType> type{arg.GetType()};
@@ -1727,11 +1734,12 @@ static bool CheckAtomicKind(const ActualArgument &arg,
"must be used with IntType or LogicalType");
}
- bool argOk = type->kind() ==
- GetBuiltinKind(builtinsScope, ("__builtin_" + atomicKindStr).c_str());
+ bool argOk{type->kind() ==
+ GetBuiltinKind(builtinsScope, ("__builtin_" + atomicKindStr).c_str())};
if (!argOk) {
messages.Say(arg.sourceLocation(),
- "Actual argument for 'atom=' must have kind=atomic_int_kind or atomic_logical_kind, but is '%s'"_err_en_US,
+ "Actual argument for '%s=' must have kind=atomic_%s_kind, but is '%s'"_err_en_US,
+ keyword, type->category() == TypeCategory::Integer ? "int" : "logical",
type->AsFortran());
}
return argOk;
@@ -2052,7 +2060,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
case KindCode::sameAtom:
if (!sameArg) {
sameArg = arg;
- argOk = CheckAtomicKind(DEREF(arg), builtinsScope, messages);
+ argOk = CheckAtomicKind(DEREF(arg), builtinsScope, messages, d.keyword);
} else {
argOk = type->IsTkCompatibleWith(sameArg->GetType().value());
if (!argOk) {
@@ -2061,23 +2069,21 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
d.keyword, type->AsFortran());
}
}
- if (!argOk)
+ if (!argOk) {
return std::nullopt;
+ }
break;
case KindCode::atomicIntKind:
- argOk = type->kind() ==
- GetBuiltinKind(builtinsScope, "__builtin_atomic_int_kind");
+ argOk = CheckAtomicKind(DEREF(arg), builtinsScope, messages, d.keyword);
if (!argOk) {
- messages.Say(arg->sourceLocation(),
- "Actual argument for '%s=' must have kind=atomic_int_kind, but is '%s'"_err_en_US,
- d.keyword, type->AsFortran());
return std::nullopt;
}
break;
case KindCode::atomicIntOrLogicalKind:
- argOk = CheckAtomicKind(DEREF(arg), builtinsScope, messages);
- if (!argOk)
+ argOk = CheckAtomicKind(DEREF(arg), builtinsScope, messages, d.keyword);
+ if (!argOk) {
return std::nullopt;
+ }
break;
default:
CRASH_NO_CASE;
@@ -3232,8 +3238,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
index 046692e87c4adc..cf3804b0d605a6 100644
--- a/flang/test/Semantics/atomic01.f90
+++ b/flang/test/Semantics/atomic01.f90
@@ -1,14 +1,13 @@
! RUN: %python %S/test_errors.py %s %flang_fc1
-! XFAIL: *
! This test checks for semantic errors in atomic_add() subroutine based on the
! statement specification in section 16.9.20 of the Fortran 2018 standard.
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[*]
+ integer non_atom_object[*], non_scalar(1), status, stat_array(1), coindexed[*]
logical non_integer
!___ standard-conforming calls with required arguments _______
@@ -31,63 +30,80 @@ program test_atomic_add
!___ non-standard-conforming calls _______
! atom must be of kind atomic_int_kind
+ ! ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind, but is 'INTEGER(4)'
call atomic_add(non_atom_object, quantity)
! atom must be a coarray
+ ! ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_add'
call atomic_add(non_coarray, quantity)
! atom must be a scalar variable
+ ! ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_add'
call atomic_add(atom_array, quantity)
! atom has an unknown keyword argument
+ ! ERROR: unknown keyword argument to intrinsic 'atomic_add'
call atomic_add(atoms=atom_object, value=quantity)
! atom has an argument mismatch
+ ! ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind, but is 'INTEGER(4)'
call atomic_add(atom=non_atom_object, value=quantity)
! value must be an integer
+ ! ERROR: Actual argument for 'value=' has bad type 'LOGICAL(4)'
call atomic_add(atom_object, non_integer)
! value must be an integer scalar
+ ! ERROR: 'value=' argument has unacceptable rank 1
call atomic_add(atom_object, array)
- ! value must be of kind atomic_int_kind
- call atomic_add(atom_object, non_atom)
-
! value has an unknown keyword argument
+ ! ERROR: unknown keyword argument to intrinsic 'atomic_add'
call atomic_add(atom_object, values=quantity)
! value has an argument mismatch
+ ! ERROR: Actual argument for 'value=' has bad type 'LOGICAL(4)'
call atomic_add(atom_object, value=non_integer)
! stat must be an integer
+ ! ERROR: Actual argument for 'stat=' has bad type 'LOGICAL(4)'
call atomic_add(atom_object, quantity, non_integer)
! stat must be an integer scalar
+ ! ERROR: 'stat=' argument has unacceptable rank 1
call atomic_add(atom_object, quantity, non_scalar)
! stat is an intent(out) argument
+ ! ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' is not definable
+ ! ERROR: '8_4' is not a variable or pointer
call atomic_add(atom_object, quantity, 8)
! stat has an unknown keyword argument
+ ! ERROR: unknown keyword argument to intrinsic 'atomic_add'
call atomic_add(atom_object, quantity, statuses=status)
! stat has an argument mismatch
+ ! ERROR: Actual argument for 'stat=' has bad type 'LOGICAL(4)'
call atomic_add(atom_object, quantity, stat=non_integer)
! stat must not be coindexed
+ ! ERROR: 'stat' argument to 'atomic_add' may not be a coindexed object
call atomic_add(atom_object, quantity, coindexed[1])
! Too many arguments
+ ! ERROR: too many actual arguments for intrinsic 'atomic_add'
call atomic_add(atom_object, quantity, status, stat_array(1))
! Repeated atom keyword
+ ! ERROR: repeated keyword argument to intrinsic 'atomic_add'
call atomic_add(atom=atom_object, atom=atom_array(1), value=quantity)
! Repeated value keyword
+ ! ERROR: repeated keyword argument to intrinsic 'atomic_add'
call atomic_add(atom=atom_object, value=quantity, value=array(1))
! Repeated stat keyword
+ ! ERROR: repeated keyword argument to intrinsic 'atomic_add'
call atomic_add(atom=atom_object, value=quantity, stat=status, stat=stat_array(1))
end program test_atomic_add
diff --git a/flang/test/Semantics/atomic02.f90 b/flang/test/Semantics/atomic02.f90
index 10a7c126dbb6d4..484239a23ede2f 100644
--- 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
index 9bb1d1c0df6b17..495df5eb97192c 100644
--- 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)
@@ -70,16 +70,16 @@ program test_atomic_cas
! mismatches where 'atom' has wrong kind
- !ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind or atomic_logical_kind, but is 'INTEGER(4)'
+ !ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind, but is 'INTEGER(4)'
call atomic_cas(default_kind_coarray, old_int, compare_int, new_int)
- !ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind or atomic_logical_kind, but is 'INTEGER(1)'
+ !ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind, but is 'INTEGER(1)'
call atomic_cas(kind1_coarray, old_int, compare_int, new_int)
- !ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind or atomic_logical_kind, but is 'LOGICAL(4)'
+ !ERROR: Actual argument for 'atom=' must have kind=atomic_logical_kind, but is 'LOGICAL(4)'
call atomic_cas(default_kind_logical_coarray, old_logical, compare_logical, new_logical)
- !ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind or atomic_logical_kind, but is 'LOGICAL(1)'
+ !ERROR: Actual argument for 'atom=' must have kind=atomic_logical_kind, but is 'LOGICAL(1)'
call atomic_cas(kind1_logical_coarray, old_logical, compare_logical, new_logical)
! mismatch where 'atom' has wrong type
diff --git a/flang/test/Semantics/atomic04.f90 b/flang/test/Semantics/atomic04.f90
index f065bf6404f1a3..9df0b56d192a86 100644
--- 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)
@@ -64,16 +64,16 @@ program test_atomic_define
!ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_define'
call atomic_define(array, val)
- !ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind or atomic_logical_kind, but is 'INTEGER(4)'
+ !ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind, but is 'INTEGER(4)'
call atomic_define(default_kind_coarray, val)
- !ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind or atomic_logical_kind, but is 'INTEGER(1)'
+ !ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind, but is 'INTEGER(1)'
call atomic_define(kind1_coarray, val)
- !ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind or atomic_logical_kind, but is 'LOGICAL(4)'
+ !ERROR: Actual argument for 'atom=' must have kind=atomic_logical_kind, but is 'LOGICAL(4)'
call atomic_define(default_kind_logical_coarray, val_logical)
- !ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind or atomic_logical_kind, but is 'LOGICAL(1)'
+ !ERROR: Actual argument for 'atom=' must have kind=atomic_logical_kind, but is 'LOGICAL(1)'
call atomic_define(kind1_logical_coarray, val_logical)
!ERROR: 'value=' argument to 'atomic_define' must have same type as 'atom=', but is 'LOGICAL(8)'
diff --git a/flang/test/Semantics/atomic05.f90 b/flang/test/Semantics/atomic05.f90
index 04c29cdd6046ba..98d6b19b1f23d1 100644
--- 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
index e6307d129262e6..c6a23dd0077ca2 100644
--- 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
index 0ac7ad152e86b8..2bc544b7578642 100644
--- 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
index a08512f1c7fe80..f519f9735e00e4 100644
--- 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
index fc09724d53bc0d..e4e062252659a6 100644
--- 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
index 46fcf537f18100..04efbd6e80fd27 100644
--- 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)
@@ -64,16 +64,16 @@ program test_atomic_ref
!ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_ref'
call atomic_ref(val, array)
- !ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind or atomic_logical_kind, but is 'INTEGER(4)'
+ !ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind, but is 'INTEGER(4)'
call atomic_ref(val, default_kind_coarray)
- !ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind or atomic_logical_kind, but is 'INTEGER(1)'
+ !ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind, but is 'INTEGER(1)'
call atomic_ref(val, kind1_coarray)
- !ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind or atomic_logical_kind, but is 'LOGICAL(4)'
+ !ERROR: Actual argument for 'atom=' must have kind=atomic_logical_kind, but is 'LOGICAL(4)'
call atomic_ref(val_logical, default_kind_logical_coarray)
- !ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind or atomic_logical_kind, but is 'LOGICAL(1)'
+ !ERROR: Actual argument for 'atom=' must have kind=atomic_logical_kind, but is 'LOGICAL(1)'
call atomic_ref(val_logical, kind1_logical_coarray)
!ERROR: 'value=' argument to 'atomic_ref' must have same type as 'atom=', but is 'LOGICAL(8)'
diff --git a/flang/test/Semantics/atomic11.f90 b/flang/test/Semantics/atomic11.f90
index 1c50825e5541f4..d4f951ea02c322 100644
--- 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)
More information about the flang-commits
mailing list