[flang-commits] [flang] 45ac2c7 - [flang] Allow PDTs with LEN parameters in REDUCE()

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2022-05-09T17:40:50-07:00
New Revision: 45ac2c730bc4f78d2d90a76e98fab66de92433b6

URL: https://github.com/llvm/llvm-project/commit/45ac2c730bc4f78d2d90a76e98fab66de92433b6
DIFF: https://github.com/llvm/llvm-project/commit/45ac2c730bc4f78d2d90a76e98fab66de92433b6.diff

LOG: [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

Added: 
    

Modified: 
    flang/lib/Evaluate/intrinsics.cpp
    flang/test/Semantics/reduce01.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 83c505353988..c6617f797356 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -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,

diff  --git a/flang/test/Semantics/reduce01.f90 b/flang/test/Semantics/reduce01.f90
index 9e6fffcc091f..fe58004ff30a 100644
--- a/flang/test/Semantics/reduce01.f90
+++ b/flang/test/Semantics/reduce01.f90
@@ -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 @@ pure real function f10(x,y)
     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 @@ subroutine test
     !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