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, 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, 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     call spp(up)
  90     !ERROR: Actual argument type 'CLASS(*)' is not compatible with dummy argument type 'CLASS(t)'
  91     call spa(ua)
  92     !ERROR: POINTER or ALLOCATABLE dummy and actual arguments must have the same declared type and kind
  93     call spp(pp2)
  94     !ERROR: POINTER or ALLOCATABLE dummy and actual arguments must have the same declared type and kind
  95     call spa(pa2)
  96     !ERROR: Rank of dummy argument is 1, but actual argument has rank 2
  97     call smp(mpmat)
  98     !ERROR: Rank of dummy argument is 1, but actual argument has rank 2
  99     call sma(mamat)
 100     call sdmp(dmp) ! ok
 101     call sdma(dma) ! ok
 102     call snmp(nmp) ! ok
 103     call snma(nma) ! ok
 104     call samp(nmp) ! ok
 105     call sama(nma) ! ok
 106     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 107     call sdmp(nmp)
 108     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 109     call sdma(nma)
 110     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 111     call snmp(dmp)
 112     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 113     call snma(dma)
 114     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 115     call samp(dmp)
 116     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 117     call sama(dma)
 118   end subroutine
 119
 120 end module
 121
 122 module m2
 123
 124   character(len=10), allocatable :: t1, t2, t3, t4
 125   character(len=:), allocatable :: t5, t6, t7, t8(:)
 126
 127   character(len=10), pointer :: p1
 128   character(len=:), pointer :: p2
 129
 130   integer, allocatable :: x(:)
 131
 132  contains
 133
 134   subroutine sma(a)
 135     character(len=:), allocatable, intent(in) :: a
 136   end
 137
 138   subroutine sma2(a)
 139     character(len=10), allocatable, intent(in) :: a
 140   end
 141
 142   subroutine smp(p)
 143     character(len=:), pointer, intent(in) :: p
 144   end
 145
 146   subroutine smp2(p)
 147     character(len=10), pointer, intent(in) :: p
 148   end
 149
 150   subroutine smb(b)
 151     integer, allocatable, intent(in) :: b(:)
 152   end
 153
 154   subroutine test()
 155
 156     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 157     call sma(t1)
 158
 159     call sma2(t1) ! ok
 160
 161     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 162     call smp(p1)
 163
 164     call smp2(p1) ! ok
 165
 166     !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
 167     call sma(t2(:))
 168
 169     !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
 170     call sma(t3(1))
 171
 172     !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
 173     call sma(t4(1:2))
 174
 175     call sma(t5) ! ok
 176
 177     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 178     call sma2(t5)
 179
 180     call smp(p2) ! ok
 181
 182     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 183     call smp2(p2)
 184
 185     !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
 186     call sma(t5(:))
 187
 188     !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
 189     call sma(t6(1))
 190
 191     !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
 192     call sma(t7(1:2))
 193
 194     !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
 195     call sma(t8(1))
 196
 197     !ERROR: ALLOCATABLE dummy argument 'b=' must be associated with an ALLOCATABLE actual argument
 198     call smb(x(:))
 199
 200     !ERROR: Rank of dummy argument is 1, but actual argument has rank 0
 201     !ERROR: ALLOCATABLE dummy argument 'b=' must be associated with an ALLOCATABLE actual argument
 202     call smb(x(2))
 203
 204     !ERROR: ALLOCATABLE dummy argument 'b=' must be associated with an ALLOCATABLE actual argument
 205     call smb(x(1:2))
 206
 207   end subroutine
 208
 209 end module
 210
 211 module test
 212   type t(l)
 213     integer, len :: l
 214     character(l) :: c
 215   end type
 216
 217  contains
 218
 219   subroutine bar(p)
 220     type(t(:)), allocatable :: p(:)
 221   end subroutine
 222
 223   subroutine foo
 224     type(t(10)), allocatable :: p(:)
 225
 226     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 227     call bar(p)
 228
 229   end subroutine
 230
 231 end module