145 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic2! Confirm enforcement of constraints and restrictions in 15.6.2.13 4non_recursive function f01(n) result(res)5 integer, value :: n6 integer :: res7 if (n <= 0) then8 res = n9 else10 !ERROR: NON_RECURSIVE procedure 'f01' cannot call itself11 res = n * f01(n-1) ! 15.6.2.1(3)12 end if13end function14 15non_recursive function f02(n) result(res)16 integer, value :: n17 integer :: res18 if (n <= 0) then19 res = n20 else21 res = nested()22 end if23 contains24 integer function nested()25 !ERROR: NON_RECURSIVE procedure 'f02' cannot call itself26 nested = n * f02(n-1) ! 15.6.2.1(3)27 end function nested28end function29 30!ERROR: An assumed-length CHARACTER(*) function cannot be RECURSIVE31recursive character(*) function f03(n) ! C72332 integer, value :: n33 f03 = ''34end function35 36!ERROR: An assumed-length CHARACTER(*) function cannot be RECURSIVE37recursive function f04(n) result(res) ! C72338 integer, value :: n39 character(*) :: res40 res = ''41end function42 43!ERROR: An assumed-length CHARACTER(*) function cannot return an array44character(*) function f05()45 dimension :: f05(1) ! C72346 f05(1) = ''47end function48 49!ERROR: An assumed-length CHARACTER(*) function cannot return an array50function f06()51 character(*) :: f06(1) ! C72352 f06(1) = ''53end function54 55!ERROR: An assumed-length CHARACTER(*) function cannot return a POINTER56character(*) function f07()57 pointer :: f07 ! C72358 character, target :: a = ' '59 f07 => a60end function61 62!ERROR: An assumed-length CHARACTER(*) function cannot return a POINTER63function f08()64 character(*), pointer :: f08 ! C72365 character, target :: a = ' '66 f08 => a67end function68 69!ERROR: An assumed-length CHARACTER(*) function cannot be PURE70pure character(*) function f09() ! C72371 f09 = ''72end function73 74!ERROR: An assumed-length CHARACTER(*) function cannot be PURE75pure function f10()76 character(*) :: f10 ! C72377 f10 = ''78end function79 80!ERROR: An assumed-length CHARACTER(*) function cannot be ELEMENTAL81elemental character(*) function f11(n) ! C72382 integer, value :: n83 f11 = ''84end function85 86!ERROR: An assumed-length CHARACTER(*) function cannot be ELEMENTAL87elemental function f12(n)88 character(*) :: f12 ! C72389 integer, value :: n90 f12 = ''91end function92 93function f13(n) result(res)94 integer, value :: n95 character(*) :: res96 if (n <= 0) then97 res = ''98 else99 !ERROR: Assumed-length CHARACTER(*) function 'f13' cannot call itself100 !ERROR: Assumed-length character function must be defined with a length to be called101 res = f13(n-1) ! 15.6.2.1(3)102 end if103end function104 105function f14(n) result(res)106 integer, value :: n107 character(*) :: res108 if (n <= 0) then109 res = ''110 else111 res = nested()112 end if113 contains114 character(1) function nested()115 !ERROR: Assumed-length CHARACTER(*) function 'f14' cannot call itself116 !ERROR: Assumed-length character function must be defined with a length to be called117 nested = f14(n-1) ! 15.6.2.1(3)118 end function nested119end function120 121subroutine s01(f1, f2, fp1, fp2, fp3)122 !PORTABILITY: A dummy procedure pointer should not have assumed-length CHARACTER(*) result type [-Wportability]123 character*(*) :: f1, f3, fp1124 external :: f1, f3125 pointer :: fp1, fp3126 !PORTABILITY: A dummy procedure pointer should not have assumed-length CHARACTER(*) result type [-Wportability]127 procedure(character*(*)), pointer :: fp2128 interface129 character*(*) function f2()130 end function131 !PORTABILITY: A dummy procedure pointer should not have assumed-length CHARACTER(*) result type [-Wportability]132 character*(*) function fp3()133 end function134 !ERROR: A function interface may not declare an assumed-length CHARACTER(*) result135 character*(*) function f4()136 end function137 end interface138 print *, f1()139 print *, f2()140 !ERROR: Assumed-length character function must be defined with a length to be called141 print *, f3()142 print *, fp1()143 print *, fp2()144end subroutine145