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

[flang] Allow PDTs with LEN parameters in REDUCE() 

The type compatibility checks for the ARRAY= argument and the dummy
arguments and result of the OPERATION= argument to the REDUCE intrinsic
function need to allow for parameterized data types with LEN parameters.
(Their values are required to be identical but this is not a numbered
constraint requiring a compilation time check).

Differential Revision: https://reviews.llvm.org/D125124
This commit is contained in:
Peter Klausler 2022-05-03 09:54:29 -07:00
parent 59fea9380d
commit 45ac2c730b
2 changed files with 16 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2393,7 +2393,7 @@ static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
context.messages().Say(at,
"OPERATION= argument of REDUCE() must be a scalar function"_err_en_US);
} else if (result->type().IsPolymorphic() ||
result->type() != *arrayType) {
!arrayType->IsTkCompatibleWith(result->type())) {
ok = false;
context.messages().Say(at,
"OPERATION= argument of REDUCE() must have the same type as ARRAY="_err_en_US);
@ -2418,7 +2418,7 @@ static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
characteristics::DummyDataObject::Attr::Pointer) &&
data[j]->type.Rank() == 0 &&
!data[j]->type.type().IsPolymorphic() &&
data[j]->type.type() == *arrayType;
data[j]->type.type().IsTkCompatibleWith(*arrayType);
}
if (!ok) {
context.messages().Say(at,

15
flang/test/Semantics/reduce01.f90
View File

@ -1,5 +1,9 @@
! RUN: %python %S/test_errors.py %s %flang_fc1
module m
type :: pdt(len)
integer, len :: len
character(len=len) :: ch
end type
contains
impure real function f1(x,y)
f1 = x + y
@ -48,8 +52,13 @@ module m
real, intent(in) :: y
f10 = x + y
end function
pure function f11(x,y) result(res)
type(pdt(*)), intent(in) :: x, y
type(pdt(max(x%len, y%len))) :: res
res%ch = x%ch // y%ch
end function
subroutine test
subroutine errors
real :: a(10,10), b
!ERROR: OPERATION= argument of REDUCE() must be a pure function of two data arguments
b = reduce(a, f1)
@ -72,4 +81,8 @@ module m
!ERROR: If either argument of the OPERATION= procedure of REDUCE() has the ASYNCHRONOUS, VOLATILE, or TARGET attribute, both must have that attribute
b = reduce(a, f10)
end subroutine
subroutine not_errors
type(pdt(10)) :: a(10), b
b = reduce(a, f11) ! check no bogus type incompatibility diagnostic
end subroutine
end module