xref: /llvm-project/flang/test/Semantics/call01.f90 (revision 1c91d9bdea3b6c38e8fbce46ec8181a9c0aa26f8) 
1! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
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    !ERROR: Assumed-length character function must be defined with a length to be called
101    res = f13(n-1) ! 15.6.2.1(3)
102  end if
103end function
104
105function f14(n) result(res)
106  integer, value :: n
107  character(*) :: res
108  if (n <= 0) then
109    res = ''
110  else
111    res = nested()
112  end if
113 contains
114  character(1) function nested()
115    !ERROR: Assumed-length CHARACTER(*) function 'f14' cannot call itself
116    !ERROR: Assumed-length character function must be defined with a length to be called
117    nested = f14(n-1) ! 15.6.2.1(3)
118  end function nested
119end function
120
121subroutine s01(f1, f2, fp1, fp2, fp3)
122  !PORTABILITY: A dummy procedure pointer should not have assumed-length CHARACTER(*) result type
123  character*(*) :: f1, f3, fp1
124  external :: f1, f3
125  pointer :: fp1, fp3
126  !PORTABILITY: A dummy procedure pointer should not have assumed-length CHARACTER(*) result type
127  procedure(character*(*)), pointer :: fp2
128  interface
129    character*(*) function f2()
130    end function
131    !PORTABILITY: A dummy procedure pointer should not have assumed-length CHARACTER(*) result type
132    character*(*) function fp3()
133    end function
134    !ERROR: A function interface may not declare an assumed-length CHARACTER(*) result
135    character*(*) function f4()
136    end function
137  end interface
138  print *, f1()
139  print *, f2()
140  !ERROR: Assumed-length character function must be defined with a length to be called
141  print *, f3()
142  print *, fp1()
143  print *, fp2()
144end subroutine
145