1! RUN: %S/test_errors.sh %s %t %f18 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 5module 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 120end module 121