/[dejagnu]/dejagnu/lib/utils.exp
ViewVC logotype

Diff of /dejagnu/lib/utils.exp

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

revision 1.7 by rsavoye, Mon Jul 28 14:45:35 2003 UTC revision 1.8 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@gnu.org  # bug-dejagnu@gnu.org
# 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 78  proc getdirs { args } { Line 78  proc getdirs { args } {
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 {
# Line 101  proc find { rootdir pattern } { Line 101  proc find { rootdir pattern } {
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
# Line 125  proc find { rootdir pattern } { Line 125  proc find { rootdir pattern } {
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] {
# Line 139  proc which { file } { Line 139  proc which { 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] {
# Line 155  proc which { file } { Line 155  proc which { 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,
# Line 163  proc which { file } { Line 163  proc which { file } {
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 } {
# Line 178  proc grep { args } { Line 178  proc grep { args } {
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 } {
# Line 225  proc prune { list pattern } { Line 225  proc prune { list pattern } {
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 } {
# Line 249  proc absolute { path } { Line 249  proc absolute { path } {
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]
# Line 322  proc runtest_file_p { runtests testcase Line 322  proc runtest_file_p { runtests testcase
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}] {
# Line 348  proc diff { file_1 file_2 } { Line 348  proc diff { file_1 file_2 } {
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}] {
# Line 376  proc diff { file_1 file_2 } { Line 376  proc diff { file_1 file_2 } {
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
# Line 392  proc diff { file_1 file_2 } { Line 392  proc diff { file_1 file_2 } {
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    

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8

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