[flang] Add co_min and co_max to the list of intrinsics

[ktras]

Summary

Add the collective subroutines, co_min and co_max, to the list
of intrinsic subroutines. Add those two subroutines to the check
for coindexed objects for the first, third, and fourth dummy
arguments. Update the co_min and co_max semantics tests.

[ktras]

Ping.

[ktras]

Ping.

flang/lib/Evaluate/intrinsics.cpp

 // AnyType + Kind::addressable.
 using CategorySet = common::EnumSet<TypeCategory, 8>;
 static constexpr CategorySet IntType{TypeCategory::Integer};
 static constexpr CategorySet RealType{TypeCategory::Real};
 static constexpr CategorySet ComplexType{TypeCategory::Complex};
 static constexpr CategorySet CharType{TypeCategory::Character};
 static constexpr CategorySet LogicalType{TypeCategory::Logical};
 static constexpr CategorySet IntOrRealType{IntType | RealType};
+static constexpr CategorySet IntOrRealOrCharType{IntType | RealType | CharType};
 static constexpr CategorySet FloatingType{RealType | ComplexType};
 static constexpr CategorySet NumericType{IntType | RealType | ComplexType};
 static constexpr CategorySet RelatableType{IntType | RealType | CharType};
 static constexpr CategorySet DerivedType{TypeCategory::Derived};
 static constexpr CategorySet IntrinsicType{
     IntType | RealType | ComplexType | CharType | LogicalType};
 static constexpr CategorySet AnyType{IntrinsicType | DerivedType};
 

 static constexpr TypePattern DoublePrecisionComplex{
     ComplexType, KindCode::doublePrecision};
 static constexpr TypePattern SubscriptInt{IntType, KindCode::subscript};
 
 // Match any kind of some intrinsic or derived types
 static constexpr TypePattern AnyInt{IntType, KindCode::any};
 static constexpr TypePattern AnyReal{RealType, KindCode::any};
 static constexpr TypePattern AnyIntOrReal{IntOrRealType, KindCode::any};
+static constexpr TypePattern AnyIntOrRealOrChar{
+    IntOrRealOrCharType, KindCode::any};
 static constexpr TypePattern AnyComplex{ComplexType, KindCode::any};
 static constexpr TypePattern AnyFloating{FloatingType, KindCode::any};
 static constexpr TypePattern AnyNumeric{NumericType, KindCode::any};
 static constexpr TypePattern AnyChar{CharType, KindCode::any};
 static constexpr TypePattern AnyLogical{LogicalType, KindCode::any};
 static constexpr TypePattern AnyRelatable{RelatableType, KindCode::any};
 static constexpr TypePattern AnyIntrinsic{IntrinsicType, KindCode::any};
 static constexpr TypePattern ExtensibleDerived{DerivedType, KindCode::any};
