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 modifiable
  26   a(i) = 3.0
  27   !ERROR: Left-hand side of assignment is not modifiable
  28   a(i:i+1) = [4, 5]
  29   !ERROR: Left-hand side of assignment is not modifiable
  30   c(i:2) = "cd"
  31 end
  32
  33 ! C901
  34 subroutine s3
  35   type :: t
  36     integer :: a(2)
  37     integer :: b
  38   end type
  39   type(t) :: x
  40   type(t), parameter :: y = t([1,2], 3)
  41   integer :: i = 1
  42   x%a(i) = 1
  43   !ERROR: Left-hand side of assignment is not modifiable
  44   y%a(i) = 2
  45   x%b = 4
  46   !ERROR: Assignment to constant 'y%b' is not allowed
  47   y%b = 5
  48 end
  49
  50 ! C844
  51 subroutine s4
  52   type :: t
  53     integer :: a(2)
  54   end type
  55 contains
  56   subroutine s(x, c)
  57     type(t), intent(in) :: x
  58     character(10), intent(in) :: c
  59     type(t) :: y
  60     !ERROR: Left-hand side of assignment is not modifiable
  61     x = y
  62     !ERROR: Left-hand side of assignment is not modifiable
  63     x%a(1) = 2
  64     !ERROR: Left-hand side of assignment is not modifiable
  65     c(2:3) = "ab"
  66   end
  67 end
  68
  69 ! 8.5.15(2)
  70 module m5
  71   real :: x
  72   real, protected :: y
  73   real, private :: z
  74   type :: t
  75     real :: a
  76   end type
  77   type(t), protected :: b
  78 end
  79 subroutine s5()
  80   use m5
  81   implicit none
  82   x = 1.0
  83   !ERROR: Left-hand side of assignment is not modifiable
  84   y = 2.0
  85   !ERROR: No explicit type declared for 'z'
  86   z = 3.0
  87   !ERROR: Left-hand side of assignment is not modifiable
  88   b%a = 1.0
  89 end
  90
  91 subroutine s6(x)
  92   integer :: x(*)
  93   x(1:3) = [1, 2, 3]
  94   x(:3) = [1, 2, 3]
  95   !ERROR: Assumed-size array 'x' must have explicit final subscript upper bound value
  96   x(:) = [1, 2, 3]
  97   !ERROR: Whole assumed-size array 'x' may not appear here without subscripts
  98   x = [1, 2, 3]
  99 end
 100
 101 module m7
 102   type :: t
 103     integer :: i
 104   end type
 105 contains
 106   subroutine s7(x)
 107     type(t) :: x(*)
 108     x(:3)%i = [1, 2, 3]
 109     !ERROR: Whole assumed-size array 'x' may not appear here without subscripts
 110     x%i = [1, 2, 3]
 111   end
 112 end
 113
 114 subroutine s7
 115   integer :: a(10), v(10)
 116   a(v(:)) = 1  ! vector subscript is ok
 117 end
 118
 119 subroutine s8
 120   !ERROR: Assignment to subprogram 's8' is not allowed
 121   s8 = 1.0
 122 end
 123
 124 real function f9() result(r)
 125   !ERROR: Assignment to subprogram 'f9' is not allowed
 126   f9 = 1.0
 127 end
 128
 129 !ERROR: No explicit type declared for dummy argument 'n'
 130 subroutine s10(a, n)
 131   implicit none
 132   real a(n)
 133   a(1:n) = 0.0  ! should not get a second error here
 134 end
 135
 136 subroutine s11
 137   intrinsic :: sin
 138   real :: a
 139   !ERROR: Function call must have argument list
 140   a = sin
 141   !ERROR: Subroutine name is not allowed here
 142   a = s11
 143 end
 144
 145 subroutine s12()
 146   type dType(l1, k1, l2, k2)
 147     integer, len :: l1
 148     integer, kind :: k1
 149     integer, len :: l2
 150     integer, kind :: k2
 151   end type
 152
 153   contains
 154     subroutine sub(arg1, arg2, arg3)
 155       integer :: arg1
 156       type(dType(arg1, 2, *, 4)) :: arg2
 157       type(dType(*, 2, arg1, 4)) :: arg3
 158       type(dType(1, 2, 3, 4)) :: local1
 159       type(dType(1, 2, 3, 4)) :: local2
 160       type(dType(1, 2, arg1, 4)) :: local3
 161       type(dType(9, 2, 3, 4)) :: local4
 162       type(dType(1, 9, 3, 4)) :: local5
 163
 164       arg2 = arg3
 165       arg2 = local1
 166       arg3 = local1
 167       local1 = local2
 168       local2 = local3
 169       !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))
 170       local1 = local4 ! mismatched constant KIND type parameter
 171       !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))
 172       local1 = local5 ! mismatched constant LEN type parameter
 173     end subroutine sub
 174 end subroutine s12
 175
 176 subroutine s13()
 177   interface assignment(=)
 178     procedure :: cToR, cToRa, cToI
 179   end interface
 180   real :: x(1)
 181   integer :: n(1)
 182   x='0' ! fine
 183   n='0' ! fine
 184   !ERROR: Defined assignment in WHERE must be elemental, but 'ctora' is not
 185   where ([1==1]) x='*'
 186   where ([1==1]) n='*' ! fine
 187   forall (j=1:1)
 188     where (j==1)
 189       !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not
 190       x(j)='?'
 191       n(j)='?' ! fine
 192     elsewhere (.false.)
 193       !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not
 194       x(j)='1'
 195       n(j)='1' ! fine
 196     elsewhere
 197       !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not
 198       x(j)='9'
 199       n(j)='9' ! fine
 200     end where
 201   end forall
 202   x='0' ! still fine
 203   n='0' ! still fine
 204  contains
 205   subroutine cToR(x, c)
 206     real, intent(out) :: x
 207     character, intent(in) :: c
 208   end subroutine
 209   subroutine cToRa(x, c)
 210     real, intent(out) :: x(:)
 211     character, intent(in) :: c
 212   end subroutine
 213   elemental subroutine cToI(n, c)
 214     integer, intent(out) :: n
 215     character, intent(in) :: c
 216   end subroutine
 217 end subroutine s13