# 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;
}

# Global variable that contains the list of types for the most recent
# build/start.  Types are encoded as two or three letter accronyms
# vis: tc or char, ts for short, tld for long double.  The full list
# is found in structs.c.

set struct_types {}

# Compile a variant of structs.c using TYPES to specify the type of
# the first N struct elements (the remaining elements take the type of
# the last TYPES field).  Run the compmiled program up to "main".
# Also updates the global "struct_types" to reflect the most recent
# build.

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

    # Set that global to the current set of structs
    global struct_types
    set struct_types $types

    # Create the additional flags
    set flags "debug"
    set name ""
    set n 0
    for {set n 0} {$n<[llength ${struct_types}]} {incr n} {
	set m [I2A ${n}]
	set t [lindex ${struct_types} $n]
	lappend flags "additional_flags=-Dt${m}=${t}"
	append name "-" "$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; ${struct_types}"
    gdb_test "set print address off" "" \
	    "set print address off; ${struct_types}"
    gdb_test "set width 0" "" \
	    "set width 0; ${struct_types}"

    # 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 ${struct_types}] \{"
    for {set n 0} {$n<[llength ${struct_types}]} {incr n} {
	append foo_t "\[\r\n \]+[lindex ${struct_types} $n] [i2a $n];"
    }
    append foo_t "\[\r\n \]+\}"
    gdb_test "ptype foo[llength ${struct_types}]" "${foo_t}" \
	    "ptype foo[llength ${struct_types}]; ${struct_types}"
}

# The expected value for fun${n}, L${n} and foo${n}.  First element is
# empty to make indexing easier.  "foo" returns the modified value,
# "zed" returns the invalid value.

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 zed { n } {
    return [lindex {
	"{}"
	"{a = 90 'Z'}"
	"{a = 90 'Z', b = 90 'Z'}"
	"{a = 90 'Z', b = 90 'Z', c = 90 'Z'}"
	"{a = 90 'Z', b = 90 'Z', c = 90 'Z', d = 90 'Z'}"
	"{a = 90 'Z', b = 90 'Z', c = 90 'Z', d = 90 'Z', e = 90 'Z'}"
	"{a = 90 'Z', b = 90 'Z', c = 90 'Z', d = 90 'Z', e = 90 'Z', f = 90 'Z'}"
	"{a = 90 'Z', b = 90 'Z', c = 90 'Z', d = 90 'Z', e = 90 'Z', f = 90 'Z', g = 90 'Z'}"
	"{a = 90 'Z', b = 90 'Z', c = 90 'Z', d = 90 'Z', e = 90 'Z', f = 90 'Z', g = 90 'Z', h = 90 'Z'}"
	"{a = 90 'Z', b = 90 'Z', c = 90 'Z', d = 90 'Z', e = 90 'Z', f = 90 'Z', g = 90 'Z', h = 90 'Z', i = 90 'Z'}"
	"{a = 90 'Z', b = 90 'Z', c = 90 'Z', d = 90 'Z', e = 90 'Z', f = 90 'Z', g = 90 'Z', h = 90 'Z', i = 90 'Z', j = 90 'Z'}"
	"{a = 90 'Z', b = 90 'Z', c = 90 'Z', d = 90 'Z', e = 90 'Z', f = 90 'Z', g = 90 'Z', h = 90 'Z', i = 90 'Z', j = 90 'Z', k = 90 'Z'}"
	"{a = 90 'Z', b = 90 'Z', c = 90 'Z', d = 90 'Z', e = 90 'Z', f = 90 'Z', g = 90 'Z', h = 90 'Z', i = 90 'Z', j = 90 'Z', k = 90 'Z', l = 90 'Z'}"
	"{a = 90 'Z', b = 90 'Z', c = 90 'Z', d = 90 'Z', e = 90 'Z', f = 90 'Z', g = 90 'Z', h = 90 'Z', i = 90 'Z', j = 90 'Z', k = 90 'Z', l = 90 'Z', m = 90 'Z'}"
	"{a = 90 'Z', b = 90 'Z', c = 90 'Z', d = 90 'Z', e = 90 'Z', f = 90 'Z', g = 90 'Z', h = 90 'Z', i = 90 'Z', j = 90 'Z', k = 90 'Z', l = 90 'Z', m = 90 'Z', n = 90 'Z'}"
	"{a = 90 'Z', b = 90 'Z', c = 90 'Z', d = 90 'Z', e = 90 'Z', f = 90 'Z', g = 90 'Z', h = 90 'Z', i = 90 'Z', j = 90 'Z', k = 90 'Z', l = 90 'Z', m = 90 'Z', n = 90 'Z', o = 90 'Z'}"
	"{a = 90 'Z', b = 90 'Z', c = 90 'Z', d = 90 'Z', e = 90 'Z', f = 90 'Z', g = 90 'Z', h = 90 'Z', i = 90 'Z', j = 90 'Z', k = 90 'Z', l = 90 'Z', m = 90 'Z', n = 90 'Z', o = 90 'Z', p = 90 'Z'}"
	"{a = 90 'Z', b = 90 'Z', c = 90 'Z', d = 90 'Z', e = 90 'Z', f = 90 'Z', g = 90 'Z', h = 90 'Z', i = 90 'Z', j = 90 'Z', k = 90 'Z', l = 90 'Z', m = 90 'Z', n = 90 'Z', o = 90 'Z', p = 90 'Z', q = 90 'Z'}"
    } $n]
}

