maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[flang] Fix conformability for intrinsic procedures 

There are situations where the arguments of intrinsics must be
conformable, which is defined in section 3.36.  This means they must
have "the same shape, or one being an array and the other being scalar".
But the check we were actually making was that their ranks were the same.

This change fixes that and adds a test for the UNPACK intrinsic, where
the FIELD argument "shall be conformable with MASK".

Differential Revision: https://reviews.llvm.org/D104936
This commit is contained in:
Peter Steinfeld 2021-06-25 11:28:30 -07:00
parent 4f5ebfdcd6
commit 57e53f0130
2 changed files with 32 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
flang/lib/Evaluate/intrinsics.cpp
View File

@ -1355,6 +1355,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
// Check the ranks of the arguments against the intrinsic's interface.
const ActualArgument *arrayArg{nullptr};
const char *arrayArgName{nullptr};
const ActualArgument *knownArg{nullptr};
std::optional<int> shapeArgSize;
int elementalRank{0};
@ -1411,6 +1412,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
argOk = rank > 0;
if (!arrayArg) {
arrayArg = arg;
arrayArgName = d.keyword;
} else {
argOk &= rank == arrayArg->Rank();
}
@ -1424,9 +1426,22 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
case Rank::anyOrAssumedRank:
argOk = true;
break;
case Rank::conformable:
case Rank::conformable: // arg must be conformable with previous arrayArg
CHECK(arrayArg);
argOk = rank == 0 || rank == arrayArg->Rank();
CHECK(arrayArgName);
if (const std::optional<Shape> &arrayArgShape{
GetShape(context, *arrayArg)}) {
if (const std::optional<Shape> &argShape{GetShape(context, *arg)}) {
std::string arrayArgMsg{"'"};
arrayArgMsg = arrayArgMsg + arrayArgName + "='" + " argument";
std::string argMsg{"'"};
argMsg = argMsg + d.keyword + "='" + " argument";
CheckConformance(context.messages(), *arrayArgShape, *argShape,
CheckConformanceFlags::RightScalarExpandable,
arrayArgMsg.c_str(), argMsg.c_str());
}
}
argOk = true; // Avoid an additional error message
break;
case Rank::dimReduced:
case Rank::dimRemovedOrScalar:

15
flang/test/Semantics/unpack.f90 Normal file
View File

@ -0,0 +1,15 @@
! RUN: %S/test_errors.sh %s %t %flang_fc1
! UNPACK() intrinsic function error tests
program test_unpack
integer, dimension(2) :: vector = [343, 512]
logical, dimension(2, 2) :: mask = &
reshape([.true., .false., .true., .false.], [2, 2])
integer, dimension(2, 2) :: field = reshape([1, 2, 3, 4, 5, 6], [2, 2])
integer, dimension(2, 1) :: bad_field = reshape([1, 2], [2, 1])
integer :: scalar_field
integer, dimension(2, 2) :: result
result = unpack(vector, mask, field)
!ERROR: Dimension 2 of 'mask=' argument has extent 2, but 'field=' argument has extent 1
result = unpack(vector, mask, bad_field)
result = unpack(vector, mask, scalar_field)
end program