OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gdb-6.8/] [gdb/] [testsuite/] [gdb.base/] [call-sc.exp] - Blame information for rev 157

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.