# Given N (0..25), return the corresponding alphabetic letter.  This
# is i18n proof.

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

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

# Report the test result.  Use the tuples in FAILS to mark up any
# expected xfail/kfail based on that result.  For instance, if the
# result is a XPASS, any tuple in the FAILS list gets reported as an
# XPASS.  Or for a KFAIL, any FAILS become KFAILS.

proc report { expected test fails bug } {
    switch $expected {
	xpass {
	    foreach f $fails { setup_xfail $f $bug }
	    pass $test
	}
	kpass {
	    foreach f $fails { setup_kfail $f $bug }
	    pass $test
	}
	xfail {
	    foreach f $fails { setup_xfail $f $bug }
	    fail $test
	}
	kfail {
	    foreach f $fails { setup_kfail $f $bug }
	    fail $test
	}
	default {
	    perror "Bad expected report $expected"
	}
    }
}

# Check GDB's ability to call inferior functions involving structs.

proc test_struct_calls { n fails } {
    global struct_types
    global gdb_prompt

    # Check that GDB can always extract a struct-return value from an
    # inferior function call.  Since GDB always knows the location of an
    # inferior function call's return value these should never fail
    
    # Implemented by calling the parameterless function "fun$N" and then
    # examining the return value printed by GDB.

    set tests "call ${struct_types}"

    # Call fun${n}, checking the printed return value.
    send_gdb "p/c fun${n}()\n"
    set test "p/c fun${n}(); ${tests}"
    gdb_expect {
        -re "[foo ${n}]\[\r\n\]+$gdb_prompt $" {
            report kpass "${test}" ${fails} gdb/1443
        }
        -re "$gdb_prompt $" {
	    # "Return value of a struct return function lost"
            report kfail "${test}" ${fails} gdb/1443
        }
        timeout {
            fail "${test} (timeout)"
        }
    }

    # Check that GDB can always pass a structure to an inferior function.
    # This test can never fail.

    # Implemented by calling the one parameter function "Fun$N" which
    # stores its parameter in the global variable "L$N".  GDB then
    # examining that global to confirm that the value is as expected.

    gdb_test "call Fun${n}(foo${n})" "" "call Fun${n}(foo${n}); ${tests}"
    gdb_test "p/c L${n}" [foo ${n}] "p/c L${n}; ${tests}"
}

