flang/test/Semantics/call03.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
   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     !ERROR: Actual argument type 'pdt(n=3_4)' is not compatible with dummy argument type 'pdt'
 172     call pdtdefault(var3)
 173     !ERROR: Actual argument type 'pdt(n=4_4)' is not compatible with dummy argument type 'pdt'
 174     call pdtdefault(var4) ! error
 175     !ERROR: Actual argument type 'pdt' is not compatible with dummy argument type 'pdt(n=4_4)'
 176     call pdt3(vardefault)
 177     !ERROR: Actual argument type 'pdt(n=3_4)' is not compatible with dummy argument type 'pdt(n=4_4)'
 178     call pdt3(var3)
 179     call pdt3(var4)
 180     !ERROR: Actual argument type 'pdt' is not compatible with dummy argument type 'pdt(n=*)'
 181     call pdt4(vardefault)
 182     call pdt4(var3)
 183     call pdt4(var4)
 184     call pdtWithDefaultdefault(defaultVardefault)
 185     call pdtWithDefaultdefault(defaultVar3)
 186     !ERROR: Actual argument type 'pdtwithdefault(n=4_4)' is not compatible with dummy argument type 'pdtwithdefault(n=3_4)'
 187     call pdtWithDefaultdefault(defaultVar4) ! error
 188     !ERROR: Actual argument type 'pdtwithdefault(n=3_4)' is not compatible with dummy argument type 'pdtwithdefault(n=4_4)'
 189     call pdtWithDefault3(defaultVardefault) ! error
 190     !ERROR: Actual argument type 'pdtwithdefault(n=3_4)' is not compatible with dummy argument type 'pdtwithdefault(n=4_4)'
 191     call pdtWithDefault3(defaultVar3) ! error
 192     call pdtWithDefault3(defaultVar4)
 193     call pdtWithDefault4(defaultVardefault)
 194     call pdtWithDefault4(defaultVar3)
 195     call pdtWithDefault4(defaultVar4)
 196   end subroutine
 197
 198   subroutine out01(x)
 199     type(alloc) :: x
 200   end subroutine
 201   subroutine test07(x) ! 15.5.2.4(6)
 202     type(alloc) :: x[*]
 203     !ERROR: Coindexed actual argument with ALLOCATABLE ultimate component '%a' must be associated with a dummy argument 'x=' with VALUE or INTENT(IN) attributes
 204     call out01(x[1])
 205   end subroutine
 206
 207   subroutine test08(x) ! 15.5.2.4(13)
 208     real :: x(1)[*]
 209     !ERROR: Coindexed scalar actual argument must be associated with a scalar dummy argument 'x='
 210     call assumedsize(x(1)[1])
 211   end subroutine
 212
 213   subroutine charray(x)
 214     character :: x(10)
 215   end subroutine
 216   subroutine test09(ashape, polyarray, c, assumed_shape_char) ! 15.5.2.4(14), 15.5.2.11
 217     real :: x, arr(10)
 218     real, pointer :: p(:)
 219     real, pointer :: p_scalar
 220     character(10), pointer :: char_pointer(:)
 221     character(*) :: assumed_shape_char(:)
 222     real :: ashape(:)
 223     class(t) :: polyarray(*)
 224     character(10) :: c(:)
 225     !ERROR: Whole scalar actual argument may not be associated with a dummy argument 'x=' array
 226     call assumedsize(x)
 227     !ERROR: Whole scalar actual argument may not be associated with a dummy argument 'x=' array
 228     call assumedsize(p_scalar)
 229     !ERROR: Element of pointer array may not be associated with a dummy argument 'x=' array
 230     call assumedsize(p(1))
 231     !ERROR: Element of assumed-shape array may not be associated with a dummy argument 'x=' array
 232     call assumedsize(ashape(1))
 233     !ERROR: Polymorphic scalar may not be associated with a dummy argument 'x=' array
 234     call polyassumedsize(polyarray(1))
 235     call charray(c(1:1))  ! not an error if character
 236     call charray(char_pointer(1))  ! not an error if character
 237     call charray(assumed_shape_char(1))  ! not an error if character
 238     call assumedsize(arr(1))  ! not an error if element in sequence
 239     call assumedrank(x)  ! not an error
 240     call assumedtypeandsize(x)  ! not an error
 241   end subroutine
 242
 243   subroutine test10(a) ! 15.5.2.4(16)
 244     real :: scalar, matrix(2,3)
 245     real :: a(*)
 246     !ERROR: Scalar actual argument may not be associated with assumed-shape dummy argument 'x='
 247     call assumedshape(scalar)
 248     call assumedshape(reshape(matrix,shape=[size(matrix)])) ! ok
 249     !ERROR: Rank of dummy argument is 1, but actual argument has rank 2
 250     call assumedshape(matrix)
 251     !ERROR: Assumed-size array may not be associated with assumed-shape dummy argument 'x='
 252     call assumedshape(a)
 253   end subroutine
 254
 255   subroutine test11(in) ! C15.5.2.4(20)
 256     real, intent(in) :: in
 257     real :: x
 258     x = 0.
 259     !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
 260     !BECAUSE: 'in' is an INTENT(IN) dummy argument
 261     call intentout(in)
 262     !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
 263     !BECAUSE: '3.141590118408203125_4' is not a variable or pointer
 264     call intentout(3.14159)
 265     !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
 266     !BECAUSE: 'in+1._4' is not a variable or pointer
 267     call intentout(in + 1.)
 268     call intentout(x) ! ok
 269     !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
 270     !BECAUSE: '(x)' is not a variable or pointer
 271     call intentout((x))
 272     !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'count=' is not definable
 273     !BECAUSE: '2_4' is not a variable or pointer
 274     call system_clock(count=2)
 275     !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
 276     !BECAUSE: 'in' is an INTENT(IN) dummy argument
 277     call intentinout(in)
 278     !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
 279     !BECAUSE: '3.141590118408203125_4' is not a variable or pointer
 280     call intentinout(3.14159)
 281     !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
 282     !BECAUSE: 'in+1._4' is not a variable or pointer
 283     call intentinout(in + 1.)
 284     call intentinout(x) ! ok
 285     !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
 286     !BECAUSE: '(x)' is not a variable or pointer
 287     call intentinout((x))
 288     !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'exitstat=' is not definable
 289     !BECAUSE: '0_4' is not a variable or pointer
 290     call execute_command_line(command="echo hello", exitstat=0)
 291   end subroutine
 292
 293   subroutine test12 ! 15.5.2.4(21)
 294     real :: a(1)
 295     integer :: j(1)
 296     j(1) = 1
 297     !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
 298     !BECAUSE: Variable 'a(int(j,kind=8))' has a vector subscript
 299     call intentout_arr(a(j))
 300     !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
 301     !BECAUSE: Variable 'a(int(j,kind=8))' has a vector subscript
 302     call intentinout_arr(a(j))
 303     call asynchronous_arr(a(j)) ! ok
 304     call volatile_arr(a(j)) ! ok
 305   end subroutine
 306
 307   subroutine coarr(x)
 308     type(ultimateCoarray):: x
 309   end subroutine
 310   subroutine volcoarr(x)
 311     type(ultimateCoarray), volatile :: x
 312   end subroutine
 313   subroutine test13(a, b) ! 15.5.2.4(22)
 314     type(ultimateCoarray) :: a
 315     type(ultimateCoarray), volatile :: b
 316     call coarr(a)  ! ok
 317     call volcoarr(b)  ! ok
 318     !ERROR: VOLATILE attribute must match for dummy argument 'x=' when actual argument has a coarray ultimate component '%a'
 319     call coarr(b)
 320     !ERROR: VOLATILE attribute must match for dummy argument 'x=' when actual argument has a coarray ultimate component '%a'
 321     call volcoarr(a)
 322   end subroutine
 323
 324   subroutine test14(a,b,c,d) ! C1538
 325     real :: a[*]
 326     real, asynchronous :: b[*]
 327     real, volatile :: c[*]
 328     real, asynchronous, volatile :: d[*]
 329     call asynchronous(a[1])  ! ok
 330     call volatile(a[1])  ! ok
 331     call asynchronousValue(b[1])  ! ok
 332     call asynchronousValue(c[1])  ! ok
 333     call asynchronousValue(d[1])  ! ok
 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(b[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(b[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(c[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(c[1])
 342     !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
 343     call asynchronous(d[1])
 344     !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
 345     call volatile(d[1])
 346   end subroutine
 347
 348   subroutine test15(assumedrank) ! C1539
 349     real, pointer :: a(:)
 350     real, asynchronous :: b(10)
 351     real, volatile :: c(10)
 352     real, asynchronous, volatile :: d(10)
 353     real, asynchronous, volatile :: assumedrank(..)
 354     call assumedsize(a(::2)) ! ok
 355     call contiguous(a(::2)) ! ok
 356     call valueassumedsize(a(::2)) ! ok
 357     call valueassumedsize(b(::2)) ! ok
 358     call valueassumedsize(c(::2)) ! ok
 359     call valueassumedsize(d(::2)) ! ok
 360     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 361     call volatileassumedsize(b(::2))
 362     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 363     call volatilecontiguous(b(::2))
 364     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 365     call volatileassumedsize(c(::2))
 366     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 367     call volatilecontiguous(c(::2))
 368     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 369     call volatileassumedsize(d(::2))
 370     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 371     call volatilecontiguous(d(::2))
 372     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 373     call volatilecontiguous(assumedrank)
 374   end subroutine
 375
 376   subroutine test16() ! C1540
 377     real, pointer :: a(:)
 378     real, asynchronous, pointer :: b(:)
 379     real, volatile, pointer :: c(:)
 380     real, asynchronous, volatile, pointer :: d(:)
 381     call assumedsize(a) ! ok
 382     call contiguous(a) ! ok
 383     call pointer(a) ! ok
 384     call pointer(b) ! ok
 385     call pointer(c) ! ok
 386     call pointer(d) ! ok
 387     call valueassumedsize(a) ! ok
 388     call valueassumedsize(b) ! ok
 389     call valueassumedsize(c) ! ok
 390     call valueassumedsize(d) ! ok
 391     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 392     call volatileassumedsize(b)
 393     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 394     call volatilecontiguous(b)
 395     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 396     call volatileassumedsize(c)
 397     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 398     call volatilecontiguous(c)
 399     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 400     call volatileassumedsize(d)
 401     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 402     call volatilecontiguous(d)
 403   end subroutine
 404
 405 end module