flang/test/Semantics/assign04.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! 9.4.5
   3 subroutine s1
   4   type :: t(k, l)
   5     integer, kind :: k
   6     integer, len :: l
   7   end type
   8   type(t(1, 2)) :: x
   9   !ERROR: Assignment to constant 'x%k' is not allowed
  10   x%k = 4
  11   !ERROR: Assignment to constant 'x%l' is not allowed
  12   x%l = 3
  13 end
  14
  15 ! C901
  16 subroutine s2(x)
  17   !ERROR: A dummy argument may not also be a named constant
  18   real, parameter :: x = 0.0
  19   real, parameter :: a(*) = [1, 2, 3]
  20   character, parameter :: c(2) = "ab"
  21   integer :: i
  22   !ERROR: Assignment to constant 'x' is not allowed
  23   x = 2.0
  24   i = 2
  25   !ERROR: Left-hand side of assignment is not definable
  26   !BECAUSE: 'a' is not a variable
  27   a(i) = 3.0
  28   !ERROR: Left-hand side of assignment is not definable
  29   !BECAUSE: 'a' is not a variable
  30   a(i:i+1) = [4, 5]
  31   !ERROR: Left-hand side of assignment is not definable
  32   !BECAUSE: 'c' is not a variable
  33   c(i:2) = "cd"
  34 end
  35
  36 ! C901
  37 subroutine s3
  38   type :: t
  39     integer :: a(2)
  40     integer :: b
  41   end type
  42   type(t) :: x
  43   type(t), parameter :: y = t([1,2], 3)
  44   integer :: i = 1
  45   x%a(i) = 1
  46   !ERROR: Left-hand side of assignment is not definable
  47   !BECAUSE: 'y' is not a variable
  48   y%a(i) = 2
  49   x%b = 4
  50   !ERROR: Assignment to constant 'y%b' is not allowed
  51   y%b = 5
  52 end
  53
  54 ! C844
  55 subroutine s4
  56   type :: t
  57     integer :: a(2)
  58   end type
  59 contains
  60   subroutine s(x, c)
  61     type(t), intent(in) :: x
  62     character(10), intent(in) :: c
  63     type(t) :: y
  64     !ERROR: Left-hand side of assignment is not definable
  65     !BECAUSE: 'x' is an INTENT(IN) dummy argument
  66     x = y
  67     !ERROR: Left-hand side of assignment is not definable
  68     !BECAUSE: 'x' is an INTENT(IN) dummy argument
  69     x%a(1) = 2
  70     !ERROR: Left-hand side of assignment is not definable
  71     !BECAUSE: 'c' is an INTENT(IN) dummy argument
  72     c(2:3) = "ab"
  73   end
  74 end
  75
  76 ! 8.5.15(2)
  77 module m5
  78   real :: x
  79   real, protected :: y
  80   real, private :: z
  81   type :: t
  82     real :: a
  83   end type
  84   type(t), protected :: b
  85 end
  86 subroutine s5()
  87   use m5
  88   implicit none
  89   x = 1.0
  90   !ERROR: Left-hand side of assignment is not definable
  91   !BECAUSE: 'y' is protected in this scope
  92   y = 2.0
  93   !ERROR: No explicit type declared for 'z'
  94   z = 3.0
  95   !ERROR: Left-hand side of assignment is not definable
  96   !BECAUSE: 'b' is protected in this scope
  97   b%a = 1.0
  98 end
  99
 100 subroutine s6(x)
 101   integer :: x(*)
 102   x(1:3) = [1, 2, 3]
 103   x(:3) = [1, 2, 3]
 104   !ERROR: Assumed-size array 'x' must have explicit final subscript upper bound value
 105   x(:) = [1, 2, 3]
 106   !ERROR: Whole assumed-size array 'x' may not appear here without subscripts
 107   x = [1, 2, 3]
 108 end
 109
 110 module m7
 111   type :: t
 112     integer :: i
 113   end type
 114 contains
 115   subroutine s7(x)
 116     type(t) :: x(*)
 117     x(:3)%i = [1, 2, 3]
 118     !ERROR: Whole assumed-size array 'x' may not appear here without subscripts
 119     x%i = [1, 2, 3]
 120   end
 121 end
 122
 123 subroutine s7
 124   integer :: a(10), v(10)
 125   a(v(:)) = 1  ! vector subscript is ok
 126 end
 127
 128 subroutine s8
 129   !ERROR: Assignment to procedure 's8' is not allowed
 130   s8 = 1.0
 131 end
 132
 133 real function f9() result(r)
 134   !ERROR: Assignment to procedure 'f9' is not allowed
 135   f9 = 1.0
 136 end
 137
 138 subroutine s9
 139   real f9a
 140   !ERROR: Assignment to procedure 'f9a' is not allowed
 141   f9a = 1.0
 142   print *, f9a(1)
 143 end
 144
 145 !ERROR: No explicit type declared for dummy argument 'n'
 146 subroutine s10(a, n)
 147   implicit none
 148   real a(n)
 149   a(1:n) = 0.0  ! should not get a second error here
 150 end
 151
 152 subroutine s11
 153   intrinsic :: sin
 154   real :: a
 155   !ERROR: Function call must have argument list
 156   a = sin
 157   !ERROR: Subroutine name is not allowed here
 158   a = s11
 159 end
 160
 161 subroutine s12()
 162   type dType(l1, k1, l2, k2)
 163     integer, len :: l1
 164     integer, kind :: k1
 165     integer, len :: l2
 166     integer, kind :: k2
 167   end type
 168
 169   contains
 170     subroutine sub(arg1, arg2, arg3)
 171       integer :: arg1
 172       type(dType(arg1, 2, *, 4)) :: arg2
 173       type(dType(*, 2, arg1, 4)) :: arg3
 174       type(dType(1, 2, 3, 4)) :: local1
 175       type(dType(1, 2, 3, 4)) :: local2
 176       type(dType(1, 2, arg1, 4)) :: local3
 177       type(dType(9, 2, 3, 4)) :: local4
 178       type(dType(1, 9, 3, 4)) :: local5
 179
 180       arg2 = arg3
 181       arg2 = local1
 182       arg3 = local1
 183       local1 = local2
 184       local2 = local3
 185       !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(dtype(k1=2_4,k2=4_4,l1=1_4,l2=3_4)) and TYPE(dtype(k1=2_4,k2=4_4,l1=9_4,l2=3_4))
 186       local1 = local4 ! mismatched constant KIND type parameter
 187       !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(dtype(k1=2_4,k2=4_4,l1=1_4,l2=3_4)) and TYPE(dtype(k1=9_4,k2=4_4,l1=1_4,l2=3_4))
 188       local1 = local5 ! mismatched constant LEN type parameter
 189     end subroutine sub
 190 end subroutine s12
 191
 192 subroutine s13()
 193   interface assignment(=)
 194     procedure :: cToR, cToRa, cToI
 195   end interface
 196   real :: x(1)
 197   integer :: n(1)
 198   x='0' ! fine
 199   n='0' ! fine
 200   !ERROR: Defined assignment in WHERE must be elemental, but 'ctora' is not
 201   where ([1==1]) x='*'
 202   where ([1==1]) n='*' ! fine
 203   forall (j=1:1)
 204     !ERROR: The mask or variable must not be scalar
 205     where (j==1)
 206       !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not
 207       !ERROR: The mask or variable must not be scalar
 208       x(j)='?'
 209       !ERROR: The mask or variable must not be scalar
 210       n(j)='?'
 211     !ERROR: The mask or variable must not be scalar
 212     elsewhere (.false.)
 213       !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not
 214       !ERROR: The mask or variable must not be scalar
 215       x(j)='1'
 216       !ERROR: The mask or variable must not be scalar
 217       n(j)='1'
 218     elsewhere
 219       !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not
 220       !ERROR: The mask or variable must not be scalar
 221       x(j)='9'
 222       !ERROR: The mask or variable must not be scalar
 223       n(j)='9'
 224     end where
 225   end forall
 226   x='0' ! still fine
 227   n='0' ! still fine
 228  contains
 229   subroutine cToR(x, c)
 230     real, intent(out) :: x
 231     character, intent(in) :: c
 232   end subroutine
 233   subroutine cToRa(x, c)
 234     real, intent(out) :: x(:)
 235     character, intent(in) :: c
 236   end subroutine
 237   elemental subroutine cToI(n, c)
 238     integer, intent(out) :: n
 239     character, intent(in) :: c
 240   end subroutine
 241 end subroutine s13
 242
 243 module m14
 244   type t1
 245     integer, pointer :: p
 246    contains
 247     procedure definedAsst1
 248     generic :: assignment(=) => definedAsst1
 249   end type
 250   type t2
 251     integer, pointer :: p
 252   end type
 253   interface assignment(=)
 254     module procedure definedAsst2
 255   end interface
 256   type t3
 257     integer, pointer :: p
 258   end type
 259  contains
 260   pure subroutine definedAsst1(lhs,rhs)
 261     class(t1), intent(in out) :: lhs
 262     class(t1), intent(in) :: rhs
 263   end subroutine
 264   pure subroutine definedAsst2(lhs,rhs)
 265     type(t2), intent(out) :: lhs
 266     type(t2), intent(in) :: rhs
 267   end subroutine
 268   pure subroutine test(y1,y2,y3)
 269     type(t1) x1
 270     type(t1), intent(in) :: y1
 271     type(t2) x2
 272     type(t2), intent(in) :: y2
 273     type(t3) x3
 274     type(t3), intent(in) :: y3
 275     x1 = y1 ! fine due to not being intrinsic assignment
 276     x2 = y2 ! fine due to not being intrinsic assignment
 277     !ERROR: A pure subprogram may not copy the value of 'y3' because it is an INTENT(IN) dummy argument and has the POINTER potential subobject component '%p'
 278     x3 = y3
 279   end subroutine
 280 end module m14