proc test_struct_returns { n fails } {
    global gdb_prompt
    global struct_types

    set tests "return ${struct_types}"
    
    # Remember if the test involves "struct return convention".  If it
    # does, the fail is expected - GDB can't handle the edge case.
    set struct_return 0

    # Check that GDB can correctly force the return of a function that has
    # a struct result.  Dependant on the ABI, it may, or may not be
    # possible to make this work.

    # The relevant code looks like "L{n} = fun{n}()".  The test forces
    # "fun{n}" to "return" with an explicit value.  Since that code
    # snippet will store the the returned value in "L{n}", its possible to
    # confirm that things work by examining "L{n}".

    # Get into a call of fun${n}
    gdb_test "advance fun${n}" \
	    "fun${n} .*\[\r\n\]+\[0-9\].*return foo${n}.*" \
	    "advance to fun${n} for return; ${tests}"

    # Check that the program invalidated the relevant global.
    gdb_test "p/c L${n}" " = [zed $n]" "zed L${n} for return; ${tests}"

    # Now test a forced return.  This code is checking that GDB does
    # not leave the user dangling and that the final resting place of
    # the return is clear (GDB 6.0 sometimes forgot to print the
    # "source and line" information leaving the user with "No frame".

    send_gdb "return foo${n}\n"
    set test "return foo${n}; ${tests}"
    gdb_expect {
	-re "The location" {
	    # Ulgh, a struct return, remember this (still need prompt).
	    set struct_return 1
	    exp_continue
	}
	-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.*" "${test}"
		}
		-re "L[expr ${n} + 1] *= fun[expr ${n} + 1].*${gdb_prompt} $" {
		    pass "${test}"
		}
		timeout {
		    fail "${test} (timeout 2)"
		}
	    }
	}
	-re "${gdb_prompt} $" {
	    fail "${test} (no query)"
	}
	timeout {
	    fail "${test} (timeout 1)"
	}
    }

    # Check that the retun value is as expected.  As noted below,
    # there are two expected outcomes.

    send_gdb "p/c L${n}\n"
    set test "value foo${n} returned; ${tests}"
    gdb_expect {
	-re " = [foo ${n}].*${gdb_prompt} $" {
	    # The value was returned and stored in the global.  Can't be
	    # the struct return case.
	    if $struct_return {
		report kfail "${test}" ${fails} gdb/1444
	    } else {
		report kpass "${test}" ${fails} gdb/1444
	    }
	}
	-re " = [zed ${n}].*${gdb_prompt} $" {
	    # The struct return case.  Since any modification would be
	    # by reference, and that can't happen, the value should
	    # be unmodified and hence Z is expected.  I guess this assumes
	    # that the compiled code pass a reference to the L variable
	    # and not something on the stack.  Reasonable?
	    if $struct_return {
		# expected
		report xfail "${test}" ${fails} gdb/1444
	    } else {
		# unexpected
		report kfail "${test}" ${fails} gdb/1444
	    }
	}
	-re "${gdb_prompt} $" {
	    # Garbage returned, garbage printed
	    report kfail "${test}" ${fails} gdb/1444
	}
	timeout {
	    fail "${test} (timeout)"
	}
    }	

    # Check that GDB can always finish a struct-return function.
    # Dependant on the ABI GDB may or may not be able to find the value
    # returned by that function.

    # The relevant code snippet is "L{n} = fun{n}()".  The program is
    # allowed to get into a call to "fun{n}" and that function is then
    # finished.  The returned value that GDB prints is then checked.

    # Get into "fun${n}()".
    gdb_test "advance fun${n}" \
	    "fun${n} .*\[\r\n\]+\[0-9\].*return foo${n}.*" \
	    "advance to fun${n} for finish; ${tests}"

    # Check that the program invalidated the relevant global.
    gdb_test "p/c L${n}" " = [zed $n]" "zed L${n} for finish; ${tests}"

    # Finish that function, this should put the return value in a
    # convenience variable.
    gdb_test "finish" "" "finish fun$n; ${tests}"

    # Reprint that last value but using a more robust format.
    # If the finish didn't display a value, the earlier ZED is displayed.
    send_gdb "p/c\n"
    set test "value foo${n} finished; ${tests}"
    gdb_expect {
	-re "[foo ${n}]\[\r\n\]+${gdb_prompt} $" {
	    report kpass "${test}" ${fails} gdb/1444
	}
	-re "[zed ${n}]\[\r\n\]+${gdb_prompt} $" {
	    # Value lost, assume struct return.  The return test
	    # will have checked this.  If struct return wasn't expected
	    # its a bug.
	    if $struct_return {
		report xfail "${test}" ${fails} gdb/1444
	    } else {
		report kfail "${test}" ${fails} gdb/1444
	    }
	}
	-re ".*${gdb_prompt} $" {
	    # Garbage returned
	    report kfail "${test}" ${fails} gdb/1444
	}
	timeout {
	    fail "${test} (timeout)"
	}
    }
}

# 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.  But only a restricted
# range of the other types.

# On NetBSD, "unnatural" sized structs get returned in memory.

