flang/test/Semantics/call03.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! Test 15.5.2.4 constraints and restrictions for non-POINTER non-ALLOCATABLE
   3 ! dummy arguments.
   4
   5 module m01
   6   type :: t
   7   end type
   8   type :: pdt(n)
   9     integer, len :: n
  10   end type
  11   type :: pdtWithDefault(n)
  12     integer, len :: n = 3
  13   end type
  14   type :: tbp
  15    contains
  16     procedure :: binding => subr01
  17   end type
  18   type :: final
  19    contains
  20     final :: subr02
  21   end type
  22   type :: alloc
  23     real, allocatable :: a(:)
  24   end type
  25   type :: ultimateCoarray
  26     real, allocatable :: a[:]
  27   end type
  28
  29  contains
  30
  31   subroutine subr01(this)
  32     class(tbp), intent(in) :: this
  33   end subroutine
  34   subroutine subr02(this)
  35     type(final), intent(inout) :: this
  36   end subroutine
  37
  38   subroutine poly(x)
  39     class(t), intent(in) :: x
  40   end subroutine
  41   subroutine polyassumedsize(x)
  42     class(t), intent(in) :: x(*)
  43   end subroutine
  44   subroutine assumedsize(x)
  45     real :: x(*)
  46   end subroutine
  47   subroutine assumedrank(x)
  48     real :: x(..)
  49   end subroutine
  50   subroutine assumedtypeandsize(x)
  51     type(*) :: x(*)
  52   end subroutine
  53   subroutine assumedshape(x)
  54     real :: x(:)
  55   end subroutine
  56   subroutine contiguous(x)
  57     real, contiguous :: x(:)
  58   end subroutine
  59   subroutine intentout(x)
  60     real, intent(out) :: x
  61   end subroutine
  62   subroutine intentout_arr(x)
  63     real, intent(out) :: x(:)
  64   end subroutine
  65   subroutine intentinout(x)
  66     real, intent(in out) :: x
  67   end subroutine
  68   subroutine intentinout_arr(x)
  69     real, intent(in out) :: x(:)
  70   end subroutine
  71   subroutine asynchronous(x)
  72     real, asynchronous :: x
  73   end subroutine
  74   subroutine asynchronous_arr(x)
  75     real, asynchronous :: x(:)
  76   end subroutine
  77   subroutine asynchronousValue(x)
  78     real, asynchronous, value :: x
  79   end subroutine
  80   subroutine volatile(x)
  81     real, volatile :: x
  82   end subroutine
  83   subroutine volatile_arr(x)
  84     real, volatile :: x(:)
  85   end subroutine
  86   subroutine pointer(x)
  87     real, pointer :: x(:)
  88   end subroutine
  89   subroutine valueassumedsize(x)
  90     real, intent(in) :: x(*)
  91   end subroutine
  92   subroutine volatileassumedsize(x)
  93     real, volatile :: x(*)
  94   end subroutine
  95   subroutine volatilecontiguous(x)
  96     real, volatile :: x(*)
  97   end subroutine
  98
  99   subroutine test01(x) ! 15.5.2.4(2)
 100     class(t), intent(in) :: x[*]
 101     !ERROR: Coindexed polymorphic object may not be associated with a polymorphic dummy argument 'x='
 102     call poly(x[1])
 103   end subroutine
 104
 105   subroutine mono(x)
 106     type(t), intent(in) :: x(*)
 107   end subroutine
 108   subroutine test02(x) ! 15.5.2.4(2)
 109     class(t), intent(in) :: x(*)
 110     !ERROR: Assumed-size polymorphic array may not be associated with a monomorphic dummy argument 'x='
 111     call mono(x)
 112   end subroutine
 113
 114   subroutine typestar(x)
 115     type(*), intent(in) :: x
 116   end subroutine
 117   subroutine test03 ! 15.5.2.4(2)
 118     type(pdt(0)) :: x
 119     !ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have a parameterized derived type
 120     call typestar(x)
 121   end subroutine
 122
 123   subroutine test04 ! 15.5.2.4(2)
 124     type(tbp) :: x
 125     !ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have type-bound procedure 'binding'
 126     call typestar(x)
 127   end subroutine
 128
 129   subroutine test05 ! 15.5.2.4(2)
 130     type(final) :: x
 131     !ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have derived type 'final' with FINAL subroutine 'subr02'
 132     call typestar(x)
 133   end subroutine
 134
 135   subroutine ch2(x)
 136     character(2), intent(in) :: x
 137   end subroutine
 138   subroutine pdtdefault (derivedArg)
 139     !ERROR: Type parameter 'n' lacks a value and has no default
 140     type(pdt) :: derivedArg
 141   end subroutine pdtdefault
 142   subroutine pdt3 (derivedArg)
 143     type(pdt(4)) :: derivedArg
 144   end subroutine pdt3
 145   subroutine pdt4 (derivedArg)
 146     type(pdt(*)) :: derivedArg
 147   end subroutine pdt4
 148   subroutine pdtWithDefaultDefault (derivedArg)
 149     type(pdtWithDefault) :: derivedArg
 150   end subroutine pdtWithDefaultdefault
 151   subroutine pdtWithDefault3 (derivedArg)
 152     type(pdtWithDefault(4)) :: derivedArg
 153   end subroutine pdtWithDefault3
 154   subroutine pdtWithDefault4 (derivedArg)
 155     type(pdtWithDefault(*)) :: derivedArg
 156   end subroutine pdtWithDefault4
 157   subroutine test06 ! 15.5.2.4(4)
 158     !ERROR: Type parameter 'n' lacks a value and has no default
 159     type(pdt) :: vardefault
 160     type(pdt(3)) :: var3
 161     type(pdt(4)) :: var4
 162     type(pdtWithDefault) :: defaultVardefault
 163     type(pdtWithDefault(3)) :: defaultVar3
 164     type(pdtWithDefault(4)) :: defaultVar4
 165     character :: ch1
 166     !ERROR: Actual argument variable length '1' is less than expected length '2'
 167     call ch2(ch1)
 168     !WARNING: Actual argument expression length '0' is less than expected length '2'
 169     call ch2("")
 170     call pdtdefault(vardefault)
 171     call pdtdefault(var3)
 172     call pdtdefault(var4) ! error
 173     call pdt3(vardefault) ! error
 174     !ERROR: Actual argument type 'pdt(n=3_4)' is not compatible with dummy argument type 'pdt(n=4_4)'
 175     call pdt3(var3) ! error
 176     call pdt3(var4)
 177     call pdt4(vardefault)
 178     call pdt4(var3)
 179     call pdt4(var4)
 180     call pdtWithDefaultdefault(defaultVardefault)
 181     call pdtWithDefaultdefault(defaultVar3)
 182     !ERROR: Actual argument type 'pdtwithdefault(n=4_4)' is not compatible with dummy argument type 'pdtwithdefault(n=3_4)'
 183     call pdtWithDefaultdefault(defaultVar4) ! error
 184     !ERROR: Actual argument type 'pdtwithdefault(n=3_4)' is not compatible with dummy argument type 'pdtwithdefault(n=4_4)'
 185     call pdtWithDefault3(defaultVardefault) ! error
 186     !ERROR: Actual argument type 'pdtwithdefault(n=3_4)' is not compatible with dummy argument type 'pdtwithdefault(n=4_4)'
 187     call pdtWithDefault3(defaultVar3) ! error
 188     call pdtWithDefault3(defaultVar4)
 189     call pdtWithDefault4(defaultVardefault)
 190     call pdtWithDefault4(defaultVar3)
 191     call pdtWithDefault4(defaultVar4)
 192   end subroutine
 193
 194   subroutine out01(x)
 195     type(alloc) :: x
 196   end subroutine
 197   subroutine test07(x) ! 15.5.2.4(6)
 198     type(alloc) :: x[*]
 199     !ERROR: Coindexed actual argument with ALLOCATABLE ultimate component '%a' must be associated with a dummy argument 'x=' with VALUE or INTENT(IN) attributes
 200     call out01(x[1])
 201   end subroutine
 202
 203   subroutine test08(x) ! 15.5.2.4(13)
 204     real :: x(1)[*]
 205     !ERROR: Coindexed scalar actual argument must be associated with a scalar dummy argument 'x='
 206     call assumedsize(x(1)[1])
 207   end subroutine
 208
 209   subroutine charray(x)
 210     character :: x(10)
 211   end subroutine
 212   subroutine test09(ashape, polyarray, c, assumed_shape_char) ! 15.5.2.4(14), 15.5.2.11
 213     real :: x, arr(10)
 214     real, pointer :: p(:)
 215     real, pointer :: p_scalar
 216     character(10), pointer :: char_pointer(:)
 217     character(*) :: assumed_shape_char(:)
 218     real :: ashape(:)
 219     class(t) :: polyarray(*)
 220     character(10) :: c(:)
 221     !ERROR: Whole scalar actual argument may not be associated with a dummy argument 'x=' array
 222     call assumedsize(x)
 223     !ERROR: Whole scalar actual argument may not be associated with a dummy argument 'x=' array
 224     call assumedsize(p_scalar)
 225     !ERROR: Element of pointer array may not be associated with a dummy argument 'x=' array
 226     call assumedsize(p(1))
 227     !ERROR: Element of assumed-shape array may not be associated with a dummy argument 'x=' array
 228     call assumedsize(ashape(1))
 229     !ERROR: Polymorphic scalar may not be associated with a dummy argument 'x=' array
 230     call polyassumedsize(polyarray(1))
 231     call charray(c(1:1))  ! not an error if character
 232     call charray(char_pointer(1))  ! not an error if character
 233     call charray(assumed_shape_char(1))  ! not an error if character
 234     call assumedsize(arr(1))  ! not an error if element in sequence
 235     call assumedrank(x)  ! not an error
 236     call assumedtypeandsize(x)  ! not an error
 237   end subroutine
 238
 239   subroutine test10(a) ! 15.5.2.4(16)
 240     real :: scalar, matrix(2,3)
 241     real :: a(*)
 242     !ERROR: Scalar actual argument may not be associated with assumed-shape dummy argument 'x='
 243     call assumedshape(scalar)
 244     call assumedshape(reshape(matrix,shape=[size(matrix)])) ! ok
 245     !ERROR: Rank of dummy argument is 1, but actual argument has rank 2
 246     call assumedshape(matrix)
 247     !ERROR: Assumed-size array may not be associated with assumed-shape dummy argument 'x='
 248     call assumedshape(a)
 249   end subroutine
 250
 251   subroutine test11(in) ! C15.5.2.4(20)
 252     real, intent(in) :: in
 253     real :: x
 254     x = 0.
 255     !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
 256     !BECAUSE: 'in' is an INTENT(IN) dummy argument
 257     call intentout(in)
 258     !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
 259     !BECAUSE: '3.141590118408203125_4' is not a variable or pointer
 260     call intentout(3.14159)
 261     !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
 262     !BECAUSE: 'in+1._4' is not a variable or pointer
 263     call intentout(in + 1.)
 264     call intentout(x) ! ok
 265     !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
 266     !BECAUSE: '(x)' is not a variable or pointer
 267     call intentout((x))
 268     !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'count=' is not definable
 269     !BECAUSE: '2_4' is not a variable or pointer
 270     call system_clock(count=2)
 271     !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
 272     !BECAUSE: 'in' is an INTENT(IN) dummy argument
 273     call intentinout(in)
 274     !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
 275     !BECAUSE: '3.141590118408203125_4' is not a variable or pointer
 276     call intentinout(3.14159)
 277     !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
 278     !BECAUSE: 'in+1._4' is not a variable or pointer
 279     call intentinout(in + 1.)
 280     call intentinout(x) ! ok
 281     !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
 282     !BECAUSE: '(x)' is not a variable or pointer
 283     call intentinout((x))
 284     !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'exitstat=' is not definable
 285     !BECAUSE: '0_4' is not a variable or pointer
 286     call execute_command_line(command="echo hello", exitstat=0)
 287   end subroutine
 288
 289   subroutine test12 ! 15.5.2.4(21)
 290     real :: a(1)
 291     integer :: j(1)
 292     j(1) = 1
 293     !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
 294     !BECAUSE: Variable 'a(int(j,kind=8))' has a vector subscript
 295     call intentout_arr(a(j))
 296     !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
 297     !BECAUSE: Variable 'a(int(j,kind=8))' has a vector subscript
 298     call intentinout_arr(a(j))
 299     call asynchronous_arr(a(j)) ! ok
 300     call volatile_arr(a(j)) ! ok
 301   end subroutine
 302
 303   subroutine coarr(x)
 304     type(ultimateCoarray):: x
 305   end subroutine
 306   subroutine volcoarr(x)
 307     type(ultimateCoarray), volatile :: x
 308   end subroutine
 309   subroutine test13(a, b) ! 15.5.2.4(22)
 310     type(ultimateCoarray) :: a
 311     type(ultimateCoarray), volatile :: b
 312     call coarr(a)  ! ok
 313     call volcoarr(b)  ! ok
 314     !ERROR: VOLATILE attribute must match for dummy argument 'x=' when actual argument has a coarray ultimate component '%a'
 315     call coarr(b)
 316     !ERROR: VOLATILE attribute must match for dummy argument 'x=' when actual argument has a coarray ultimate component '%a'
 317     call volcoarr(a)
 318   end subroutine
 319
 320   subroutine test14(a,b,c,d) ! C1538
 321     real :: a[*]
 322     real, asynchronous :: b[*]
 323     real, volatile :: c[*]
 324     real, asynchronous, volatile :: d[*]
 325     call asynchronous(a[1])  ! ok
 326     call volatile(a[1])  ! ok
 327     call asynchronousValue(b[1])  ! ok
 328     call asynchronousValue(c[1])  ! ok
 329     call asynchronousValue(d[1])  ! ok
 330     !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
 331     call asynchronous(b[1])
 332     !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
 333     call volatile(b[1])
 334     !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
 335     call asynchronous(c[1])
 336     !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
 337     call volatile(c[1])
 338     !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
 339     call asynchronous(d[1])
 340     !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
 341     call volatile(d[1])
 342   end subroutine
 343
 344   subroutine test15() ! C1539
 345     real, pointer :: a(:)
 346     real, asynchronous :: b(10)
 347     real, volatile :: c(10)
 348     real, asynchronous, volatile :: d(10)
 349     call assumedsize(a(::2)) ! ok
 350     call contiguous(a(::2)) ! ok
 351     call valueassumedsize(a(::2)) ! ok
 352     call valueassumedsize(b(::2)) ! ok
 353     call valueassumedsize(c(::2)) ! ok
 354     call valueassumedsize(d(::2)) ! ok
 355     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 356     call volatileassumedsize(b(::2))
 357     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 358     call volatilecontiguous(b(::2))
 359     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 360     call volatileassumedsize(c(::2))
 361     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 362     call volatilecontiguous(c(::2))
 363     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 364     call volatileassumedsize(d(::2))
 365     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 366     call volatilecontiguous(d(::2))
 367   end subroutine
 368
 369   subroutine test16() ! C1540
 370     real, pointer :: a(:)
 371     real, asynchronous, pointer :: b(:)
 372     real, volatile, pointer :: c(:)
 373     real, asynchronous, volatile, pointer :: d(:)
 374     call assumedsize(a) ! ok
 375     call contiguous(a) ! ok
 376     call pointer(a) ! ok
 377     call pointer(b) ! ok
 378     call pointer(c) ! ok
 379     call pointer(d) ! ok
 380     call valueassumedsize(a) ! ok
 381     call valueassumedsize(b) ! ok
 382     call valueassumedsize(c) ! ok
 383     call valueassumedsize(d) ! ok
 384     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 385     call volatileassumedsize(b)
 386     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 387     call volatilecontiguous(b)
 388     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 389     call volatileassumedsize(c)
 390     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 391     call volatilecontiguous(c)
 392     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 393     call volatileassumedsize(d)
 394     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 395     call volatilecontiguous(d)
 396   end subroutine
 397
 398 end module