flang/test/Semantics/defined-ops.f90

   1 ! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
   2
   3 ! Check the analyzed form of a defined operator or assignment.
   4
   5 ! Type-bound defined assignment
   6 module m1
   7   type :: t
   8   contains
   9     procedure :: b1 => s1
  10     procedure, pass(y) :: b2 => s2
  11     generic :: assignment(=) => b1, b2
  12   end type
  13 contains
  14   subroutine s1(x, y)
  15     class(t), intent(out) :: x
  16     integer, intent(in), value :: y
  17   end
  18   subroutine s2(x, y)
  19     real, intent(out) :: x
  20     class(t), intent(in) :: y
  21   end
  22   subroutine test1(x)
  23     type(t) :: x
  24     real :: a
  25     integer :: j
  26     !CHECK: CALL s1(x,1_4)
  27     x = 1
  28     j = 1
  29     !CHECK: CALL s1(x,j)
  30     x = j ! no parentheses due to VALUE
  31     !CHECK: CALL s2(a,(x))
  32     a = x
  33   end
  34   subroutine test2(x)
  35     class(t) :: x
  36     real :: a
  37     !CHECK: CALL x%b1(1_4)
  38     x = 1
  39     !CHECK: CALL (x)%b2(a)
  40     a = x
  41   end
  42 end
  43
  44 ! Type-bound operator
  45 module m2
  46   type :: t2
  47   contains
  48     procedure, pass(x2) :: b2 => f
  49     generic :: operator(+) => b2
  50   end type
  51 contains
  52   integer pure function f(x1, x2)
  53     class(t2), intent(in) :: x1
  54     class(t2), intent(in) :: x2
  55   end
  56   subroutine test2(x, y)
  57     class(t2) :: x
  58     type(t2) :: y
  59     !CHECK: i=f(x,y)
  60     i = x + y
  61     !CHECK: i=x%b2(y)
  62     i = y + x
  63   end
  64 end module
  65
  66 ! Non-type-bound assignment and operator
  67 module m3
  68   type t
  69   end type
  70   interface assignment(=)
  71     subroutine s1(x, y)
  72       import
  73       class(t), intent(out) :: x
  74       integer, intent(in) :: y
  75     end
  76     subroutine s2(x, y)
  77       real, intent(out) :: x
  78       class(*), intent(in) :: y
  79     end
  80     subroutine s3(x, y)
  81       integer, intent(out) :: x
  82       class(*), intent(in), value :: y
  83     end
  84   end interface
  85   interface operator(+)
  86     integer function f(x, y)
  87       import
  88       class(t), intent(in) :: x, y
  89     end
  90   end interface
  91 contains
  92   subroutine test(x, y, z)
  93     class(t) :: x, y
  94     class(*), intent(in) :: z
  95     real :: a
  96     !CHECK: CALL s1(x,2_4)
  97     x = 2
  98     !CHECK: i=f(x,y)
  99     i = x + y
 100     !CHECK: CALL s2(a,(z))
 101     a = z
 102     !CHECK: CALL s3(i,z)
 103     i = z
 104   end
 105 end