[flang-commits] [flang] d2460d9 - [flang] Add co_sum to the list of intrinsics and update test
Katherine Rasmussen via flang-commits
flang-commits at lists.llvm.org
Thu Jul 14 13:50:15 PDT 2022
Author: Katherine Rasmussen
Date: 2022-07-14T13:49:38-07:00
New Revision: d2460d90080f2ff8564ceed745998f821544ec98
URL: https://github.com/llvm/llvm-project/commit/d2460d90080f2ff8564ceed745998f821544ec98
DIFF: https://github.com/llvm/llvm-project/commit/d2460d90080f2ff8564ceed745998f821544ec98.diff
LOG: [flang] Add co_sum to the list of intrinsics and update test
Add the collective subroutine, co_sum, to the list of intrinsics.
In accordance with 16.9.50 and 16.9.137, add a check for and an
error if coindexed objects are being passed to certain arguments
in co_sum and in move_alloc. Add a semantics test to check that
this error is successfully caught in calls to move_alloc. Remove
the XFAIL directive, update the ERROR directives and add both
standard-conforming and non-standard conforming calls to the
semantics test for co_sum.
Reviewed By: jeanPerier
Differential Revision: https://reviews.llvm.org/D114134
Added:
flang/test/Semantics/move_alloc.f90
Modified:
flang/lib/Evaluate/intrinsics.cpp
flang/test/Semantics/collectives01.f90
Removed:
################################################################################
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index d9a7084c52098..eb8cdd1d962f9 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1073,6 +1073,16 @@ static const SpecificIntrinsicInterface specificIntrinsicFunction[]{
static const IntrinsicInterface intrinsicSubroutine[]{
{"abort", {}, {}, Rank::elemental, IntrinsicClass::impureSubroutine},
+ {"co_sum",
+ {{"a", AnyNumeric, Rank::anyOrAssumedRank, Optionality::required,
+ common::Intent::InOut},
+ {"result_image", AnyInt, Rank::scalar, Optionality::optional,
+ common::Intent::In},
+ {"stat", AnyInt, Rank::scalar, Optionality::optional,
+ common::Intent::Out},
+ {"errmsg", DefaultChar, Rank::scalar, Optionality::optional,
+ common::Intent::InOut}},
+ {}, Rank::elemental, IntrinsicClass::collectiveSubroutine},
{"cpu_time",
{{"time", AnyReal, Rank::scalar, Optionality::required,
common::Intent::Out}},
@@ -2364,6 +2374,26 @@ static bool CheckForNonPositiveValues(FoldingContext &context,
return ok;
}
+static bool CheckForCoindexedObjects(SpecificCall &call,
+ FoldingContext &context, const std::vector<std::string> &dummyNames) {
+ bool ok{true};
+ CHECK(call.arguments.size() == dummyNames.size());
+ for (std::size_t j{0}; j < call.arguments.size(); ++j) {
+ if (dummyNames[j] != "result_image") {
+ const auto &arg{call.arguments[j]};
+ if (const auto *expr{arg->UnwrapExpr()}) {
+ if (ExtractCoarrayRef(*expr)) {
+ ok = false;
+ context.messages().Say(arg->sourceLocation(),
+ "'%s' argument to '%s' may not be a coindexed object"_err_en_US,
+ dummyNames[j], call.specificIntrinsic.name);
+ }
+ }
+ }
+ }
+ return ok;
+}
+
// Applies any semantic checks peculiar to an intrinsic.
static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
bool ok{true};
@@ -2382,6 +2412,9 @@ static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
}
} else if (name == "associated") {
return CheckAssociated(call, context);
+ } else if (name == "co_sum") {
+ return CheckForCoindexedObjects(call, context,
+ std::vector<std::string>{"a", "result_image", "stat", "errmsg"});
} else if (name == "image_status") {
if (const auto &arg{call.arguments[0]}) {
ok = CheckForNonPositiveValues(context, *arg, name, "image");
@@ -2413,6 +2446,9 @@ static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
arg ? arg->sourceLocation() : context.messages().at(),
"Argument of LOC() must be an object or procedure"_err_en_US);
}
+ } else if (name == "move_alloc") {
+ return CheckForCoindexedObjects(call, context,
+ std::vector<std::string>{"from", "to", "stat", "errmsg"});
} else if (name == "present") {
const auto &arg{call.arguments[0]};
if (arg) {
@@ -2560,6 +2596,7 @@ std::optional<SpecificCall> IntrinsicProcTable::Implementation::Probe(
for (auto iter{subrRange.first}; iter != subrRange.second; ++iter) {
if (auto specificCall{iter->second->Match(
call, defaults_, arguments, context, builtinsScope_)}) {
+ ApplySpecificChecks(*specificCall, context);
return specificCall;
}
}
diff --git a/flang/test/Semantics/collectives01.f90 b/flang/test/Semantics/collectives01.f90
index e07a93fd3e964..3eb9aa92ea5da 100644
--- a/flang/test/Semantics/collectives01.f90
+++ b/flang/test/Semantics/collectives01.f90
@@ -1,13 +1,11 @@
! RUN: %python %S/test_errors.py %s %flang_fc1
-! XFAIL: *
! This test checks for semantic errors in co_sum subroutine calls based on
! the co_reduce interface defined in section 16.9.50 of the Fortran 2018 standard.
-! To Do: add co_sum to the list of intrinsics
program test_co_sum
implicit none
- integer i, status, integer_array(1), coindexed_integer[*]
+ integer i, status, integer_array(1), coindexed_integer[*], coindexed_result_image[*]
complex c, complex_array(1,1,1, 1,1,1, 1,1,1, 1,1,1, 1,1,1)
double precision d, double_precision_array(1)
real r, real_array(1), coindexed_real[*]
@@ -44,15 +42,22 @@ program test_co_sum
call co_sum(a=i, result_image=1 )
call co_sum(a=i, stat=status )
call co_sum(a=i, errmsg=message)
+ call co_sum(a=i, result_image=coindexed_result_image[1])
! no optional arguments present
call co_sum(a=i )
!___ non-standard-conforming calls ___
+ !ERROR: missing mandatory 'a=' argument
+ call co_sum()
+
!ERROR: missing mandatory 'a=' argument
call co_sum(result_image=1, stat=status, errmsg=message)
+ !ERROR: repeated keyword argument to intrinsic 'co_sum'
+ call co_sum(a=i, a=c)
+
! argument 'a' shall be of numeric type
!ERROR: Actual argument for 'a=' has bad type 'LOGICAL(4)'
call co_sum(bool)
@@ -61,8 +66,7 @@ program test_co_sum
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'a=' must be definable
call co_sum(a=1+1)
- ! argument 'a' shall not be a coindexed object
- !ERROR: to be determined
+ !ERROR: 'a' argument to 'co_sum' may not be a coindexed object
call co_sum(a=coindexed_real[1])
! 'result_image' argument shall be a integer
@@ -77,9 +81,11 @@ program test_co_sum
!ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' must be definable
call co_sum(a=i, result_image=1, stat=1+1, errmsg=message)
- ! 'stat' argument shall be noncoindexed
- !ERROR: to be determined
+ !ERROR: 'stat' argument to 'co_sum' may not be a coindexed object
call co_sum(d, stat=coindexed_integer[1])
+
+ !ERROR: 'stat' argument to 'co_sum' may not be a coindexed object
+ call co_sum(stat=coindexed_integer[1], a=d)
! 'stat' argument shall be an integer
!ERROR: Actual argument for 'stat=' has bad type 'CHARACTER(KIND=1,LEN=1_8)'
@@ -93,24 +99,27 @@ program test_co_sum
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'errmsg=' must be definable
call co_sum(a=i, result_image=1, stat=status, errmsg='c')
- ! 'errmsg' argument shall be noncoindexed
- !ERROR: to be determined
+ !ERROR: 'errmsg' argument to 'co_sum' may not be a coindexed object
call co_sum(c, errmsg=coindexed_character[1])
! 'errmsg' argument shall be a character
- !ERROR: to be determined
+ !ERROR: Actual argument for 'errmsg=' has bad type 'INTEGER(4)'
call co_sum(c, errmsg=i)
! 'errmsg' argument shall be character scalar
!ERROR: 'errmsg=' argument has unacceptable rank 1
call co_sum(d, errmsg=character_array)
- ! the error is seen as too many arguments to the co_sum() call
!ERROR: too many actual arguments for intrinsic 'co_sum'
call co_sum(r, result_image=1, stat=status, errmsg=message, 3.4)
! keyword argument with incorrect name
!ERROR: unknown keyword argument to intrinsic 'co_sum'
call co_sum(fake=3.4)
+
+ !ERROR: 'a' argument to 'co_sum' may not be a coindexed object
+ !ERROR: 'errmsg' argument to 'co_sum' may not be a coindexed object
+ !ERROR: 'stat' argument to 'co_sum' may not be a coindexed object
+ call co_sum(result_image=coindexed_result_image[1], a=coindexed_real[1], errmsg=coindexed_character[1], stat=coindexed_integer[1])
end program test_co_sum
diff --git a/flang/test/Semantics/move_alloc.f90 b/flang/test/Semantics/move_alloc.f90
new file mode 100644
index 0000000000000..41e38c6761294
--- /dev/null
+++ b/flang/test/Semantics/move_alloc.f90
@@ -0,0 +1,46 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Check for semantic errors in move_alloc() subroutine calls
+program main
+ integer, allocatable :: a(:)[:], b(:)[:], c(:)[:], d(:)[:]
+ !ERROR: 'e' is an ALLOCATABLE coarray and must have a deferred coshape
+ integer, allocatable :: e(:)[*]
+ integer status, coindexed_status[*]
+ character(len=1) message, coindexed_message[*]
+
+ ! standards conforming
+ allocate(a(3)[*])
+ a = [ 1, 2, 3 ]
+ call move_alloc(a, b, status, message)
+
+ allocate(c(3)[*])
+ c = [ 1, 2, 3 ]
+
+ !ERROR: too many actual arguments for intrinsic 'move_alloc'
+ call move_alloc(a, b, status, message, 1)
+
+ ! standards non-conforming
+ !ERROR: 'from' argument to 'move_alloc' may not be a coindexed object
+ call move_alloc(c[1], d)
+
+ !ERROR: 'to' argument to 'move_alloc' may not be a coindexed object
+ call move_alloc(c, d[1])
+
+ !ERROR: 'stat' argument to 'move_alloc' may not be a coindexed object
+ call move_alloc(c, d, coindexed_status[1])
+
+ !ERROR: 'errmsg' argument to 'move_alloc' may not be a coindexed object
+ call move_alloc(c, d, status, coindexed_message[1])
+
+ !ERROR: 'errmsg' argument to 'move_alloc' may not be a coindexed object
+ call move_alloc(c, d, errmsg=coindexed_message[1])
+
+ !ERROR: 'errmsg' argument to 'move_alloc' may not be a coindexed object
+ call move_alloc(c, d, errmsg=coindexed_message[1], stat=status)
+
+ !ERROR: 'stat' argument to 'move_alloc' may not be a coindexed object
+ call move_alloc(c, d, stat=coindexed_status[1])
+
+ !ERROR: 'stat' argument to 'move_alloc' may not be a coindexed object
+ call move_alloc(c, d, errmsg=message, stat=coindexed_status[1])
+
+end program main
More information about the flang-commits
mailing list