[flang-commits] [PATCH] D125124: [flang] Allow PDTs with LEN parameters in REDUCE()

[Peter Klausler via Phabricator via flang-commits]

klausler created this revision.
klausler added a reviewer: PeteSteinfeld.
klausler added a project: Flang.
Herald added a subscriber: jdoerfert.
Herald added a project: All.
klausler requested review of this revision.

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).


https://reviews.llvm.org/D125124

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


Index: flang/test/Semantics/reduce01.f90
===================================================================
--- flang/test/Semantics/reduce01.f90
+++ 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 @@
     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 @@
     !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
Index: flang/lib/Evaluate/intrinsics.cpp
===================================================================
--- flang/lib/Evaluate/intrinsics.cpp
+++ flang/lib/Evaluate/intrinsics.cpp
@@ -2392,7 +2392,7 @@
         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);
@@ -2417,7 +2417,7 @@
                     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,


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D125124.427724.patch
Type: text/x-patch
Size: 2230 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20220506/56dc97ad/attachment.bin>