flang/test/Semantics/call05.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! Test 15.5.2.5 constraints and restrictions for POINTER & ALLOCATABLE
   3 ! arguments when both sides of the call have the same attributes.
   4
   5 module m
   6
   7   type :: t
   8   end type
   9   type, extends(t) :: t2
  10   end type
  11   type :: pdt(n)
  12     integer, len :: n
  13   end type
  14
  15   type(t), pointer :: mp(:), mpmat(:,:)
  16   type(t), allocatable :: ma(:), mamat(:,:)
  17   class(t), pointer :: pp(:)
  18   class(t), allocatable :: pa(:)
  19   class(t2), pointer :: pp2(:)
  20   class(t2), allocatable :: pa2(:)
  21   class(*), pointer :: up(:)
  22   class(*), allocatable :: ua(:)
  23   !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, character named constant, or external function result
  24   type(pdt(*)), pointer :: amp(:)
  25   !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, character named constant, or external function result
  26   type(pdt(*)), allocatable :: ama(:)
  27   type(pdt(:)), pointer :: dmp(:)
  28   type(pdt(:)), allocatable :: dma(:)
  29   type(pdt(1)), pointer :: nmp(:)
  30   type(pdt(1)), allocatable :: nma(:)
  31
  32  contains
  33
  34   subroutine smp(x)
  35     type(t), pointer :: x(:)
  36   end subroutine
  37   subroutine sma(x)
  38     type(t), allocatable :: x(:)
  39   end subroutine
  40   subroutine spp(x)
  41     class(t), pointer :: x(:)
  42   end subroutine
  43   subroutine spa(x)
  44     class(t), allocatable :: x(:)
  45   end subroutine
  46   subroutine sup(x)
  47     class(*), pointer :: x(:)
  48   end subroutine
  49   subroutine sua(x)
  50     class(*), allocatable :: x(:)
  51   end subroutine
  52   subroutine samp(x)
  53     type(pdt(*)), pointer :: x(:)
  54   end subroutine
  55   subroutine sama(x)
  56     type(pdt(*)), allocatable :: x(:)
  57   end subroutine
  58   subroutine sdmp(x)
  59     type(pdt(:)), pointer :: x(:)
  60   end subroutine
  61   subroutine sdma(x)
  62     type(pdt(:)), allocatable :: x(:)
  63   end subroutine
  64   subroutine snmp(x)
  65     type(pdt(1)), pointer :: x(:)
  66   end subroutine
  67   subroutine snma(x)
  68     type(pdt(1)), allocatable :: x(:)
  69   end subroutine
  70
  71   subroutine test
  72     call smp(mp) ! ok
  73     call sma(ma) ! ok
  74     call spp(pp) ! ok
  75     call spa(pa) ! ok
  76     !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so
  77     call smp(pp)
  78     !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so
  79     call sma(pa)
  80     !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so
  81     call spp(mp)
  82     !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so
  83     call spa(ma)
  84     !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both must be so
  85     call sup(pp)
  86     !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both must be so
  87     call sua(pa)
  88     !ERROR: Actual argument type 'CLASS(*)' is not compatible with dummy argument type 'CLASS(t)'
  89     !ERROR: Pointer type must be unlimited polymorphic or non-extensible derived type when target is unlimited polymorphic
  90     call spp(up)
  91     !ERROR: Actual argument type 'CLASS(*)' is not compatible with dummy argument type 'CLASS(t)'
  92     call spa(ua)
  93     !ERROR: POINTER or ALLOCATABLE dummy and actual arguments must have the same declared type and kind
  94     call spp(pp2)
  95     !ERROR: POINTER or ALLOCATABLE dummy and actual arguments must have the same declared type and kind
  96     call spa(pa2)
  97     !ERROR: Rank of dummy argument is 1, but actual argument has rank 2
  98     !ERROR: Pointer has rank 1 but target has rank 2
  99     call smp(mpmat)
 100     !ERROR: Rank of dummy argument is 1, but actual argument has rank 2
 101     call sma(mamat)
 102     call sdmp(dmp) ! ok
 103     call sdma(dma) ! ok
 104     call snmp(nmp) ! ok
 105     call snma(nma) ! ok
 106     call samp(nmp) ! ok
 107     call sama(nma) ! ok
 108     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 109     call sdmp(nmp)
 110     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 111     call sdma(nma)
 112     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 113     call snmp(dmp)
 114     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 115     call snma(dma)
 116     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 117     call samp(dmp)
 118     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 119     call sama(dma)
 120   end subroutine
 121
 122 end module
 123
 124 module m2
 125
 126   !ERROR: Procedure 't3' may not be ALLOCATABLE without an explicit interface
 127   character(len=10), allocatable :: t1, t2, t3, t4
 128   !ERROR: Procedure 't6' may not be ALLOCATABLE without an explicit interface
 129   character(len=:), allocatable :: t5, t6, t7, t8(:)
 130
 131   character(len=10), pointer :: p1
 132   character(len=:), pointer :: p2
 133
 134   integer, allocatable :: x(:)
 135
 136  contains
 137
 138   subroutine sma(a)
 139     character(len=:), allocatable, intent(in) :: a
 140   end
 141
 142   subroutine sma2(a)
 143     character(len=10), allocatable, intent(in) :: a
 144   end
 145
 146   subroutine smp(p)
 147     character(len=:), pointer, intent(in) :: p
 148   end
 149
 150   subroutine smp2(p)
 151     character(len=10), pointer, intent(in) :: p
 152   end
 153
 154   subroutine smb(b)
 155     integer, allocatable, intent(in) :: b(:)
 156   end
 157
 158   subroutine test()
 159
 160     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 161     call sma(t1)
 162
 163     call sma2(t1) ! ok
 164
 165     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 166     call smp(p1)
 167
 168     call smp2(p1) ! ok
 169
 170     !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
 171     call sma(t2(:))
 172
 173     !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
 174     call sma(t3(1))
 175
 176     !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
 177     call sma(t4(1:2))
 178
 179     call sma(t5) ! ok
 180
 181     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 182     call sma2(t5)
 183
 184     call smp(p2) ! ok
 185
 186     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 187     call smp2(p2)
 188
 189     !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
 190     call sma(t5(:))
 191
 192     !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
 193     call sma(t6(1))
 194
 195     !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
 196     call sma(t7(1:2))
 197
 198     !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
 199     call sma(t8(1))
 200
 201     !ERROR: ALLOCATABLE dummy argument 'b=' must be associated with an ALLOCATABLE actual argument
 202     call smb(x(:))
 203
 204     !ERROR: Rank of dummy argument is 1, but actual argument has rank 0
 205     !ERROR: ALLOCATABLE dummy argument 'b=' must be associated with an ALLOCATABLE actual argument
 206     call smb(x(2))
 207
 208     !ERROR: ALLOCATABLE dummy argument 'b=' must be associated with an ALLOCATABLE actual argument
 209     call smb(x(1:2))
 210
 211   end subroutine
 212
 213 end module
 214
 215 module test
 216   type t(l)
 217     integer, len :: l
 218     character(l) :: c
 219   end type
 220
 221  contains
 222
 223   subroutine bar(p)
 224     type(t(:)), allocatable :: p(:)
 225   end subroutine
 226
 227   subroutine foo
 228     type(t(10)), allocatable :: p(:)
 229
 230     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 231     call bar(p)
 232
 233   end subroutine
 234
 235 end module