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 intentinout(x)
  63     real, intent(in out) :: x
  64   end subroutine
  65   subroutine asynchronous(x)
  66     real, asynchronous :: x
  67   end subroutine
  68   subroutine asynchronousValue(x)
  69     real, asynchronous, value :: x
  70   end subroutine
  71   subroutine volatile(x)
  72     real, volatile :: x
  73   end subroutine
  74   subroutine pointer(x)
  75     real, pointer :: x(:)
  76   end subroutine
  77   subroutine valueassumedsize(x)
  78     real, intent(in) :: x(*)
  79   end subroutine
  80   subroutine volatileassumedsize(x)
  81     real, volatile :: x(*)
  82   end subroutine
  83   subroutine volatilecontiguous(x)
  84     real, volatile :: x(*)
  85   end subroutine
  86
  87   subroutine test01(x) ! 15.5.2.4(2)
  88     class(t), intent(in) :: x[*]
  89     !ERROR: Coindexed polymorphic object may not be associated with a polymorphic dummy argument 'x='
  90     call poly(x[1])
  91   end subroutine
  92
  93   subroutine mono(x)
  94     type(t), intent(in) :: x
  95   end subroutine
  96   subroutine test02(x) ! 15.5.2.4(2)
  97     class(t), intent(in) :: x(*)
  98     !ERROR: Assumed-size polymorphic array may not be associated with a monomorphic dummy argument 'x='
  99     call mono(x)
 100   end subroutine
 101
 102   subroutine typestar(x)
 103     type(*), intent(in) :: x
 104   end subroutine
 105   subroutine test03 ! 15.5.2.4(2)
 106     type(pdt(0)) :: x
 107     !ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have a parameterized derived type
 108     call typestar(x)
 109   end subroutine
 110
 111   subroutine test04 ! 15.5.2.4(2)
 112     type(tbp) :: x
 113     !ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have type-bound procedure 'binding'
 114     call typestar(x)
 115   end subroutine
 116
 117   subroutine test05 ! 15.5.2.4(2)
 118     type(final) :: x
 119     !ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have derived type 'final' with FINAL subroutine 'subr02'
 120     call typestar(x)
 121   end subroutine
 122
 123   subroutine ch2(x)
 124     character(2), intent(in out) :: x
 125   end subroutine
 126   subroutine pdtdefault (derivedArg)
 127     !ERROR: Type parameter 'n' lacks a value and has no default
 128     type(pdt) :: derivedArg
 129   end subroutine pdtdefault
 130   subroutine pdt3 (derivedArg)
 131     type(pdt(4)) :: derivedArg
 132   end subroutine pdt3
 133   subroutine pdt4 (derivedArg)
 134     type(pdt(*)) :: derivedArg
 135   end subroutine pdt4
 136   subroutine pdtWithDefaultDefault (derivedArg)
 137     type(pdtWithDefault) :: derivedArg
 138   end subroutine pdtWithDefaultdefault
 139   subroutine pdtWithDefault3 (derivedArg)
 140     type(pdtWithDefault(4)) :: derivedArg
 141   end subroutine pdtWithDefault3
 142   subroutine pdtWithDefault4 (derivedArg)
 143     type(pdtWithDefault(*)) :: derivedArg
 144   end subroutine pdtWithDefault4
 145   subroutine test06 ! 15.5.2.4(4)
 146     !ERROR: Type parameter 'n' lacks a value and has no default
 147     type(pdt) :: vardefault
 148     type(pdt(3)) :: var3
 149     type(pdt(4)) :: var4
 150     type(pdtWithDefault) :: defaultVardefault
 151     type(pdtWithDefault(3)) :: defaultVar3
 152     type(pdtWithDefault(4)) :: defaultVar4
 153     character :: ch1
 154     ! The actual argument is converted to a padded expression.
 155     !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
 156     call ch2(ch1)
 157     call pdtdefault(vardefault)
 158     call pdtdefault(var3)
 159     call pdtdefault(var4) ! error
 160     call pdt3(vardefault) ! error
 161     !ERROR: Actual argument type 'pdt(n=3_4)' is not compatible with dummy argument type 'pdt(n=4_4)'
 162     call pdt3(var3) ! error
 163     call pdt3(var4)
 164     call pdt4(vardefault)
 165     call pdt4(var3)
 166     call pdt4(var4)
 167     call pdtWithDefaultdefault(defaultVardefault)
 168     call pdtWithDefaultdefault(defaultVar3)
 169     !ERROR: Actual argument type 'pdtwithdefault(n=4_4)' is not compatible with dummy argument type 'pdtwithdefault(n=3_4)'
 170     call pdtWithDefaultdefault(defaultVar4) ! error
 171     !ERROR: Actual argument type 'pdtwithdefault(n=3_4)' is not compatible with dummy argument type 'pdtwithdefault(n=4_4)'
 172     call pdtWithDefault3(defaultVardefault) ! error
 173     !ERROR: Actual argument type 'pdtwithdefault(n=3_4)' is not compatible with dummy argument type 'pdtwithdefault(n=4_4)'
 174     call pdtWithDefault3(defaultVar3) ! error
 175     call pdtWithDefault3(defaultVar4)
 176     call pdtWithDefault4(defaultVardefault)
 177     call pdtWithDefault4(defaultVar3)
 178     call pdtWithDefault4(defaultVar4)
 179   end subroutine
 180
 181   subroutine out01(x)
 182     type(alloc) :: x
 183   end subroutine
 184   subroutine test07(x) ! 15.5.2.4(6)
 185     type(alloc) :: x[*]
 186     !ERROR: Coindexed actual argument with ALLOCATABLE ultimate component '%a' must be associated with a dummy argument 'x=' with VALUE or INTENT(IN) attributes
 187     call out01(x[1])
 188   end subroutine
 189
 190   subroutine test08(x) ! 15.5.2.4(13)
 191     real :: x(1)[*]
 192     !ERROR: Coindexed scalar actual argument must be associated with a scalar dummy argument 'x='
 193     call assumedsize(x(1)[1])
 194   end subroutine
 195
 196   subroutine charray(x)
 197     character :: x(10)
 198   end subroutine
 199   subroutine test09(ashape, polyarray, c, assumed_shape_char) ! 15.5.2.4(14), 15.5.2.11
 200     real :: x, arr(10)
 201     real, pointer :: p(:)
 202     real, pointer :: p_scalar
 203     character(10), pointer :: char_pointer(:)
 204     character(*) :: assumed_shape_char(:)
 205     real :: ashape(:)
 206     class(t) :: polyarray(*)
 207     character(10) :: c(:)
 208     !ERROR: Whole scalar actual argument may not be associated with a dummy argument 'x=' array
 209     call assumedsize(x)
 210     !ERROR: Whole scalar actual argument may not be associated with a dummy argument 'x=' array
 211     call assumedsize(p_scalar)
 212     !ERROR: Element of pointer array may not be associated with a dummy argument 'x=' array
 213     call assumedsize(p(1))
 214     !ERROR: Element of assumed-shape array may not be associated with a dummy argument 'x=' array
 215     call assumedsize(ashape(1))
 216     !ERROR: Polymorphic scalar may not be associated with a dummy argument 'x=' array
 217     call polyassumedsize(polyarray(1))
 218     call charray(c(1:1))  ! not an error if character
 219     call charray(char_pointer(1))  ! not an error if character
 220     call charray(assumed_shape_char(1))  ! not an error if character
 221     call assumedsize(arr(1))  ! not an error if element in sequence
 222     call assumedrank(x)  ! not an error
 223     call assumedtypeandsize(x)  ! not an error
 224   end subroutine
 225
 226   subroutine test10(a) ! 15.5.2.4(16)
 227     real :: scalar, matrix(2,3)
 228     real :: a(*)
 229     !ERROR: Scalar actual argument may not be associated with assumed-shape dummy argument 'x='
 230     call assumedshape(scalar)
 231     !ERROR: Rank of dummy argument is 1, but actual argument has rank 2
 232     call assumedshape(matrix)
 233     !ERROR: Assumed-size array may not be associated with assumed-shape dummy argument 'x='
 234     call assumedshape(a)
 235   end subroutine
 236
 237   subroutine test11(in) ! C15.5.2.4(20)
 238     real, intent(in) :: in
 239     real :: x
 240     x = 0.
 241     !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
 242     call intentout(in)
 243     !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
 244     call intentout(3.14159)
 245     !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
 246     call intentout(in + 1.)
 247     call intentout(x) ! ok
 248     !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
 249     call intentout((x))
 250     !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'count=' must be definable
 251     call system_clock(count=2)
 252     !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
 253     call intentinout(in)
 254     !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
 255     call intentinout(3.14159)
 256     !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
 257     call intentinout(in + 1.)
 258     call intentinout(x) ! ok
 259     !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
 260     call intentinout((x))
 261     !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'exitstat=' must be definable
 262     call execute_command_line(command="echo hello", exitstat=0)
 263   end subroutine
 264
 265   subroutine test12 ! 15.5.2.4(21)
 266     real :: a(1)
 267     integer :: j(1)
 268     j(1) = 1
 269     !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
 270     call intentout(a(j))
 271     !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
 272     call intentinout(a(j))
 273     !ERROR: Actual argument associated with ASYNCHRONOUS dummy argument 'x=' must be definable
 274     call asynchronous(a(j))
 275     !ERROR: Actual argument associated with VOLATILE dummy argument 'x=' must be definable
 276     call volatile(a(j))
 277   end subroutine
 278
 279   subroutine coarr(x)
 280     type(ultimateCoarray):: x
 281   end subroutine
 282   subroutine volcoarr(x)
 283     type(ultimateCoarray), volatile :: x
 284   end subroutine
 285   subroutine test13(a, b) ! 15.5.2.4(22)
 286     type(ultimateCoarray) :: a
 287     type(ultimateCoarray), volatile :: b
 288     call coarr(a)  ! ok
 289     call volcoarr(b)  ! ok
 290     !ERROR: VOLATILE attribute must match for dummy argument 'x=' when actual argument has a coarray ultimate component '%a'
 291     call coarr(b)
 292     !ERROR: VOLATILE attribute must match for dummy argument 'x=' when actual argument has a coarray ultimate component '%a'
 293     call volcoarr(a)
 294   end subroutine
 295
 296   subroutine test14(a,b,c,d) ! C1538
 297     real :: a[*]
 298     real, asynchronous :: b[*]
 299     real, volatile :: c[*]
 300     real, asynchronous, volatile :: d[*]
 301     call asynchronous(a[1])  ! ok
 302     call volatile(a[1])  ! ok
 303     call asynchronousValue(b[1])  ! ok
 304     call asynchronousValue(c[1])  ! ok
 305     call asynchronousValue(d[1])  ! ok
 306     !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
 307     call asynchronous(b[1])
 308     !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
 309     call volatile(b[1])
 310     !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
 311     call asynchronous(c[1])
 312     !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
 313     call volatile(c[1])
 314     !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
 315     call asynchronous(d[1])
 316     !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
 317     call volatile(d[1])
 318   end subroutine
 319
 320   subroutine test15() ! C1539
 321     real, pointer :: a(:)
 322     real, asynchronous :: b(10)
 323     real, volatile :: c(10)
 324     real, asynchronous, volatile :: d(10)
 325     call assumedsize(a(::2)) ! ok
 326     call contiguous(a(::2)) ! ok
 327     call valueassumedsize(a(::2)) ! ok
 328     call valueassumedsize(b(::2)) ! ok
 329     call valueassumedsize(c(::2)) ! ok
 330     call valueassumedsize(d(::2)) ! ok
 331     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 332     call volatileassumedsize(b(::2))
 333     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 334     call volatilecontiguous(b(::2))
 335     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 336     call volatileassumedsize(c(::2))
 337     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 338     call volatilecontiguous(c(::2))
 339     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 340     call volatileassumedsize(d(::2))
 341     !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
 342     call volatilecontiguous(d(::2))
 343   end subroutine
 344
 345   subroutine test16() ! C1540
 346     real, pointer :: a(:)
 347     real, asynchronous, pointer :: b(:)
 348     real, volatile, pointer :: c(:)
 349     real, asynchronous, volatile, pointer :: d(:)
 350     call assumedsize(a) ! ok
 351     call contiguous(a) ! ok
 352     call pointer(a) ! ok
 353     call pointer(b) ! ok
 354     call pointer(c) ! ok
 355     call pointer(d) ! ok
 356     call valueassumedsize(a) ! ok
 357     call valueassumedsize(b) ! ok
 358     call valueassumedsize(c) ! ok
 359     call valueassumedsize(d) ! 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)
 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)
 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)
 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)
 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)
 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)
 372   end subroutine
 373
 374 end module