start_structs_test { tc }
test_struct_calls 1 { }
test_struct_calls 2 { }
test_struct_calls 3 { }
test_struct_calls 4 { }
test_struct_calls 5 { }
test_struct_calls 6 { }
test_struct_calls 7 { }
test_struct_calls 8 { }
test_struct_calls 9 { }
test_struct_calls 10 { }
test_struct_calls 11 { }
test_struct_calls 12 { }
test_struct_calls 13 { }
test_struct_calls 14 { }
test_struct_calls 15 { }
test_struct_calls 16 { }
test_struct_calls 17 { }
test_struct_returns 1 { }
test_struct_returns 2 { }
test_struct_returns 3 { powerpc-*-netbsd* }
test_struct_returns 4 { }
test_struct_returns 5 { powerpc-*-netbsd* }
test_struct_returns 6 { powerpc-*-netbsd* }
test_struct_returns 7 { powerpc-*-netbsd* }
test_struct_returns 8 { }

start_structs_test { ts}
test_struct_calls 1 { }
test_struct_calls 2 { }
test_struct_calls 3 { }
test_struct_calls 4 { }
test_struct_calls 5 { }
test_struct_returns 1 { }
test_struct_returns 2 { }
test_struct_returns 3 { powerpc-*-netbsd* }
test_struct_returns 4 { }

start_structs_test { ti }
test_struct_calls 1 { }
test_struct_calls 2 { }
test_struct_calls 3 { }
test_struct_returns 1 { }
test_struct_returns 2 { }

start_structs_test { tl }
test_struct_calls 1 { }
test_struct_calls 2 { }
test_struct_calls 3 { }
test_struct_returns 1 { }
test_struct_returns 2 { }

start_structs_test { tll }
test_struct_calls 1 { }
test_struct_calls 2 { }
test_struct_returns 1 { }

start_structs_test { tf }
test_struct_calls 1 { }
test_struct_calls 2 { }
test_struct_calls 3 { }
test_struct_returns 1 { }
test_struct_returns 2 { }

start_structs_test { td }
test_struct_calls 1 { }
test_struct_calls 2 { }
test_struct_returns 1 { }

start_structs_test { tld }
test_struct_calls 1 { }
test_struct_calls 2 { }
test_struct_returns 1 { }

start_structs_test { ts tc }
test_struct_calls 2 { }
test_struct_calls 3 { }
test_struct_calls 4 { }
test_struct_calls 5 { }
test_struct_calls 6 { }
test_struct_calls 7 { }
test_struct_calls 8 { }
test_struct_returns 2 { }

start_structs_test { ti tc }
test_struct_calls 2 { }
test_struct_calls 3 { }
test_struct_calls 4 { }
test_struct_calls 5 { }
test_struct_calls 6 { }
test_struct_returns 2 { }

start_structs_test { tl tc }
test_struct_calls 2 { }
test_struct_calls 3 { }
test_struct_calls 4 { }
test_struct_calls 5 { }
test_struct_calls 6 { }
test_struct_returns 2 { }

start_structs_test { tll tc }
test_struct_calls 2 { }

start_structs_test { tf tc }
test_struct_calls 2 { }
test_struct_calls 3 { }
test_struct_calls 4 { }
test_struct_calls 5 { }
test_struct_calls 6 { }
test_struct_returns 2 { }

start_structs_test { td tc }
test_struct_calls 2 { }

start_structs_test { tld tc }
test_struct_calls 2 { }

start_structs_test { tc ts }
test_struct_calls 2 { }
test_struct_calls 3 { }
test_struct_calls 4 { }
test_struct_calls 5 { }
test_struct_calls 6 { }
test_struct_returns 2 { }

start_structs_test { tc ti }
test_struct_calls 2 { }
test_struct_calls 3 { }
test_struct_calls 4 { }
test_struct_returns 2 { }

start_structs_test { tc tl }
test_struct_calls 2 { }
test_struct_calls 3 { }
test_struct_calls 4 { }
test_struct_returns 2 { }

start_structs_test { tc tll }
test_struct_calls 2 { }

start_structs_test { tc tf }
test_struct_calls 2 { }
test_struct_calls 3 { }
test_struct_calls 4 { }

start_structs_test { tc td }
test_struct_calls 2 { }

start_structs_test { tc tld }
test_struct_calls 2 { }

return 0