833 lines
22 KiB
Text
833 lines
22 KiB
Text
# 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"
|
|
}
|
|
}
|