xref: /netbsd-src/external/gpl3/gdb.old/dist/gdb/testsuite/gdb.base/call-sc.exp (revision b2c35e17b976cf7ccd7250c86c6f5e95090ed636)
1# This testcase is part of GDB, the GNU debugger.
2
3# Copyright 2004-2020 Free Software Foundation, Inc.
4
5# This program is free software; you can redistribute it and/or modify
6# it under the terms of the GNU General Public License as published by
7# the Free Software Foundation; either version 3 of the License, or
8# (at your option) any later version.
9#
10# This program is distributed in the hope that it will be useful,
11# but WITHOUT ANY WARRANTY; without even the implied warranty of
12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13# GNU General Public License for more details.
14#
15# You should have received a copy of the GNU General Public License
16# along with this program.  If not, see <http://www.gnu.org/licenses/>.
17
18# Test "return", "finish", and "call" of functions that a scalar (int,
19# float, enum) and/or take a single scalar parameter.
20
21
22# Some targets can't call functions, so don't even bother with this
23# test.
24
25if [target_info exists gdb,cannot_call_functions] {
26    unsupported "this target can not call functions"
27    continue
28}
29
30standard_testfile .c
31
32# Create and source the file that provides information about the
33# compiler used to compile the test case.
34
35if [get_compiler_info] {
36    return -1
37}
38set skip_float_test [gdb_skip_float_test]
39
40# Compile a variant of scalars.c using TYPE to specify the type of the
41# parameter and return-type.  Run the compiled program up to "main".
42# Also updates the global "testfile" to reflect the most recent build.
43
44proc start_scalars_test { type } {
45    global testfile
46    global srcfile
47    global binfile
48    global subdir
49    global srcdir
50    global gdb_prompt
51    global expect_out
52
53    # Create the additional flags
54    set flags "debug additional_flags=-DT=${type}"
55    set testfile "call-sc-${type}"
56
57    set binfile [standard_output_file ${testfile}]
58    if { [prepare_for_testing "failed to prepare" $binfile $srcfile $flags] } {
59	return -1
60    }
61
62    # Make certain that the output is consistent
63    with_test_prefix "testfile=$testfile" {
64	gdb_test_no_output "set print sevenbit-strings"
65	gdb_test_no_output "set print address off"
66	gdb_test_no_output "set width 0"
67    }
68
69    # Advance to main
70    if { ![runto_main] } then {
71	gdb_suppress_tests
72    }
73
74    # Get the debug format
75    get_debug_format
76
77    # check that type matches what was passed in
78    set test "ptype; ${testfile}"
79    set foo_t "xxx"
80    gdb_test_multiple "ptype/r ${type}" "${test}" {
81	-re "type = (\[^\r\n\]*)\r\n$gdb_prompt $" {
82	    set foo_t "$expect_out(1,string)"
83	    pass "$test (${foo_t})"
84	}
85    }
86    gdb_test "ptype/r foo" "type = ${foo_t}" "ptype foo; ${testfile} $expect_out(1,string)"
87}
88
89
90# Given N (0..25), return the corresponding alphabetic letter in lower
91# or upper case.  This is ment to be i18n proof.
92
93proc i2a { n } {
94    return [string range "abcdefghijklmnopqrstuvwxyz" $n $n]
95}
96
97proc I2A { n } {
98    return [string toupper [i2a $n]]
99}
100
101
102# Test GDB's ability to make inferior function calls to functions
103# returning (or passing) in a single scalar.
104
105# start_scalars_test() will have previously built a program with a
106# specified scalar type.  To ensure robustness of the output, "p/c" is
107# used.
108
109# This tests the code paths "which return-value convention?" and
110# "extract return-value from registers" called by "infcall.c".
111
112proc test_scalar_calls { } {
113    global testfile
114    global gdb_prompt
115
116    # Check that GDB can always extract a scalar-return value from an
117    # inferior function call.  Since GDB always knows the location of
118    # an inferior function call's return value these should never fail
119
120    # Implemented by calling the parameterless function "fun" and then
121    # examining the return value printed by GDB.
122
123    set tests "call ${testfile}"
124
125    # Call fun, checking the printed return-value.
126    gdb_test "p/c fun()" "= 49 '1'" "p/c fun(); ${tests}"
127
128    # Check that GDB can always pass a structure to an inferior function.
129    # This test can never fail.
130
131    # Implemented by calling the one parameter function "Fun" which
132    # stores its parameter in the global variable "L".  GDB then
133    # examining that global to confirm that the value is as expected.
134
135    gdb_test_no_output "call Fun(foo)" "call Fun(foo); ${tests}"
136    gdb_test "p/c L" " = 49 '1'" "p/c L; ${tests}"
137}
138
139# Test GDB's ability to both return a function (with "return" or
140# "finish") and correctly extract/store any corresponding
141# return-value.
142
143# Check that GDB can consistently extract/store structure return
144# values.  There are two cases - returned in registers and returned in
145# memory.  For the latter case, the return value can't be found and a
146# failure is "expected".  However GDB must still both return the
147# function and display the final source and line information.
148
149# N identifies the number of elements in the struct that will be used
150# for the test case.  FAILS is a list of target tuples that will fail
151# this test.
152
153# This tests the code paths "which return-value convention?", "extract
154# return-value from registers", and "store return-value in registers".
155# Unlike "test struct calls", this test is expected to "fail" when the
156# return-value is in memory (GDB can't find the location).  The test
157# is in three parts: test "return"; test "finish"; check that the two
158# are consistent.  GDB can sometimes work for one command and not the
159# other.
160
161proc test_scalar_returns { } {
162    global gdb_prompt
163    global testfile
164
165    set tests "return ${testfile}"
166
167
168    # Check that "return" works.
169
170    # GDB must always force the return of a function that has
171    # a struct result.  Dependant on the ABI, it may, or may not be
172    # possible to store the return value in a register.
173
174    # The relevant code looks like "L{n} = fun{n}()".  The test forces
175    # "fun{n}" to "return" with an explicit value.  Since that code
176    # snippet will store the returned value in "L{n}" the return
177    # is tested by examining "L{n}".  This assumes that the
178    # compiler implemented this as fun{n}(&L{n}) and hence that when
179    # the value isn't stored "L{n}" remains unchanged.  Also check for
180    # consistency between this and the "finish" case.
181
182    # Get into a call of fun
183    gdb_test "advance fun" \
184	    "fun .*\[\r\n\]+\[0-9\].*return foo.*" \
185	    "advance to fun for return; ${tests}"
186
187    # Check that the program invalidated the relevant global.
188    gdb_test "p/c L" " = 90 'Z'" "zed L for return; ${tests}"
189
190    # Force the "return".  This checks that the return is always
191    # performed, and that GDB correctly reported this to the user.
192    # GDB 6.0 and earlier, when the return-value's location wasn't
193    # known, both failed to print a final "source and line" and misplaced
194    # the frame ("No frame").
195
196    # The test is writen so that it only reports one FAIL/PASS for the
197    # entire operation.  The value returned is checked further down.
198    # "return_value_unknown", if non-empty, records why GDB realised
199    # that it didn't know where the return value was.
200
201    set test "return foo; ${tests}"
202    set return_value_unknown 0
203    set return_value_unimplemented 0
204    gdb_test_multiple "return foo" "${test}" {
205	-re "The location" {
206	    # Ulgh, a struct return, remember this (still need prompt).
207	    set return_value_unknown 1
208	    exp_continue
209	}
210	-re "A structure or union" {
211	    # Ulgh, a struct return, remember this (still need prompt).
212	    set return_value_unknown 1
213	    # Double ulgh.  Architecture doesn't use return_value and
214	    # hence hasn't implemented small structure return.
215	    set return_value_unimplemented 1
216	    exp_continue
217	}
218	-re "Make fun return now.*y or n. $" {
219	    gdb_test_multiple "y" "${test}" {
220		-re "L *= fun.*${gdb_prompt} $" {
221		    # Need to step off the function call
222		    gdb_test "next" "zed.*" "${test}"
223		}
224		-re "zed \\(\\);.*$gdb_prompt $" {
225		    pass "${test}"
226		}
227	    }
228	}
229    }
230
231    # If the previous test did not work, the program counter might
232    # still be inside foo() rather than main().  Make sure the program
233    # counter is is main().
234    #
235    # This happens on ppc64 GNU/Linux with gcc 3.4.1 and a buggy GDB
236
237    set test "return foo; synchronize pc to main() for '${testfile}'"
238    for {set loop_count 0} {$loop_count < 2} {incr loop_count} {
239      gdb_test_multiple "backtrace 1" $test {
240        -re "#0.*main \\(\\).*${gdb_prompt} $" {
241          pass $test
242          set loop_count 2
243        }
244        -re "#0.*fun \\(\\).*${gdb_prompt} $" {
245          if {$loop_count < 1} {
246            gdb_test "finish" ".*" ""
247          } else {
248            fail $test
249            set loop_count 2
250          }
251        }
252      }
253    }
254
255    # Check that the return-value is as expected.  At this stage we're
256    # just checking that GDB has returned a value consistent with
257    # "return_value_unknown" set above.
258
259    set test "value foo returned; ${tests}"
260    gdb_test_multiple "p/c L" "${test}" {
261	-re " = 49 '1'.*${gdb_prompt} $" {
262	    if $return_value_unknown {
263		# This contradicts the above claim that GDB didn't
264		# know the location of the return-value.
265		fail "${test}"
266	    } else {
267		pass "${test}"
268	    }
269	}
270	-re " = 90 .*${gdb_prompt} $" {
271	    if $return_value_unknown {
272		# The struct return case.  Since any modification
273		# would be by reference, and that can't happen, the
274		# value should be unmodified and hence Z is expected.
275		# Is this a reasonable assumption?
276		pass "${test}"
277	    } else {
278		# This contradicts the above claim that GDB knew
279		# the location of the return-value.
280		fail "${test}"
281	    }
282	}
283	-re ".*${gdb_prompt} $" {
284	    if $return_value_unimplemented {
285		# What a suprize.  The architecture hasn't implemented
286		# return_value, and hence has to fail.
287		kfail "$test" gdb/1444
288	    } else {
289		fail "$test"
290	    }
291	}
292    }
293
294    # Check that a "finish" works.
295
296    # This is almost but not quite the same as "call struct funcs".
297    # Architectures can have subtle differences in the two code paths.
298
299    # The relevant code snippet is "L{n} = fun{n}()".  The program is
300    # advanced into a call to  "fun{n}" and then that function is
301    # finished.  The returned value that GDB prints, reformatted using
302    # "p/c", is checked.
303
304    # Get into "fun()".
305    gdb_test "advance fun" \
306	    "fun .*\[\r\n\]+\[0-9\].*return foo.*" \
307	    "advance to fun for finish; ${tests}"
308
309    # Check that the program invalidated the relevant global.
310    gdb_test "p/c L" " = 90 'Z'" "zed L for finish; ${tests}"
311
312    # Finish the function, set 'finish_value_unknown" to non-empty if the
313    # return-value was not found.
314    set test "finish foo; ${tests}"
315    set finish_value_unknown 0
316    gdb_test_multiple "finish" "${test}" {
317	-re "Value returned is .*${gdb_prompt} $" {
318	    pass "${test}"
319	}
320	-re "Cannot determine contents.*${gdb_prompt} $" {
321	    # Expected bad value.  For the moment this is ok.
322	    set finish_value_unknown 1
323	    pass "${test}"
324	}
325    }
326
327    # Re-print the last (return-value) using the more robust
328    # "p/c".  If no return value was found, the 'Z' from the previous
329    # check that the variable was cleared, is printed.
330    set test "value foo finished; ${tests}"
331    gdb_test_multiple "p/c" "${test}" {
332	-re " = 49 '1'\[\r\n\]+${gdb_prompt} $" {
333	    if $finish_value_unknown {
334		# This contradicts the above claim that GDB didn't
335		# know the location of the return-value.
336		fail "${test}"
337	    } else {
338		pass "${test}"
339	    }
340	}
341	-re " = 90 'Z'\[\r\n\]+${gdb_prompt} $" {
342	    # The value didn't get found.  This is "expected".
343	    if $finish_value_unknown {
344		pass "${test}"
345	    } else {
346		# This contradicts the above claim that GDB did
347		# know the location of the return-value.
348		fail "${test}"
349	    }
350	}
351    }
352
353    # Finally, check that "return" and finish" have consistent
354    # behavior.
355
356    # Since both "return" and "finish" use equivalent "which
357    # return-value convention" logic, both commands should have
358    # identical can/can-not find return-value messages.
359
360    # Note that since "call" and "finish" use common code paths, a
361    # failure here is a strong indicator of problems with "store
362    # return-value" code paths.  Suggest looking at "return_value"
363    # when investigating a fix.
364
365    set test "return and finish use same convention; ${tests}"
366    if {$finish_value_unknown == $return_value_unknown} {
367	pass "${test}"
368    } else {
369	kfail gdb/1444 "${test}"
370    }
371}
372
373# ABIs pass anything >8 or >16 bytes in memory but below that things
374# randomly use register and/and structure conventions.  Check all
375# possible sized char scalars in that range.  But only a restricted
376# range of the other types.
377
378# NetBSD/PPC returns "unnatural" (3, 5, 6, 7) sized scalars in memory.
379
380# Test every single char struct from 1..17 in size.  This is what the
381# original "scalars" test was doing.
382
383start_scalars_test tc
384test_scalar_calls
385test_scalar_returns
386
387
388# Let the fun begin.
389
390# Assuming that any integer struct larger than 8 bytes goes in memory,
391# come up with many and varied combinations of a return struct.  For
392# "struct calls" test just beyond that 8 byte boundary, for "struct
393# returns" test up to that boundary.
394
395# For floats, assumed that up to two struct elements can be stored in
396# floating point registers, regardless of their size.
397
398# The approx size of each structure it is computed assumed that tc=1,
399# ts=2, ti=4, tl=4, tll=8, tf=4, td=8, tld=16, and that all fields are
400# naturally aligned.  Padding being added where needed.
401
402# Approx size: 2, 4, ...
403start_scalars_test ts
404test_scalar_calls
405test_scalar_returns
406
407# Approx size: 4, 8, ...
408start_scalars_test ti
409test_scalar_calls
410test_scalar_returns
411
412# Approx size: 4, 8, ...
413start_scalars_test tl
414test_scalar_calls
415test_scalar_returns
416
417# Approx size: 8, 16, ...
418start_scalars_test tll
419test_scalar_calls
420test_scalar_returns
421
422if {!$skip_float_test} {
423    # Approx size: 4, 8, ...
424    start_scalars_test tf
425    test_scalar_calls
426    test_scalar_returns
427
428    # Approx size: 8, 16, ...
429    start_scalars_test td
430    test_scalar_calls
431    test_scalar_returns
432
433    # Approx size: 16, 32, ...
434    start_scalars_test tld
435    test_scalar_calls
436    test_scalar_returns
437}
438
439# Approx size: 4, 8, ...
440start_scalars_test te
441test_scalar_calls
442test_scalar_returns
443
444return 0
445