2020-02-26 07:22:14 +08:00
|
|
|
! RUN: %B/test/Semantics/test_errors.sh %s %flang %t
|
2019-09-05 04:26:41 +08:00
|
|
|
! Confirm enforcement of constraints and restrictions in 15.6.2.1
|
|
|
|
|
|
|
|
non_recursive function f01(n) result(res)
|
|
|
|
integer, value :: n
|
|
|
|
integer :: res
|
|
|
|
if (n <= 0) then
|
|
|
|
res = n
|
|
|
|
else
|
2019-09-14 04:57:35 +08:00
|
|
|
!ERROR: NON_RECURSIVE procedure 'f01' cannot call itself
|
2019-09-05 04:26:41 +08:00
|
|
|
res = n * f01(n-1) ! 15.6.2.1(3)
|
|
|
|
end if
|
|
|
|
end function
|
|
|
|
|
|
|
|
non_recursive function f02(n) result(res)
|
|
|
|
integer, value :: n
|
|
|
|
integer :: res
|
|
|
|
if (n <= 0) then
|
|
|
|
res = n
|
|
|
|
else
|
|
|
|
res = nested()
|
|
|
|
end if
|
|
|
|
contains
|
|
|
|
integer function nested
|
2019-09-14 04:57:35 +08:00
|
|
|
!ERROR: NON_RECURSIVE procedure 'f02' cannot call itself
|
2019-09-05 04:26:41 +08:00
|
|
|
nested = n * f02(n-1) ! 15.6.2.1(3)
|
|
|
|
end function nested
|
|
|
|
end function
|
|
|
|
|
2019-09-14 04:57:35 +08:00
|
|
|
!ERROR: An assumed-length CHARACTER(*) function cannot be RECURSIVE
|
2019-09-05 04:26:41 +08:00
|
|
|
recursive character(*) function f03(n) ! C723
|
|
|
|
integer, value :: n
|
|
|
|
f03 = ''
|
|
|
|
end function
|
|
|
|
|
2019-09-14 04:57:35 +08:00
|
|
|
!ERROR: An assumed-length CHARACTER(*) function cannot be RECURSIVE
|
2019-09-05 04:26:41 +08:00
|
|
|
recursive function f04(n) result(res) ! C723
|
|
|
|
integer, value :: n
|
|
|
|
character(*) :: res
|
|
|
|
res = ''
|
|
|
|
end function
|
|
|
|
|
2019-09-14 04:57:35 +08:00
|
|
|
!ERROR: An assumed-length CHARACTER(*) function cannot return an array
|
2019-09-05 04:26:41 +08:00
|
|
|
character(*) function f05()
|
|
|
|
dimension :: f05(1) ! C723
|
|
|
|
f05(1) = ''
|
|
|
|
end function
|
|
|
|
|
2019-09-14 04:57:35 +08:00
|
|
|
!ERROR: An assumed-length CHARACTER(*) function cannot return an array
|
2019-09-05 04:26:41 +08:00
|
|
|
function f06()
|
|
|
|
character(*) :: f06(1) ! C723
|
|
|
|
f06(1) = ''
|
|
|
|
end function
|
|
|
|
|
2019-09-14 04:57:35 +08:00
|
|
|
!ERROR: An assumed-length CHARACTER(*) function cannot return a POINTER
|
2019-09-05 04:26:41 +08:00
|
|
|
character(*) function f07()
|
|
|
|
pointer :: f07 ! C723
|
|
|
|
character, target :: a = ' '
|
|
|
|
f07 => a
|
|
|
|
end function
|
|
|
|
|
2019-09-14 04:57:35 +08:00
|
|
|
!ERROR: An assumed-length CHARACTER(*) function cannot return a POINTER
|
2019-09-05 04:26:41 +08:00
|
|
|
function f08()
|
|
|
|
character(*), pointer :: f08 ! C723
|
|
|
|
character, target :: a = ' '
|
|
|
|
f08 => a
|
|
|
|
end function
|
|
|
|
|
2019-09-14 04:57:35 +08:00
|
|
|
!ERROR: An assumed-length CHARACTER(*) function cannot be PURE
|
2019-09-05 04:26:41 +08:00
|
|
|
pure character(*) function f09() ! C723
|
|
|
|
f09 = ''
|
|
|
|
end function
|
|
|
|
|
2019-09-14 04:57:35 +08:00
|
|
|
!ERROR: An assumed-length CHARACTER(*) function cannot be PURE
|
2019-09-05 04:26:41 +08:00
|
|
|
pure function f10()
|
|
|
|
character(*) :: f10 ! C723
|
|
|
|
f10 = ''
|
|
|
|
end function
|
|
|
|
|
2019-09-14 04:57:35 +08:00
|
|
|
!ERROR: An assumed-length CHARACTER(*) function cannot be ELEMENTAL
|
2019-09-05 04:26:41 +08:00
|
|
|
elemental character(*) function f11(n) ! C723
|
|
|
|
integer, value :: n
|
|
|
|
f11 = ''
|
|
|
|
end function
|
|
|
|
|
2019-09-14 04:57:35 +08:00
|
|
|
!ERROR: An assumed-length CHARACTER(*) function cannot be ELEMENTAL
|
2019-09-05 04:26:41 +08:00
|
|
|
elemental function f12(n)
|
|
|
|
character(*) :: f12 ! C723
|
|
|
|
integer, value :: n
|
|
|
|
f12 = ''
|
|
|
|
end function
|
|
|
|
|
|
|
|
function f13(n) result(res)
|
|
|
|
integer, value :: n
|
|
|
|
character(*) :: res
|
|
|
|
if (n <= 0) then
|
|
|
|
res = ''
|
|
|
|
else
|
2019-09-14 04:57:35 +08:00
|
|
|
!ERROR: Assumed-length CHARACTER(*) function 'f13' cannot call itself
|
2019-09-05 04:26:41 +08:00
|
|
|
res = f13(n-1) ! 15.6.2.1(3)
|
|
|
|
end if
|
|
|
|
end function
|
|
|
|
|
|
|
|
function f14(n) result(res)
|
|
|
|
integer, value :: n
|
|
|
|
character(*) :: res
|
|
|
|
if (n <= 0) then
|
|
|
|
res = ''
|
|
|
|
else
|
|
|
|
res = nested()
|
|
|
|
end if
|
|
|
|
contains
|
|
|
|
character(1) function nested
|
2019-09-14 04:57:35 +08:00
|
|
|
!ERROR: Assumed-length CHARACTER(*) function 'f14' cannot call itself
|
2019-09-05 04:26:41 +08:00
|
|
|
nested = f14(n-1) ! 15.6.2.1(3)
|
|
|
|
end function nested
|
|
|
|
end function
|