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