# This testcase is part of GDB, the GNU debugger.

# Copyright 1996, 1997, 1999, 2003 Free Software Foundation, Inc.

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  

# Please email any bugs, comments, and/or additions to this file to:
# bug-gdb@prep.ai.mit.edu

if $tracelevel then {
	strace $tracelevel
}

set prms_id 0
set bug_id 0

# Some targets can't call functions, so don't even bother with this
# test.

if [target_info exists gdb,cannot_call_functions] {
    setup_xfail "*-*-*" 2416
    fail "This target can not call functions"
    continue
}

set testfile "structs"
set srcfile ${testfile}.c
set binfile ${objdir}/${subdir}/${testfile}

# Create and source the file that provides information about the
# compiler used to compile the test case.

if [get_compiler_info ${binfile}] {
    return -1;
}

# Build a testcase with the specified set of types

proc start_structs_test { name types } {
    global testfile
    global srcfile
    global binfile
    global objdir
    global subdir
    global srcdir

    # Create the additional flags
    set flags "debug"
    set n 0
    for {set n 0} {$n<[llength ${types}]} {incr n} {
	set m [I2A ${n}]
	set t [lindex ${types} $n]
	lappend flags "additional_flags=-Dt${m}=${t}"
    }

    set binfile ${objdir}/${subdir}/${testfile}-${name}
    if  { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable "${flags}"] != "" } {
	# built the second test case since we can't use prototypes
	warning "Prototypes not supported, rebuilding with -DNO_PROTOTYPES"
	if  { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable "${flags} additional_flags=-DNO_PROTOTYPES"] != "" } {
	    gdb_suppress_entire_file "Testcase compile failed, so all tests in this file will automatically fail."
	}
    }

    # Start with a fresh gdb.
    gdb_start
    gdb_reinitialize_dir $srcdir/$subdir
    gdb_load ${binfile}

    # Make certain that the output is consistent
    gdb_test "set print sevenbit-strings" "" "set print sevenbit-strings for ${name}"
    gdb_test "set print address off" ""      "set print address off for ${name}"
    gdb_test "set width 0" ""                "set width 0 for ${name}"

    # Advance to main
    if { ![runto_main] } then {
	gdb_suppress_tests;
    }

    # check that at the struct containing all the relevant types is correct
    set foo_t "type = struct struct[llength ${types}] {"
    for {set n 0} {$n<[llength ${types}]} {incr n} {
	append foo_t {[\r\n ]+} [lindex ${types} $n] " " [i2a $n] ";"
    }
    append foo_t {[\r\n ]+} "}"
    gdb_test "ptype foo[llength ${types}]" "${foo_t}" "${foo_t} for ${name}"
}

