Differential D113086 Diff 395494 flang/test/Semantics/collectives05.f90

Changeset View

Standalone View

View Options

flang/test/Semantics/collectives05.f90

This file was added.

! RUN: %python %S/test_errors.py %s %flang_fc1

! XFAIL: *

! This test checks for semantic errors in co_reduce subroutine calls based on

! the co_reduce interface defined in section 16.9.49 of the Fortran 2018 standard.

! To Do: add co_reduce to the list of intrinsics

clementvalUnsubmitted

Done

What is the evaluation stage?

clementval: What is the evaluation stage?

ktrasUnsubmitted

Done

@rouson added this comment because I plan to add the collective subroutines to the list of intrinsic functions in flang/lib/Evaluate/intrinsics.cpp. If the term evaluation stage does not have significant meaning, I will suggest to Damian to change the to-do comment.

ktras: @rouson added this comment because I plan to add the collective subroutines to the list of…

module foo_m

implicit none

type foo_t

integer :: n=0

contains

procedure :: derived_type_op

generic :: operator(+) => derived_type_op

end type

contains

pure function derived_type_op(lhs, rhs) result(lhs_op_rhs)

class(foo_t), intent(in) :: lhs, rhs

type(foo_t) lhs_op_rhs

lhs_op_rhs%n = lhs%n + rhs%n

end function

end module foo_m

program main

use foo_m, only : foo_t

implicit none

type(foo_t) foo

class(foo_t), allocatable :: polymorphic

integer i, status, integer_array(1)

real x

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, character_array(1)

integer coindexed[*]

logical bool

! correct calls, should produce no errors

call co_reduce(i, int_op)

ekieriUnsubmitted

Done

Please start error messages with a captial letter, as per [1]. (I suppose that overrides [2], which requires the opposite.) Same things on line 45.

[1] https://flang.llvm.org/docs/C++style.html#error-messages
[2] https://llvm.org/docs/CodingStandards.html#error-and-warning-messages

ekieri: Please start error messages with a captial letter, as per [1]. (I suppose that overrides [2]…

ktrasUnsubmitted

Done

@rouson is not creating error messages here, he is matching the error message that will be produced by the compiler once collectives have been added to the list of intrinsics. If the error message not beginning with a capital letter is an issue, the source code that currently procedures this message would need to be edited. I personally would think that that might be outside the scope of this patch, as it is just adding a test, not editing source code.

ktras: @rouson is not creating error messages here, he is matching the error message that will be…

ekieriUnsubmitted

Done

Indeed, sorry, and thanks for pointing that out. I agree completely, fixing that kind of formatting is another patch.

ekieri: Indeed, sorry, and thanks for pointing that out. I agree completely, fixing that kind of…

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)

allocate(foo_t :: polymorphic)

! Test all statically verifiable semantic requirements on co_reduce arguments

! Note: We cannot check requirements that relate to "corresponding references."

! References can correspond only if they execute on differing images. A code that

! executes in a single image might be standard-conforming even if the same code

! executing in multiple images is not.

! argument 'a' cannot be polymorphic

!ERROR: to be determined

call co_reduce(polymorphic, derived_type_op)

! argument 'a' cannot be coindexed

!ERROR: (message to be determined)

call co_reduce(coindexed[1], int_op)

! argument 'a' is intent(inout)

!ERROR: (message to be determined)

call co_reduce(i + 1, int_op)

! operation must be a pure function

!ERROR: (message to be determined)

call co_reduce(i, operation=not_pure)

! operation must have exactly two arguments

!ERROR: (message to be determined)

call co_reduce(i, too_many_args)

! operation result must be a scalar

!ERROR: (message to be determined)

call co_reduce(i, array_result)

! operation result must be non-allocatable

!ERROR: (message to be determined)

call co_reduce(i, allocatable_result)

! operation result must be non-pointer

!ERROR: (message to be determined)

call co_reduce(i, pointer_result)

! operation's arguments must be scalars

ekieriUnsubmitted

Done

This function is not defined.

ekieri: This function is not defined.

rousonAuthorUnsubmitted

Done

@ekieri I deleted the line of code that contained the undefined function.

rouson: @ekieri I deleted the line of code that contained the undefined function.

!ERROR: (message to be determined)

ekieriUnsubmitted

Done

call co_reduce(i, pointer_result)

- ! operation's arguments must scalars

+ ! operation's arguments must be scalars

!ERROR: (message to be determined)

ekieri:

call co_reduce(i, array_args)

! operation arguments must be non-allocatable

!ERROR: (message to be determined)

call co_reduce(i, allocatable_args)

! operation arguments must be non-pointer

!ERROR: (message to be determined)

call co_reduce(i, pointer_args)

! operation arguments must be non-polymorphic

!ERROR: (message to be determined)

call co_reduce(i, polymorphic_args)

! operation: type of 'operation' result and arguments must match type of argument 'a'

!ERROR: (message to be determined)

call co_reduce(i, real_op)

! operation: kind type parameter of 'operation' result and arguments must match kind type parameter of argument 'a'

!ERROR: (message to be determined)

call co_reduce(x, double_precision_op)

! arguments must be non-optional

!ERROR: (message to be determined)

ekieriUnsubmitted

