gdb.exp

gdb-6.8 Linux下的调试程序 最新版本

    log_file -a "$outdir/$tool.log" 

    # Eval the output.
    set unknown 0
    foreach cppline [ split "$cppout" "\n" ] {
	if { [ regexp "^#" "$cppline" ] } {
	    # line marker
	} elseif { [ regexp "^\[\n\r\t \]*$" "$cppline" ] } {
	    # blank line
	} elseif { [ regexp "^\[\n\r\t \]*set\[\n\r\t \]" "$cppline" ] } {
	    # eval this line
	    verbose "get_compiler_info: $cppline" 2
	    eval "$cppline"
	} else {
	    # unknown line
	    verbose -log "get_compiler_info: $cppline"
	    set unknown 1
	}
    }

    # Reset to unknown compiler if any diagnostics happened.
    if { $unknown } {
	set compiler_info "unknown"
    }

    # Set the legacy symbols.
    set gcc_compiled     0
    set hp_cc_compiler   0
    set hp_aCC_compiler  0
    if { [regexp "^gcc-1-" "$compiler_info" ] } { set gcc_compiled 1 }
    if { [regexp "^gcc-2-" "$compiler_info" ] } { set gcc_compiled 2 }
    if { [regexp "^gcc-3-" "$compiler_info" ] } { set gcc_compiled 3 }
    if { [regexp "^gcc-4-" "$compiler_info" ] } { set gcc_compiled 4 }
    if { [regexp "^gcc-5-" "$compiler_info" ] } { set gcc_compiled 5 }
    if { [regexp "^hpcc-"  "$compiler_info" ] } { set hp_cc_compiler 1 }
    if { [regexp "^hpacc-" "$compiler_info" ] } { set hp_aCC_compiler 1 }

    # Log what happened.
    verbose -log "get_compiler_info: $compiler_info"

    # Most compilers will evaluate comparisons and other boolean
    # operations to 0 or 1.
    uplevel \#0 { set true 1 }
    uplevel \#0 { set false 0 }

    # Use of aCC results in boolean results being displayed as
    # "true" or "false"
    if { $hp_aCC_compiler } {
      uplevel \#0 { set true true }
      uplevel \#0 { set false false }
    }

    return 0;
}

proc test_compiler_info { {compiler ""} } {
    global compiler_info

     # if no arg, return the compiler_info string

     if [string match "" $compiler] {
         if [info exists compiler_info] {
             return $compiler_info
         } else {
             perror "No compiler info found."
         }
     }

    return [string match $compiler $compiler_info]
}

set gdb_wrapper_initialized 0

proc gdb_wrapper_init { args } {
    global gdb_wrapper_initialized;
    global gdb_wrapper_file;
    global gdb_wrapper_flags;

    if { $gdb_wrapper_initialized == 1 } { return; }

    if {[target_info exists needs_status_wrapper] && \
	    [target_info needs_status_wrapper] != "0"} {
	set result [build_wrapper "testglue.o"];
	if { $result != "" } {
	    set gdb_wrapper_file [lindex $result 0];
	    set gdb_wrapper_flags [lindex $result 1];
	} else {
	    warning "Status wrapper failed to build."
	}
    }
    set gdb_wrapper_initialized 1
}

