|
Packit |
62fe53 |
# Copyright (C) 1992-2016 Free Software Foundation, Inc.
|
|
Packit |
62fe53 |
#
|
|
Packit |
62fe53 |
# This file is part of DejaGnu.
|
|
Packit |
62fe53 |
#
|
|
Packit |
62fe53 |
# DejaGnu is free software; you can redistribute it and/or modify it
|
|
Packit |
62fe53 |
# under the terms of the GNU General Public License as published by
|
|
Packit |
62fe53 |
# the Free Software Foundation; either version 3 of the License, or
|
|
Packit |
62fe53 |
# (at your option) any later version.
|
|
Packit |
62fe53 |
#
|
|
Packit |
62fe53 |
# DejaGnu is distributed in the hope that it will be useful, but
|
|
Packit |
62fe53 |
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
Packit |
62fe53 |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
Packit |
62fe53 |
# General Public License for more details.
|
|
Packit |
62fe53 |
#
|
|
Packit |
62fe53 |
# You should have received a copy of the GNU General Public License
|
|
Packit |
62fe53 |
# along with DejaGnu; if not, write to the Free Software Foundation,
|
|
Packit |
62fe53 |
# Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
# This file was written by Rob Savoye. (rob@welcomehome.org)
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
# Most of the procedures found here mimic their UNIX counterpart.
|
|
Packit |
62fe53 |
# This file is sourced by runtest.exp, so they are usable by any test
|
|
Packit |
62fe53 |
# script.
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
# Gets the directories in a directory, or in a directory tree.
|
|
Packit |
62fe53 |
# args: the first is the dir to look in, the next
|
|
Packit |
62fe53 |
# is the pattern to match. It
|
|
Packit |
62fe53 |
# defaults to *. Patterns are csh style
|
|
Packit |
62fe53 |
# globbing rules
|
|
Packit |
62fe53 |
# options: -all search the tree recursively
|
|
Packit |
62fe53 |
# returns: a list of dirs or NULL; the root directory is not returned.
|
|
Packit |
62fe53 |
#
|
|
Packit |
62fe53 |
proc getdirs { args } {
|
|
Packit |
62fe53 |
if { [lindex $args 0] == "-all" } {
|
|
Packit |
62fe53 |
set alldirs 1
|
|
Packit |
62fe53 |
set args [lrange $args 1 end]
|
|
Packit |
62fe53 |
} else {
|
|
Packit |
62fe53 |
set alldirs 0
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
set path [lindex $args 0]
|
|
Packit |
62fe53 |
if { [llength $args] > 1} {
|
|
Packit |
62fe53 |
set pattern [lindex $args 1]
|
|
Packit |
62fe53 |
} else {
|
|
Packit |
62fe53 |
set pattern "*"
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
verbose "Looking in ${path} for directories that match \"${pattern}\"" 3
|
|
Packit |
62fe53 |
catch "glob ${path}/${pattern}" tmp
|
|
Packit |
62fe53 |
if { ${tmp} != "" } {
|
|
Packit |
62fe53 |
foreach i ${tmp} {
|
|
Packit |
62fe53 |
if {[file isdirectory $i]} {
|
|
Packit |
62fe53 |
switch -- "[file tail $i]" {
|
|
Packit |
62fe53 |
"testsuite" -
|
|
Packit |
62fe53 |
"config" -
|
|
Packit |
62fe53 |
"lib" -
|
|
Packit |
62fe53 |
".git" -
|
|
Packit |
62fe53 |
".svn" -
|
|
Packit |
62fe53 |
"CVS" -
|
|
Packit |
62fe53 |
"RCS" -
|
|
Packit |
62fe53 |
"SCCS" {
|
|
Packit |
62fe53 |
verbose "Ignoring directory [file tail $i]" 3
|
|
Packit |
62fe53 |
continue
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
default {
|
|
Packit |
62fe53 |
if {[file readable $i]} {
|
|
Packit |
62fe53 |
verbose "Found directory [file tail $i]" 3
|
|
Packit |
62fe53 |
lappend dirs $i
|
|
Packit |
62fe53 |
if { $alldirs } {
|
|
Packit |
62fe53 |
eval lappend dirs [getdirs -all $i $pattern]
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
} else {
|
|
Packit |
62fe53 |
perror "$tmp"
|
|
Packit |
62fe53 |
return ""
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
if {![info exists dirs]} {
|
|
Packit |
62fe53 |
return ""
|
|
Packit |
62fe53 |
} else {
|
|
Packit |
62fe53 |
return $dirs
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
# Finds paths of all non-directory files, recursively, whose names match
|
|
Packit |
62fe53 |
# a pattern. Certain directory name are not searched (see proc getdirs).
|
|
Packit |
62fe53 |
# rootdir - search in this directory and its subdirectories, recursively.
|
|
Packit |
62fe53 |
# pattern - specified with Tcl string match "globbing" rules.
|
|
Packit |
62fe53 |
# returns: a possibly empty list of pathnames.
|
|
Packit |
62fe53 |
#
|
|
Packit |
62fe53 |
proc find { rootdir pattern } {
|
|
Packit |
62fe53 |
set files [list]
|
|
Packit |
62fe53 |
if { [string length $rootdir] == 0 || [string length $pattern] == 0 } {
|
|
Packit |
62fe53 |
return $files
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
# find all the directories
|
|
Packit |
62fe53 |
set dirs [concat [getdirs -all $rootdir] $rootdir]
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
# find all the files in the directories that match the pattern
|
|
Packit |
62fe53 |
foreach i $dirs {
|
|
Packit |
62fe53 |
verbose "Looking in $i" 3
|
|
Packit |
62fe53 |
foreach match [glob -nocomplain $i/$pattern] {
|
|
Packit |
62fe53 |
if {![file isdirectory $match]} {
|
|
Packit |
62fe53 |
lappend files $match
|
|
Packit |
62fe53 |
verbose "Adding $match to file list" 3
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
return $files
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
# Search the path for a file. This is basically a version of the BSD
|
|
Packit |
62fe53 |
# Unix which(1) utility. This procedure depends on the shell
|
|
Packit |
62fe53 |
# environment variable $PATH. It returns 0 if $PATH does not exist or
|
|
Packit |
62fe53 |
# the binary is not in the path. If the binary is in the path, it
|
|
Packit |
62fe53 |
# returns the full path to the binary.
|
|
Packit |
62fe53 |
#
|
|
Packit |
62fe53 |
proc which { file } {
|
|
Packit |
62fe53 |
global env
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
# strip off any extraneous arguments (like flags to the compiler)
|
|
Packit |
62fe53 |
set file [lindex $file 0]
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
# if the filename has a path component, then the file must exist
|
|
Packit |
62fe53 |
if {[llength [file split $file]] > 1} {
|
|
Packit |
62fe53 |
verbose "Checking $file" 2
|
|
Packit |
62fe53 |
if {[file exists $file] && [file executable $file]} {
|
|
Packit |
62fe53 |
verbose "file $file is executable" 2
|
|
Packit |
62fe53 |
return [file normalize $file]
|
|
Packit |
62fe53 |
} else {
|
|
Packit |
62fe53 |
return 0
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
# Otherwise the file must exist in the PATH
|
|
Packit |
62fe53 |
if {[info exists env(PATH)]} {
|
|
Packit |
62fe53 |
set path [split $env(PATH) ":"]
|
|
Packit |
62fe53 |
} else {
|
|
Packit |
62fe53 |
return 0
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
foreach dir $path {
|
|
Packit |
62fe53 |
verbose "Checking $dir for $file" 3
|
|
Packit |
62fe53 |
set filename [file normalize [file join $dir $file]]
|
|
Packit |
62fe53 |
if {[file exists $filename]} {
|
|
Packit |
62fe53 |
if {[file executable $filename]} {
|
|
Packit |
62fe53 |
verbose "Choosing $filename" 2
|
|
Packit |
62fe53 |
return [file normalize $filename]
|
|
Packit |
62fe53 |
} else {
|
|
Packit |
62fe53 |
warning "file $filename exists but is not executable"
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
# not in path
|
|
Packit |
62fe53 |
return 0
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
# Looks for occurrences of a string in a file.
|
|
Packit |
62fe53 |
# return:list of lines that matched or NULL if none match.
|
|
Packit |
62fe53 |
# args: first arg is the filename,
|
|
Packit |
62fe53 |
# second is the pattern,
|
|
Packit |
62fe53 |
# third are any options.
|
|
Packit |
62fe53 |
# Options: line - puts line numbers of match in list
|
|
Packit |
62fe53 |
#
|
|
Packit |
62fe53 |
proc grep { args } {
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
set file [lindex $args 0]
|
|
Packit |
62fe53 |
set pattern [lindex $args 1]
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
verbose "Grepping $file for the pattern \"$pattern\"" 3
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
set argc [llength $args]
|
|
Packit |
62fe53 |
if { $argc > 2 } {
|
|
Packit |
62fe53 |
for { set i 2 } { $i < $argc } { incr i } {
|
|
Packit |
62fe53 |
append options [lindex $args $i]
|
|
Packit |
62fe53 |
append options " "
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
} else {
|
|
Packit |
62fe53 |
set options ""
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
set i 0
|
|
Packit |
62fe53 |
set fd [open $file r]
|
|
Packit |
62fe53 |
while { [gets $fd cur_line]>=0 } {
|
|
Packit |
62fe53 |
incr i
|
|
Packit |
62fe53 |
if {[regexp -- "$pattern" $cur_line match]} {
|
|
Packit |
62fe53 |
if {![string match "" $options]} {
|
|
Packit |
62fe53 |
foreach opt $options {
|
|
Packit |
62fe53 |
switch -- $opt {
|
|
Packit |
62fe53 |
"line" {
|
|
Packit |
62fe53 |
lappend grep_out [concat $i $match]
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
} else {
|
|
Packit |
62fe53 |
lappend grep_out $match
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
close $fd
|
|
Packit |
62fe53 |
unset fd
|
|
Packit |
62fe53 |
unset i
|
|
Packit |
62fe53 |
if {![info exists grep_out]} {
|
|
Packit |
62fe53 |
set grep_out ""
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
return $grep_out
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
#
|
|
Packit |
62fe53 |
# Remove elements based on patterns. elements are delimited by spaces.
|
|
Packit |
62fe53 |
# pattern is the pattern to look for using glob style matching
|
|
Packit |
62fe53 |
# lst is the list to check against
|
|
Packit |
62fe53 |
# returns the new list
|
|
Packit |
62fe53 |
#
|
|
Packit |
62fe53 |
proc prune { lst pattern } {
|
|
Packit |
62fe53 |
set tmp {}
|
|
Packit |
62fe53 |
foreach i $lst {
|
|
Packit |
62fe53 |
verbose "Checking pattern \"$pattern\" against $i" 3
|
|
Packit |
62fe53 |
if {![string match $pattern $i]} {
|
|
Packit |
62fe53 |
lappend tmp $i
|
|
Packit |
62fe53 |
} else {
|
|
Packit |
62fe53 |
verbose "Removing element $i from list" 3
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
return $tmp
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
# Check if a testcase should be run or not
|
|
Packit |
62fe53 |
#
|
|
Packit |
62fe53 |
# RUNTESTS is a copy of global `runtests'.
|
|
Packit |
62fe53 |
#
|
|
Packit |
62fe53 |
# This proc hides the details of global `runtests' from the test scripts, and
|
|
Packit |
62fe53 |
# implements uniform handling of "script arguments" where those arguments are
|
|
Packit |
62fe53 |
# file names (eg, "foo.c" in make check RUNTESTFLAGS="bar.exp=foo.c").
|
|
Packit |
62fe53 |
# "glob" style expressions are supported as well as multiple files (with
|
|
Packit |
62fe53 |
# spaces between them).
|
|
Packit |
62fe53 |
# Eg: RUNTESTFLAGS="bar.exp=foo1.c foo2.c foo3*.c bar/baz*.c"
|
|
Packit |
62fe53 |
#
|
|
Packit |
62fe53 |
proc runtest_file_p { runtests testcase } {
|
|
Packit |
62fe53 |
if {[string length [lindex $runtests 1]]} {
|
|
Packit |
62fe53 |
foreach ptn [lindex $runtests 1] {
|
|
Packit |
62fe53 |
if {[string match "*/$ptn" $testcase]} {
|
|
Packit |
62fe53 |
return 1
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
if {[string match $ptn $testcase]} {
|
|
Packit |
62fe53 |
return 1
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
return 0
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
return 1
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
# Compares two files line-by-line just like the Unix diff(1) utility.
|
|
Packit |
62fe53 |
#
|
|
Packit |
62fe53 |
# Returns 1 if the files match,
|
|
Packit |
62fe53 |
# 0 if there was a file error,
|
|
Packit |
62fe53 |
# -1 if they did not match.
|
|
Packit |
62fe53 |
#
|
|
Packit |
62fe53 |
proc diff { file_1 file_2 } {
|
|
Packit |
62fe53 |
set eof -1
|
|
Packit |
62fe53 |
set differences 0
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
if {[file exists ${file_1}]} {
|
|
Packit |
62fe53 |
set file_a [open ${file_1} r]
|
|
Packit |
62fe53 |
fconfigure $file_a -encoding binary
|
|
Packit |
62fe53 |
} else {
|
|
Packit |
62fe53 |
warning "${file_1} doesn't exist"
|
|
Packit |
62fe53 |
return 0
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
if {[file exists ${file_2}]} {
|
|
Packit |
62fe53 |
set file_b [open ${file_2} r]
|
|
Packit |
62fe53 |
fconfigure $file_b -encoding binary
|
|
Packit |
62fe53 |
} else {
|
|
Packit |
62fe53 |
warning "${file_2} doesn't exist"
|
|
Packit |
62fe53 |
return 0
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
verbose "# Diff'ing: ${file_1} ${file_2}" 1
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
set list_a ""
|
|
Packit |
62fe53 |
while { [gets ${file_a} line] != ${eof} } {
|
|
Packit |
62fe53 |
if {[regexp "^#.*$" ${line}]} {
|
|
Packit |
62fe53 |
continue
|
|
Packit |
62fe53 |
} else {
|
|
Packit |
62fe53 |
lappend list_a ${line}
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
close ${file_a}
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
set list_b ""
|
|
Packit |
62fe53 |
while { [gets ${file_b} line] != ${eof} } {
|
|
Packit |
62fe53 |
if {[regexp "^#.*$" ${line}]} {
|
|
Packit |
62fe53 |
continue
|
|
Packit |
62fe53 |
} else {
|
|
Packit |
62fe53 |
lappend list_b ${line}
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
close ${file_b}
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
for { set i 0 } { $i < [llength $list_a] } { incr i } {
|
|
Packit |
62fe53 |
set line_a [lindex ${list_a} ${i}]
|
|
Packit |
62fe53 |
set line_b [lindex ${list_b} ${i}]
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
if {[string compare ${line_a} ${line_b}]} {
|
|
Packit |
62fe53 |
verbose -log "line #${i}" 2
|
|
Packit |
62fe53 |
verbose -log "\< ${line_a}" 2
|
|
Packit |
62fe53 |
verbose -log "\> ${line_b}" 2
|
|
Packit |
62fe53 |
set differences -1
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
if { $differences == -1 || [llength ${list_a}] != [llength ${list_b}] } {
|
|
Packit |
62fe53 |
verbose "Files not the same" 2
|
|
Packit |
62fe53 |
set differences -1
|
|
Packit |
62fe53 |
} else {
|
|
Packit |
62fe53 |
verbose "Files are the same" 2
|
|
Packit |
62fe53 |
set differences 1
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
return $differences
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
# Set an environment variable
|
|
Packit |
62fe53 |
#
|
|
Packit |
62fe53 |
proc setenv { var val } {
|
|
Packit |
62fe53 |
global env
|
|
Packit |
62fe53 |
set env($var) $val
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
# Unset an environment variable
|
|
Packit |
62fe53 |
#
|
|
Packit |
62fe53 |
proc unsetenv { var } {
|
|
Packit |
62fe53 |
global env
|
|
Packit |
62fe53 |
unset env($var)
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
|
|
Packit |
62fe53 |
# Get a value from an environment variable
|
|
Packit |
62fe53 |
#
|
|
Packit |
62fe53 |
proc getenv { var } {
|
|
Packit |
62fe53 |
global env
|
|
Packit |
62fe53 |
if {[info exists env($var)]} {
|
|
Packit |
62fe53 |
return $env($var)
|
|
Packit |
62fe53 |
} else {
|
|
Packit |
62fe53 |
return ""
|
|
Packit |
62fe53 |
}
|
|
Packit |
62fe53 |
}
|