# Copyright (C) 1992 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

# This file was written by Fred Fish. (fnf@cygnus.com)

if $tracelevel then {
	strace $tracelevel
}

#
#  Cause gdb to lookup a specific C++ function and print the demangled
#  form.
#

proc info_func { regex demangled } {
    global prompt

    send "info function $regex\n"
    expect {
	-re "File .*:\r\n$demangled\r\n$prompt $" {
	    pass "info function for \"$regex\""
	}
	-re ".*$prompt $" {
	    fail "info function for \"$regex\""
	}
	timeout {
	    fail "info function for \"$regex\" (timeout)"
	}
    }
}

#
#  Run print &'$arg' on the input arg and verify that we can correctly
#  lookup the fully qualified C++ function.
#  We ignore the return type of the function since we are only interested
#  in the rootname and arguments part.
#

proc print_addr_of { arg } {
    global prompt
    global hex

    set pattern [string_to_regexp $arg]
    send "print &'$arg'\n"
    expect {
	-re ".* = .* $hex <$pattern>\r\n$prompt $" { pass "print &'$arg'" }
	-re ".*$prompt $" {
	    fail "print &'$arg'"
	}
	timeout {
	    fail "print &'$arg' (timeout)"
	}
    }
}

#
# Test name demangling for operators.
#
# The '(' at the end of each regex input pattern is so that we match only
# the one we are looking for.  I.E. "operator&" would match both
# "operator&(foo &)" and "operator&&(foo &)".
#

proc test_lookup_operator_functions {} {

    # These tests don't work for COFF targets; don't even try them
    if [istarget "a29k-*-udi"] then {
	setup_xfail "a29k-*-udi"
	fail "skipping operator tests"
	return
    }

    info_func "operator&&("  "void foo::operator&&\\(foo &\\);"
    info_func "operator&=("  "void foo::operator&=\\(foo &\\);"
    info_func "operator&("  "void foo::operator&\\(foo &\\);"
    info_func "operator/=("  "void foo::operator/=\\(foo &\\);"
    info_func "operator^=("  "void foo::operator.=\\(foo &\\);"
    info_func "operator<<=("  "void foo::operator<<=\\(foo &\\);"
    info_func "operator%=("  "void foo::operator%=\\(foo &\\);"
    info_func "operator-=("  "void foo::operator-=\\(foo &\\);"

    # There doesn't appear to be any way to get GDB to treat '*' as a
    # character to match, rather than as a regex special character.
    setup_xfail "*-*-*"
    info_func "operator\*=("  "void foo::operator\\*=\\(foo &\\);"

    info_func "operator|=("  "void foo::operator\\|=\\(foo &\\);"
    info_func "operator+=("  "void foo::operator.=\\(foo &\\);"
    info_func "operator>>=("  "void foo::operator\>\>=\\(foo &\\);"
    info_func "operator=("  "void foo::operator=\\(foo &\\);"
    info_func "operator()("  "void foo::operator\\(\\)\\(foo &\\);"

    # The function should be "operator," not "operator, ".  (note space)
    # This test will work; I've commented it out because it should not
    # count as a pass, since it is incorrect.  Ian Taylor.
    # info_func "operator, ("  "void foo::operator, \\(foo &\\);"
    setup_xfail "*-*-*"
    info_func "operator,("  "void foo::operator,\\(foo &\\);"

    info_func "operator~("  "void foo::operator~\\(void\\);"
    info_func "operator delete("  "void foo::operator delete\\(void \\*\\);"
    info_func "operator/("  "void foo::operator/\\(foo &\\);"
    info_func "operator==("  "void foo::operator==\\(foo &\\);"
    info_func "operator^("  "void foo::operator\\^\\(foo &\\);"

    info_func "operator>=("  "void foo::operator>=\\(foo &\\);"
    info_func "operator>("  "void foo::operator>\\(foo &\\);"
    info_func "operator<=("  "void foo::operator<=\\(foo &\\);"
    info_func "operator<<("  "void foo::operator<<\\(foo &\\);"
    info_func "operator<("  "void foo::operator<\\(foo &\\);"
    info_func "operator%("  "void foo::operator%\\(foo &\\);"
    info_func "operator-("  "void foo::operator-\\(foo &\\);"

    # There doesn't appear to be anyway to get '*' treated as a character
    # to match, rather than as a regex special character.
    setup_xfail "*-*-*"
    info_func "operator\*("  "void foo::operator\\*\\(foo &\\);"

    info_func "operator--("  "void foo::operator--\\(int\\);"
    info_func "operator!=("  "void foo::operator!=\\(foo &\\);"
    info_func "operator!("  "void foo::operator!\\(void\\);"
    info_func "operator new("  "void \\*foo::operator new\\(.*\\);"
    info_func "operator||("  "void foo::operator\\|\\|\\(foo &\\);"
    info_func "operator char \\*("  "char \\*foo::operator char \\*\\(void\\);"
    info_func "operator int("  "int foo::operator int\\(void\\);"
    info_func "operator|("  "void foo::operator\\|\\(foo &\\);"
    info_func "operator+("  "void foo::operator\\+\\(foo &\\);"
    info_func "operator++("  "void foo::operator\\+\\+\\(int\\);"
    info_func "operator->("  "void foo::operator->\\(void\\);"
    info_func "operator->\\*("  "void foo::operator->\\*\\(foo &\\);"
    info_func "operator>>("  "void foo::operator\>\>\\(foo &\\);"

    # GDB says "`operator \[\](' not supported".  I don't know why.
    setup_xfail "*-*-*"
    info_func "operator\\\[\\\](" "void foo::operator\\\[\\\]\\(foo &\\);"
    # But this works, for some reason.
    info_func ".perator\\\[\\\](" "void foo::operator\\\[\\\]\\(foo &\\);"
}


