flang/test/Semantics/resolve66.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! Test that user-defined assignment is used in the right places
   3
   4 module m1
   5   type t1
   6   end type
   7   type t2
   8   end type
   9   interface assignment(=)
  10     subroutine assign_il(x, y)
  11       integer, intent(out) :: x
  12       logical, intent(in) :: y
  13     end
  14     subroutine assign_li(x, y)
  15       logical, intent(out) :: x
  16       integer, intent(in) :: y
  17     end
  18     subroutine assign_tt(x, y)
  19       import t1
  20       type(t1), intent(out) :: x
  21       type(t1), intent(in) :: y
  22     end
  23     subroutine assign_tz(x, y)
  24       import t1
  25       type(t1), intent(out) :: x
  26       complex, intent(in) :: y
  27     end
  28     subroutine assign_01(x, y)
  29       real, intent(out) :: x
  30       real, intent(in) :: y(:)
  31     end
  32   end interface
  33 contains
  34   ! These are all intrinsic assignments
  35   pure subroutine test1()
  36     type(t2) :: a, b, b5(5)
  37     logical :: l
  38     integer :: i, i5(5)
  39     a = b
  40     b5 = a
  41     l = .true.
  42     i = z'1234'
  43     i5 = 1.0
  44   end
  45
  46   ! These have invalid type combinations
  47   subroutine test2()
  48     type(t1) :: a
  49     type(t2) :: b
  50     logical :: l, l5(5)
  51     complex :: z, z5(5), z55(5,5)
  52     !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(t1) and TYPE(t2)
  53     a = b
  54     !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types REAL(4) and LOGICAL(4)
  55     r = l
  56     !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types LOGICAL(4) and REAL(4)
  57     l = r
  58     !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(t1) and REAL(4)
  59     a = r
  60     !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(t2) and COMPLEX(4)
  61     b = z
  62     !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches scalar COMPLEX(4) and rank 1 array of COMPLEX(4)
  63     z = z5
  64     !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches rank 1 array of LOGICAL(4) and scalar COMPLEX(4)
  65     l5 = z
  66     !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches rank 1 array of COMPLEX(4) and rank 2 array of COMPLEX(4)
  67     z5 = z55
  68   end
  69
  70   ! These should all be defined assignments. Because the subroutines
  71   ! implementing them are not pure, they should all produce errors
  72   pure subroutine test3()
  73     type(t1) :: a, b
  74     integer :: i
  75     logical :: l
  76     complex :: z
  77     real :: r, r5(5)
  78     !ERROR: Procedure 'assign_tt' referenced in pure subprogram 'test3' must be pure too
  79     a = b
  80     !ERROR: Procedure 'assign_il' referenced in pure subprogram 'test3' must be pure too
  81     i = l
  82     !ERROR: Procedure 'assign_li' referenced in pure subprogram 'test3' must be pure too
  83     l = i
  84     !ERROR: Procedure 'assign_il' referenced in pure subprogram 'test3' must be pure too
  85     i = .true.
  86     !ERROR: Procedure 'assign_tz' referenced in pure subprogram 'test3' must be pure too
  87     a = z
  88     !ERROR: Procedure 'assign_01' referenced in pure subprogram 'test3' must be pure too
  89     r = r5
  90   end
  91
  92   ! Like test3 but not in a pure subroutine so no errors.
  93   subroutine test4()
  94     type(t1) :: a, b
  95     integer :: i
  96     logical :: l
  97     complex :: z
  98     real :: r, r5(5)
  99     a = b
 100     i = l
 101     l = i
 102     i = .true.
 103     a = z
 104     r = r5
 105   end
 106 end