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

[klausler]

Summary

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

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/lib/Evaluate/intrinsics.cpp

if (!arrayType || !procChars) {
         ok = false;
         context.messages().Say(at,
             "OPERATION= argument of REDUCE() must be a pure function of two data arguments"_err_en_US);
       } else if (!result || result->Rank() != 0) {
         ok = false;
         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);
       } else {
         const characteristics::DummyDataObject *data[2]{};
         for (int j{0}; j < 2; ++j) {
           const auto &dummy{procChars->dummyArguments.at(j)};
           data[j] = std::get_if<characteristics::DummyDataObject>(&dummy.u);
           ok = ok && data[j];
         }
         if (!ok) {
           context.messages().Say(at,
               "OPERATION= argument of REDUCE() may not have dummy procedure arguments"_err_en_US);
         } else {
           for (int j{0}; j < 2; ++j) {
             ok = ok &&
                 !data[j]->attrs.test(
                     characteristics::DummyDataObject::Attr::Optional) &&
                 !data[j]->attrs.test(
                     characteristics::DummyDataObject::Attr::Allocatable) &&
                 !data[j]->attrs.test(
                     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,
                 "Arguments of OPERATION= procedure of REDUCE() must be both scalar of the same type as ARRAY=, and neither allocatable, pointer, polymorphic, or optional"_err_en_US);
           } else if (data[0]->attrs.test(characteristics::DummyDataObject::
                              Attr::Asynchronous) !=
                   data[1]->attrs.test(
                       characteristics::DummyDataObject::Attr::Asynchronous) ||

flang/test/Semantics/reduce01.f90

 ! 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
   end function
   pure function f2(x,y)
     real :: f2(1)
     real, intent(in) :: x, y
     f2(1) = x + y
pure real function f9(x,y)
     real, intent(in) :: y
     f9 = x + y
   end function
   pure real function f10(x,y)
     real, intent(in), target :: x
     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)
     !ERROR: OPERATION= argument of REDUCE() must be a scalar function
     b = reduce(a, f2)
     !ERROR: OPERATION= argument of REDUCE() must be a pure function of two data arguments
     b = reduce(a, f3)
     !ERROR: OPERATION= argument of REDUCE() may not have dummy procedure arguments
     b = reduce(a, f4)
     !ERROR: OPERATION= argument of REDUCE() must have the same type as ARRAY=
     b = reduce(a, f5)
     !ERROR: Arguments of OPERATION= procedure of REDUCE() must be both scalar of the same type as ARRAY=, and neither allocatable, pointer, polymorphic, or optional
     b = reduce(a, f6)
     !ERROR: Arguments of OPERATION= procedure of REDUCE() must be both scalar of the same type as ARRAY=, and neither allocatable, pointer, polymorphic, or optional
     b = reduce(a, f7)
     !ERROR: Arguments of OPERATION= procedure of REDUCE() must be both scalar of the same type as ARRAY=, and neither allocatable, pointer, polymorphic, or optional
     b = reduce(a, f8)
     !ERROR: Arguments of OPERATION= procedure of REDUCE() must be both scalar of the same type as ARRAY=, and neither allocatable, pointer, polymorphic, or optional
     b = reduce(a, f9)
     !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