proc test_paddr_operator_functions {} {
    global hex

    print_addr_of "foo::operator&&(foo &)"
    print_addr_of "foo::operator&=(foo &)"
    print_addr_of "foo::operator&(foo &)"
    print_addr_of "foo::operator/=(foo &)"
    print_addr_of "foo::operator^=(foo &)"
    print_addr_of "foo::operator<<=(foo &)"
    print_addr_of "foo::operator%=(foo &)"
    print_addr_of "foo::operator-=(foo &)"
    print_addr_of "foo::operator*=(foo &)"
    print_addr_of "foo::operator|=(foo &)"
    print_addr_of "foo::operator+=(foo &)"
    print_addr_of "foo::operator>>=(foo &)"
    print_addr_of "foo::operator=(foo &)"
    print_addr_of "foo::operator()(foo &)"
    print_addr_of "foo::operator, (foo &)"
    print_addr_of "foo::operator~(void)"
    print_addr_of "foo::operator delete(void *)"
    print_addr_of "foo::operator/(foo &)"
    print_addr_of "foo::operator==(foo &)"
    print_addr_of "foo::operator^(foo &)"
    print_addr_of "foo::operator>=(foo &)"
    print_addr_of "foo::operator>(foo &)"
    print_addr_of "foo::operator<=(foo &)"
    print_addr_of "foo::operator<<(foo &)"
    print_addr_of "foo::operator<(foo &)"
    print_addr_of "foo::operator%(foo &)"
    print_addr_of "foo::operator-(foo &)"
    print_addr_of "foo::operator*(foo &)"
    print_addr_of "foo::operator--(int)"
    print_addr_of "foo::operator!=(foo &)"
    print_addr_of "foo::operator!(void)"
    gdb_test "print &'foo::operator new'" \
	" = .* $hex <foo::operator new\\(.*\\)>"
    print_addr_of "foo::operator||(foo &)"
    print_addr_of "foo::operator char *(void)"
    print_addr_of "foo::operator int(void)"
    print_addr_of "foo::operator|(foo &)"
    print_addr_of "foo::operator+(foo &)"
    print_addr_of "foo::operator++(int)"
    print_addr_of "foo::operator->(void)"
    print_addr_of "foo::operator->*(foo &)"
    print_addr_of "foo::operator>>(foo &)"
    gdb_test "print &'foo::operator\[\](foo &)'" \
	" = .*0x\[0-9a-f\]+ <foo::operator\\\[\\\]\\(foo &\\)>"
}

#
# Test overloaded functions (1 arg).
#

proc test_paddr_overloaded_functions {} {
    print_addr_of "overload1arg(signed char)"
    print_addr_of "overload1arg(unsigned char)"
    print_addr_of "overload1arg(unsigned int)"
    print_addr_of "overload1arg(unsigned long)"
    print_addr_of "overload1arg(unsigned short)"
    print_addr_of "overload1arg(char)"
    print_addr_of "overload1arg(double)"
    print_addr_of "overload1arg(float)"
    print_addr_of "overload1arg(int)"
    print_addr_of "overload1arg(long)"
    print_addr_of "overload1arg(short)"
    print_addr_of "overload1arg(void)"
    print_addr_of "overloadargs(int)"
    print_addr_of "overloadargs(int, int)"
    print_addr_of "overloadargs(int, int, int)"
    print_addr_of "overloadargs(int, int, int, int)"
    print_addr_of "overloadargs(int, int, int, int, int)"
    print_addr_of "overloadargs(int, int, int, int, int, int)"
    print_addr_of "overloadargs(int, int, int, int, int, int, int)"
    print_addr_of "overloadargs(int, int, int, int, int, int, int, int)"
    print_addr_of "overloadargs(int, int, int, int, int, int, int, int, int)"
    print_addr_of "overloadargs(int, int, int, int, int, int, int, int, int, int)"
    print_addr_of "overloadargs(int, int, int, int, int, int, int, int, int, int, int)"
}

proc test_paddr_hairy_functions {} {
    print_addr_of "hairyfunc1(int)"
    print_addr_of "hairyfunc2(int (*)(char *))"
    print_addr_of "hairyfunc3(int (*)(short (*)(long *)))"
    print_addr_of "hairyfunc4(int (*)(short (*)(char *)))"
    print_addr_of "hairyfunc5(int (*(*)(char *))(long))"
    print_addr_of "hairyfunc6(int (*(*)(int *))(long))"
    print_addr_of "hairyfunc7(int (*(*)(int (*)(char *)))(long))"
}

proc do_tests {} {
    global prms_id
    global bug_id
    global subdir
    global objdir
    global srcdir
    global binfile
    global prompt

    set prms_id 0
    set bug_id 0

    # Start with a fresh gdb.

    gdb_exit
    gdb_start
    gdb_reinitialize_dir $srcdir/$subdir
    gdb_load $objdir/$subdir/$binfile

    send "set language c++\n"
    expect -re "$prompt $"
    send "set width 0\n"
    expect -re "$prompt $"

    test_paddr_overloaded_functions
    test_paddr_operator_functions
    test_paddr_hairy_functions
    test_lookup_operator_functions
}

# Check to see if we have an executable to test.  If not, then either we
# haven't tried to compile one, or the compilation failed for some reason.
# In either case, just notify the user and skip the tests in this file.

set binfile "cplusfuncs"
set srcfile $binfile.cc

if ![file exists $objdir/$subdir/$binfile] then {
    warning "$binfile does not exist; tests suppressed."
} else {
    do_tests
}
