flang/test/Semantics/reduce01.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 module m
   3   type :: pdt(len)
   4     integer, len :: len
   5     character(len=len) :: ch
   6   end type
   7  contains
   8   pure real function f(x,y)
   9     real, intent(in) :: x, y
  10     f = x + y
  11   end function
  12   impure real function f1(x,y)
  13     f1 = x + y
  14   end function
  15   pure function f2(x,y)
  16     real :: f2(1)
  17     real, intent(in) :: x, y
  18     f2(1) = x + y
  19   end function
  20   pure real function f3(x,y,z)
  21     real, intent(in) :: x, y, z
  22     f3 = x + y + z
  23   end function
  24   pure real function f4(x,y)
  25     interface
  26       pure real function x(); end function
  27       pure real function y(); end function
  28     end interface
  29     f4 = x() + y()
  30   end function
  31   pure integer function f5(x,y)
  32     real, intent(in) :: x, y
  33     f5 = x + y
  34   end function
  35   pure real function f6(x,y)
  36     real, intent(in) :: x(*), y(*)
  37     f6 = x(1) + y(1)
  38   end function
  39   pure real function f7(x,y)
  40     real, intent(in), allocatable :: x
  41     real, intent(in) :: y
  42     f7 = x + y
  43   end function
  44   pure real function f8(x,y)
  45     real, intent(in), pointer :: x
  46     real, intent(in) :: y
  47     f8 = x + y
  48   end function
  49   pure real function f9(x,y)
  50     real, intent(in), optional :: x
  51     real, intent(in) :: y
  52     f9 = x + y
  53   end function
  54   pure real function f10a(x,y)
  55     real, intent(in), asynchronous :: x
  56     real, intent(in) :: y
  57     f10a = x + y
  58   end function
  59   pure real function f10b(x,y)
  60     real, intent(in), target :: x
  61     real, intent(in) :: y
  62     f10b = x + y
  63   end function
  64   pure real function f10c(x,y)
  65     real, intent(in), value :: x
  66     real, intent(in) :: y
  67     f10c = x + y
  68   end function
  69   pure function f11(x,y) result(res)
  70     type(pdt(*)), intent(in) :: x, y
  71     type(pdt(max(x%len, y%len))) :: res
  72     res%ch = x%ch // y%ch
  73   end function
  74
  75   subroutine errors
  76     real :: a(10,10), b, c(10)
  77     !ERROR: OPERATION= argument of REDUCE() must be a pure function of two data arguments
  78     b = reduce(a, f1)
  79     !ERROR: OPERATION= argument of REDUCE() must be a scalar function
  80     b = reduce(a, f2)
  81     !ERROR: OPERATION= argument of REDUCE() must be a pure function of two data arguments
  82     b = reduce(a, f3)
  83     !ERROR: OPERATION= argument of REDUCE() may not have dummy procedure arguments
  84     b = reduce(a, f4)
  85     !ERROR: OPERATION= argument of REDUCE() must have the same type as ARRAY=
  86     b = reduce(a, f5)
  87     !ERROR: Arguments of OPERATION= procedure of REDUCE() must be both scalar of the same type as ARRAY=, and neither allocatable, pointer, polymorphic, nor optional
  88     b = reduce(a, f6)
  89     !ERROR: Arguments of OPERATION= procedure of REDUCE() must be both scalar of the same type as ARRAY=, and neither allocatable, pointer, polymorphic, nor optional
  90     b = reduce(a, f7)
  91     !ERROR: Arguments of OPERATION= procedure of REDUCE() must be both scalar of the same type as ARRAY=, and neither allocatable, pointer, polymorphic, nor optional
  92     b = reduce(a, f8)
  93     !ERROR: Arguments of OPERATION= procedure of REDUCE() must be both scalar of the same type as ARRAY=, and neither allocatable, pointer, polymorphic, nor optional
  94     b = reduce(a, f9)
  95     !ERROR: If either argument of the OPERATION= procedure of REDUCE() has the ASYNCHRONOUS, TARGET, or VALUE attribute, both must have that attribute
  96     b = reduce(a, f10a)
  97     !ERROR: If either argument of the OPERATION= procedure of REDUCE() has the ASYNCHRONOUS, TARGET, or VALUE attribute, both must have that attribute
  98     b = reduce(a, f10b)
  99     !ERROR: If either argument of the OPERATION= procedure of REDUCE() has the ASYNCHRONOUS, TARGET, or VALUE attribute, both must have that attribute
 100     b = reduce(a, f10c)
 101     !ERROR: IDENTITY= must be present when the array is empty and the result is scalar
 102     b = reduce(a(1:0,:), f)
 103     !ERROR: IDENTITY= must be present when the array is empty and the result is scalar
 104     b = reduce(a(1:0, 1), f, dim=1)
 105     !ERROR: IDENTITY= must be present when DIM=1 and the array has zero extent on that dimension
 106     c = reduce(a(1:0, :), f, dim=1)
 107     !ERROR: IDENTITY= must be present when DIM=1 and the array has zero extent on that dimension
 108     c = reduce(a(1:0, :), f, dim=1)
 109     !ERROR: IDENTITY= must be present when DIM=2 and the array has zero extent on that dimension
 110     c = reduce(a(:, 1:0), f, dim=2)
 111     c(1:0) = reduce(a(1:0, 1:0), f, dim=1) ! ok, result is empty
 112     c(1:0) = reduce(a(1:0, 1:0), f, dim=2) ! ok, result is empty
 113     !ERROR: MASK= has no .TRUE. element, so IDENTITY= must be present
 114     b = reduce(a, f, .false.)
 115     !ERROR: MASK= has no .TRUE. element, so IDENTITY= must be present
 116     b = reduce(a, f, reshape([(j > 100, j=1, 100)], shape(a)))
 117     b = reduce(a, f, reshape([(j == 50, j=1, 100)], shape(a))) ! ok
 118   end subroutine
 119   subroutine not_errors
 120     type(pdt(10)) :: a(10), b
 121     b = reduce(a, f11) ! check no bogus type incompatibility diagnostic
 122   end subroutine
 123 end module