proc gdb_compile {source dest type options} {
    global GDB_TESTCASE_OPTIONS;
    global gdb_wrapper_file;
    global gdb_wrapper_flags;
    global gdb_wrapper_initialized;

    set outdir [file dirname $dest]

    # Add platform-specific options if a shared library was specified using
    # "shlib=librarypath" in OPTIONS.
    set new_options ""
    set shlib_found 0
    foreach opt $options {
        if [regexp {^shlib=(.*)} $opt dummy_var shlib_name] {
            if [test_compiler_info "xlc-*"] {
		# IBM xlc compiler doesn't accept shared library named other
		# than .so: use "-Wl," to bypass this
		lappend source "-Wl,$shlib_name"
	    } elseif { ([istarget "*-*-mingw*"]
			|| [istarget *-*-cygwin*]
			|| [istarget *-*-pe*])} {
		lappend source "${shlib_name}.a"
            } else {
               lappend source $shlib_name
            }
            if {$shlib_found == 0} {
                set shlib_found 1
                if { ([test_compiler_info "gcc-*"]
                      &&  ([istarget "powerpc*-*-aix*"]
                        || [istarget "rs6000*-*-aix*"] )) } {
                    lappend options "additional_flags=-L${outdir}"
                } elseif { [istarget "mips-sgi-irix*"] } {
                    lappend options "additional_flags=-rpath ${outdir}"
                }
            }
	} elseif { $opt == "shlib_load" } {
	    if { ([istarget "*-*-mingw*"]
		  || [istarget *-*-cygwin*]
		  || [istarget *-*-pe*]
		  || [istarget arm*-*-symbianelf*]
		  || [istarget hppa*-*-hpux*])} {
		# Do not need anything.
	    } elseif { [istarget *-*-openbsd*] } {
		lappend new_options "additional_flags=-Wl,-rpath,${outdir}"
	    } else {
		lappend new_options "libs=-ldl"
		lappend new_options "additional_flags=-Wl,-rpath,\\\$ORIGIN"
	    }
        } else {
            lappend new_options $opt
        }
    }
    set options $new_options

    if [target_info exists gdb_stub] {
	set options2 { "additional_flags=-Dusestubs" }
	lappend options "libs=[target_info gdb_stub]";
	set options [concat $options2 $options]
    }
    if [target_info exists is_vxworks] {
	set options2 { "additional_flags=-Dvxworks" }
	lappend options "libs=[target_info gdb_stub]";
	set options [concat $options2 $options]
    }
    if [info exists GDB_TESTCASE_OPTIONS] {
	lappend options "additional_flags=$GDB_TESTCASE_OPTIONS";
    }
    verbose "options are $options"
    verbose "source is $source $dest $type $options"

    if { $gdb_wrapper_initialized == 0 } { gdb_wrapper_init }

    if {[target_info exists needs_status_wrapper] && \
	    [target_info needs_status_wrapper] != "0" && \
	    [info exists gdb_wrapper_file]} {
	lappend options "libs=${gdb_wrapper_file}"
	lappend options "ldflags=${gdb_wrapper_flags}"
    }

    # Replace the "nowarnings" option with the appropriate additional_flags
    # to disable compiler warnings.
    set nowarnings [lsearch -exact $options nowarnings]
    if {$nowarnings != -1} {
	if [target_info exists gdb,nowarnings_flag] {
	    set flag "additional_flags=[target_info gdb,nowarnings_flag]"
	} else {
	    set flag "additional_flags=-w"
	}
	set options [lreplace $options $nowarnings $nowarnings $flag]
    }

    set result [target_compile $source $dest $type $options];

    # Prune uninteresting compiler (and linker) output.
    regsub "Creating library file: \[^\r\n\]*\[\r\n\]+" $result "" result

    regsub "\[\r\n\]*$" "$result" "" result;
    regsub "^\[\r\n\]*" "$result" "" result;

    if { $result != "" && [lsearch $options quiet] == -1} {
	clone_output "gdb compile failed, $result"
    }
    return $result;
}


# This is just like gdb_compile, above, except that it tries compiling
# against several different thread libraries, to see which one this
# system has.
proc gdb_compile_pthreads {source dest type options} {
    set built_binfile 0
    set why_msg "unrecognized error"
    foreach lib {-lpthreads -lpthread -lthread} {
        # This kind of wipes out whatever libs the caller may have
        # set.  Or maybe theirs will override ours.  How infelicitous.
        set options_with_lib [concat $options [list libs=$lib quiet]]
        set ccout [gdb_compile $source $dest $type $options_with_lib]
        switch -regexp -- $ccout {
            ".*no posix threads support.*" {
                set why_msg "missing threads include file"
                break
            }
            ".*cannot open -lpthread.*" {
                set why_msg "missing runtime threads library"
            }
            ".*Can't find library for -lpthread.*" {
                set why_msg "missing runtime threads library"
            }
            {^$} {
                pass "successfully compiled posix threads test case"
                set built_binfile 1
                break
            }
        }
    }
    if {!$built_binfile} {
        unsupported "Couldn't compile $source: ${why_msg}"
        return -1
    }
}

# Build a shared library from SOURCES.  You must use get_compiler_info
# first.

proc gdb_compile_shlib {sources dest options} {
    set obj_options $options

    switch -glob [test_compiler_info] {
        "xlc-*" {
            lappend obj_options "additional_flags=-qpic"
        }
        "gcc-*" {
            if { !([istarget "powerpc*-*-aix*"]
                   || [istarget "rs6000*-*-aix*"]
                   || [istarget "*-*-cygwin*"]
                   || [istarget "*-*-mingw*"]
                   || [istarget "*-*-pe*"]) } {
                lappend obj_options "additional_flags=-fpic"
            }
        }
        default {
            switch -glob [istarget] {
                "hppa*-hp-hpux*" {
                    lappend obj_options "additional_flags=+z"
                }
                "mips-sgi-irix*" {
                    # Disable SGI compiler's implicit -Dsgi
                    lappend obj_options "additional_flags=-Usgi"
                } 
                default {
                    # don't know what the compiler is...
                }
            }
        }
    }

    set outdir [file dirname $dest]
    set objects ""
    foreach source $sources {
       set sourcebase [file tail $source]
       if {[gdb_compile $source "${outdir}/${sourcebase}.o" object $obj_options] != ""} {
           return -1
       }
       lappend objects ${outdir}/${sourcebase}.o
    }

    if [istarget "hppa*-*-hpux*"] {
       remote_exec build "ld -b ${objects} -o ${dest}"
    } else {
       set link_options $options
       if [test_compiler_info "xlc-*"] {
          lappend link_options "additional_flags=-qmkshrobj"
       } else {
          lappend link_options "additional_flags=-shared"

	   if { ([istarget "*-*-mingw*"]
		 || [istarget *-*-cygwin*]
		 || [istarget *-*-pe*])} {
	       lappend link_options "additional_flags=-Wl,--out-implib,${dest}.a"
	   }
       }
       if {[gdb_compile "${objects}" "${dest}" executable $link_options] != ""} {
           return -1
       }
    }
}

