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   impure real function f1(x,y)
   9     f1 = x + y
  10   end function
  11   pure function f2(x,y)
  12     real :: f2(1)
  13     real, intent(in) :: x, y
  14     f2(1) = x + y
  15   end function
  16   pure real function f3(x,y,z)
  17     real, intent(in) :: x, y, z
  18     f3 = x + y + z
  19   end function
  20   pure real function f4(x,y)
  21     interface
  22       pure real function x(); end function
  23       pure real function y(); end function
  24     end interface
  25     f4 = x() + y()
  26   end function
  27   pure integer function f5(x,y)
  28     real, intent(in) :: x, y
  29     f5 = x + y
  30   end function
  31   pure real function f6(x,y)
  32     real, intent(in) :: x(*), y(*)
  33     f6 = x(1) + y(1)
  34   end function
  35   pure real function f7(x,y)
  36     real, intent(in), allocatable :: x
  37     real, intent(in) :: y
  38     f7 = x + y
  39   end function
  40   pure real function f8(x,y)
  41     real, intent(in), pointer :: x
  42     real, intent(in) :: y
  43     f8 = x + y
  44   end function
  45   pure real function f9(x,y)
  46     real, intent(in), optional :: x
  47     real, intent(in) :: y
  48     f9 = x + y
  49   end function
  50   pure real function f10(x,y)
  51     real, intent(in), target :: x
  52     real, intent(in) :: y
  53     f10 = x + y
  54   end function
  55   pure function f11(x,y) result(res)
  56     type(pdt(*)), intent(in) :: x, y
  57     type(pdt(max(x%len, y%len))) :: res
  58     res%ch = x%ch // y%ch
  59   end function
  60
  61   subroutine errors
  62     real :: a(10,10), b
  63     !ERROR: OPERATION= argument of REDUCE() must be a pure function of two data arguments
  64     b = reduce(a, f1)
  65     !ERROR: OPERATION= argument of REDUCE() must be a scalar function
  66     b = reduce(a, f2)
  67     !ERROR: OPERATION= argument of REDUCE() must be a pure function of two data arguments
  68     b = reduce(a, f3)
  69     !ERROR: OPERATION= argument of REDUCE() may not have dummy procedure arguments
  70     b = reduce(a, f4)
  71     !ERROR: OPERATION= argument of REDUCE() must have the same type as ARRAY=
  72     b = reduce(a, f5)
  73     !ERROR: Arguments of OPERATION= procedure of REDUCE() must be both scalar of the same type as ARRAY=, and neither allocatable, pointer, polymorphic, or optional
  74     b = reduce(a, f6)
  75     !ERROR: Arguments of OPERATION= procedure of REDUCE() must be both scalar of the same type as ARRAY=, and neither allocatable, pointer, polymorphic, or optional
  76     b = reduce(a, f7)
  77     !ERROR: Arguments of OPERATION= procedure of REDUCE() must be both scalar of the same type as ARRAY=, and neither allocatable, pointer, polymorphic, or optional
  78     b = reduce(a, f8)
  79     !ERROR: Arguments of OPERATION= procedure of REDUCE() must be both scalar of the same type as ARRAY=, and neither allocatable, pointer, polymorphic, or optional
  80     b = reduce(a, f9)
  81     !ERROR: If either argument of the OPERATION= procedure of REDUCE() has the ASYNCHRONOUS, VOLATILE, or TARGET attribute, both must have that attribute
  82     b = reduce(a, f10)
  83   end subroutine
  84   subroutine not_errors
  85     type(pdt(10)) :: a(10), b
  86     b = reduce(a, f11) ! check no bogus type incompatibility diagnostic
  87   end subroutine
  88 end module