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
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# Pre-8.5 TCL doesn't have lreverse.  The following is taken from:
42#  http://www2.tcl.tk/17188
43
44if {[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.
65proc 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
121proc 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
172proc 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
188proc 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
239proc 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
255proc 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
269set 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
286proc 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
350proc 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
377proc 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
391proc 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
415proc 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
469proc 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
550proc 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
585proc 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
614proc 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
645proc 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
674proc 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
702proc 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#
716proc 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#
726proc ltrace_args { args } {
727
728	global LTRACE_ARGS
729	set LTRACE_ARGS $args
730}
731
732#
733# handle run-time library paths
734#
735proc 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#
766proc 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#
814proc 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