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@gnu.org |
# bug-dejagnu@gnu.org |
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 |
|
|
78 |
perror "$tmp" |
perror "$tmp" |
79 |
return "" |
return "" |
80 |
} |
} |
81 |
|
|
82 |
if ![info exists dirs] { |
if ![info exists dirs] { |
83 |
return "" |
return "" |
84 |
} else { |
} else { |
101 |
|
|
102 |
# find all the directories |
# find all the directories |
103 |
set dirs [concat [getdirs -all $rootdir] $rootdir] |
set dirs [concat [getdirs -all $rootdir] $rootdir] |
104 |
|
|
105 |
# find all the files in the directories that match the pattern |
# find all the files in the directories that match the pattern |
106 |
foreach i $dirs { |
foreach i $dirs { |
107 |
verbose "Looking in $i" 3 |
verbose "Looking in $i" 3 |
125 |
# |
# |
126 |
proc which { file } { |
proc which { file } { |
127 |
global env |
global env |
128 |
|
|
129 |
# strip off any extraneous arguments (like flags to the compiler) |
# strip off any extraneous arguments (like flags to the compiler) |
130 |
set file [lindex $file 0] |
set file [lindex $file 0] |
131 |
|
|
132 |
# if it exists then the path must be OK |
# if it exists then the path must be OK |
133 |
# ??? What if $file has no path and "." isn't in $PATH? |
# ??? What if $file has no path and "." isn't in $PATH? |
134 |
if [file exists $file] { |
if [file exists $file] { |
139 |
} else { |
} else { |
140 |
return 0 |
return 0 |
141 |
} |
} |
142 |
|
|
143 |
foreach i $path { |
foreach i $path { |
144 |
verbose "Checking against $i" 3 |
verbose "Checking against $i" 3 |
145 |
if [file exists $i/$file] { |
if [file exists $i/$file] { |
155 |
} |
} |
156 |
|
|
157 |
# |
# |
158 |
# Looks for a string in a file. |
# Looks for a string in a file. |
159 |
# return:list of lines that matched or NULL if none match. |
# return:list of lines that matched or NULL if none match. |
160 |
# args: first arg is the filename, |
# args: first arg is the filename, |
161 |
# second is the pattern, |
# second is the pattern, |
163 |
# Options: line - puts line numbers of match in list |
# Options: line - puts line numbers of match in list |
164 |
# |
# |
165 |
proc grep { args } { |
proc grep { args } { |
166 |
|
|
167 |
set file [lindex $args 0] |
set file [lindex $args 0] |
168 |
set pattern [lindex $args 1] |
set pattern [lindex $args 1] |
169 |
|
|
170 |
verbose "Grepping $file for the pattern \"$pattern\"" 3 |
verbose "Grepping $file for the pattern \"$pattern\"" 3 |
171 |
|
|
172 |
set argc [llength $args] |
set argc [llength $args] |
173 |
if { $argc > 2 } { |
if { $argc > 2 } { |
174 |
for { set i 2 } { $i < $argc } { incr i } { |
for { set i 2 } { $i < $argc } { incr i } { |
178 |
} else { |
} else { |
179 |
set options "" |
set options "" |
180 |
} |
} |
181 |
|
|
182 |
set i 0 |
set i 0 |
183 |
set fd [open $file r] |
set fd [open $file r] |
184 |
while { [gets $fd cur_line]>=0 } { |
while { [gets $fd cur_line]>=0 } { |
225 |
return $tmp |
return $tmp |
226 |
} |
} |
227 |
|
|
228 |
# |
# |
229 |
# Attempt to kill a process that you started on the local machine. |
# Attempt to kill a process that you started on the local machine. |
230 |
# |
# |
231 |
proc slay { name } { |
proc slay { name } { |
249 |
if [string match "." $path] { |
if [string match "." $path] { |
250 |
return [pwd] |
return [pwd] |
251 |
} |
} |
252 |
|
|
253 |
set basedir [pwd] |
set basedir [pwd] |
254 |
cd $path |
cd $path |
255 |
set path [pwd] |
set path [pwd] |
322 |
proc diff { file_1 file_2 } { |
proc diff { file_1 file_2 } { |
323 |
set eof -1 |
set eof -1 |
324 |
set differences 0 |
set differences 0 |
325 |
|
|
326 |
if [file exists ${file_1}] { |
if [file exists ${file_1}] { |
327 |
set file_a [open ${file_1} r] |
set file_a [open ${file_1} r] |
328 |
} else { |
} else { |
329 |
warning "${file_1} doesn't exist" |
warning "${file_1} doesn't exist" |
330 |
return 0 |
return 0 |
331 |
} |
} |
332 |
|
|
333 |
if [file exists ${file_2}] { |
if [file exists ${file_2}] { |
334 |
set file_b [open ${file_2} r] |
set file_b [open ${file_2} r] |
335 |
} else { |
} else { |
336 |
warning "${file_2} doesn't exist" |
warning "${file_2} doesn't exist" |
337 |
return 0 |
return 0 |
338 |
} |
} |
339 |
|
|
340 |
verbose "# Diff'ing: ${file_1} ${file_2}\n" 1 |
verbose "# Diff'ing: ${file_1} ${file_2}\n" 1 |
341 |
|
|
342 |
set list_a "" |
set list_a "" |
343 |
while { [gets ${file_a} line] != ${eof} } { |
while { [gets ${file_a} line] != ${eof} } { |
344 |
if [regexp "^#.*$" ${line}] { |
if [regexp "^#.*$" ${line}] { |
348 |
} |
} |
349 |
} |
} |
350 |
close ${file_a} |
close ${file_a} |
351 |
|
|
352 |
set list_b "" |
set list_b "" |
353 |
while { [gets ${file_b} line] != ${eof} } { |
while { [gets ${file_b} line] != ${eof} } { |
354 |
if [regexp "^#.*$" ${line}] { |
if [regexp "^#.*$" ${line}] { |
376 |
set differences -1 |
set differences -1 |
377 |
} |
} |
378 |
} |
} |
379 |
|
|
380 |
if { $differences == -1 || [llength ${list_a}] != [llength ${list_b}] } { |
if { $differences == -1 || [llength ${list_a}] != [llength ${list_b}] } { |
381 |
verbose "Files not the same" 2 |
verbose "Files not the same" 2 |
382 |
set differences -1 |
set differences -1 |
392 |
# |
# |
393 |
proc setenv { var val } { |
proc setenv { var val } { |
394 |
global env |
global env |
395 |
|
|
396 |
set env($var) $val |
set env($var) $val |
397 |
} |
} |
398 |
|
|