1! RUN: %S/test_errors.sh %s %t %flang_fc1 2! REQUIRES: shell 3! Test 15.5.2.5 constraints and restrictions for POINTER & ALLOCATABLE 4! arguments when both sides of the call have the same attributes. 5 6module m 7 8 type :: t 9 end type 10 type, extends(t) :: t2 11 end type 12 type :: pdt(n) 13 integer, len :: n 14 end type 15 16 type(t), pointer :: mp(:), mpmat(:,:) 17 type(t), allocatable :: ma(:), mamat(:,:) 18 class(t), pointer :: pp(:) 19 class(t), allocatable :: pa(:) 20 class(t2), pointer :: pp2(:) 21 class(t2), allocatable :: pa2(:) 22 class(*), pointer :: up(:) 23 class(*), allocatable :: ua(:) 24 !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, named constant, or external function result 25 type(pdt(*)), pointer :: amp(:) 26 !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, named constant, or external function result 27 type(pdt(*)), allocatable :: ama(:) 28 type(pdt(:)), pointer :: dmp(:) 29 type(pdt(:)), allocatable :: dma(:) 30 type(pdt(1)), pointer :: nmp(:) 31 type(pdt(1)), allocatable :: nma(:) 32 33 contains 34 35 subroutine smp(x) 36 type(t), pointer :: x(:) 37 end subroutine 38 subroutine sma(x) 39 type(t), allocatable :: x(:) 40 end subroutine 41 subroutine spp(x) 42 class(t), pointer :: x(:) 43 end subroutine 44 subroutine spa(x) 45 class(t), allocatable :: x(:) 46 end subroutine 47 subroutine sup(x) 48 class(*), pointer :: x(:) 49 end subroutine 50 subroutine sua(x) 51 class(*), allocatable :: x(:) 52 end subroutine 53 subroutine samp(x) 54 type(pdt(*)), pointer :: x(:) 55 end subroutine 56 subroutine sama(x) 57 type(pdt(*)), allocatable :: x(:) 58 end subroutine 59 subroutine sdmp(x) 60 type(pdt(:)), pointer :: x(:) 61 end subroutine 62 subroutine sdma(x) 63 type(pdt(:)), allocatable :: x(:) 64 end subroutine 65 subroutine snmp(x) 66 type(pdt(1)), pointer :: x(:) 67 end subroutine 68 subroutine snma(x) 69 type(pdt(1)), allocatable :: x(:) 70 end subroutine 71 72 subroutine test 73 call smp(mp) ! ok 74 call sma(ma) ! ok 75 call spp(pp) ! ok 76 call spa(pa) ! ok 77 !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so 78 call smp(pp) 79 !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so 80 call sma(pa) 81 !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so 82 call spp(mp) 83 !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so 84 call spa(ma) 85 !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both must be so 86 call sup(pp) 87 !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both must be so 88 call sua(pa) 89 !ERROR: Actual argument type 'CLASS(*)' is not compatible with dummy argument type 't' 90 call spp(up) 91 !ERROR: Actual argument type 'CLASS(*)' is not compatible with dummy argument type '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 call smp(mpmat) 99 !ERROR: Rank of dummy argument is 1, but actual argument has rank 2 100 call sma(mamat) 101 call sdmp(dmp) ! ok 102 call sdma(dma) ! ok 103 call snmp(nmp) ! ok 104 call snma(nma) ! ok 105 call samp(nmp) ! ok 106 call sama(nma) ! ok 107 !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE 108 call sdmp(nmp) 109 !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE 110 call sdma(nma) 111 !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE 112 call snmp(dmp) 113 !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE 114 call snma(dma) 115 !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE 116 call samp(dmp) 117 !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE 118 call sama(dma) 119 end subroutine 120 121end module 122