# The value of each fooN structure.  First element is empty to make
# indexing easier.
proc foo { n } {
    return [lindex {
	"{}"
	"{a = 49 '1'}"
	"{a = 97 'a', b = 50 '2'}"
	"{a = 49 '1', b = 98 'b', c = 51 '3'}"
	"{a = 97 'a', b = 50 '2', c = 99 'c', D = 52 '4'}"
	"{a = 49 '1', b = 98 'b', c = 51 '3', D = 100 'd', e = 53 '5'}"
	"{a = 97 'a', b = 50 '2', c = 99 'c', D = 52 '4', e = 101 'e', f = 54 '6'}"
	"{a = 49 '1', b = 98 'b', c = 51 '3', D = 100 'd', e = 53 '5', f = 102 'f', g = 55 '7'}"
	"{a = 97 'a', b = 50 '2', c = 99 'c', D = 52 '4', e = 101 'e', f = 54 '6', g = 103 'g', h = 56 '8'}"
	"{a = 49 '1', b = 98 'b', c = 51 '3', D = 100 'd', e = 53 '5', f = 102 'f', g = 55 '7', h = 104 'h', i = 57 '9'}"
	"{a = 97 'a', b = 50 '2', c = 99 'c', D = 52 '4', e = 101 'e', f = 54 '6', g = 103 'g', h = 56 '8', i = 105 'i', j = 65 'A'}"
	"{a = 49 '1', b = 98 'b', c = 51 '3', D = 100 'd', e = 53 '5', f = 102 'f', g = 55 '7', h = 104 'h', i = 57 '9', j = 106 'j', k = 66 'B'}"
	"{a = 97 'a', b = 50 '2', c = 99 'c', D = 52 '4', e = 101 'e', f = 54 '6', g = 103 'g', h = 56 '8', i = 105 'i', j = 65 'A', k = 107 'k', l = 67 'C'}"
	"{a = 49 '1', b = 98 'b', c = 51 '3', D = 100 'd', e = 53 '5', f = 102 'f', g = 55 '7', h = 104 'h', i = 57 '9', j = 106 'j', k = 66 'B', l = 108 'l', m = 68 'D'}"
	"{a = 97 'a', b = 50 '2', c = 99 'c', D = 52 '4', e = 101 'e', f = 54 '6', g = 103 'g', h = 56 '8', i = 105 'i', j = 65 'A', k = 107 'k', l = 67 'C', m = 109 'm', n = 69 'E'}"
	"{a = 49 '1', b = 98 'b', c = 51 '3', D = 100 'd', e = 53 '5', f = 102 'f', g = 55 '7', h = 104 'h', i = 57 '9', j = 106 'j', k = 66 'B', l = 108 'l', m = 68 'D', n = 110 'n', o = 70 'F'}"
	"{a = 97 'a', b = 50 '2', c = 99 'c', D = 52 '4', e = 101 'e', f = 54 '6', g = 103 'g', h = 56 '8', i = 105 'i', j = 65 'A', k = 107 'k', l = 67 'C', m = 109 'm', n = 69 'E', o = 111 'o', p = 71 'G'}"
	"{a = 49 '1', b = 98 'b', c = 51 '3', D = 100 'd', e = 53 '5', f = 102 'f', g = 55 '7', h = 104 'h', i = 57 '9', j = 106 'j', k = 66 'B', l = 108 'l', m = 68 'D', n = 110 'n', o = 70 'F', p = 112 'p', q = 72 'H'}"
    } $n]
}

proc i2a { n } {
    return [string range "abcdefghijklmnopqrstuvwxyz" $n $n]
}

proc I2A { n } {
    return [string toupper [i2a $n]]
}

# Call FUNC with no arguments, and expect to see the regexp RESULT in
# the output.  Since GDB called the function, GDB always knows where
# the return value is.  These tests should never fail.  Use a char
# formatted print so that, regardless of the type of each struct
# element, the printed value are always the same.

proc call_struct_func { name n } {
    global gdb_prompt
    set command "p/c fun${n}()"
    set result [foo ${n}]
    send_gdb "${command}\n"
    gdb_expect {
        -re "$result\[\r\n\]+$gdb_prompt $" {
            pass "$command for ${name} ${n}"
        }
        -re "$gdb_prompt $" {
            fail "$command for ${name} ${n}"
        }
        timeout {
            fail "$command for ${name} ${n} (timeout)"
        }
    }
}

proc call_void_func { name n } {
    set command  "p Fun${n}(foo${n})"
    gdb_test "${command}" " = (void|0)" "${command} for ${name} ${n}"
}

proc print_struct { name n } {
    set command  "p/c L${n}"
    set result [foo ${n}]
    gdb_test "${command}" ${result} "${command} for ${name} ${n}"
}

proc test_function_call { name n } {
    # First, call the "fun" functions and examine the value they
    # return.  This checks that GDB can correctly, and always, extract
    # the return value from an inferior function call.
    call_struct_func ${name} $n

    # Now call the Fun functions to set the L* variables.  This
    # tests that gdb properly passes structures to functions (by
    # checking that the function stored the correct value in a global
    # variable).
    call_void_func ${name} $n
    print_struct ${name} $n
}

# Simple test - all elements are the same size

