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 't'
  89     call spp(up)
  90     !ERROR: Actual argument type 'CLASS(*)' is not compatible with dummy argument type '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