[flang-commits] [flang] 2944f8e - [flang] Add co_sum to the list of intrinsics and update test
Katherine Rasmussen via flang-commits
flang-commits at lists.llvm.org
Thu Sep 8 09:40:26 PDT 2022
Author: Katherine Rasmussen
Date: 2022-09-08T09:38:24-07:00
New Revision: 2944f8ef049fa83ee96159c390fa893f251558da
URL: https://github.com/llvm/llvm-project/commit/2944f8ef049fa83ee96159c390fa893f251558da
DIFF: https://github.com/llvm/llvm-project/commit/2944f8ef049fa83ee96159c390fa893f251558da.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
standard-conforming and non-standard conforming calls in 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 1b98fd0230300..fe338e7dbc82c 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1084,6 +1084,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}},
@@ -2406,6 +2416,21 @@ static bool CheckDimAgainstCorank(SpecificCall &call, FoldingContext &context) {
return ok;
}
+static bool CheckForCoindexedObject(FoldingContext &context,
+ const std::optional<ActualArgument> &arg, const std::string &procName,
+ const std::string &argName) {
+ bool ok{true};
+ if (arg) {
+ if (ExtractCoarrayRef(arg->UnwrapExpr())) {
+ ok = false;
+ context.messages().Say(arg->sourceLocation(),
+ "'%s' argument to '%s' may not be a coindexed object"_err_en_US,
+ argName, procName);
+ }
+ }
+ return ok;
+}
+
// Applies any semantic checks peculiar to an intrinsic.
static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
bool ok{true};
@@ -2424,6 +2449,13 @@ static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
}
} else if (name == "associated") {
return CheckAssociated(call, context);
+ } else if (name == "co_sum") {
+ bool aOk{CheckForCoindexedObject(context, call.arguments[0], name, "a")};
+ bool statOk{
+ CheckForCoindexedObject(context, call.arguments[2], name, "stat")};
+ bool errmsgOk{
+ CheckForCoindexedObject(context, call.arguments[3], name, "errmsg")};
+ ok = aOk && statOk && errmsgOk;
} else if (name == "image_status") {
if (const auto &arg{call.arguments[0]}) {
ok = CheckForNonPositiveValues(context, *arg, name, "image");
@@ -2457,6 +2489,15 @@ 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") {
+ bool fromOk{
+ CheckForCoindexedObject(context, call.arguments[0], name, "from")};
+ bool toOk{CheckForCoindexedObject(context, call.arguments[1], name, "to")};
+ bool statOk{
+ CheckForCoindexedObject(context, call.arguments[2], name, "stat")};
+ bool errmsgOk{
+ CheckForCoindexedObject(context, call.arguments[3], name, "errmsg")};
+ ok = fromOk && toOk && statOk && errmsgOk;
} else if (name == "present") {
const auto &arg{call.arguments[0]};
if (arg) {
@@ -2613,6 +2654,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..e0c7a3688bfe2 100644
--- a/flang/test/Semantics/collectives01.f90
+++ b/flang/test/Semantics/collectives01.f90
@@ -1,20 +1,18 @@
! 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[*]
- complex c, complex_array(1,1,1, 1,1,1, 1,1,1, 1,1,1, 1,1,1)
+ integer i, status, integer_array(1), coindexed_integer[*], coindexed_result_image[*], repeated_status
+ 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[*]
- character(len=1) message, coindexed_character[*], character_array(1)
+ character(len=1) message, coindexed_character[*], character_array(1), repeated_message
logical bool
-
+
!___ standard-conforming calls with no keyword arguments ___
call co_sum(i)
call co_sum(c)
@@ -32,43 +30,71 @@ program test_co_sum
!___ standard-conforming calls with keyword arguments ___
! all arguments present
- call co_sum(a=i, result_image=1, stat=status, errmsg=message)
+ call co_sum(a=i, result_image=1, stat=status, errmsg=message)
+ call co_sum(a = i, result_image = 1, stat = status, errmsg = message)
call co_sum(result_image=1, a=i, errmsg=message, stat=status)
! one optional argument not present
- call co_sum(a=i, stat=status, errmsg=message)
+ call co_sum(a=i, stat=status, errmsg=message)
call co_sum(a=i, result_image=1, errmsg=message)
call co_sum(a=i, result_image=1, stat=status )
! two optional arguments not present
- call co_sum(a=i, result_image=1 )
+ 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, errmsg=message)
+ call co_sum(a=i, result_image=coindexed_result_image[1])
! no optional arguments present
- call co_sum(a=i )
+ 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)
+
+ !ERROR: repeated keyword argument to intrinsic 'co_sum'
+ call co_sum(a=i, result_image=1, result_image=2, stat=status, errmsg=message)
+
+ !ERROR: repeated keyword argument to intrinsic 'co_sum'
+ call co_sum(a=i, result_image=1, stat=status, stat=repeated_status, errmsg=message)
+
+ !ERROR: repeated keyword argument to intrinsic 'co_sum'
+ call co_sum(a=i, result_image=1, stat=status, errmsg=message, errmsg=repeated_message)
+
+ !ERROR: keyword argument to intrinsic 'co_sum' was supplied positionally by an earlier actual argument
+ call co_sum(i, 1, a=c)
+
+ !ERROR: keyword argument to intrinsic 'co_sum' was supplied positionally by an earlier actual argument
+ call co_sum(i, 1, result_image=2)
+
+ !ERROR: keyword argument to intrinsic 'co_sum' was supplied positionally by an earlier actual argument
+ call co_sum(i, 1, status, stat=repeated_status)
+
+ !ERROR: keyword argument to intrinsic 'co_sum' was supplied positionally by an earlier actual argument
+ call co_sum(i, 1, status, message, errmsg=repeated_message)
+
! argument 'a' shall be of numeric type
!ERROR: Actual argument for 'a=' has bad type 'LOGICAL(4)'
call co_sum(bool)
-
+
! argument 'a' is intent(inout)
!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
!ERROR: Actual argument for 'result_image=' has bad type 'LOGICAL(4)'
call co_sum(i, result_image=bool)
-
+
! 'result_image' argument shall be an integer scalar
!ERROR: 'result_image=' argument has unacceptable rank 1
call co_sum(c, result_image=integer_array)
@@ -77,40 +103,45 @@ 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)'
call co_sum(r, stat=message)
-
+
! 'stat' argument shall be an integer scalar
!ERROR: 'stat=' argument has unacceptable rank 1
call co_sum(i, stat=integer_array)
-
+
! 'errmsg' argument shall be intent(inout)
!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..a8e124969fb0f
--- /dev/null
+++ b/flang/test/Semantics/move_alloc.f90
@@ -0,0 +1,52 @@
+! 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])
+
+ !ERROR: 'from' argument to 'move_alloc' may not be a coindexed object
+ !ERROR: 'to' argument to 'move_alloc' may not be a coindexed object
+ !ERROR: 'stat' argument to 'move_alloc' may not be a coindexed object
+ !ERROR: 'errmsg' argument to 'move_alloc' may not be a coindexed object
+ call move_alloc(c[1], d[1], stat=coindexed_status[1], errmsg=coindexed_message[1])
+
+end program main
More information about the flang-commits
mailing list