196 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic2! Test 15.5.2.9(2,3,5) dummy procedure requirements3! C8434! An entity with the INTENT attribute shall be a dummy data object or a5! dummy procedure pointer.6 7module m8 contains9 10 integer function intfunc(x)11 integer, intent(in) :: x12 intfunc = x13 end function14 real function realfunc(x)15 real, intent(in) :: x16 realfunc = x17 end function18 19 subroutine s01(p)20 procedure(realfunc), pointer, intent(in) :: p21 end subroutine22 subroutine s02(p)23 procedure(realfunc), pointer :: p24 end subroutine25 subroutine s02b(p)26 procedure(real), pointer :: p27 end subroutine28 subroutine s03(p)29 procedure(realfunc) :: p30 end subroutine31 subroutine s04(p)32 !ERROR: A dummy procedure without the POINTER attribute may not have an INTENT attribute33 procedure(realfunc), intent(in) :: p34 end subroutine35 subroutine s05(p)36 procedure(realfunc), pointer, intent(in out) :: p37 end subroutine38 39 subroutine selemental1(p)40 !PORTABILITY: A dummy procedure should not have an ELEMENTAL intrinsic as its interface [-Wportability]41 procedure(cos) :: p ! ok42 end subroutine43 44 real elemental function elemfunc(x)45 real, intent(in) :: x46 elemfunc = x47 end function48 subroutine selemental2(p)49 !ERROR: A dummy procedure may not be ELEMENTAL50 procedure(elemfunc) :: p51 end subroutine52 53 function procptr()54 procedure(realfunc), pointer :: procptr55 procptr => realfunc56 end function57 function intprocptr()58 procedure(intfunc), pointer :: intprocptr59 intprocptr => intfunc60 end function61 62 subroutine test1 ! 15.5.2.9(5)63 intrinsic :: sin64 procedure(realfunc), pointer :: p65 procedure(intfunc), pointer :: ip66 integer, pointer :: intPtr67 p => realfunc68 ip => intfunc69 call s01(realfunc) ! ok70 !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) ! ok73 call s01(procptr()) ! ok74 !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()) ! ok77 call s01(null(p)) ! ok78 !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) ! ok81 !ERROR: Actual argument associated with procedure dummy argument 'p=' is not a procedure82 call s01(null(intPtr))83 !ERROR: Actual argument associated with procedure dummy argument 'p=' is typeless84 call s01(B"0101")85 !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' is not a procedure pointer86 call s02(realfunc)87 call s02(p) ! ok88 !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 call s02(procptr()) ! believed to be ok91 call s02(null()) ! ok92 !ERROR: Actual argument associated with INTENT(IN OUT) procedure pointer dummy argument 'p=' is not definable93 !BECAUSE: 'NULL()' is a null pointer94 call s05(null())95 !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' is not a procedure pointer96 call s02(sin)97 !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' is not a procedure pointer98 call s02b(realfunc)99 call s02b(p) ! ok100 !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 call s02b(procptr()) ! believed to be ok103 call s02b(null())104 !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' is not a procedure pointer105 call s02b(sin)106 end subroutine107 108 subroutine callsub(s)109 call s110 end subroutine111 subroutine takesrealfunc1(f)112 external f113 real f114 end subroutine115 subroutine takesrealfunc2(f)116 x = f(1)117 end subroutine118 subroutine forwardproc(p)119 implicit none120 external :: p ! function or subroutine not known121 call foo(p)122 end subroutine123 124 subroutine test2(unknown,ds,drf,dif) ! 15.5.2.9(2,3)125 external :: unknown, ds, drf, dif126 real :: drf127 integer :: dif128 procedure(callsub), pointer :: ps129 procedure(realfunc), pointer :: prf130 procedure(intfunc), pointer :: pif131 call ds ! now we know that's it's a subroutine132 call callsub(callsub) ! ok apart from infinite recursion133 call callsub(unknown) ! ok134 call callsub(ds) ! ok135 call callsub(ps) ! ok136 call takesrealfunc1(realfunc) ! ok137 call takesrealfunc1(unknown) ! ok138 call takesrealfunc1(drf) ! ok139 call takesrealfunc1(prf) ! ok140 call takesrealfunc2(realfunc) ! ok141 call takesrealfunc2(unknown) ! ok142 call takesrealfunc2(drf) ! ok143 call takesrealfunc2(prf) ! ok144 call forwardproc(callsub) ! ok145 call forwardproc(realfunc) ! ok146 call forwardproc(intfunc) ! ok147 call forwardproc(unknown) ! ok148 call forwardproc(ds) ! ok149 call forwardproc(drf) ! ok150 call forwardproc(dif) ! ok151 call forwardproc(ps) ! ok152 call forwardproc(prf) ! ok153 call forwardproc(pif) ! ok154 !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine155 call callsub(realfunc)156 !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine157 call callsub(intfunc)158 !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine159 call callsub(drf)160 !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine161 call callsub(dif)162 !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine163 call callsub(prf)164 !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine165 call callsub(pif)166 !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function167 call takesrealfunc1(callsub)168 !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function169 call takesrealfunc1(ds)170 !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function171 call takesrealfunc1(ps)172 !ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)173 call takesrealfunc1(intfunc)174 !ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)175 call takesrealfunc1(dif)176 !ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)177 call takesrealfunc1(pif)178 !ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)179 call takesrealfunc1(intfunc)180 !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function181 call takesrealfunc2(callsub)182 !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function183 call takesrealfunc2(ds)184 !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function185 call takesrealfunc2(ps)186 !ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)187 call takesrealfunc2(intfunc)188 !ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)189 call takesrealfunc2(dif)190 !ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)191 call takesrealfunc2(pif)192 !ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)193 call takesrealfunc2(intfunc)194 end subroutine195end module196