4 |
# it under the terms of the GNU General Public License as published by |
# it under the terms of the GNU General Public License as published by |
5 |
# the Free Software Foundation; either version 2 of the License, or |
# the Free Software Foundation; either version 2 of the License, or |
6 |
# (at your option) any later version. |
# (at your option) any later version. |
7 |
# |
# |
8 |
# This program is distributed in the hope that it will be useful, |
# This program is distributed in the hope that it will be useful, |
9 |
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
10 |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
11 |
# GNU General Public License for more details. |
# GNU General Public License for more details. |
12 |
# |
# |
13 |
# You should have received a copy of the GNU General Public License |
# You should have received a copy of the GNU General Public License |
14 |
# along with this program; if not, write to the Free Software |
# along with this program; if not, write to the Free Software |
15 |
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. |
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. |
16 |
|
|
17 |
# Please email any bugs, comments, and/or additions to this file to: |
# Please email any bugs, comments, and/or additions to this file to: |
18 |
# bug-dejagnu@prep.ai.mit.edu |
# bug-dejagnu@prep.ai.mit.edu |
20 |
# This file was written by Rob Savoye. (rob@welcomehome.org) |
# This file was written by Rob Savoye. (rob@welcomehome.org) |
21 |
|
|
22 |
# |
# |
23 |
# Most of the procedures found here mimic their unix counter-part. |
# Most of the procedures found here mimic their unix counter-part. |
24 |
# This file is sourced by runtest.exp, so they are usable by any test case. |
# This file is sourced by runtest.exp, so they are usable by any test case. |
25 |
# |
# |
26 |
|
|
67 |
perror "$tmp" |
perror "$tmp" |
68 |
return "" |
return "" |
69 |
} |
} |
70 |
|
|
71 |
if ![info exists dirs] { |
if ![info exists dirs] { |
72 |
return "" |
return "" |
73 |
} else { |
} else { |
80 |
# rootdir - this is the directory to start the search |
# rootdir - this is the directory to start the search |
81 |
# from. This is and all subdirectories are search for |
# from. This is and all subdirectories are search for |
82 |
# filenames. Directory names are not included in the |
# filenames. Directory names are not included in the |
83 |
# list, but the filenames have path information. |
# list, but the filenames have path information. |
84 |
# pattern - this is the pattern to match. Patterns are csh style |
# pattern - this is the pattern to match. Patterns are csh style |
85 |
# globbing rules. |
# globbing rules. |
86 |
# returns: a list or a NULL. |
# returns: a list or a NULL. |
106 |
} |
} |
107 |
set tmp "" |
set tmp "" |
108 |
} |
} |
109 |
|
|
110 |
# find all the files that match the pattern |
# find all the files that match the pattern |
111 |
foreach i $dirs { |
foreach i $dirs { |
112 |
verbose "Looking in $i" 3 |
verbose "Looking in $i" 3 |
120 |
} |
} |
121 |
} |
} |
122 |
} |
} |
123 |
|
|
124 |
if ![info exists files] { |
if ![info exists files] { |
125 |
lappend files "" |
lappend files "" |
126 |
} |
} |
136 |
# |
# |
137 |
proc which { file } { |
proc which { file } { |
138 |
global env |
global env |
139 |
|
|
140 |
# strip off any extraneous arguments (like flags to the compiler) |
# strip off any extraneous arguments (like flags to the compiler) |
141 |
set file [lindex $file 0] |
set file [lindex $file 0] |
142 |
|
|
143 |
# if it exists then the path must be OK |
# if it exists then the path must be OK |
144 |
# ??? What if $file has no path and "." isn't in $PATH? |
# ??? What if $file has no path and "." isn't in $PATH? |
145 |
if [file exists $file] { |
if [file exists $file] { |
150 |
} else { |
} else { |
151 |
return 0 |
return 0 |
152 |
} |
} |
153 |
|
|
154 |
foreach i $path { |
foreach i $path { |
155 |
verbose "Checking against $i" 3 |
verbose "Checking against $i" 3 |
156 |
if [file exists $i/$file] { |
if [file exists $i/$file] { |
166 |
} |
} |
167 |
|
|
168 |
# |
# |
169 |
# Looks for a string in a file. |
# Looks for a string in a file. |
170 |
# return:list of lines that matched or NULL if none match. |
# return:list of lines that matched or NULL if none match. |
171 |
# args: first arg is the filename, |
# args: first arg is the filename, |
172 |
# second is the pattern, |
# second is the pattern, |
174 |
# Options: line - puts line numbers of match in list |
# Options: line - puts line numbers of match in list |
175 |
# |
# |
176 |
proc grep { args } { |
proc grep { args } { |
177 |
|
|
178 |
set file [lindex $args 0] |
set file [lindex $args 0] |
179 |
set pattern [lindex $args 1] |
set pattern [lindex $args 1] |
180 |
|
|
181 |
verbose "Grepping $file for the pattern \"$pattern\"" 3 |
verbose "Grepping $file for the pattern \"$pattern\"" 3 |
182 |
|
|
183 |
set argc [llength $args] |
set argc [llength $args] |
184 |
if { $argc > 2 } { |
if { $argc > 2 } { |
185 |
for { set i 2 } { $i < $argc } { incr i } { |
for { set i 2 } { $i < $argc } { incr i } { |
189 |
} else { |
} else { |
190 |
set options "" |
set options "" |
191 |
} |
} |
192 |
|
|
193 |
set i 0 |
set i 0 |
194 |
set fd [open $file r] |
set fd [open $file r] |
195 |
while { [gets $fd cur_line]>=0 } { |
while { [gets $fd cur_line]>=0 } { |
259 |
if [string match "." $path] { |
if [string match "." $path] { |
260 |
return [pwd] |
return [pwd] |
261 |
} |
} |
262 |
|
|
263 |
set basedir [pwd] |
set basedir [pwd] |
264 |
cd $path |
cd $path |
265 |
set path [pwd] |
set path [pwd] |
359 |
proc diff { file_1 file_2 } { |
proc diff { file_1 file_2 } { |
360 |
set eof -1 |
set eof -1 |
361 |
set differences 0 |
set differences 0 |
362 |
|
|
363 |
if [file exists ${file_1}] { |
if [file exists ${file_1}] { |
364 |
set file_a [open ${file_1} r] |
set file_a [open ${file_1} r] |
365 |
} else { |
} else { |
366 |
warning "${file_1} doesn't exist" |
warning "${file_1} doesn't exist" |
367 |
return 0 |
return 0 |
368 |
} |
} |
369 |
|
|
370 |
if [file exists ${file_2}] { |
if [file exists ${file_2}] { |
371 |
set file_b [open ${file_2} r] |
set file_b [open ${file_2} r] |
372 |
} else { |
} else { |
373 |
warning "${file_2} doesn't exist" |
warning "${file_2} doesn't exist" |
374 |
return 0 |
return 0 |
375 |
} |
} |
376 |
|
|
377 |
verbose "# Diff'ing: ${file_1} ${file_2}\n" 1 |
verbose "# Diff'ing: ${file_1} ${file_2}\n" 1 |
378 |
|
|
379 |
while { [gets ${file_a} line] != ${eof} } { |
while { [gets ${file_a} line] != ${eof} } { |
380 |
if [regexp "^#.*$" ${line}] { |
if [regexp "^#.*$" ${line}] { |
381 |
continue |
continue |
384 |
} |
} |
385 |
} |
} |
386 |
close ${file_a} |
close ${file_a} |
387 |
|
|
388 |
while { [gets ${file_b} line] != ${eof} } { |
while { [gets ${file_b} line] != ${eof} } { |
389 |
if [regexp "^#.*$" ${line}] { |
if [regexp "^#.*$" ${line}] { |
390 |
continue |
continue |
411 |
set differences -1 |
set differences -1 |
412 |
} |
} |
413 |
} |
} |
414 |
|
|
415 |
if { [llength ${list_a}] != [llength ${list_b}] } { |
if { [llength ${list_a}] != [llength ${list_b}] } { |
416 |
verbose "Files not the same" 2 |
verbose "Files not the same" 2 |
417 |
set differences -1 |
set differences -1 |
427 |
# |
# |
428 |
proc setenv { var val } { |
proc setenv { var val } { |
429 |
global env |
global env |
430 |
|
|
431 |
set env($var) $val |
set env($var) $val |
432 |
} |
} |
433 |
|
|