1! RUN: %S/test_errors.sh %s %t %f18
2! Confirm enforcement of constraints and restrictions in 15.6.2.1
3
4non_recursive function f01(n) result(res)
5  integer, value :: n
6  integer :: res
7  if (n <= 0) then
8    res = n
9  else
10    !ERROR: NON_RECURSIVE procedure 'f01' cannot call itself
11    res = n * f01(n-1) ! 15.6.2.1(3)
12  end if
13end function
14
15non_recursive function f02(n) result(res)
16  integer, value :: n
17  integer :: res
18  if (n <= 0) then
19    res = n
20  else
21    res = nested()
22  end if
23 contains
24  integer function nested
25    !ERROR: NON_RECURSIVE procedure 'f02' cannot call itself
26    nested = n * f02(n-1) ! 15.6.2.1(3)
27  end function nested
28end function
29
30!ERROR: An assumed-length CHARACTER(*) function cannot be RECURSIVE
31recursive character(*) function f03(n) ! C723
32  integer, value :: n
33  f03 = ''
34end function
35
36!ERROR: An assumed-length CHARACTER(*) function cannot be RECURSIVE
37recursive function f04(n) result(res) ! C723
38  integer, value :: n
39  character(*) :: res
40  res = ''
41end function
42
43!ERROR: An assumed-length CHARACTER(*) function cannot return an array
44character(*) function f05()
45  dimension :: f05(1) ! C723
46  f05(1) = ''
47end function
48
49!ERROR: An assumed-length CHARACTER(*) function cannot return an array
50function f06()
51  character(*) :: f06(1) ! C723
52  f06(1) = ''
53end function
54
55!ERROR: An assumed-length CHARACTER(*) function cannot return a POINTER
56character(*) function f07()
57  pointer :: f07 ! C723
58  character, target :: a = ' '
59  f07 => a
60end function
61
62!ERROR: An assumed-length CHARACTER(*) function cannot return a POINTER
63function f08()
64  character(*), pointer :: f08 ! C723
65  character, target :: a = ' '
66  f08 => a
67end function
68
69!ERROR: An assumed-length CHARACTER(*) function cannot be PURE
70pure character(*) function f09() ! C723
71  f09 = ''
72end function
73
74!ERROR: An assumed-length CHARACTER(*) function cannot be PURE
75pure function f10()
76  character(*) :: f10 ! C723
77  f10 = ''
78end function
79
80!ERROR: An assumed-length CHARACTER(*) function cannot be ELEMENTAL
81elemental character(*) function f11(n) ! C723
82  integer, value :: n
83  f11 = ''
84end function
85
86!ERROR: An assumed-length CHARACTER(*) function cannot be ELEMENTAL
87elemental function f12(n)
88  character(*) :: f12 ! C723
89  integer, value :: n
90  f12 = ''
91end function
92
93function f13(n) result(res)
94  integer, value :: n
95  character(*) :: res
96  if (n <= 0) then
97    res = ''
98  else
99    !ERROR: Assumed-length CHARACTER(*) function 'f13' cannot call itself
100    res = f13(n-1) ! 15.6.2.1(3)
101  end if
102end function
103
104function f14(n) result(res)
105  integer, value :: n
106  character(*) :: res
107  if (n <= 0) then
108    res = ''
109  else
110    res = nested()
111  end if
112 contains
113  character(1) function nested
114    !ERROR: Assumed-length CHARACTER(*) function 'f14' cannot call itself
115    nested = f14(n-1) ! 15.6.2.1(3)
116  end function nested
117end function
118