Initial revision

1 files changed, 441 insertions, 0 deletions

diff --git a/lib/utils.exp b/lib/utils.exp
new file mode 100644
index 0000000..565f18e
--- /dev/null
+++ b/lib/utils.exp
@@ -0,0 +1,441 @@
+# Copyright (C) 92, 93, 94, 95, 96, 97, 98, 1999 Free Software Foundation, Inc.
+
+# 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., 675 Mass Ave, Cambridge, MA 02139, USA. 
+
+# Please email any bugs, comments, and/or additions to this file to:
+# bug-dejagnu@prep.ai.mit.edu
+
+# This file was written by Rob Savoye. (rob@cygnus.com)
+
+#
+# Most of the procedures found here mimic their unix counter-part. 
+# This file is sourced by runtest.exp, so they are usable by any test case.
+#
+
+#
+# Gets the directories in a directory
+#     args: the first is the dir to look in, the next
+#         is the pattern to match. It
+#         defaults to *. Patterns are csh style
+#   	  globbing rules
+#     returns: a list of dirs or NULL
+#
+proc getdirs { args } {
+    if { [lindex $args 0] == "-all" } {
+	set alldirs 1
+	set args [lrange $args 1 end]
+    } else {
+	set alldirs 0
+    }
+
+    set path [lindex $args 0]
+    if { [llength $args] > 1} {
+	set pattern [lindex $args 1]
+    } else {
+	set pattern "*"
+    }
+    verbose "Looking in ${path} for directories that match \"${pattern}\"" 3
+    catch "glob ${path}/${pattern}" tmp
+    if { ${tmp} != "" } {
+	foreach i ${tmp} {
+	    if [file isdirectory $i] {
+		switch -- "[file tail $i]" {
+		    "testsuite" -
+		    "config" -
+		    "lib" -
+		    "CVS" -
+		    "RCS" -
+		    "SCCS" {
+			verbose "Ignoring directory [file tail $i]" 3
+			continue
+		    }
+		    default {
+			if [file readable $i] {
+			    verbose "Found directory [file tail $i]" 3
+			    lappend dirs $i
+			    if { $alldirs } {
+				eval lappend dirs [getdirs -all $i $pattern]
+			    }
+			}
+		    }
+		}
+	    }
+	}
+    } else {
+	perror "$tmp"
+	return ""
+    }
+    
+    if ![info exists dirs] {
+	return ""
+    } else {
+	return $dirs
+    }
+}
+
+#
+# Finds all the files recursively
+#     rootdir - this is the directory to start the search
+#   	  from. This is and all subdirectories are search for
+#   	  filenames. Directory names are not included in the
+#   	  list, but the filenames have path information. 
+#     pattern - this is the pattern to match. Patterns are csh style
+#   	  globbing rules.
+#     returns: a list or a NULL.
+#
+proc find { rootdir pattern } {
+    # first find all the directories
+    set dirs "$rootdir "
+    while 1 {
+	set tmp $rootdir
+	set rootdir ""
+	if [string match "" $tmp] {
+	    break
+	}
+	foreach i $tmp {
+	    set j [getdirs $i]
+	    if ![string match "" $j] {
+		append dirs "$j "
+		set rootdir $j
+		unset j
+	    } else {
+		set rootdir ""
+	    }
+	}
+	set tmp ""
+    }
+    
+    # find all the files that match the pattern
+    foreach i $dirs {
+	verbose "Looking in $i" 3
+	set tmp [glob -nocomplain $i/$pattern]
+	if { [llength $tmp] != 0 } {
+	    foreach j $tmp {
+		if ![file isdirectory $j] {
+		    lappend files $j
+		    verbose "Adding $j to file list" 3
+		}
+	    }
+	}
+    }
+    
+    if ![info exists files] {
+	lappend files ""
+    }
+    return $files
+}
+
+#
+# Search the path for a file. This is basically a version
+# of the BSD-unix which utility. This procedure depends on
+# the shell environment variable $PATH. It returns 0 if $PATH
+# does not exist or the binary is not in the path. If the
+# binary is in the path, it returns the full path to the binary.
+#
+proc which { file } {
+    global env
+    
+    # strip off any extraneous arguments (like flags to the compiler)
+    set file [lindex $file 0]
+    
+    # if it exists then the path must be OK
+    # ??? What if $file has no path and "." isn't in $PATH?
+    if [file exists $file] {
+	return $file
+    }
+    if [info exists env(PATH)] {
+	set path [split $env(PATH) ":"]
+    } else {
+	return 0
+    }
+    
+    foreach i $path {
+	verbose "Checking against $i" 3
+	if [file exists $i/$file] {
+	    if [file executable $i/$file] {
+		return $i/$file
+	    } else {
+		warning "$i/$file exists but is not an executable"
+	    }
+	}
+    }
+    # not in path
+    return 0
+}
+
+#
+# Looks for a string in a file. 
+#     return:list of lines that matched or NULL if none match.
+#     args:  first arg is the filename,
+#            second is the pattern,
+#            third are any options.
+#     Options: line  - puts line numbers of match in list
+#
+proc grep { args } {
+    
+    set file [lindex $args 0]
+    set pattern [lindex $args 1]
+    
+    verbose "Grepping $file for the pattern \"$pattern\"" 3
+    
+    set argc [llength $args]
+    if { $argc > 2 } {
+	for { set i 2 } { $i < $argc } { incr i } {
+	    append options [lindex $args $i]
+	    append options " "
+	}
+    } else {
+	set options ""
+    }
+    
+    set i 0
+    set fd [open $file r]
+    while { [gets $fd cur_line]>=0 } {
+	incr i
+	if [regexp -- "$pattern" $cur_line match] {
+	    if ![string match "" $options] {
+		foreach opt $options {
+		    case $opt in {
+			"line" {
+			    lappend grep_out [concat $i $match]
+			}
+		    }
+		}
+	    } else {
+		lappend grep_out $match
+	    }
+	}
+    }
+    close $fd
+    unset fd
+    unset i
+    if ![info exists grep_out] {
+	set grep_out ""
+    }
+    return $grep_out
+}
+
+#
+# Remove elements based on patterns. elements are delimited by spaces.
+# pattern is the pattern to look for using glob style matching
+# list is the list to check against
+# returns the new list
+#
+proc prune { list pattern } {
+    set tmp {}
+    foreach i $list {
+	verbose "Checking pattern \"$pattern\" against $i" 3
+	if ![string match $pattern $i] {
+	    lappend tmp $i
+	} else {
+	    verbose "Removing element $i from list" 3
+	}
+    }
+    return $tmp
+}
+
+# 
+# Attempt to kill a process that you started on the local machine.
+#
+proc slay { name } {
+    set in [open [concat "|ps"] r]
+    while {[gets $in line]>-1} {
+	if ![string match "*expect*slay*" $line] {
+	    if [string match "*$name*" $line] {
+		set pid [lindex $line 0]
+		catch "exec kill -9 $pid]"
+		verbose "Killing $name, pid = $pid\n"
+	    }
+	}
+    }
+    close $in
+}
+
+#
+# Convert a relative path to an absolute one on the local machine.
+#
+proc absolute { path } {
+    if [string match "." $path] {
+        return [pwd]
+    }
+    
+    set basedir [pwd]
+    cd $path
+    set path [pwd]
+    cd $basedir
+    return $path
+}
+
+#
+# Source a file and trap any real errors. This ignores extraneous
+# output. returns a 1 if there was an error, otherwise it returns 0.
+#
+proc psource { file } {
+    global errorInfo
+    global errorCode
+
+    unset errorInfo
+    if [file exists $file] {
+	catch "source $file"
+	if [info exists errorInfo] {
+	    send_error "ERROR: errors in $file\n"
+	    send_error "$errorInfo"
+	    return 1
+	}
+    }
+    return 0
+}
+
+#
+# Check if a testcase should be run or not
+#
+# RUNTESTS is a copy of global `runtests'.
+#
+# This proc hides the details of global `runtests' from the test scripts, and
+# implements uniform handling of "script arguments" where those arguments are
+# file names (ie: the "foo" in make check RUNTESTFLAGS="bar.exp=foo").
+# "glob" style expressions are supported as well as multiple files (with
+# spaces between them).
+# Eg: RUNTESTFLAGS="bar.exp=foo1.c foo2.c foo3*.c bar*.c"
+#
+proc runtest_file_p { runtests testcase } {
+    if [string length [lindex $runtests 1]] {
+	set basename [file tail $testcase]
+	foreach ptn [lindex $runtests 1] {
+	    if [string match $ptn $basename] {
+		return 1
+	    }
+	    if [string match $ptn $testcase] {
+		return 1
+	    }
+	}
+	return 0
+    }
+    return 1
+}
+
+#
+# Delete various system verbosities from TEXT on SYSTEM
+#
+# An example is:
+# ld.so: warning: /usr/lib/libc.so.1.8.1 has older revision than expected 9
+#
+# SYSTEM is typical $target_triplet or $host_triplet.
+#
+
+#
+# Compares two files line-by-line
+#     returns 1 it the files match,
+#     returns 0 if there was a file error,
+#     returns -1 if they didn't match.
+#
+proc diff { file_1 file_2 } {
+    set eof -1
+    set differences 0
+    
+    if [file exists ${file_1}] {
+        set file_a [open ${file_1} r]
+    } else {
+        warning "${file_1} doesn't exist"
+        return 0
+    }
+    
+    if [file exists ${file_2}] {
+        set file_b [open ${file_2} r]
+    } else {
+        warning "${file_2} doesn't exist"
+        return 0
+    }
+    
+    verbose "# Diff'ing: ${file_1} ${file_2}\n" 1
+    
+    set list_a ""
+    while { [gets ${file_a} line] != ${eof} } {
+        if [regexp "^#.*$" ${line}] {
+            continue
+        } else {
+            lappend list_a ${line}
+        }
+    }
+    close ${file_a}
+    
+    set list_b ""
+    while { [gets ${file_b} line] != ${eof} } {
+        if [regexp "^#.*$" ${line}] {
+            continue
+        } else {
+            lappend list_b ${line}
+        }
+    }
+    close ${file_b}
+    for { set i 0 } { $i < [llength $list_a] } { incr i } {
+        set line_a [lindex ${list_a} ${i}]
+        set line_b [lindex ${list_b} ${i}]
+
+#        verbose "\t${file_1}: ${i}: ${line_a}\n" 3
+#        verbose "\t${file_2}: ${i}: ${line_b}\n" 3
+        if [string compare ${line_a} ${line_b}] {
+	    verbose "line #${i}\n" 2
+            verbose "\< ${line_a}\n" 2
+            verbose "\> ${line_b}\n" 2
+
+	    send_log "line #${i}\n"
+            send_log "\< ${line_a}\n"
+            send_log "\> ${line_b}\n"
+
+            set differences -1
+        }
+    }
+    
+    if { $differences == -1 || [llength ${list_a}] != [llength ${list_b}] } {
+	verbose "Files not the same" 2
+        set differences -1
+    } else {
+	verbose "Files are the same" 2
+	set differences 1
+    }
+    return ${differences}
+}
+
+#
+# Set an environment variable
+#
+proc setenv { var val } {
+    global env
+    
+    set env($var) $val
+}
+
+#
+# Unset an environment variable
+#
+proc unsetenv { var } {
+    global env
+    unset env($var)
+}
+
+#
+# Get a value from an environment variable
+#
+proc getenv { var } {
+    global env
+
+    if [info exists env($var)] {
+	return $env($var)
+    } else {
+	return ""
+    }
+}
+