Done

call co_reduce(x, double_precision_op)

- ! arguments must non-optional

+ ! arguments must be non-optional

!ERROR: (message to be determined)

ekieri:

call co_reduce(i, optional_args)

! if one argument is asynchronous, the other must be also

!ERROR: (message to be determined)

call co_reduce(i, asynchronous_mismatch)

! if one argument is a target, the other must be also

!ERROR: (message to be determined)

call co_reduce(i, target_mismatch)

! if one argument has the value attribute, the other must have it also

!ERROR: (message to be determined)

call co_reduce(i, value_mismatch)

! result_image argument must be an integer scalar

!ERROR: to be determined

call co_reduce(i, int_op, result_image=integer_array)

! result_image argument must be an integer

!ERROR: to be determined

call co_reduce(i, int_op, result_image=bool)

! stat not allowed to be coindexed

!ERROR: to be determined

call co_reduce(i, int_op, stat=coindexed[1])

! stat argument must be an integer scalar

!ERROR: to be determined

call co_reduce(i, int_op, result_image=1, stat=integer_array)

! stat argument has incorrect type

!ERROR: Actual argument for 'stat=' has bad type 'CHARACTER(KIND=1,LEN=1_8)'

call co_reduce(i, int_op, result_image=1, string)

! stat argument is intent(out)

!ERROR: to be determined

call co_reduce(i, int_op, result_image=1, stat=1+1)

! errmsg argument must not be coindexed

!ERROR: to be determined

call co_reduce(i, int_op, result_image=1, stat=status, errmsg=conindexed_string[1])

! errmsg argument must be a scalar

!ERROR: to be determined

call co_reduce(i, int_op, result_image=1, stat=status, errmsg=character_array)

! errmsg argument must be a character

!ERROR: to be determined

call co_reduce(i, int_op, result_image=1, stat=status, errmsg=i)

! errmsg argument is intent(inout)

!ERROR: to be determined

call co_reduce(i, int_op, result_image=1, stat=status, errmsg="literal constant")

! too many arguments to the co_reduce() call

!ERROR: too many actual arguments for intrinsic 'co_reduce'

call co_reduce(i, int_op, result_image=1, stat=status, errmsg=message, 3.4)

! non-existent keyword argument

!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 double_precision_op(lhs, rhs) result(lhs_op_rhs)

integer, parameter :: double = kind(1.0D0)

real(double), intent(in) :: lhs, rhs

real(double) 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

function not_pure(lhs, rhs) result(lhs_op_rhs)

integer, intent(in) :: lhs, rhs

integer :: lhs_op_rhs

lhs_op_rhs = lhs + rhs

end function

pure function too_many_args(lhs, rhs, foo) result(lhs_op_rhs)

integer, intent(in) :: lhs, rhs, foo

integer lhs_op_rhs

lhs_op_rhs = lhs + rhs

end function

pure function array_result(lhs, rhs)

integer, intent(in) :: lhs, rhs

integer array_result(1)

array_result = lhs + rhs

end function

pure function allocatable_result(lhs, rhs)

integer, intent(in) :: lhs, rhs

integer, allocatable :: allocatable_result

allocatable_result = lhs + rhs

end function

pure function pointer_result(lhs, rhs)

integer, intent(in) :: lhs, rhs

integer, pointer :: pointer_result

allocate(pointer_result, source=lhs + rhs )

end function

pure function array_args(lhs, rhs)

integer, intent(in) :: lhs(1), rhs(1)

integer array_args

array_args = lhs(1) + rhs(1)

end function

pure function allocatable_args(lhs, rhs) result(lhs_op_rhs)

integer, intent(in), allocatable :: lhs, rhs

integer lhs_op_rhs

lhs_op_rhs = lhs + rhs

end function

pure function pointer_args(lhs, rhs) result(lhs_op_rhs)

integer, intent(in), pointer :: lhs, rhs

integer lhs_op_rhs

lhs_op_rhs = lhs + rhs

end function

pure function polymorphic_args(lhs, rhs) result(lhs_op_rhs)

class(foo_t), intent(in) :: lhs, rhs

type(foo_t) lhs_op_rhs

lhs_op_rhs%n = lhs%n + rhs%n

end function

pure function optional_args(lhs, rhs) result(lhs_op_rhs)

integer, intent(in), optional :: lhs, rhs

integer lhs_op_rhs

if (present(lhs) .and. present(rhs)) then

lhs_op_rhs = lhs + rhs

else

lhs_op_rhs = 0

end if

end function

pure function target_mismatch(lhs, rhs) result(lhs_op_rhs)

integer, intent(in), target :: lhs

integer, intent(in) :: rhs

integer lhs_op_rhs

lhs_op_rhs = lhs + rhs

end function

pure function value_mismatch(lhs, rhs) result(lhs_op_rhs)

integer, intent(in), value:: lhs

integer, intent(in) :: rhs

integer lhs_op_rhs

lhs_op_rhs = lhs + rhs

end function

pure function asynchronous_mismatch(lhs, rhs) result(lhs_op_rhs)

integer, intent(in), asynchronous:: lhs

integer, intent(in) :: rhs

integer lhs_op_rhs

lhs_op_rhs = lhs + rhs

end function

end program