proc struct_call_test { types last } {

    # Create the name
    set name "call-"
    foreach t $types {
	append name "$t"
    }

    # Now compile and run the program
    start_structs_test ${name} ${types}

    # Test all relevant functions.  Skip those that don't at least
    # contain all the specified types, and stop at the upper bound.
    for {set test [llength ${types}]} {$test<=$last} {incr test} {
	test_function_call ${name} $test
    }

    gdb_stop_suppressing_tests;
}

# ABIs pass anything >8 or >16 bytes in memory but below that things
# randomly use register and/and structure conventions.  Check all
# possible sized char structs in that range.

struct_call_test { tc } 17


# Now do the same for other typed structs but this time limit things
# to roughly 8 bytes.

struct_call_test { ts } 5
struct_call_test { ti } 3
struct_call_test { tl } 3
struct_call_test { tll } 2
struct_call_test { tf } 3
struct_call_test { td } 2
struct_call_test { tld } 1

struct_call_test { ts tc } 7
struct_call_test { ti tc } 5
struct_call_test { tl tc } 5
struct_call_test { tll tc } 1
struct_call_test { tf tc } 5
struct_call_test { td tc } 1
struct_call_test { tld tc } 1

struct_call_test { tc ts } 5
struct_call_test { tc ti } 3
struct_call_test { tc tl } 3
struct_call_test { tc tll } 1
struct_call_test { tc tf } 3
struct_call_test { tc td } 1
struct_call_test { tc tld } 1


# Check that GDB can force a struct return value.  This tests the
# "return_value" write path.

# Advance to parameterless FUNC and force its return.
proc return_struct_func { name n } {
    global gdb_prompt
    
    gdb_test "advance fun${n}" \
	    "fun${n} .*\[\r\n\]+\[0-9\].*return foo${n}.*" \
	    "advance fun${n} for ${name}"

    # Be careful to only produce one PASS/FAIL.
    send_gdb "return foo${n}\n"
    gdb_expect {
	-re  "Make fun${n} return now.*y or n. $" {
	    send_gdb "y\n"
	    gdb_expect {
		-re "L${n} *= fun${n}.*${gdb_prompt} $" {
		    # Need to step off the function call
		    gdb_test "next" "L.* *= fun.*" "return foo${n} for ${name}"
		}
		-re "${gdb_prompt} $" {
		    pass "return foo${n} for ${name}"
		}
		timeout {
		    fail "return foo${n} for ${name} (timeout)"
		}
	    }
	}
    }

    # Check that the returned value really was returned.
    gdb_test "p/c L${n}" " = [foo ${n}]" "p/c L${n} for ${name}"
}

proc struct_return_test { types last } {
    set n [llength ${types}]

    # Create the name
    set name "return-"
    foreach t $types {
	append name "$t"
    }

    # Now compile and run the program
    start_structs_test ${name} ${types}

    # Check as many functions as possible
    for {set test [llength ${types}]} {$test<=$last} {incr test} {
	return_struct_func ${name} ${test}
    }
    
    gdb_stop_suppressing_tests;
}

struct_return_test { tc } 1

# Check that GDB can do a finish.  This checks the struct return read
# path.

# Advance to parameterless FUNC and force its return.
proc finish_struct_func { name n } {
    gdb_test "advance fun${n}" \
	    "fun${n} .*\[\r\n\]+\[0-9\].*return foo${n}.*" \
	    "advance fun${n} for ${name}"
    gdb_test "finish" "[foo ${n}]" "finish for ${name} ${n}"
}

proc struct_finish_test { types last } {

    # Create the name
    set name "finish-"
    foreach t $types {
	append name "$t"
    }

    # Now compile and run the program
    start_structs_test ${name} ${types}

    # Check as many functions as possible
    for {set test [llength ${types}]} {$test<=$last} {incr test} {
	finish_struct_func ${name} ${test}
    }
    
    gdb_stop_suppressing_tests;
}

struct_finish_test { tc } 1

return 0