# This is just like gdb_compile_pthreads, above, except that we always add the
# objc library for compiling Objective-C programs
proc gdb_compile_objc {source dest type options} {
    set built_binfile 0
    set why_msg "unrecognized error"
    foreach lib {-lobjc -lpthreads -lpthread -lthread solaris} {
        # This kind of wipes out whatever libs the caller may have
        # set.  Or maybe theirs will override ours.  How infelicitous.
        if { $lib == "solaris" } {
            set lib "-lpthread -lposix4"
	}
        if { $lib != "-lobjc" } {
	  set lib "-lobjc $lib"
	}
        set options_with_lib [concat $options [list libs=$lib quiet]]
        set ccout [gdb_compile $source $dest $type $options_with_lib]
        switch -regexp -- $ccout {
            ".*no posix threads support.*" {
                set why_msg "missing threads include file"
                break
            }
            ".*cannot open -lpthread.*" {
                set why_msg "missing runtime threads library"
            }
            ".*Can't find library for -lpthread.*" {
                set why_msg "missing runtime threads library"
            }
            {^$} {
                pass "successfully compiled objc with posix threads test case"
                set built_binfile 1
                break
            }
        }
    }
    if {!$built_binfile} {
        unsupported "Couldn't compile $source: ${why_msg}"
        return -1
    }
}

proc send_gdb { string } {
    global suppress_flag;
    if { $suppress_flag } {
	return "suppressed";
    }
    return [remote_send host "$string"];
}

#
#

proc gdb_expect { args } {
    if { [llength $args] == 2  && [lindex $args 0] != "-re" } {
	set gtimeout [lindex $args 0];
	set expcode [list [lindex $args 1]];
    } else {
	upvar timeout timeout;

	set expcode $args;
	if [target_info exists gdb,timeout] {
	    if [info exists timeout] {
		if { $timeout < [target_info gdb,timeout] } {
		    set gtimeout [target_info gdb,timeout];
		} else {
		    set gtimeout $timeout;
		}
	    } else {
		set gtimeout [target_info gdb,timeout];
	    }
	}

	if ![info exists gtimeout] {
	    global timeout;
	    if [info exists timeout] {
		set gtimeout $timeout;
	    } else {
		# Eeeeew.
		set gtimeout 60;
	    }
	}
    }
    global suppress_flag;
    global remote_suppress_flag;
    if [info exists remote_suppress_flag] {
	set old_val $remote_suppress_flag;
    }
    if [info exists suppress_flag] {
	if { $suppress_flag } {
	    set remote_suppress_flag 1;
	}
    }
    set code [catch \
	{uplevel remote_expect host $gtimeout $expcode} string];
    if [info exists old_val] {
	set remote_suppress_flag $old_val;
    } else {
	if [info exists remote_suppress_flag] {
	    unset remote_suppress_flag;
	}
    }

    if {$code == 1} {
        global errorInfo errorCode;

	return -code error -errorinfo $errorInfo -errorcode $errorCode $string
    } elseif {$code == 2} {
	return -code return $string
    } elseif {$code == 3} {
	return
    } elseif {$code > 4} {
	return -code $code $string
    }
}

# gdb_expect_list MESSAGE SENTINEL LIST -- expect a sequence of outputs
#
# Check for long sequence of output by parts.
# MESSAGE: is the test message to be printed with the test success/fail.
# SENTINEL: Is the terminal pattern indicating that output has finished.
# LIST: is the sequence of outputs to match.
# If the sentinel is recognized early, it is considered an error.
#
# Returns:
#    1 if the test failed,
#    0 if the test passes,
#   -1 if there was an internal error.
#
proc gdb_expect_list {test sentinel list} {
    global gdb_prompt
    global suppress_flag
    set index 0
    set ok 1
    if { $suppress_flag } {
	set ok 0
	unresolved "${test}"
    }
    while { ${index} < [llength ${list}] } {
	set pattern [lindex ${list} ${index}]
        set index [expr ${index} + 1]
	if { ${index} == [llength ${list}] } {
	    if { ${ok} } {
		gdb_expect {
		    -re "${pattern}${sentinel}" {
			# pass "${test}, pattern ${index} + sentinel"
		    }
		    -re "${sentinel}" {
			fail "${test} (pattern ${index} + sentinel)"
			set ok 0
		    }
		    -re ".*A problem internal to GDB has been detected" {
			fail "${test} (GDB internal error)"
			set ok 0
			gdb_internal_error_resync
		    }
		    timeout {
			fail "${test} (pattern ${index} + sentinel) (timeout)"
			set ok 0
		    }
		}
	    } else {
		# unresolved "${test}, pattern ${index} + sentinel"
	    }
	} else {
	    if { ${ok} } {
		gdb_expect {
		    -re "${pattern}" {
			# pass "${test}, pattern ${index}"
		    }
		    -re "${sentinel}" {
			fail "${test} (pattern ${index})"
			set ok 0
		    }
		    -re ".*A problem internal to GDB has been detected" {
			fail "${test} (GDB internal error)"
			set ok 0