1! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic 2! Test 15.5.2.9(2,3,5) dummy procedure requirements 3! C843 4! An entity with the INTENT attribute shall be a dummy data object or a 5! dummy procedure pointer. 6 7module m 8 contains 9 10 integer function intfunc(x) 11 integer, intent(in) :: x 12 intfunc = x 13 end function 14 real function realfunc(x) 15 real, intent(in) :: x 16 realfunc = x 17 end function 18 19 subroutine s01(p) 20 procedure(realfunc), pointer, intent(in) :: p 21 end subroutine 22 subroutine s02(p) 23 procedure(realfunc), pointer :: p 24 end subroutine 25 subroutine s02b(p) 26 procedure(real), pointer :: p 27 end subroutine 28 subroutine s03(p) 29 procedure(realfunc) :: p 30 end subroutine 31 subroutine s04(p) 32 !ERROR: A dummy procedure without the POINTER attribute may not have an INTENT attribute 33 procedure(realfunc), intent(in) :: p 34 end subroutine 35 subroutine s05(p) 36 procedure(realfunc), pointer, intent(in out) :: p 37 end subroutine 38 39 subroutine selemental1(p) 40 !PORTABILITY: A dummy procedure should not have an ELEMENTAL intrinsic as its interface 41 procedure(cos) :: p ! ok 42 end subroutine 43 44 real elemental function elemfunc(x) 45 real, intent(in) :: x 46 elemfunc = x 47 end function 48 subroutine selemental2(p) 49 !ERROR: A dummy procedure may not be ELEMENTAL 50 procedure(elemfunc) :: p 51 end subroutine 52 53 function procptr() 54 procedure(realfunc), pointer :: procptr 55 procptr => realfunc 56 end function 57 function intprocptr() 58 procedure(intfunc), pointer :: intprocptr 59 intprocptr => intfunc 60 end function 61 62 subroutine test1 ! 15.5.2.9(5) 63 intrinsic :: sin 64 procedure(realfunc), pointer :: p 65 procedure(intfunc), pointer :: ip 66 integer, pointer :: intPtr 67 p => realfunc 68 ip => intfunc 69 call s01(realfunc) ! ok 70 !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=': function results have distinct types: REAL(4) vs INTEGER(4) 71 call s01(intfunc) 72 call s01(p) ! ok 73 call s01(procptr()) ! ok 74 !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=': function results have distinct types: REAL(4) vs INTEGER(4) 75 call s01(intprocptr()) 76 call s01(null()) ! ok 77 call s01(null(p)) ! ok 78 !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=': function results have distinct types: REAL(4) vs INTEGER(4) 79 call s01(null(ip)) 80 call s01(sin) ! ok 81 !ERROR: Actual argument associated with procedure dummy argument 'p=' is not a procedure 82 call s01(null(intPtr)) 83 !ERROR: Actual argument associated with procedure dummy argument 'p=' is typeless 84 call s01(B"0101") 85 !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a pointer unless INTENT(IN) 86 call s02(realfunc) 87 call s02(p) ! ok 88 !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=': function results have distinct types: REAL(4) vs INTEGER(4) 89 call s02(ip) 90 !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a pointer unless INTENT(IN) 91 call s02(procptr()) 92 call s02(null()) ! ok 93 !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a pointer unless INTENT(IN) 94 call s05(null()) 95 !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a pointer unless INTENT(IN) 96 call s02(sin) 97 !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a pointer unless INTENT(IN) 98 call s02b(realfunc) 99 call s02b(p) ! ok 100 !ERROR: Actual argument function associated with procedure dummy argument 'p=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4) 101 call s02b(ip) 102 !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a pointer unless INTENT(IN) 103 call s02b(procptr()) 104 call s02b(null()) 105 !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a pointer unless INTENT(IN) 106 call s02b(sin) 107 end subroutine 108 109 subroutine callsub(s) 110 call s 111 end subroutine 112 subroutine takesrealfunc1(f) 113 external f 114 real f 115 end subroutine 116 subroutine takesrealfunc2(f) 117 x = f(1) 118 end subroutine 119 subroutine forwardproc(p) 120 implicit none 121 external :: p ! function or subroutine not known 122 call foo(p) 123 end subroutine 124 125 subroutine test2(unknown,ds,drf,dif) ! 15.5.2.9(2,3) 126 external :: unknown, ds, drf, dif 127 real :: drf 128 integer :: dif 129 procedure(callsub), pointer :: ps 130 procedure(realfunc), pointer :: prf 131 procedure(intfunc), pointer :: pif 132 call ds ! now we know that's it's a subroutine 133 call callsub(callsub) ! ok apart from infinite recursion 134 call callsub(unknown) ! ok 135 call callsub(ds) ! ok 136 call callsub(ps) ! ok 137 call takesrealfunc1(realfunc) ! ok 138 call takesrealfunc1(unknown) ! ok 139 call takesrealfunc1(drf) ! ok 140 call takesrealfunc1(prf) ! ok 141 call takesrealfunc2(realfunc) ! ok 142 call takesrealfunc2(unknown) ! ok 143 call takesrealfunc2(drf) ! ok 144 call takesrealfunc2(prf) ! ok 145 call forwardproc(callsub) ! ok 146 call forwardproc(realfunc) ! ok 147 call forwardproc(intfunc) ! ok 148 call forwardproc(unknown) ! ok 149 call forwardproc(ds) ! ok 150 call forwardproc(drf) ! ok 151 call forwardproc(dif) ! ok 152 call forwardproc(ps) ! ok 153 call forwardproc(prf) ! ok 154 call forwardproc(pif) ! ok 155 !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine 156 call callsub(realfunc) 157 !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine 158 call callsub(intfunc) 159 !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine 160 call callsub(drf) 161 !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine 162 call callsub(dif) 163 !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine 164 call callsub(prf) 165 !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine 166 call callsub(pif) 167 !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function 168 call takesrealfunc1(callsub) 169 !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function 170 call takesrealfunc1(ds) 171 !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function 172 call takesrealfunc1(ps) 173 !ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4) 174 call takesrealfunc1(intfunc) 175 !ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4) 176 call takesrealfunc1(dif) 177 !ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4) 178 call takesrealfunc1(pif) 179 !ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4) 180 call takesrealfunc1(intfunc) 181 !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function 182 call takesrealfunc2(callsub) 183 !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function 184 call takesrealfunc2(ds) 185 !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function 186 call takesrealfunc2(ps) 187 !ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4) 188 call takesrealfunc2(intfunc) 189 !ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4) 190 call takesrealfunc2(dif) 191 !ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4) 192 call takesrealfunc2(pif) 193 !ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4) 194 call takesrealfunc2(intfunc) 195 end subroutine 196end module 197