/[dejagnu]/dejagnu/contrib/bluegnu2.0.3/lib/utils.exp
ViewVC logotype

Diff of /dejagnu/contrib/bluegnu2.0.3/lib/utils.exp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1.1.1 by rsavoye, Mon Feb 5 04:30:38 2001 UTC revision 1.2 by bje, Sat Aug 16 13:08:57 2003 UTC
# Line 4  Line 4 
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
# Line 20  Line 20 
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    
# Line 67  proc getdirs { args } { Line 67  proc getdirs { args } {
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 {
# Line 80  proc getdirs { args } { Line 80  proc getdirs { args } {
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.
# Line 106  proc find { rootdir pattern } { Line 106  proc find { rootdir pattern } {
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
# Line 120  proc find { rootdir pattern } { Line 120  proc find { rootdir pattern } {
120              }              }
121          }          }
122      }      }
123        
124      if ![info exists files] {      if ![info exists files] {
125          lappend files ""          lappend files ""
126      }      }
# Line 136  proc find { rootdir pattern } { Line 136  proc find { rootdir pattern } {
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] {
# Line 150  proc which { file } { Line 150  proc which { 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] {
# Line 166  proc which { file } { Line 166  proc which { 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,
# Line 174  proc which { file } { Line 174  proc which { file } {
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 } {
# Line 189  proc grep { args } { Line 189  proc grep { args } {
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 } {
# Line 259  proc absolute { path } { Line 259  proc absolute { path } {
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]
# Line 359  if { [info procs prune_system_crud] == " Line 359  if { [info procs prune_system_crud] == "
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
# Line 384  proc diff { file_1 file_2 } { Line 384  proc diff { file_1 file_2 } {
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
# Line 411  proc diff { file_1 file_2 } { Line 411  proc diff { file_1 file_2 } {
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
# Line 427  proc diff { file_1 file_2 } { Line 427  proc diff { file_1 file_2 } {
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    

Legend:
Removed from v.1.1.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26