Index: flang/test/Semantics/co_reduce.f90 =================================================================== --- /dev/null +++ flang/test/Semantics/co_reduce.f90 @@ -0,0 +1,76 @@ +! RUN: %S/test_errors.sh %s %t %flang_fc1 +! REQUIRES: shell +! Check for semantic errors in co_reduce() function calls + +module test_co_reduce + implicit none + +contains + + subroutine test + + type foo_t + end type + + type(foo_t) foo + integer i, status + real vector(1) + real array(1,1,1, 1,1,1, 1,1,1, 1,1,1, 1,1,1) + character(len=1) string, message + + ! correct calls, should produce no errors + call co_reduce(i, int_op) + call co_reduce(i, int_op, status) + call co_reduce(i, int_op, stat=status) + call co_reduce(i, int_op, errmsg=message) + call co_reduce(i, int_op, stat=status, errmsg=message) + call co_reduce(i, int_op, result_image=1, stat=status, errmsg=message) + call co_reduce(i, operation=int_op, result_image=1, stat=status, errmsg=message) + call co_reduce(a=i, operation=int_op, result_image=1, stat=status, errmsg=message) + + call co_reduce(array, operation=real_op, result_image=1, stat=status, errmsg=message) + call co_reduce(vector, operation=real_op, result_image=1, stat=status, errmsg=message) + call co_reduce(string, operation=char_op, result_image=1, stat=status, errmsg=message) + call co_reduce(foo, operation=left, result_image=1, stat=status, errmsg=message) + + ! the error is seen as an incorrect type for the stat= argument + !ERROR: Actual argument for ‘stat=’ has bad type ‘CHARACTER(KIND=1,LEN=1_8)’ + call co_reduce(i, int_op) + + ! the error is seen as too many arguments to the co_reduce() call + !ERROR: too many actual arguments for collective subroutines 'co_reduce' + call co_reduce(i, int_op, result_image=1, stat=status, errmsg=message, 3.4) + + ! keyword argument with incorrect type + !ERROR: unknown keyword argument to intrinsic 'co_reduce' + call co_reduce(fake=3.4) + + contains + + pure function left(lhs, rhs) result(lhs_op_rhs) + type(foo_t), intent(in) :: lhs, rhs + type(foo_t) :: lhs_op_rhs + lhs_op_rhs = lhs + end function + + pure function char_op(lhs, rhs) result(lhs_op_rhs) + character(len=1), intent(in) :: lhs, rhs + character(len=1) :: lhs_op_rhs + lhs_op_rhs = min(lhs, rhs) + end function + + pure function real_op(lhs, rhs) result(lhs_op_rhs) + real, intent(in) :: lhs, rhs + real :: lhs_op_rhs + lhs_op_rhs = lhs + rhs + end function + + pure function int_op(lhs, rhs) result(lhs_op_rhs) + integer, intent(in) :: lhs, rhs + integer :: lhs_op_rhs + lhs_op_rhs = lhs + rhs + end function + + end subroutine + +end module test_co_reduce