ltrace.exp revision da7f3c67d075ee47cfd092dcb73362b0cb1ce4d3
1# This file is part of ltrace. 2# Copyright (C) 2012 Petr Machata, Red Hat Inc. 3# Copyright (C) 2006 Yao Qi, IBM Corporation 4# 5# This program is free software; you can redistribute it and/or 6# modify it under the terms of the GNU General Public License as 7# published by the Free Software Foundation; either version 2 of the 8# License, or (at your option) any later version. 9# 10# This program is distributed in the hope that it will be useful, but 11# WITHOUT ANY WARRANTY; without even the implied warranty of 12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13# General Public License for more details. 14# 15# You should have received a copy of the GNU General Public License 16# along with this program; if not, write to the Free Software 17# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 18# 02110-1301 USA 19 20# Generic ltrace test subroutines that should work for any target. If these 21# need to be modified for any target, it can be done with a variable 22# or by passing arguments. 23 24source $objdir/env.exp 25 26if [info exists TOOL_EXECUTABLE] { 27 set LTRACE $TOOL_EXECUTABLE 28} else { 29 set LTRACE $objdir/../ltrace 30} 31 32if {[info exists VALGRIND] && ![string equal $VALGRIND {}]} { 33 verbose "Running under valgrind command: `$VALGRIND'" 34 set LTRACE "$VALGRIND $LTRACE" 35} 36 37set LTRACE_OPTIONS {} 38set LTRACE_ARGS {} 39set LTRACE_TEMP_FILES {} 40 41# ltrace_compile SOURCE DEST TYPE OPTIONS 42# 43# Compile PUT(program under test) by native compiler. ltrace_compile runs 44# the right compiler, and TCL captures the output, and I evaluate the output. 45# 46# SOURCE is the name of program under test, with full directory. 47# DEST is the name of output of compilation, with full directory. 48# TYPE is an enum-like variable to affect the format or result of compiler 49# output. Values: 50# executable if output is an executable. 51# object if output is an object. 52# OPTIONS is option to compiler in this compilation. 53proc ltrace_compile {source dest type options} { 54 global LTRACE_TESTCASE_OPTIONS; 55 56 if {![string equal "object" $type]} { 57 # Add platform-specific options if a shared library was specified using 58 # "shlib=librarypath" in OPTIONS. 59 set new_options "" 60 set shlib_found 0 61 62 foreach opt $options { 63 if [regexp {^shlib=(.*)} $opt dummy_var shlib_name] { 64 if [test_compiler_info "xlc*"] { 65 # IBM xlc compiler doesn't accept shared library named other 66 # than .so: use "-Wl," to bypass this 67 lappend source "-Wl,$shlib_name" 68 } else { 69 lappend source $shlib_name 70 } 71 72 if {$shlib_found == 0} { 73 set shlib_found 1 74 75 if { ([test_compiler_info "gcc-*"]&& ([istarget "powerpc*-*-aix*"]|| [istarget "rs6000*-*-aix*"] ))} { 76 lappend options "additional_flags=-L${objdir}/${subdir}" 77 } elseif { [istarget "mips-sgi-irix*"] } { 78 lappend options "additional_flags=-rpath ${objdir}/${subdir}" 79 } 80 } 81 82 } else { 83 lappend new_options $opt 84 } 85 } 86 87 #end of for loop 88 set options $new_options 89 } 90 91 # dump some information for debug purpose. 92 verbose "options are $options" 93 verbose "source is $source $dest $type $options" 94 95 # Wipe the DEST file, so that we don't end up running an obsolete 96 # version of the binary. 97 exec rm -f $dest 98 99 set result [target_compile $source $dest $type $options]; 100 verbose "result is $result" 101 regsub "\[\r\n\]*$" "$result" "" result; 102 regsub "^\[\r\n\]*" "$result" "" result; 103 if { $result != "" && [lsearch $options quiet] == -1} { 104 clone_output "compile failed for ltrace test, $result" 105 } 106 return $result; 107} 108 109proc get_compiler_info {binfile args} { 110 # For compiler.c and compiler.cc 111 global srcdir 112 113 # I am going to play with the log to keep noise out. 114 global outdir 115 global tool 116 117 # These come from compiler.c or compiler.cc 118 global compiler_info 119 120 # Legacy global data symbols. 121 #global gcc_compiled 122 123 # Choose which file to preprocess. 124 set ifile "${srcdir}/lib/compiler.c" 125 if { [llength $args] > 0 && [lindex $args 0] == "c++" } { 126 set ifile "${srcdir}/lib/compiler.cc" 127 } 128 129 # Run $ifile through the right preprocessor. 130 # Toggle ltrace.log to keep the compiler output out of the log. 131 #log_file 132 set cppout [ ltrace_compile "${ifile}" "" preprocess [list "$args" quiet] ] 133 #log_file -a "$outdir/$tool.log" 134 135 # Eval the output. 136 set unknown 0 137 foreach cppline [ split "$cppout" "\n" ] { 138 if { [ regexp "^#" "$cppline" ] } { 139 # line marker 140 } elseif { [ regexp "^\[\n\r\t \]*$" "$cppline" ] } { 141 # blank line 142 } elseif { [ regexp "^\[\n\r\t \]*set\[\n\r\t \]" "$cppline" ] } { 143 # eval this line 144 verbose "get_compiler_info: $cppline" 2 145 eval "$cppline" 146 } else { 147 # unknown line 148 verbose "get_compiler_info: $cppline" 149 set unknown 1 150 } 151 } 152 153 # Reset to unknown compiler if any diagnostics happened. 154 if { $unknown } { 155 set compiler_info "unknown" 156 } 157 return 0 158} 159 160proc test_compiler_info { {compiler ""} } { 161 global compiler_info 162 163 if [string match "" $compiler] { 164 if [info exists compiler_info] { 165 verbose "compiler_info=$compiler_info" 166 # if no arg, return the compiler_info string 167 return $compiler_info 168 } else { 169 perror "No compiler info found." 170 } 171 } 172 173 return [string match $compiler $compiler_info] 174} 175 176proc ltrace_compile_shlib {sources dest options} { 177 set obj_options $options 178 verbose "+++++++ [test_compiler_info]" 179 switch -glob [test_compiler_info] { 180 "xlc-*" { 181 lappend obj_options "additional_flags=-qpic" 182 } 183 "gcc-*" { 184 if { !([istarget "powerpc*-*-aix*"] 185 || [istarget "rs6000*-*-aix*"]) } { 186 lappend obj_options "additional_flags=-fpic" 187 } 188 } 189 "xlc++-*" { 190 lappend obj_options "additional_flags=-qpic" 191 } 192 193 default { 194 fail "Bad compiler!" 195 } 196 } 197 198 if {![LtraceCompileObjects $sources $obj_options objects]} { 199 return -1 200 } 201 202 set link_options $options 203 if { [test_compiler_info "xlc-*"] || [test_compiler_info "xlc++-*"]} { 204 lappend link_options "additional_flags=-qmkshrobj" 205 } else { 206 lappend link_options "additional_flags=-shared" 207 } 208 if {[ltrace_compile "${objects}" "${dest}" executable $link_options] != ""} { 209 return -1 210 } 211 212 return 213} 214 215# WipeFiles -- 216# 217# Delete each file in the list. 218# 219# Arguments: 220# files List of files to delete. 221# Results: 222# Each of the files is deleted. Returns nothing. 223 224proc WipeFiles {files} { 225 verbose "WipeFiles: $files\n" 226 foreach f $files { 227 file delete $f 228 } 229} 230 231# LtraceTmpDir -- 232# 233# Guess what directory to use for temporary files. 234# This was adapted from http://wiki.tcl.tk/772 235# 236# Results: 237# A temporary directory to use. The current directory if no 238# other seems to be available. 239 240proc LtraceTmpDir {} { 241 set tmpdir [pwd] 242 243 if {[file exists "/tmp"]} { 244 set tmpdir "/tmp" 245 } 246 247 catch {set tmpdir $::env(TMP)} 248 catch {set tmpdir $::env(TEMP)} 249 catch {set tmpdir $::env(TMPDIR)} 250 251 return $tmpdir 252} 253 254set LTRACE_TEMP_DIR [LtraceTmpDir] 255 256# LtraceTempFile -- 257# 258# Create a temporary file according to a pattern, and return its 259# name. This behaves similar to mktemp. We don't use mktemp 260# directly, because on older systems, mktemp requires that the 261# array of X's be at the very end of the string, while ltrace 262# temporary files need to have suffixes. 263# 264# Arguments: 265# pat Pattern to use. See mktemp for description of its format. 266# 267# Results: 268# Creates the temporary file and returns its name. The name is 269# also appended to LTRACE_TEMP_FILES. 270 271proc LtraceTempFile {pat} { 272 global LTRACE_TEMP_FILES 273 global LTRACE_TEMP_DIR 274 275 set letters "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" 276 set numLetters [string length $letters] 277 278 if {![regexp -indices {(X{3,})} $pat m]} { 279 send_error -- "Pattern $pat contains insufficient number of X's." 280 return {} 281 } 282 283 set start [lindex $m 0] 284 set end [lindex $m 1] 285 set len [expr {$end - $start + 1}] 286 287 for {set j 0} {$j < 10} {incr j} { 288 289 # First, generate a random name. 290 291 set randstr {} 292 for {set i 0} {$i < $len} {incr i} { 293 set r [expr {int(rand() * $numLetters)}] 294 append randstr [string index $letters $r] 295 } 296 set prefix [string range $pat 0 [expr {$start - 1}]] 297 set suffix [string range $pat [expr {$end + 1}] end] 298 set name [file join $LTRACE_TEMP_DIR "$prefix$randstr$suffix"] 299 300 # Now check that it's free. This is of course racy, but this 301 # is a test suite, not anything used in actual production. 302 303 if {[file exists $name]} { 304 continue 305 } 306 307 # We don't bother attempting to open the file. Downstream 308 # code can do it itself. 309 310 lappend LTRACE_TEMP_FILES $name 311 return $name 312 } 313 314 send_error -- "Couldn't create a temporary file for pattern $pat." 315 return 316} 317 318# ltraceSource -- 319# 320# Create a temporary file with a given suffix and prime it with 321# contents given in text. 322# 323# Arguments: 324# suffix Suffix of the temp file to be created. 325# 326# text Contents of the new file. 327# 328# Results: 329# Returns file name of created file. 330 331proc ltraceSource {suffix text} { 332 set ret [LtraceTempFile "lt-XXXXXXXXXX.$suffix"] 333 334 set chan [open $ret w] 335 puts $chan $text 336 close $chan 337 338 return $ret 339} 340 341# LtraceCompileObjects -- 342# 343# Compile each source file into an object file. ltrace_compile 344# is called to perform actual compilation. 345# 346# Arguments: 347# sources List of source files. 348# 349# options Options for ltrace_compile. 350# 351# retName Variable where the resulting list of object names is 352# to be placed. 353# Results: 354# Returns true or false depending on whether there were any 355# errors. If it returns true, then variable referenced by 356# retName contains list of object files, produced by compiling 357# files in sources list. 358 359proc LtraceCompileObjects {sources options retName} { 360 global LTRACE_TEMP_FILES 361 upvar $retName ret 362 set ret {} 363 364 foreach source $sources { 365 set sourcebase [file tail $source] 366 set dest $source.o 367 lappend LTRACE_TEMP_FILES $dest 368 verbose "LtraceCompileObjects: $source -> $dest" 369 if {[ltrace_compile $source $dest object $options] != ""} { 370 return false 371 } 372 lappend ret $dest 373 } 374 375 return true 376} 377 378# ltraceCompile -- 379# 380# This attempts to compile a binary from sources given in ARGS. 381# 382# Arguments: 383# dest A binary to be produced. If this is called lib*.so, then 384# the resulting binary will be a library, if *.pie, it 385# will be a PIE, otherwise it will be an executable. In 386# theory this could also be *.o for "object" and *.i for 387# "preprocess" for cases with one source file, but that 388# is not supported at the moment. The binary will be 389# placed in $objdir/$subdir. 390# 391# args List of options and source files. 392# 393# Options are arguments that start with a dash. Options 394# (sans the dash) are passed to ltrace_compile. 395# 396# Source files named lib*.so are libraries. Those are 397# passed to ltrace_compile as options shlib=X. Source 398# files named *.o are objects. The remaining source 399# files are first compiled (by LtraceCompileObjects) and 400# then together with other objects passed to 401# ltrace_compile to produce resulting binary. 402# 403# Any argument that is empty string prompts the function 404# to fail. This is done so that errors caused by 405# ltraceSource (or similar) distribute naturally 406# upwards. 407# 408# Results: 409# This compiles given source files into a binary. Full file name 410# of that binary is returned. Empty string is returned in case 411# of a failure. 412 413proc ltraceCompile {dest args} { 414 global objdir 415 global subdir 416 417 get_compiler_info {} c 418 get_compiler_info {} c++ 419 420 if {[string match "lib*.so" $dest]} { 421 set type "library" 422 set extraObjOptions "additional_flags=-fpic" 423 set extraOptions "additional_flags=-shared" 424 } elseif {[string match "*.pie" $dest]} { 425 set type "executable" 426 set extraObjOptions "additional_flags=-fpic" 427 set extraOptions "additional_flags=-pie" 428 } else { 429 set type "executable" 430 set extraObjOptions {} 431 set extraOptions {} 432 } 433 434 set options {} 435 set sources {} 436 set objects {} 437 foreach a $args { 438 if {[string match "-?*" $a]} { 439 lappend options [string range $a 1 end] 440 } elseif {[string match "*.so" $a]} { 441 lappend options "shlib=$a" 442 } elseif {[string match "*.o" $a]} { 443 lappend objects $a 444 } else { 445 lappend sources $a 446 } 447 } 448 449 if {[string equal $dest {}]} { 450 set dest [LtraceTempFile "exe-XXXXXXXXXX"] 451 } elseif {[string equal $dest ".pie"]} { 452 set dest [LtraceTempFile "pie-XXXXXXXXXX"] 453 } else { 454 set dest $objdir/$subdir/$dest 455 } 456 457 verbose "ltraceCompile: dest $dest" 458 verbose " : options $options" 459 verbose " : sources $sources" 460 verbose " : objects $objects" 461 462 if {![LtraceCompileObjects $sources \ 463 [concat $options $extraObjOptions] newObjects]} { 464 return {} 465 } 466 set objects [concat $objects $newObjects] 467 468 verbose "ltraceCompile: objects $objects" 469 470 if {[ltrace_compile $objects $dest $type \ 471 [concat $options $extraOptions]] != ""} { 472 return {} 473 } 474 475 return $dest 476} 477 478# ltraceRun -- 479# 480# Invoke command identified by LTRACE global variable with given 481# ARGS. A logfile redirection is automatically ordered by 482# passing -o and a temporary file name. 483# 484# Arguments: 485# args Arguments to ltrace binary. 486# 487# Results: 488# Returns name of logfile. The "exec" command that it uses 489# under the hood fails loudly if the process exits with a 490# non-zero exit status, or uses stderr in any way. 491 492proc ltraceRun {args} { 493 global LTRACE 494 global objdir 495 global subdir 496 497 set LdPath [ld_library_path $objdir/$subdir] 498 set logfile [ltraceSource ltrace {}] 499 500 # Run ltrace. expect will show an error if this doesn't exit with 501 # zero exit status (i.e. ltrace fails, valgrind finds errors, 502 # etc.). 503 504 set command "exec env LD_LIBRARY_PATH=$LdPath $LTRACE -o $logfile $args" 505 verbose $command 506 if {[catch {eval $command}] } { 507 fail "test case execution failed" 508 send_error -- $command 509 send_error -- $::errorInfo 510 } 511 512 return $logfile 513} 514 515# ltraceDone -- 516# 517# Wipes or dumps all temporary files after a test suite has 518# finished. 519# 520# Results: 521# Doesn't return anything. Wipes all files gathered in 522# LTRACE_TEMP_FILES. If SAVE_TEMPS is defined and true, the 523# temporary files are not wiped, but their names are dumped 524# instead. Contents of LTRACE_TEMP_FILES are deleted in any 525# case. 526 527proc ltraceDone {} { 528 global SAVE_TEMPS 529 global LTRACE_TEMP_FILES 530 531 if {[info exists SAVE_TEMPS] && $SAVE_TEMPS} { 532 foreach tmp $LTRACE_TEMP_FILES { 533 send_user "$tmp\n" 534 } 535 } else { 536 WipeFiles $LTRACE_TEMP_FILES 537 } 538 539 set LTRACE_TEMP_FILES {} 540 return 541} 542 543# Grep -- 544# 545# Return number of lines in a given file, matching a given 546# regular expression. 547# 548# Arguments: 549# logfile File to search through. 550# 551# re Regular expression to match. 552# 553# Results: 554# Returns number of matching lines. 555 556proc Grep {logfile re} { 557 set count 0 558 set fp [open $logfile] 559 while {[gets $fp line] >= 0} { 560 if [regexp -- $re $line] { 561 incr count 562 } 563 } 564 close $fp 565 return $count 566} 567 568# ltraceMatch1 -- 569# 570# Look for a pattern in a given logfile, comparing number of 571# occurences of the pattern with expectation. 572# 573# Arguments: 574# logfile The name of file where to look for patterns. 575# 576# pattern Regular expression pattern to look for. 577# 578# op Operator to compare number of occurences. 579# 580# expect Second operand to op, the first being number of 581# occurences of pattern. 582# 583# Results: 584# Doesn't return anything, but calls fail or pass depending on 585# whether the patterns matches expectation. 586 587proc ltraceMatch1 {logfile pattern {op ==} {expect 1}} { 588 set count [Grep $logfile $pattern] 589 set msgMain "$pattern appears in $logfile $count times" 590 set msgExpect ", expected $op $expect" 591 592 if {[eval expr $count $op $expect]} { 593 pass $msgMain 594 } else { 595 fail $msgMain$msgExpect 596 } 597 return 598} 599 600# ltraceMatch -- 601# 602# Look for series of patterns in a given logfile, comparing 603# number of occurences of each pattern with expectations. 604# 605# Arguments: 606# logfile The name of file where to look for patterns. 607# 608# patterns List of patterns to look for. ltraceMatch1 is called 609# on each of these in turn. 610# 611# Results: 612# 613# Doesn't return anything, but calls fail or pass depending on 614# whether each of the patterns holds. 615 616proc ltraceMatch {logfile patterns} { 617 foreach pat $patterns { 618 eval ltraceMatch1 [linsert $pat 0 $logfile] 619 } 620 return 621} 622 623# 624# ltrace_options OPTIONS_LIST 625# Pass ltrace commandline options. 626# 627proc ltrace_options { args } { 628 629 global LTRACE_OPTIONS 630 set LTRACE_OPTIONS $args 631} 632 633# 634# ltrace_args ARGS_LIST 635# Pass ltrace'd program its own commandline options. 636# 637proc ltrace_args { args } { 638 639 global LTRACE_ARGS 640 set LTRACE_ARGS $args 641} 642 643# 644# handle run-time library paths 645# 646proc ld_library_path { args } { 647 648 set ALL_LIBRARY_PATHS { } 649 if [info exists LD_LIBRARY_PATH] { 650 lappend ALL_LIBRARY_PATHS $LD_LIBRARY_PATH 651 } 652 global libelf_LD_LIBRARY_PATH 653 if {[string length $libelf_LD_LIBRARY_PATH] > 0} { 654 lappend ALL_LIBRARY_PATHS $libelf_LD_LIBRARY_PATH 655 } 656 global libunwind_LD_LIBRARY_PATH 657 if {[string length $libunwind_LD_LIBRARY_PATH] > 0} { 658 lappend ALL_LIBRARY_PATHS $libunwind_LD_LIBRARY_PATH 659 } 660 lappend ALL_LIBRARY_PATHS $args 661 join $ALL_LIBRARY_PATHS ":" 662} 663 664# 665# ltrace_runtest LD_LIBRARY_PATH BIN FILE 666# Trace the execution of BIN and return result. 667# 668# BIN is program-under-test. 669# LD_LIBRARY_PATH is the env for program-under-test to run. 670# FILE is to save the output from ltrace with default name $BIN.ltrace. 671# Retrun output from ltrace. 672# 673proc ltrace_runtest { args } { 674 675 global LTRACE 676 global LTRACE_OPTIONS 677 global LTRACE_ARGS 678 679 verbose "LTRACE = $LTRACE" 680 681 set LD_LIBRARY_PATH_ [ld_library_path [lindex $args 0]] 682 set BIN [lindex $args 1] 683 684 # specify the output file, the default one is $BIN.ltrace 685 if [llength $args]==3 then { 686 set file [lindex $args 2] 687 } else { 688 set file $BIN.ltrace 689 } 690 691 # Remove the file first. If ltrace fails to overwrite it, we 692 # would be comparing output to an obsolete run. 693 exec rm -f $file 694 695 # append this option to LTRACE_OPTIONS. 696 lappend LTRACE_OPTIONS "-o" 697 lappend LTRACE_OPTIONS "$file" 698 verbose "LTRACE_OPTIONS = $LTRACE_OPTIONS" 699 set command "exec sh -c {export LD_LIBRARY_PATH=$LD_LIBRARY_PATH_; \ 700 $LTRACE $LTRACE_OPTIONS $BIN $LTRACE_ARGS;exit}" 701 #ltrace the PUT. 702 if {[catch $command output]} { 703 fail "test case execution failed" 704 send_error -- $command 705 send_error -- $::errorInfo 706 } 707 708 # return output from ltrace. 709 return $output 710} 711 712# 713# ltrace_verify_output FILE_TO_SEARCH PATTERN MAX_LINE 714# Verify the ltrace output by comparing the number of PATTERN in 715# FILE_TO_SEARCH with INSTANCE_NO. Do not specify INSTANCE_NO if 716# instance number is ignored in this test. 717# Reutrn: 718# 0 = number of PATTERN in FILE_TO_SEARCH inqual to INSTANCE_NO. 719# 1 = number of PATTERN in FILE_TO_SEARCH qual to INSTANCE_NO. 720# 721proc ltrace_verify_output { file_to_search pattern {instance_no 0} {grep_command "grep"}} { 722 723 # compute the number of PATTERN in FILE_TO_SEARCH by grep and wc. 724 catch "exec sh -c {$grep_command \"$pattern\" $file_to_search | wc -l ;exit}" output 725 verbose "output = $output" 726 727 if [ regexp "syntax error" $output ] then { 728 fail "Invalid regular expression $pattern" 729 } elseif { $instance_no == 0 } then { 730 if { $output == 0 } then { 731 fail "Fail to find $pattern in $file_to_search" 732 } else { 733 pass "$pattern in $file_to_search" 734 } 735 } elseif { $output >= $instance_no } then { 736 pass "$pattern in $file_to_search for $output times" 737 } else { 738 fail "$pattern in $file_to_search for $output times, should be $instance_no" 739 } 740} 741