flang/test/Semantics/call05.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
   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     !PORTABILITY: If a POINTER or ALLOCATABLE actual argument is polymorphic, the corresponding dummy argument should also be so
  77     call smp(pp)
  78     !PORTABILITY: If a POINTER or ALLOCATABLE actual argument is polymorphic, the corresponding dummy argument should also 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   character(len=10), allocatable :: t1, t2, t3, t4
 127   character(len=:), allocatable :: t5, t6, t7, t8(:)
 128
 129   character(len=10), pointer :: p1
 130   character(len=:), pointer :: p2
 131
 132   integer, allocatable :: x(:)
 133
 134  contains
 135
 136   subroutine sma(a)
 137     character(len=:), allocatable, intent(in) :: a
 138   end
 139
 140   subroutine sma2(a)
 141     character(len=10), allocatable, intent(in) :: a
 142   end
 143
 144   subroutine smp(p)
 145     character(len=:), pointer, intent(in) :: p
 146   end
 147
 148   subroutine smp2(p)
 149     character(len=10), pointer, intent(in) :: p
 150   end
 151
 152   subroutine smb(b)
 153     integer, allocatable, intent(in) :: b(:)
 154   end
 155
 156   function return_deferred_length_ptr()
 157     character(len=:), pointer :: return_deferred_length_ptr
 158     return_deferred_length_ptr => p2
 159   end function
 160
 161   function return_explicit_length_ptr(n)
 162     integer :: n
 163     character(len=n), pointer :: return_explicit_length_ptr
 164     return_explicit_length_ptr => p2(1:n)
 165   end function
 166
 167   subroutine test()
 168
 169     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 170     call sma(t1)
 171
 172     call sma2(t1) ! ok
 173
 174     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 175     call smp(p1)
 176
 177     call smp2(p1) ! ok
 178
 179     call smp(return_deferred_length_ptr()) ! ok
 180
 181     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 182     call smp2(return_deferred_length_ptr())
 183
 184     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 185     call smp(return_explicit_length_ptr(10))
 186
 187     call smp2(return_explicit_length_ptr(10)) ! ok
 188
 189     !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
 190     call sma(t2(:))
 191
 192     !ERROR: 't3' is not a callable procedure
 193     call sma(t3(1))
 194
 195     !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
 196     call sma(t4(1:2))
 197
 198     call sma(t5) ! ok
 199
 200     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 201     call sma2(t5)
 202
 203     call smp(p2) ! ok
 204
 205     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 206     call smp2(p2)
 207
 208     !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
 209     call sma(t5(:))
 210
 211     !ERROR: 't6' is not a callable procedure
 212     call sma(t6(1))
 213
 214     !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
 215     call sma(t7(1:2))
 216
 217     !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
 218     call sma(t8(1))
 219
 220     !ERROR: ALLOCATABLE dummy argument 'b=' must be associated with an ALLOCATABLE actual argument
 221     call smb(x(:))
 222
 223     !ERROR: Rank of dummy argument is 1, but actual argument has rank 0
 224     !ERROR: ALLOCATABLE dummy argument 'b=' must be associated with an ALLOCATABLE actual argument
 225     call smb(x(2))
 226
 227     !ERROR: ALLOCATABLE dummy argument 'b=' must be associated with an ALLOCATABLE actual argument
 228     call smb(x(1:2))
 229
 230   end subroutine
 231
 232 end module
 233
 234 module test
 235   type t(l)
 236     integer, len :: l
 237     character(l) :: c
 238   end type
 239
 240  contains
 241
 242   subroutine bar(p)
 243     type(t(:)), allocatable :: p(:)
 244   end subroutine
 245
 246   subroutine foo
 247     type(t(10)), allocatable :: p(:)
 248
 249     !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
 250     call bar(p)
 251
 252   end subroutine
 253
 254 end module