| # This file is part of ltrace. |
| # Copyright (C) 2012, 2013 Petr Machata, Red Hat Inc. |
| # Copyright (C) 2006 Yao Qi, IBM Corporation |
| # |
| # 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., 51 Franklin St, Fifth Floor, Boston, MA |
| # 02110-1301 USA |
| |
| # Generic ltrace test subroutines that should work for any target. If these |
| # need to be modified for any target, it can be done with a variable |
| # or by passing arguments. |
| |
| source $objdir/env.exp |
| |
| if [info exists TOOL_EXECUTABLE] { |
| set LTRACE $TOOL_EXECUTABLE |
| } else { |
| set LTRACE $objdir/../ltrace |
| } |
| |
| if {[info exists VALGRIND] && ![string equal $VALGRIND {}]} { |
| verbose "Running under valgrind command: `$VALGRIND'" |
| set LTRACE "$VALGRIND $LTRACE" |
| } |
| |
| set LTRACE_OPTIONS {} |
| set LTRACE_ARGS {} |
| set LTRACE_TEMP_FILES {} |
| |
| # Pre-8.5 TCL doesn't have lreverse. The following is taken from: |
| # http://www2.tcl.tk/17188 |
| |
| if {[info command lreverse] == ""} { |
| proc lreverse l { |
| set r {} |
| set i [llength $l] |
| while {[incr i -1]} {lappend r [lindex $l $i]} |
| lappend r [lindex $l 0] |
| } |
| } |
| |
| # ltrace_compile SOURCE DEST TYPE OPTIONS |
| # |
| # Compile PUT(program under test) by native compiler. ltrace_compile runs |
| # the right compiler, and TCL captures the output, and I evaluate the output. |
| # |
| # SOURCE is the name of program under test, with full directory. |
| # DEST is the name of output of compilation, with full directory. |
| # TYPE is an enum-like variable to affect the format or result of compiler |
| # output. Values: |
| # executable if output is an executable. |
| # object if output is an object. |
| # OPTIONS is option to compiler in this compilation. |
| proc ltrace_compile {source dest type options} { |
| global LTRACE_TESTCASE_OPTIONS; |
| |
| if {![string equal "object" $type]} { |
| # 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" |
| } 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${objdir}/${subdir}" |
| } elseif { [istarget "mips-sgi-irix*"] } { |
| lappend options "additional_flags=-rpath ${objdir}/${subdir}" |
| } |
| } |
| |
| } else { |
| lappend new_options $opt |
| } |
| } |
| |
| #end of for loop |
| set options $new_options |
| } |
| |
| # dump some information for debug purpose. |
| verbose "options are $options" |
| verbose "source is $source $dest $type $options" |
| |
| # Wipe the DEST file, so that we don't end up running an obsolete |
| # version of the binary. |
| exec rm -f $dest |
| |
| set result [target_compile $source $dest $type $options]; |
| verbose "result is $result" |
| regsub "\[\r\n\]*$" "$result" "" result; |
| regsub "^\[\r\n\]*" "$result" "" result; |
| if { $result != "" && [lsearch $options quiet] == -1} { |
| clone_output "compile failed for ltrace test, $result" |
| } |
| return $result; |
| } |
| |
| proc get_compiler_info {binfile args} { |
| # For compiler.c and compiler.cc |
| global srcdir |
| |
| # I am going to play with the log to keep noise out. |
| global outdir |
| global tool |
| |
| # These come from compiler.c or compiler.cc |
| global compiler_info |
| |
| # Legacy global data symbols. |
| #global gcc_compiled |
| |
| # Choose which file to preprocess. |
| set ifile "${srcdir}/lib/compiler.c" |
| if { [llength $args] > 0 && [lindex $args 0] == "c++" } { |
| set ifile "${srcdir}/lib/compiler.cc" |
| } |
| |
| # Run $ifile through the right preprocessor. |
| # Toggle ltrace.log to keep the compiler output out of the log. |
| #log_file |
| set cppout [ ltrace_compile "${ifile}" "" preprocess [list "$args" quiet] ] |
| #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 "get_compiler_info: $cppline" |
| set unknown 1 |
| } |
| } |
| |
| # Reset to unknown compiler if any diagnostics happened. |
| if { $unknown } { |
| set compiler_info "unknown" |
| } |
| return 0 |
| } |
| |
| proc test_compiler_info { {compiler ""} } { |
| global compiler_info |
| |
| if [string match "" $compiler] { |
| if [info exists compiler_info] { |
| verbose "compiler_info=$compiler_info" |
| # if no arg, return the compiler_info string |
| return $compiler_info |
| } else { |
| perror "No compiler info found." |
| } |
| } |
| |
| return [string match $compiler $compiler_info] |
| } |
| |
| proc ltrace_compile_shlib {sources dest options} { |
| set obj_options $options |
| verbose "+++++++ [test_compiler_info]" |
| switch -glob [test_compiler_info] { |
| "xlc-*" { |
| lappend obj_options "additional_flags=-qpic" |
| } |
| "gcc-*" { |
| if { !([istarget "powerpc*-*-aix*"] |
| || [istarget "rs6000*-*-aix*"]) } { |
| lappend obj_options "additional_flags=-fpic" |
| } |
| } |
| "xlc++-*" { |
| lappend obj_options "additional_flags=-qpic" |
| } |
| |
| default { |
| fail "Bad compiler!" |
| } |
| } |
| |
| if {![LtraceCompileObjects $sources $obj_options objects]} { |
| return -1 |
| } |
| |
| set link_options $options |
| if { [test_compiler_info "xlc-*"] || [test_compiler_info "xlc++-*"]} { |
| lappend link_options "additional_flags=-qmkshrobj" |
| } else { |
| lappend link_options "additional_flags=-shared" |
| } |
| if {[ltrace_compile "${objects}" "${dest}" executable $link_options] != ""} { |
| return -1 |
| } |
| |
| return |
| } |
| |
| # WipeFiles -- |
| # |
| # Delete each file in the list. |
| # |
| # Arguments: |
| # files List of files to delete. |
| # |
| # Results: |
| # Each of the files is deleted. Files are deleted in reverse |
| # order, so that directories are emptied and can be deleted |
| # without using -force. Returns nothing. |
| |
| proc WipeFiles {files} { |
| verbose "WipeFiles: $files\n" |
| foreach f [lreverse $files] { |
| file delete $f |
| } |
| } |
| |
| # LtraceTmpDir -- |
| # |
| # Guess what directory to use for temporary files. |
| # This was adapted from http://wiki.tcl.tk/772 |
| # |
| # Results: |
| # A temporary directory to use. The current directory if no |
| # other seems to be available. |
| |
| proc LtraceTmpDir {} { |
| set tmpdir [pwd] |
| |
| if {[file exists "/tmp"]} { |
| set tmpdir "/tmp" |
| } |
| |
| catch {set tmpdir $::env(TMP)} |
| catch {set tmpdir $::env(TEMP)} |
| catch {set tmpdir $::env(TMPDIR)} |
| |
| return $tmpdir |
| } |
| |
| set LTRACE_TEMP_DIR [LtraceTmpDir] |
| |
| # LtraceTempFile -- |
| # |
| # Create a temporary file according to a pattern, and return its |
| # name. This behaves similar to mktemp. We don't use mktemp |
| # directly, because on older systems, mktemp requires that the |
| # array of X's be at the very end of the string, while ltrace |
| # temporary files need to have suffixes. |
| # |
| # Arguments: |
| # pat Pattern to use. See mktemp for description of its format. |
| # |
| # Results: |
| # Creates the temporary file and returns its name. The name is |
| # also appended to LTRACE_TEMP_FILES. |
| |
| proc LtraceTempFile {pat} { |
| global LTRACE_TEMP_FILES |
| global LTRACE_TEMP_DIR |
| |
| set letters "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" |
| set numLetters [string length $letters] |
| |
| if {![regexp -indices {(X{3,})} $pat m]} { |
| send_error -- "Pattern $pat contains insufficient number of X's." |
| return {} |
| } |
| |
| set start [lindex $m 0] |
| set end [lindex $m 1] |
| set len [expr {$end - $start + 1}] |
| |
| for {set j 0} {$j < 10} {incr j} { |
| |
| # First, generate a random name. |
| |
| set randstr {} |
| for {set i 0} {$i < $len} {incr i} { |
| set r [expr {int(rand() * $numLetters)}] |
| append randstr [string index $letters $r] |
| } |
| set prefix [string range $pat 0 [expr {$start - 1}]] |
| set suffix [string range $pat [expr {$end + 1}] end] |
| set name [file join $LTRACE_TEMP_DIR "$prefix$randstr$suffix"] |
| |
| # Now check that it's free. This is of course racy, but this |
| # is a test suite, not anything used in actual production. |
| |
| if {[file exists $name]} { |
| continue |
| } |
| |
| # We don't bother attempting to open the file. Downstream |
| # code can do it itself. |
| |
| lappend LTRACE_TEMP_FILES $name |
| return $name |
| } |
| |
| send_error -- "Couldn't create a temporary file for pattern $pat." |
| return |
| } |
| |
| # ltraceNamedSource -- |
| # |
| # Create a file named FILENAME, and prime it with TEXT. If |
| # REMEMBERTEMP, add the file into LTRACE_TEMP_FILES, so that |
| # ltraceDone (or rather WipeFiles) erases it later. |
| # |
| # Arguments: |
| # filename Name of the file to create. |
| # |
| # text Contents of the new file. |
| # |
| # rememberTemp Whether to add filename to LTRACE_TEMP_FILES. |
| # |
| # Results: |
| # Returns $filename, which now refers to a file with contents |
| # given by TEXT. |
| |
| proc ltraceNamedSource {filename text {rememberTemp 1}} { |
| global LTRACE_TEMP_FILES |
| |
| set chan [open $filename w] |
| puts $chan $text |
| close $chan |
| |
| if $rememberTemp { |
| lappend LTRACE_TEMP_FILES $filename |
| } |
| |
| return $filename |
| } |
| |
| # ltraceSource -- |
| # |
| # Create a temporary file with a given suffix and prime it with |
| # contents given in text. |
| # |
| # Arguments: |
| # suffix Suffix of the temp file to be created. |
| # |
| # text Contents of the new file. |
| # |
| # Results: |
| # Returns file name of created file. |
| |
| proc ltraceSource {suffix text} { |
| return [ltraceNamedSource \ |
| [LtraceTempFile "lt-XXXXXXXXXX.$suffix"] $text 0] |
| } |
| |
| # ltraceDir -- |
| # |
| # Create a temporary directory. |
| # |
| # Arguments: |
| # |
| # Results: |
| # Returns name of created directory. |
| |
| proc ltraceDir {} { |
| set ret [LtraceTempFile "lt-XXXXXXXXXX.dir"] |
| file mkdir $ret |
| return $ret |
| } |
| |
| # LtraceCompileObjects -- |
| # |
| # Compile each source file into an object file. ltrace_compile |
| # is called to perform actual compilation. |
| # |
| # Arguments: |
| # sources List of source files. |
| # |
| # options Options for ltrace_compile. |
| # |
| # retName Variable where the resulting list of object names is |
| # to be placed. |
| # Results: |
| # Returns true or false depending on whether there were any |
| # errors. If it returns true, then variable referenced by |
| # retName contains list of object files, produced by compiling |
| # files in sources list. |
| |
| proc LtraceCompileObjects {sources options retName} { |
| global LTRACE_TEMP_FILES |
| upvar $retName ret |
| set ret {} |
| |
| foreach source $sources { |
| set sourcebase [file tail $source] |
| set dest $source.o |
| lappend LTRACE_TEMP_FILES $dest |
| verbose "LtraceCompileObjects: $source -> $dest" |
| if {[ltrace_compile $source $dest object $options] != ""} { |
| return false |
| } |
| lappend ret $dest |
| } |
| |
| return true |
| } |
| |
| # ltraceCompile -- |
| # |
| # This attempts to compile a binary from sources given in ARGS. |
| # |
| # Arguments: |
| # dest A binary to be produced. If this is called lib*.so, then |
| # the resulting binary will be a library, if *.pie, it |
| # will be a PIE, otherwise it will be an executable. In |
| # theory this could also be *.o for "object" and *.i for |
| # "preprocess" for cases with one source file, but that |
| # is not supported at the moment. The binary will be |
| # placed in $objdir/$subdir. |
| # |
| # args List of options and source files. |
| # |
| # Options are arguments that start with a dash. Options |
| # (sans the dash) are passed to ltrace_compile. |
| # |
| # Source files named lib*.so are libraries. Those are |
| # passed to ltrace_compile as options shlib=X. Source |
| # files named *.o are objects. The remaining source |
| # files are first compiled (by LtraceCompileObjects) and |
| # then together with other objects passed to |
| # ltrace_compile to produce resulting binary. |
| # |
| # Any argument that is empty string prompts the function |
| # to fail. This is done so that errors caused by |
| # ltraceSource (or similar) distribute naturally |
| # upwards. |
| # |
| # Results: |
| # This compiles given source files into a binary. Full file name |
| # of that binary is returned. Empty string is returned in case |
| # of a failure. |
| |
| proc ltraceCompile {dest args} { |
| global objdir |
| global subdir |
| |
| get_compiler_info {} c |
| get_compiler_info {} c++ |
| |
| if {[string match "lib*.so" $dest]} { |
| set type "library" |
| set extraObjOptions "additional_flags=-fpic" |
| set extraOptions "additional_flags=-shared" |
| } elseif {[string match "*.pie" $dest]} { |
| set type "executable" |
| set extraObjOptions "additional_flags=-fpic" |
| set extraOptions "additional_flags=-pie" |
| } else { |
| set type "executable" |
| set extraObjOptions {} |
| set extraOptions {} |
| } |
| |
| set options {} |
| set sources {} |
| set objects {} |
| foreach a $args { |
| if {[string match "-l*" $a]} { |
| lappend options "shlib=$a" |
| } elseif {[string match "-?*" $a]} { |
| lappend options [string range $a 1 end] |
| } elseif {[string match "*.so" $a]} { |
| lappend options "shlib=$a" |
| } elseif {[string match "*.o" $a]} { |
| lappend objects $a |
| } else { |
| lappend sources $a |
| } |
| } |
| |
| if {[string equal $dest {}]} { |
| set dest [LtraceTempFile "exe-XXXXXXXXXX"] |
| } elseif {[string equal $dest ".pie"]} { |
| set dest [LtraceTempFile "pie-XXXXXXXXXX"] |
| } else { |
| set dest $objdir/$subdir/$dest |
| } |
| |
| verbose "ltraceCompile: dest $dest" |
| verbose " : options $options" |
| verbose " : sources $sources" |
| verbose " : objects $objects" |
| |
| if {![LtraceCompileObjects $sources \ |
| [concat $options $extraObjOptions] newObjects]} { |
| return {} |
| } |
| set objects [concat $objects $newObjects] |
| |
| verbose "ltraceCompile: objects $objects" |
| |
| if {[ltrace_compile $objects $dest $type \ |
| [concat $options $extraOptions]] != ""} { |
| return {} |
| } |
| |
| return $dest |
| } |
| |
| # ltraceRun -- |
| # |
| # Invoke command identified by LTRACE global variable with given |
| # ARGS. A logfile redirection is automatically ordered by |
| # passing -o and a temporary file name. |
| # |
| # Arguments: |
| # args Arguments to ltrace binary. |
| # |
| # Results: |
| # Returns name of logfile. The "exec" command that it uses |
| # under the hood fails loudly if the process exits with a |
| # non-zero exit status, or uses stderr in any way. |
| |
| proc ltraceRun {args} { |
| global LTRACE |
| global objdir |
| global subdir |
| |
| set LdPath [ld_library_path $objdir/$subdir] |
| set logfile [ltraceSource ltrace {}] |
| |
| # Run ltrace. expect will show an error if this doesn't exit with |
| # zero exit status (i.e. ltrace fails, valgrind finds errors, |
| # etc.). |
| |
| set command "exec env LD_LIBRARY_PATH=$LdPath $LTRACE -o $logfile $args" |
| verbose $command |
| if {[catch {eval $command}] } { |
| fail "test case execution failed" |
| send_error -- $command |
| send_error -- $::errorInfo |
| } |
| |
| return $logfile |
| } |
| |
| # ltraceDone -- |
| # |
| # Wipes or dumps all temporary files after a test suite has |
| # finished. |
| # |
| # Results: |
| # Doesn't return anything. Wipes all files gathered in |
| # LTRACE_TEMP_FILES. If SAVE_TEMPS is defined and true, the |
| # temporary files are not wiped, but their names are dumped |
| # instead. Contents of LTRACE_TEMP_FILES are deleted in any |
| # case. |
| |
| proc ltraceDone {} { |
| global SAVE_TEMPS |
| global LTRACE_TEMP_FILES |
| |
| if {[info exists SAVE_TEMPS] && $SAVE_TEMPS} { |
| foreach tmp $LTRACE_TEMP_FILES { |
| send_user "$tmp\n" |
| } |
| } else { |
| WipeFiles $LTRACE_TEMP_FILES |
| } |
| |
| set LTRACE_TEMP_FILES {} |
| return |
| } |
| |
| # Grep -- |
| # |
| # Return number of lines in a given file, matching a given |
| # regular expression. |
| # |
| # Arguments: |
| # logfile File to search through. |
| # |
| # re Regular expression to match. |
| # |
| # Results: |
| # Returns number of matching lines. |
| |
| proc Grep {logfile re} { |
| set count 0 |
| set fp [open $logfile] |
| while {[gets $fp line] >= 0} { |
| if [regexp -- $re $line] { |
| incr count |
| } |
| } |
| close $fp |
| return $count |
| } |
| |
| # ltraceMatch1 -- |
| # |
| # Look for a pattern in a given logfile, comparing number of |
| # occurences of the pattern with expectation. |
| # |
| # Arguments: |
| # logfile The name of file where to look for patterns. |
| # |
| # pattern Regular expression pattern to look for. |
| # |
| # op Operator to compare number of occurences. |
| # |
| # expect Second operand to op, the first being number of |
| # occurences of pattern. |
| # |
| # Results: |
| # Doesn't return anything, but calls fail or pass depending on |
| # whether the patterns matches expectation. |
| |
| proc ltraceMatch1 {logfile pattern {op ==} {expect 1}} { |
| set count [Grep $logfile $pattern] |
| set msgMain "$pattern appears in $logfile $count times" |
| set msgExpect ", expected $op $expect" |
| |
| if {[eval expr $count $op $expect]} { |
| pass $msgMain |
| } else { |
| fail $msgMain$msgExpect |
| } |
| return |
| } |
| |
| # ltraceMatch -- |
| # |
| # Look for series of patterns in a given logfile, comparing |
| # number of occurences of each pattern with expectations. |
| # |
| # Arguments: |
| # logfile The name of file where to look for patterns. |
| # |
| # patterns List of patterns to look for. ltraceMatch1 is called |
| # on each of these in turn. |
| # |
| # Results: |
| # |
| # Doesn't return anything, but calls fail or pass depending on |
| # whether each of the patterns holds. |
| |
| proc ltraceMatch {logfile patterns} { |
| foreach pat $patterns { |
| eval ltraceMatch1 [linsert $pat 0 $logfile] |
| } |
| return |
| } |
| |
| # ltraceLibTest -- |
| # |
| # Generate a binary, a library (liblib.so) and a config file. |
| # Run the binary using ltraceRun, passing it -F to load the |
| # config file. |
| # |
| # Arguments: |
| # conf Contents of ltrace config file. |
| # |
| # cdecl Contents of header file. |
| # |
| # libcode Contents of library implementation file. |
| # |
| # maincode Contents of function "main". |
| # |
| # params Additional parameters to pass to ltraceRun. |
| # |
| # Results: |
| # |
| # Returns whatever ltraceRun returns. |
| |
| proc ltraceLibTest {conf cdecl libcode maincode {params ""}} { |
| set conffile [ltraceSource conf $conf] |
| set lib [ltraceCompile liblib.so [ltraceSource c [concat $cdecl $libcode]]] |
| set bin [ltraceCompile {} $lib \ |
| [ltraceSource c \ |
| [concat $cdecl "int main(void) {" $maincode "}"]]] |
| |
| return [eval [concat "ltraceRun -F $conffile " $params "-- $bin"]] |
| } |
| |
| # |
| # ltrace_options OPTIONS_LIST |
| # Pass ltrace commandline options. |
| # |
| proc ltrace_options { args } { |
| |
| global LTRACE_OPTIONS |
| set LTRACE_OPTIONS $args |
| } |
| |
| # |
| # ltrace_args ARGS_LIST |
| # Pass ltrace'd program its own commandline options. |
| # |
| proc ltrace_args { args } { |
| |
| global LTRACE_ARGS |
| set LTRACE_ARGS $args |
| } |
| |
| # |
| # handle run-time library paths |
| # |
| proc ld_library_path { args } { |
| |
| set ALL_LIBRARY_PATHS { } |
| if [info exists LD_LIBRARY_PATH] { |
| lappend ALL_LIBRARY_PATHS $LD_LIBRARY_PATH |
| } |
| global libelf_LD_LIBRARY_PATH |
| if {[string length $libelf_LD_LIBRARY_PATH] > 0} { |
| lappend ALL_LIBRARY_PATHS $libelf_LD_LIBRARY_PATH |
| } |
| global elfutils_LD_LIBRARY_PATH |
| if {[string length $elfutils_LD_LIBRARY_PATH] > 0} { |
| lappend ALL_LIBRARY_PATHS $elfutils_LD_LIBRARY_PATH |
| } |
| global libunwind_LD_LIBRARY_PATH |
| if {[string length $libunwind_LD_LIBRARY_PATH] > 0} { |
| lappend ALL_LIBRARY_PATHS $libunwind_LD_LIBRARY_PATH |
| } |
| lappend ALL_LIBRARY_PATHS $args |
| join $ALL_LIBRARY_PATHS ":" |
| } |
| |
| # |
| # ltrace_runtest LD_LIBRARY_PATH BIN FILE |
| # Trace the execution of BIN and return result. |
| # |
| # BIN is program-under-test. |
| # LD_LIBRARY_PATH is the env for program-under-test to run. |
| # FILE is to save the output from ltrace with default name $BIN.ltrace. |
| # Retrun output from ltrace. |
| # |
| proc ltrace_runtest { args } { |
| |
| global LTRACE |
| global LTRACE_OPTIONS |
| global LTRACE_ARGS |
| |
| verbose "LTRACE = $LTRACE" |
| |
| set LD_LIBRARY_PATH_ [ld_library_path [lindex $args 0]] |
| set BIN [lindex $args 1] |
| |
| # specify the output file, the default one is $BIN.ltrace |
| if [llength $args]==3 then { |
| set file [lindex $args 2] |
| } else { |
| set file $BIN.ltrace |
| } |
| |
| # Remove the file first. If ltrace fails to overwrite it, we |
| # would be comparing output to an obsolete run. |
| exec rm -f $file |
| |
| # append this option to LTRACE_OPTIONS. |
| lappend LTRACE_OPTIONS "-o" |
| lappend LTRACE_OPTIONS "$file" |
| verbose "LTRACE_OPTIONS = $LTRACE_OPTIONS" |
| set command "exec sh -c {export LD_LIBRARY_PATH=$LD_LIBRARY_PATH_; \ |
| $LTRACE $LTRACE_OPTIONS $BIN $LTRACE_ARGS;exit}" |
| #ltrace the PUT. |
| if {[catch $command output]} { |
| fail "test case execution failed" |
| send_error -- $command |
| send_error -- $::errorInfo |
| } |
| |
| # return output from ltrace. |
| return $output |
| } |
| |
| # |
| # ltrace_verify_output FILE_TO_SEARCH PATTERN MAX_LINE |
| # Verify the ltrace output by comparing the number of PATTERN in |
| # FILE_TO_SEARCH with INSTANCE_NO. Do not specify INSTANCE_NO if |
| # instance number is ignored in this test. |
| # Reutrn: |
| # 0 = number of PATTERN in FILE_TO_SEARCH inqual to INSTANCE_NO. |
| # 1 = number of PATTERN in FILE_TO_SEARCH qual to INSTANCE_NO. |
| # |
| proc ltrace_verify_output { file_to_search pattern {instance_no 0} {grep_command "grep"}} { |
| |
| # compute the number of PATTERN in FILE_TO_SEARCH by grep and wc. |
| catch "exec sh -c {$grep_command \"$pattern\" $file_to_search | wc -l ;exit}" output |
| verbose "output = $output" |
| |
| if [ regexp "syntax error" $output ] then { |
| fail "Invalid regular expression $pattern" |
| } elseif { $instance_no == 0 } then { |
| if { $output == 0 } then { |
| fail "Fail to find $pattern in $file_to_search" |
| } else { |
| pass "$pattern in $file_to_search" |
| } |
| } elseif { $output >= $instance_no } then { |
| pass "$pattern in $file_to_search for $output times" |
| } else { |
| fail "$pattern in $file_to_search for $output times, should be $instance_no" |
| } |
| } |