Skip to content

Commit 512b44d

Browse files
klauslerklausler
authored
[flang] Define ATOMIC_ADD as an intrinsic procedure (llvm#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.
1 parent 34b1395 commit 512b44d

File tree

12 files changed

+67
-45
lines changed

12 files changed

+67
-45
lines changed

‎flang/lib/Evaluate/intrinsics.cpp‎

Lines changed: 23 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -1311,6 +1311,14 @@ static const SpecificIntrinsicInterface specificIntrinsicFunction[]{
13111311

13121312
static const IntrinsicInterface intrinsicSubroutine[]{
13131313
{"abort", {}, {}, Rank::elemental, IntrinsicClass::impureSubroutine},
1314+
{"atomic_add",
1315+
{{"atom", AtomicInt, Rank::atom, Optionality::required,
1316+
common::Intent::InOut},
1317+
{"value", AnyInt, Rank::scalar, Optionality::required,
1318+
common::Intent::In},
1319+
{"stat", AnyInt, Rank::scalar, Optionality::optional,
1320+
common::Intent::Out}},
1321+
{}, Rank::elemental, IntrinsicClass::atomicSubroutine},
13141322
{"atomic_and",
13151323
{{"atom", AtomicInt, Rank::atom, Optionality::required,
13161324
common::Intent::InOut},
@@ -1585,7 +1593,6 @@ static const IntrinsicInterface intrinsicSubroutine[]{
15851593
};
15861594

15871595
// TODO: Intrinsic subroutine EVENT_QUERY
1588-
// TODO: Atomic intrinsic subroutines: ATOMIC_ADD
15891596
// TODO: Collective intrinsic subroutines: co_reduce
15901597

15911598
// Finds a built-in derived type and returns it as a DynamicType.
@@ -1713,8 +1720,8 @@ static bool CheckAndPushMinMaxArgument(ActualArgument &arg,
17131720
}
17141721

17151722
static bool CheckAtomicKind(const ActualArgument &arg,
1716-
const semantics::Scope *builtinsScope,
1717-
parser::ContextualMessages &messages) {
1723+
const semantics::Scope *builtinsScope, parser::ContextualMessages &messages,
1724+
const char *keyword) {
17181725
std::string atomicKindStr;
17191726
std::optional<DynamicType> type{arg.GetType()};
17201727

@@ -1727,11 +1734,12 @@ static bool CheckAtomicKind(const ActualArgument &arg,
17271734
"must be used with IntType or LogicalType");
17281735
}
17291736

1730-
bool argOk = type->kind() ==
1731-
GetBuiltinKind(builtinsScope, ("__builtin_" + atomicKindStr).c_str());
1737+
bool argOk{type->kind() ==
1738+
GetBuiltinKind(builtinsScope, ("__builtin_" + atomicKindStr).c_str())};
17321739
if (!argOk) {
17331740
messages.Say(arg.sourceLocation(),
1734-
"Actual argument for 'atom=' must have kind=atomic_int_kind or atomic_logical_kind, but is '%s'"_err_en_US,
1741+
"Actual argument for '%s=' must have kind=atomic_%s_kind, but is '%s'"_err_en_US,
1742+
keyword, type->category() == TypeCategory::Integer ? "int" : "logical",
17351743
type->AsFortran());
17361744
}
17371745
return argOk;
@@ -2052,7 +2060,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
20522060
case KindCode::sameAtom:
20532061
if (!sameArg) {
20542062
sameArg = arg;
2055-
argOk = CheckAtomicKind(DEREF(arg), builtinsScope, messages);
2063+
argOk = CheckAtomicKind(DEREF(arg), builtinsScope, messages, d.keyword);
20562064
} else {
20572065
argOk = type->IsTkCompatibleWith(sameArg->GetType().value());
20582066
if (!argOk) {
@@ -2061,23 +2069,21 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
20612069
d.keyword, type->AsFortran());
20622070
}
20632071
}
2064-
if (!argOk)
2072+
if (!argOk) {
20652073
return std::nullopt;
2074+
}
20662075
break;
20672076
case KindCode::atomicIntKind:
2068-
argOk = type->kind() ==
2069-
GetBuiltinKind(builtinsScope, "__builtin_atomic_int_kind");
2077+
argOk = CheckAtomicKind(DEREF(arg), builtinsScope, messages, d.keyword);
20702078
if (!argOk) {
2071-
messages.Say(arg->sourceLocation(),
2072-
"Actual argument for '%s=' must have kind=atomic_int_kind, but is '%s'"_err_en_US,
2073-
d.keyword, type->AsFortran());
20742079
return std::nullopt;
20752080
}
20762081
break;
20772082
case KindCode::atomicIntOrLogicalKind:
2078-
argOk = CheckAtomicKind(DEREF(arg), builtinsScope, messages);
2079-
if (!argOk)
2083+
argOk = CheckAtomicKind(DEREF(arg), builtinsScope, messages, d.keyword);
2084+
if (!argOk) {
20802085
return std::nullopt;
2086+
}
20812087
break;
20822088
default:
20832089
CRASH_NO_CASE;
@@ -3232,8 +3238,8 @@ static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
32323238
arg ? arg->sourceLocation() : context.messages().at(),
32333239
"Argument of ALLOCATED() must be an ALLOCATABLE object or component"_err_en_US);
32343240
}
3235-
} else if (name == "atomic_and" || name == "atomic_or" ||
3236-
name == "atomic_xor") {
3241+
} else if (name == "atomic_add" || name == "atomic_and" ||
3242+
name == "atomic_or" || name == "atomic_xor") {
32373243
return CheckForCoindexedObject(
32383244
context.messages(), call.arguments[2], name, "stat");
32393245
} else if (name == "atomic_cas") {

‎flang/test/Semantics/atomic01.f90‎

Lines changed: 22 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,13 @@
11
! RUN: %python %S/test_errors.py %s %flang_fc1
2-
! XFAIL: *
32
! This test checks for semantic errors in atomic_add() subroutine based on the
43
! statement specification in section 16.9.20 of the Fortran 2018 standard.
54

65
program test_atomic_add
76
use iso_fortran_env, only : atomic_int_kind
8-
implicit none
7+
implicit none(external, type)
98

109
integer(kind=atomic_int_kind) atom_object[*], atom_array(2)[*], quantity, array(1), coarray[*], non_coarray
11-
integer non_atom_object[*], non_atom, non_scalar(1), status, stat_array(1), coindexed[*]
10+
integer non_atom_object[*], non_scalar(1), status, stat_array(1), coindexed[*]
1211
logical non_integer
1312

1413
!___ standard-conforming calls with required arguments _______
@@ -31,63 +30,80 @@ program test_atomic_add
3130
!___ non-standard-conforming calls _______
3231

3332
! atom must be of kind atomic_int_kind
33+
! ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind, but is 'INTEGER(4)'
3434
call atomic_add(non_atom_object, quantity)
3535

3636
! atom must be a coarray
37+
! ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_add'
3738
call atomic_add(non_coarray, quantity)
3839

3940
! atom must be a scalar variable
41+
! ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_add'
4042
call atomic_add(atom_array, quantity)
4143

4244
! atom has an unknown keyword argument
45+
! ERROR: unknown keyword argument to intrinsic 'atomic_add'
4346
call atomic_add(atoms=atom_object, value=quantity)
4447

4548
! atom has an argument mismatch
49+
! ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind, but is 'INTEGER(4)'
4650
call atomic_add(atom=non_atom_object, value=quantity)
4751

4852
! value must be an integer
53+
! ERROR: Actual argument for 'value=' has bad type 'LOGICAL(4)'
4954
call atomic_add(atom_object, non_integer)
5055

5156
! value must be an integer scalar
57+
! ERROR: 'value=' argument has unacceptable rank 1
5258
call atomic_add(atom_object, array)
5359

54-
! value must be of kind atomic_int_kind
55-
call atomic_add(atom_object, non_atom)
56-
5760
! value has an unknown keyword argument
61+
! ERROR: unknown keyword argument to intrinsic 'atomic_add'
5862
call atomic_add(atom_object, values=quantity)
5963

6064
! value has an argument mismatch
65+
! ERROR: Actual argument for 'value=' has bad type 'LOGICAL(4)'
6166
call atomic_add(atom_object, value=non_integer)
6267

6368
! stat must be an integer
69+
! ERROR: Actual argument for 'stat=' has bad type 'LOGICAL(4)'
6470
call atomic_add(atom_object, quantity, non_integer)
6571

6672
! stat must be an integer scalar
73+
! ERROR: 'stat=' argument has unacceptable rank 1
6774
call atomic_add(atom_object, quantity, non_scalar)
6875

6976
! stat is an intent(out) argument
77+
! ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' is not definable
78+
! ERROR: '8_4' is not a variable or pointer
7079
call atomic_add(atom_object, quantity, 8)
7180

7281
! stat has an unknown keyword argument
82+
! ERROR: unknown keyword argument to intrinsic 'atomic_add'
7383
call atomic_add(atom_object, quantity, statuses=status)
7484

7585
! stat has an argument mismatch
86+
! ERROR: Actual argument for 'stat=' has bad type 'LOGICAL(4)'
7687
call atomic_add(atom_object, quantity, stat=non_integer)
7788

7889
! stat must not be coindexed
90+
! ERROR: 'stat' argument to 'atomic_add' may not be a coindexed object
7991
call atomic_add(atom_object, quantity, coindexed[1])
8092

8193
! Too many arguments
94+
! ERROR: too many actual arguments for intrinsic 'atomic_add'
8295
call atomic_add(atom_object, quantity, status, stat_array(1))
8396

8497
! Repeated atom keyword
98+
! ERROR: repeated keyword argument to intrinsic 'atomic_add'
8599
call atomic_add(atom=atom_object, atom=atom_array(1), value=quantity)
86100

87101
! Repeated value keyword
102+
! ERROR: repeated keyword argument to intrinsic 'atomic_add'
88103
call atomic_add(atom=atom_object, value=quantity, value=array(1))
89104

90105
! Repeated stat keyword
106+
! ERROR: repeated keyword argument to intrinsic 'atomic_add'
91107
call atomic_add(atom=atom_object, value=quantity, stat=status, stat=stat_array(1))
92108

93109
end program test_atomic_add

‎flang/test/Semantics/atomic02.f90‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@
44

55
program test_atomic_and
66
use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind
7-
implicit none
7+
implicit none(external, type)
88

99
integer(kind=atomic_int_kind) :: scalar_coarray[*], non_scalar_coarray(10)[*], val, non_coarray
1010
integer(kind=atomic_int_kind) :: repeated_atom[*], repeated_val, array(10)

‎flang/test/Semantics/atomic03.f90‎

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@
44

55
program test_atomic_cas
66
use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind
7-
implicit none
7+
implicit none(external, type)
88

99
integer(kind=atomic_int_kind) :: int_scalar_coarray[*], non_scalar_coarray(10)[*], non_coarray
1010
integer(kind=atomic_int_kind) :: repeated_atom[*], array(10)
@@ -70,16 +70,16 @@ program test_atomic_cas
7070

7171
! mismatches where 'atom' has wrong kind
7272

73-
!ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind or atomic_logical_kind, but is 'INTEGER(4)'
73+
!ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind, but is 'INTEGER(4)'
7474
call atomic_cas(default_kind_coarray, old_int, compare_int, new_int)
7575

76-
!ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind or atomic_logical_kind, but is 'INTEGER(1)'
76+
!ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind, but is 'INTEGER(1)'
7777
call atomic_cas(kind1_coarray, old_int, compare_int, new_int)
7878

79-
!ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind or atomic_logical_kind, but is 'LOGICAL(4)'
79+
!ERROR: Actual argument for 'atom=' must have kind=atomic_logical_kind, but is 'LOGICAL(4)'
8080
call atomic_cas(default_kind_logical_coarray, old_logical, compare_logical, new_logical)
8181

82-
!ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind or atomic_logical_kind, but is 'LOGICAL(1)'
82+
!ERROR: Actual argument for 'atom=' must have kind=atomic_logical_kind, but is 'LOGICAL(1)'
8383
call atomic_cas(kind1_logical_coarray, old_logical, compare_logical, new_logical)
8484

8585
! mismatch where 'atom' has wrong type

‎flang/test/Semantics/atomic04.f90‎

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@
44

55
program test_atomic_define
66
use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind
7-
implicit none
7+
implicit none(external, type)
88

99
integer(kind=atomic_int_kind) :: scalar_coarray[*], non_scalar_coarray(10)[*], val, non_coarray
1010
integer(kind=atomic_int_kind) :: repeated_atom[*], repeated_val, array(10)
@@ -64,16 +64,16 @@ program test_atomic_define
6464
!ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_define'
6565
call atomic_define(array, val)
6666

67-
!ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind or atomic_logical_kind, but is 'INTEGER(4)'
67+
!ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind, but is 'INTEGER(4)'
6868
call atomic_define(default_kind_coarray, val)
6969

70-
!ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind or atomic_logical_kind, but is 'INTEGER(1)'
70+
!ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind, but is 'INTEGER(1)'
7171
call atomic_define(kind1_coarray, val)
7272

73-
!ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind or atomic_logical_kind, but is 'LOGICAL(4)'
73+
!ERROR: Actual argument for 'atom=' must have kind=atomic_logical_kind, but is 'LOGICAL(4)'
7474
call atomic_define(default_kind_logical_coarray, val_logical)
7575

76-
!ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind or atomic_logical_kind, but is 'LOGICAL(1)'
76+
!ERROR: Actual argument for 'atom=' must have kind=atomic_logical_kind, but is 'LOGICAL(1)'
7777
call atomic_define(kind1_logical_coarray, val_logical)
7878

7979
!ERROR: 'value=' argument to 'atomic_define' must have same type as 'atom=', but is 'LOGICAL(8)'

‎flang/test/Semantics/atomic05.f90‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@
44

55
program test_atomic_fetch_add
66
use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind
7-
implicit none
7+
implicit none(external, type)
88

99
integer(kind=atomic_int_kind) :: scalar_coarray[*], non_scalar_coarray(10)[*], val, old_val, non_coarray
1010
integer(kind=atomic_int_kind) :: repeated_atom[*], repeated_old, repeated_val, array(10)

‎flang/test/Semantics/atomic06.f90‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@
44

55
program test_atomic_fetch_and
66
use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind
7-
implicit none
7+
implicit none(external, type)
88

99
integer(kind=atomic_int_kind) :: scalar_coarray[*], non_scalar_coarray(10)[*], val, old_val, non_coarray
1010
integer(kind=atomic_int_kind) :: repeated_atom[*], repeated_old, repeated_val, array(10)

‎flang/test/Semantics/atomic07.f90‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@
44

55
program test_atomic_fetch_or
66
use iso_fortran_env, only: atomic_int_kind
7-
implicit none
7+
implicit none(external, type)
88

99
integer(kind=atomic_int_kind) :: scalar_coarray[*], non_scalar_coarray(10)[*], val, old_val, non_coarray
1010
integer(kind=atomic_int_kind) :: repeated_atom[*], repeated_old, repeated_val, array(10), val_coarray[*], old_val_coarray[*]

‎flang/test/Semantics/atomic08.f90‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@
44

55
program test_atomic_fetch_xor
66
use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind
7-
implicit none
7+
implicit none(external, type)
88

99
integer(kind=atomic_int_kind) :: scalar_coarray[*], non_scalar_coarray(10)[*], val, old_val, non_coarray
1010
integer(kind=atomic_int_kind) :: repeated_atom[*], repeated_old, repeated_val, array(10)

‎flang/test/Semantics/atomic09.f90‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@
44

55
program test_atomic_or
66
use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind
7-
implicit none
7+
implicit none(external, type)
88

99
integer(kind=atomic_int_kind) :: scalar_coarray[*], non_scalar_coarray(10)[*], val, non_coarray
1010
integer(kind=atomic_int_kind) :: repeated_atom[*], repeated_val, array(10)

0 commit comments

Comments
 (0)