static const SpecificIntrinsicInterface specificIntrinsicFunction[]{
     {{"tanh", {{"x", DefaultReal}}, DefaultReal}},
     {{"zabs", {{"a", TypePattern{ComplexType, KindCode::exactKind, 8}}},
          TypePattern{RealType, KindCode::exactKind, 8}},
         "abs"},
 };
 
 static const IntrinsicInterface intrinsicSubroutine[]{
     {"abort", {}, {}, Rank::elemental, IntrinsicClass::impureSubroutine},
+    {"co_max",
+        {{"a", AnyIntOrRealOrChar, Rank::anyOrAssumedRank,
+             Optionality::required, common::Intent::InOut},
+            {"result_image", AnyInt, Rank::scalar, Optionality::optional,
+                common::Intent::In},
+            {"stat", AnyInt, Rank::scalar, Optionality::optional,
+                common::Intent::Out},
+            {"errmsg", DefaultChar, Rank::scalar, Optionality::optional,
+                common::Intent::InOut}},
+        {}, Rank::elemental, IntrinsicClass::collectiveSubroutine},
+    {"co_min",
+        {{"a", AnyIntOrRealOrChar, Rank::anyOrAssumedRank,
+             Optionality::required, common::Intent::InOut},
+            {"result_image", AnyInt, Rank::scalar, Optionality::optional,
+                common::Intent::In},
+            {"stat", AnyInt, Rank::scalar, Optionality::optional,
+                common::Intent::Out},
+            {"errmsg", DefaultChar, Rank::scalar, Optionality::optional,
+                common::Intent::InOut}},
+        {}, Rank::elemental, IntrinsicClass::collectiveSubroutine},
     {"co_sum",
         {{"a", AnyNumeric, Rank::anyOrAssumedRank, Optionality::required,
              common::Intent::InOut},
             {"result_image", AnyInt, Rank::scalar, Optionality::optional,
                 common::Intent::In},
             {"stat", AnyInt, Rank::scalar, Optionality::optional,
                 common::Intent::Out},
             {"errmsg", DefaultChar, Rank::scalar, Optionality::optional,
if (name == "allocated") {
     }
     if (!ok) {
       context.messages().Say(
           arg ? arg->sourceLocation() : context.messages().at(),
           "Argument of ALLOCATED() must be an ALLOCATABLE object or component"_err_en_US);
     }
   } else if (name == "associated") {
     return CheckAssociated(call, context);
-  } else if (name == "co_sum") {
+  } else if (name == "co_max" || name == "co_min" || name == "co_sum") {
     bool aOk{CheckForCoindexedObject(context, call.arguments[0], name, "a")};
     bool statOk{
         CheckForCoindexedObject(context, call.arguments[2], name, "stat")};
     bool errmsgOk{
         CheckForCoindexedObject(context, call.arguments[3], name, "errmsg")};
     ok = aOk && statOk && errmsgOk;
   } else if (name == "image_status") {
     if (const auto &arg{call.arguments[0]}) {

flang/test/Semantics/collectives02.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
-! XFAIL: *
 ! This test checks for semantic errors in co_min subroutine calls based on
 ! the co_min interface defined in section 16.9.48 of the Fortran 2018 standard.
-! To Do: add co_min to the list of intrinsics
 
 program test_co_min
   implicit none
 
-  integer          i, integer_array(1), coindexed_integer[*], status
-  character(len=1) c, character_array(1), coindexed_character[*], message
+  integer          i, integer_array(1), coindexed_integer[*], status, coindexed_result_image[*], repeated_status
+  character(len=1) c, character_array(1), coindexed_character[*], message, repeated_message
   double precision d, double_precision_array(1)
   real             r, real_array(1), coindexed_real[*]
   complex          complex_type
   logical          bool
-  
   !___ standard-conforming calls with no keyword arguments ___
   call co_min(i)
   call co_min(c)
   call co_min(d)
   call co_min(r)
   call co_min(i, 1)
   call co_min(c, 1, status)
   call co_min(d, 1, status, message)
   call co_min(r, 1, status, message)
   call co_min(integer_array)
   call co_min(character_array, 1)
   call co_min(double_precision_array, 1, status)
   call co_min(real_array, 1, status, message)
 
   !___ standard-conforming calls with keyword arguments ___
 
   ! all arguments present
-  call co_min(a=i, result_image=1, stat=status, errmsg=message) 
-  call co_min(result_image=1, a=i, errmsg=message, stat=status) 
+  call co_min(a=i, result_image=1, stat=status, errmsg=message)
+  call co_min(result_image=1, a=i, errmsg=message, stat=status)
 
   ! one optional argument not present
-  call co_min(a=i,                 stat=status, errmsg=message) 
+  call co_min(a=i,                 stat=status, errmsg=message)
   call co_min(a=i, result_image=1,              errmsg=message)
   call co_min(a=i, result_image=1, stat=status                )
 
   ! two optional arguments not present
-  call co_min(a=i, result_image=1                             ) 
+  call co_min(a=i, result_image=1                             )
   call co_min(a=i,                 stat=status                )
-  call co_min(a=i,                              errmsg=message) 
+  call co_min(a=i,                              errmsg=message)
+  call co_min(a=i, result_image=coindexed_result_image[1]     )
 
   ! no optional arguments present
-  call co_min(a=i) 
+  call co_min(a=i)
 
   !___ non-standard-conforming calls ___
 
+  !ERROR: missing mandatory 'a=' argument
+  call co_min()
+
+  !ERROR: repeated keyword argument to intrinsic 'co_min'
+  call co_min(a=i, a=c)
+
+  !ERROR: repeated keyword argument to intrinsic 'co_min'
+  call co_min(d, result_image=1, result_image=3)
+
+  !ERROR: repeated keyword argument to intrinsic 'co_min'
+  call co_min(d, 1, stat=status, stat=repeated_status)
+
+  !ERROR: repeated keyword argument to intrinsic 'co_min'
+  call co_min(d, 1, status, errmsg=message, errmsg=repeated_message)
+
+  !ERROR: keyword argument to intrinsic 'co_min' was supplied positionally by an earlier actual argument
+  call co_min(i, 1, a=c)
+
+  !ERROR: keyword argument to intrinsic 'co_min' was supplied positionally by an earlier actual argument
+  call co_min(i, 1, status, result_image=1)
+
+  !ERROR: keyword argument to intrinsic 'co_min' was supplied positionally by an earlier actual argument
+  call co_min(i, 1, status, stat=repeated_status)
+
+  !ERROR: keyword argument to intrinsic 'co_min' was supplied positionally by an earlier actual argument
+  call co_min(i, 1, status, message, errmsg=repeated_message)
+
   ! argument 'a' shall be of numeric type
   !ERROR: Actual argument for 'a=' has bad type 'LOGICAL(4)'
   call co_min(bool)
-  
   ! argument 'a' shall be of numeric type
   !ERROR: Actual argument for 'a=' has bad type 'COMPLEX(4)'
   call co_min(complex_type)
-  
-  ! argument 'a' is intent(inout)
   !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'a=' must be definable
   call co_min(a=1+1)
-  
-  ! argument 'a' shall not be a coindexed object
-  !ERROR: to be determined
+  !ERROR: 'a' argument to 'co_min' may not be a coindexed object
   call co_min(a=coindexed_real[1])
-  
-  ! 'result_image' argument shall be a scalar
-  !ERROR: too many actual arguments for intrinsic 'co_min'
+  !ERROR: Actual argument for 'result_image=' has bad type 'LOGICAL(4)'
   call co_min(i, result_image=bool)
-  
-  ! 'result_image' argument shall be an integer scalar
-  !ERROR: too many actual arguments for intrinsic 'co_min'
+  !ERROR: 'result_image=' argument has unacceptable rank 1
   call co_min(c, result_image=integer_array)
-  
-  ! 'stat' argument shall be noncoindexed
-  !ERROR: to be determined
+  !ERROR: 'stat' argument to 'co_min' may not be a coindexed object
   call co_min(d, stat=coindexed_integer[1])
- 
   ! 'stat' argument shall be an integer
   !ERROR: Actual argument for 'stat=' has bad type 'CHARACTER(KIND=1,LEN=1_8)'
   call co_min(r, stat=message)
- 
-  ! 'stat' argument shall be an integer scalar
   !ERROR: 'stat=' argument has unacceptable rank 1
   call co_min(i, stat=integer_array)
 
-  ! 'errmsg' argument shall be intent(inout)
   !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'errmsg=' must be definable
   call co_min(a=i, result_image=1, stat=status, errmsg='c')
 
-  ! 'errmsg' argument shall be noncoindexed
-  !ERROR: to be determined
+  !ERROR: 'errmsg' argument to 'co_min' may not be a coindexed object
   call co_min(c, errmsg=coindexed_character[1])
 
   ! 'errmsg' argument shall be a character
-  !ERROR: to be determined
+  !ERROR: Actual argument for 'errmsg=' has bad type 'INTEGER(4)'
   call co_min(c, errmsg=i)
 
-  ! 'errmsg' argument shall be character scalar
   !ERROR: 'errmsg=' argument has unacceptable rank 1
   call co_min(d, errmsg=character_array)
- 
-  ! the error is seen as too many arguments to the co_min() call
   !ERROR: too many actual arguments for intrinsic 'co_min'
   call co_min(r, result_image=1, stat=status, errmsg=message, 3.4)
-  
-  ! keyword argument with incorrect name
   !ERROR: unknown keyword argument to intrinsic 'co_min'
   call co_min(fake=3.4)
-  
+  !ERROR: 'a' argument to 'co_min' may not be a coindexed object
+  !ERROR: 'errmsg' argument to 'co_min' may not be a coindexed object
+  !ERROR: 'stat' argument to 'co_min' may not be a coindexed object
+  call co_min(result_image=coindexed_result_image[1], a=coindexed_real[1], errmsg=coindexed_character[1], stat=coindexed_integer[1])
+
 end program test_co_min

flang/test/Semantics/collectives03.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
-! XFAIL: *
 ! This test checks for semantic errors in co_max subroutine calls based on
 ! the co_max interface defined in section 16.9.47 of the Fortran 2018 standard.
-! To Do: add co_max to the list of intrinsics
 
 program test_co_max
   implicit none
 
-  integer          i, integer_array(1), coindexed_integer[*], status
-  character(len=1) c, character_array(1), coindexed_character[*], message
+  integer          i, integer_array(1), coindexed_integer[*], status, coindexed_result_image[*], repeated_status
+  character(len=1) c, character_array(1), coindexed_character[*], message, repeated_message
   double precision d, double_precision_array(1)
   real             r, real_array(1), coindexed_real[*]
   complex          complex_type
   logical          bool
-  
   !___ standard-conforming calls with no keyword arguments ___
   call co_max(i)
   call co_max(c)
   call co_max(d)
   call co_max(r)
   call co_max(i, 1)
   call co_max(c, 1, status)
   call co_max(d, 1, status, message)
   call co_max(r, 1, status, message)
   call co_max(integer_array)
   call co_max(character_array, 1)
   call co_max(double_precision_array, 1, status)
   call co_max(real_array, 1, status, message)
 
   !___ standard-conforming calls with keyword arguments ___
 
   ! all arguments present
-  call co_max(a=i, result_image=1, stat=status, errmsg=message) 
-  call co_max(result_image=1, a=i, errmsg=message, stat=status) 
+  call co_max(a=i, result_image=1, stat=status, errmsg=message)
+  call co_max(result_image=1, a=i, errmsg=message, stat=status)
 
   ! one optional argument not present
-  call co_max(a=i,                 stat=status, errmsg=message) 
+  call co_max(a=i,                 stat=status, errmsg=message)
   call co_max(a=i, result_image=1,              errmsg=message)
   call co_max(a=i, result_image=1, stat=status                )
 
   ! two optional arguments not present
-  call co_max(a=i, result_image=1                             ) 
+  call co_max(a=i, result_image=1                             )
   call co_max(a=i,                 stat=status                )
-  call co_max(a=i,                              errmsg=message) 
+  call co_max(a=i,                              errmsg=message)
+  call co_max(a=i, result_image=coindexed_result_image[1]     )
 
   ! no optional arguments present
-  call co_max(a=i) 
+  call co_max(a=i)
 
   !___ non-standard-conforming calls ___
 
+  !ERROR: missing mandatory 'a=' argument
+  call co_max()
+
+  !ERROR: repeated keyword argument to intrinsic 'co_max'
+  call co_max(a=i, a=c)
+
+  !ERROR: repeated keyword argument to intrinsic 'co_max'
+  call co_max(d, result_image=1, result_image=3)
+
+  !ERROR: repeated keyword argument to intrinsic 'co_max'
+  call co_max(d, 1, stat=status, stat=repeated_status)
+
+  !ERROR: repeated keyword argument to intrinsic 'co_max'
+  call co_max(d, 1, status, errmsg=message, errmsg=repeated_message)
+
+  !ERROR: keyword argument to intrinsic 'co_max' was supplied positionally by an earlier actual argument
+  call co_max(i, 1, a=c)
+
+  !ERROR: keyword argument to intrinsic 'co_max' was supplied positionally by an earlier actual argument
+  call co_max(i, 1, status, result_image=1)
+
+  !ERROR: keyword argument to intrinsic 'co_max' was supplied positionally by an earlier actual argument
+  call co_max(i, 1, status, stat=repeated_status)
+
+  !ERROR: keyword argument to intrinsic 'co_max' was supplied positionally by an earlier actual argument
+  call co_max(i, 1, status, message, errmsg=repeated_message)
+
   ! argument 'a' shall be of numeric type
   !ERROR: Actual argument for 'a=' has bad type 'LOGICAL(4)'
   call co_max(bool)
-  
   ! argument 'a' shall be of numeric type
   !ERROR: Actual argument for 'a=' has bad type 'COMPLEX(4)'
   call co_max(complex_type)
-  
-  ! argument 'a' is intent(inout)
   !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'a=' must be definable
   call co_max(a=1+1)
-  
-  ! argument 'a' shall not be a coindexed object
-  !ERROR: to be determined
+  !ERROR: 'a' argument to 'co_max' may not be a coindexed object
   call co_max(a=coindexed_real[1])
-  
-  ! 'result_image' argument shall be a scalar
-  !ERROR: too many actual arguments for intrinsic 'co_max'
+  !ERROR: Actual argument for 'result_image=' has bad type 'LOGICAL(4)'
   call co_max(i, result_image=bool)
-  
-  ! 'result_image' argument shall be an integer scalar
-  !ERROR: too many actual arguments for intrinsic 'co_max'
+  !ERROR: 'result_image=' argument has unacceptable rank 1
   call co_max(c, result_image=integer_array)
-  
-  ! 'stat' argument shall be noncoindexed
-  !ERROR: to be determined
+  !ERROR: 'stat' argument to 'co_max' may not be a coindexed object
   call co_max(d, stat=coindexed_integer[1])
- 
   ! 'stat' argument shall be an integer
   !ERROR: Actual argument for 'stat=' has bad type 'CHARACTER(KIND=1,LEN=1_8)'
   call co_max(r, stat=message)
- 
-  ! 'stat' argument shall be an integer scalar
   !ERROR: 'stat=' argument has unacceptable rank 1
   call co_max(i, stat=integer_array)
- 
-  ! 'errmsg' argument shall be intent(inout)
   !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'errmsg=' must be definable
   call co_max(a=i, result_image=1, stat=status, errmsg='c')
 
-  ! 'errmsg' argument shall be noncoindexed
-  !ERROR: to be determined
+  !ERROR: 'errmsg' argument to 'co_max' may not be a coindexed object
   call co_max(c, errmsg=coindexed_character[1])
 
   ! 'errmsg' argument shall be a character
-  !ERROR: to be determined
+  !ERROR: Actual argument for 'errmsg=' has bad type 'INTEGER(4)'
   call co_max(c, errmsg=i)
 
-  ! 'errmsg' argument shall be character scalar
   !ERROR: 'errmsg=' argument has unacceptable rank 1
   call co_max(d, errmsg=character_array)
- 
-  ! the error is seen as too many arguments to the co_max() call
   !ERROR: too many actual arguments for intrinsic 'co_max'
   call co_max(r, result_image=1, stat=status, errmsg=message, 3.4)
-  
-  ! keyword argument with incorrect name
   !ERROR: unknown keyword argument to intrinsic 'co_max'
   call co_max(fake=3.4)
-  
+  !ERROR: 'a' argument to 'co_max' may not be a coindexed object
+  !ERROR: 'errmsg' argument to 'co_max' may not be a coindexed object
+  !ERROR: 'stat' argument to 'co_max' may not be a coindexed object
+  call co_max(result_image=coindexed_result_image[1], a=coindexed_real[1], errmsg=coindexed_character[1], stat=coindexed_integer[1])
+
 end program test_co_max