OSDN Git Service

* config/alpha/vms.h (INCLUDE_DEFAULTS): Add /gnu/lib/gcc-lib/include.
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / lib / chill.exp
1 #
2 # Expect script for Chill Regression Tests
3 #   Copyright (C) 1993, 1996, 1997 Free Software Foundation
4 #
5 # This file is free software; you can redistribute it and/or modify
6 # it under the terms of the GNU General Public License as published by
7 # the Free Software Foundation; either version 2 of the License, or
8 # (at your option) any later version.
9 #
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13 # GNU General Public License for more details.
14 #
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
18 #
19 # Written by Jeffrey Wheat (cassidy@cygnus.com)
20 #
21
22 #
23 # chill support library procedures and testsuite specific instructions
24 #
25
26 #
27 # default_chill_version 
28 #       extract and print the version number of the chill compiler
29 #       exits if compiler does not exist
30 #
31 proc default_chill_version { } {
32     global GCC_UNDER_TEST
33     
34     # ignore any arguments after the command 
35     set compiler [lindex $GCC_UNDER_TEST 0]
36     
37     # verify that the compiler exists
38     if {[which $compiler] != 0} then {
39         set tmp [ exec $compiler -v ]
40         regexp "version.*$" $tmp version
41         
42         if [info exists version] then {
43             clone_output "[which $compiler] $version\n"
44         }
45     } else {
46         warning "$compiler does not exist"
47         exit -1
48     }
49 }
50
51 #
52 # chill_compile
53 #       compile the specified file
54 #
55 #       returns values:
56 #               return 0 on success
57 #               return 1 on failure with $result containing compiler output
58 #               exit with -1 if compiler doesn't exist
59 #
60 #       verbosity output:
61 #               1 - indicate compile in progress
62 #               2 - indicate compile, target name
63 #               3 - indicate compile, target name, exec command, and result
64 #
65 proc chill_compile { src obj } {
66     global GCC_UNDER_TEST
67     global CFLAGS
68     
69     global errno
70     global result
71     global verbose
72
73     global subdir
74     global tmpdir
75    
76     set errno 0 
77     set cflags $CFLAGS
78     set dumpfile [file rootname $obj].cmp    ;# name of file to dump stderr in
79
80     # verify that the compiler exists
81     if { [which $GCC_UNDER_TEST] == 0 } then {
82         warning "$GCC_UNDER_TEST does not exist"
83         exit -1
84     }
85     
86     if { $verbose == 1 } then {
87         send_user "Compiling... "
88     } else {
89         verbose " -  CMPL: Compiling [file tail $src]" 2
90     }
91    
92     # if object type is a grt file, then only build a grant file
93     if [string match "*.grt" $obj] then {
94         set cflags [concat $cflags -fgrant-only]
95     }
96
97     # build command line
98     set commandline "$GCC_UNDER_TEST $cflags -I$subdir -c $src"
99
100     # write command line to logfile
101     send_log "\n### EXEC: $commandline\n"
102     
103     # tell us whats going on if verbose 
104     verbose "### EXEC: $commandline" 3
105     
106     # exec the compiler with the appropriate flags
107     set errno [catch "exec $commandline" result]
108
109     # dump compiler's stderr output into $dumpfile - this is a gross hack
110     set dumpfile [open $dumpfile w+]; puts $dumpfile $result; close $dumpfile
111
112     # log any compiler output unless its null
113     if ![string match "" $result] then { send_log "\n$result\n" }
114     unset cflags
115     return
116 }
117
118 #
119 # chill_link
120 #       link the specified files
121 #
122 #       returns values:
123 #               return 0 on success
124 #               return 1 on failure with $result containing compiler output
125 #               exit with -1 if compiler doesn't exist
126 #
127 #       verbosity output:
128 #               1 - indicate linking in progress
129 #               2 - indicate linking, target name
130 #               3 - indicate linking, target name, exec command, and result
131 #
132 proc chill_link { target } {
133     global GCC_UNDER_TEST
134     global CFLAGS
135     
136     global errno 
137     global result
138     global verbose
139     global tmptarget
140     
141     global crt0
142     global libs
143     global objs
144     
145     set errno 0
146     
147     # verify that the compiler exists
148     if { [which $GCC_UNDER_TEST] == 0 } then {
149         warning "$GCC_UNDER_TEST does not exist"
150         exit -1
151     }
152     
153     if { $verbose == 1 } then {
154         send_user "Linking... "
155     } else {
156         verbose " -  LINK: Linking [file tail $target]" 2
157     }
158     
159     # verify that the object exists
160     if ![file exists $target.o] then {
161         set errno 1
162         set result "file $target.o doesn't exist"
163         return
164     }
165     
166     # build command line
167     set commandline "$GCC_UNDER_TEST $CFLAGS -o $target $target.o $objs $crt0 $libs"
168
169     # write command line to logfile
170     send_log "\n### EXEC: $commandline\n"
171     
172     # tell us whats going on if we are verbose  
173     verbose "### EXEC: $commandline" 3
174     
175     # link the objects, sending any linker output to $result
176     set errno [catch "exec $commandline > $tmptarget.lnk" result]
177  
178     # log any linker output unless its null
179     if ![string match "" $result] then { send_log "\n$result\n" }
180     return
181 }
182
183 #
184 # default_chill_start
185 #
186 proc default_chill_start { } {
187     global srcdir
188     global subdir
189     global tmpdir
190     global verbose
191   
192     if { $verbose > 1 } then { send_user "Configuring testsuite... " }
193
194     # tmpdir is obtained from $objdir/site.exp. if not, set it to /tmp
195     if ![info exists tmpdir] then { set tmpdir /tmp }
196
197     # save and convert $srcdir to an absolute pathname, stomp on the old value
198     # stomp on $subdir and set to the absolute path to the subdirectory
199     global osrcdir; set osrcdir $srcdir; set srcdir [cd $srcdir; pwd]
200     global osubdir; set osubdir $subdir; set subdir $srcdir/$subdir
201
202     # cd the temporary directory, $tmpdir
203     cd $tmpdir; verbose "### PWD: [pwd]" 5
204
205     # copy init files to the tmpdir
206     foreach initfile [glob -nocomplain $subdir/*.init] {
207         set targfile $tmpdir/[file tail [file rootname $initfile]]
208         verbose "### EXEC: cp $initfile $targfile" 5
209         if [catch "exec cp $initfile $targfile"] then {
210             send_user "\nConfigure failed.\n"
211             exit -1
212         }
213     }
214     if { $verbose > 1 } then { send_user "Configuring finished.\n" }
215 }
216     
217 #
218 # default_chill_exit
219 #
220 #
221 proc default_chill_exit { } {
222     global srcdir
223     global objdir
224     global tmpdir
225     global osrcdir
226     global osubdir
227     
228     # reset directory variables
229     set srcdir $osrcdir; set subdir $osubdir
230
231     # remove all generated targets and objects  
232     verbose "### EXEC: rm -f $tmpdir/*" 3
233     catch "exec rm -f $tmpdir/*" result
234
235     # change back to the main object directory
236     cd $objdir
237     verbose "### SANITY: [pwd]" 5
238 }
239
240 #
241 # chill_diff
242 #       compare two files line-by-line
243 #
244 #       returns values:
245 #               return 0 on success
246 #               return 1 if different
247 #               return -1 if output file doesn't exist
248 #
249 #       verbosity output:
250 #               1 - indicate diffing in progress
251 #               2 - indicate diffing, target names
252 #               3 - indicate diffing, target names, and result
253 #
254 proc chill_diff { file_1 file_2 } {
255     global errno
256     global result
257     global target
258     global tmptarget
259
260     global verbose
261     
262     set eof -1
263     set errno 0
264     set differences 0
265     
266     if { $verbose == 1 } then {
267         send_user "Diffing... "
268     } else {
269         verbose " -  DIFF: Diffing [file tail $file_1] [file tail $file_2]" 2
270     }
271     
272     # write command line to logfile
273     send_log "### EXEC: diff $file_1 $file_2\n"
274     
275     # tell us whats going on if we are verbose  
276     verbose "### EXEC: diff $file_1 $file_2" 3
277     
278     # verify file exists and open it
279     if [file exists $file_1] then {
280         set file_a [open $file_1 r]
281     } else {
282         set errno -1; set result "$file_1 doesn't exist"
283         return
284     }
285     
286     # verify file exists and is not zero length, and then open it
287     if [file exists $file_2] then {
288         if [file size $file_2]!=0 then {
289             set file_b [open $file_2 r]
290         } else {
291             set errno -1; set result "$file_2 is zero bytes"; return
292         }
293     } else {
294         set errno -1; set result "$file_2 doesn't exist"; return
295     }
296     
297     # spoof the diff routine
298     lappend list_a $target
299
300     while { [gets $file_a line] != $eof } {
301         if [regexp "^#.*$" $line] then {
302             continue
303         } else {
304             lappend list_a $line
305         }
306     }
307     close $file_a
308
309     # spoof the diff routine
310     lappend list_b $target
311
312     while { [gets $file_b line] != $eof } {
313         if [regexp "^#.*$" $line] then {
314             continue
315         } else {
316             # use [file tail $line] to strip off pathname
317             lappend list_b [file tail $line]
318         }
319     }
320     close $file_b
321     
322     for { set i 0 } { $i < [llength $list_a] } { incr i } {
323         set line_a [lindex $list_a $i]
324         set line_b [lindex $list_b $i]
325         
326         if [string compare $line_a $line_b] then {
327             set errno 1
328             set count [expr $i+1]
329             set linenum [format %dc%d $count $count]
330             verbose "$linenum" 3            
331             verbose "< $line_a" 3
332             verbose "---" 3
333             verbose "> $line_b" 3
334             
335             send_log "$file_1: < $count: $line_a\n"
336             send_log "$file_2: > $count: $line_b\n"
337             set result "differences found"
338         }
339     }
340     return
341 }
342
343 #
344 # chill_fail
345 #       a wrapper around the framework fail proc
346 #
347 proc chill_fail { target result } {
348     global verbose
349
350     if { $verbose == 1 } then { send_user "\n" }
351     fail $target
352     verbose "--------------------------------------------------" 3
353     verbose "### RESULT: $result" 3
354 }
355
356 #
357 # chill_pass
358 #       a wrapper around the framework fail proc
359 #
360 proc chill_pass { target } {
361     global verbose
362
363     if { $verbose == 1 } then { send_user "\n" }
364     pass $target
365 }