]>
Commit | Line | Data |
---|---|---|
9dfcd609 JM |
1 | # Copyright (C) 1992, 1993, 1994, 1996, 1997, 2000, 2001, 2002, 2004 |
2 | # Free Software Foundation, Inc. | |
6cfea11b TJ |
3 | |
4 | # This program is free software; you can redistribute it and/or modify | |
5 | # it under the terms of the GNU General Public License as published by | |
6 | # the Free Software Foundation; either version 2 of the License, or | |
7 | # (at your option) any later version. | |
8 | # | |
9 | # This program is distributed in the hope that it will be useful, | |
10 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
11 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
12 | # GNU General Public License for more details. | |
13 | # | |
14 | # You should have received a copy of the GNU General Public License | |
15 | # along with this program; if not, write to the Free Software | |
16 | # Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. | |
17 | ||
9dfcd609 JM |
18 | # This file was written by Rob Savoye (rob@cygnus.com) |
19 | # Currently maintained by James A. Morrison (ja2morri@uwaterloo.ca) | |
20 | ||
6cfea11b TJ |
21 | # Having this file here magically tells dejagnu that the treelang |
22 | # directory is worthy of testing | |
23 | ||
9dfcd609 JM |
24 | # This file is basically treelang.exp with treelang replaced with treelang. |
25 | ||
26 | # This file is loaded by the tool init file (eg: unix.exp). It provides | |
27 | # default definitions for treelang_start, etc. and other supporting cast members. | |
28 | ||
29 | # These globals are used by treelang_start if no compiler arguments are provided. | |
30 | # They are also used by the various testsuites to define the environment: | |
31 | # where to find stdio.h, libc.a, etc. | |
32 | ||
33 | load_lib libgloss.exp | |
34 | load_lib prune.exp | |
35 | load_lib gcc-defs.exp | |
36 | ||
37 | # | |
38 | # TREELANG_UNDER_TEST is the compiler under test. | |
39 | # | |
40 | ||
41 | # | |
42 | # default_treelang_version -- extract and print the version number of the compiler | |
43 | # | |
44 | ||
45 | proc default_treelang_version { } { | |
46 | global TREELANG_UNDER_TEST | |
47 | ||
48 | treelang_init; | |
49 | ||
50 | # ignore any arguments after the command | |
51 | set compiler [lindex $TREELANG_UNDER_TEST 0] | |
52 | ||
53 | if ![is_remote host] { | |
54 | set compiler_name [which $compiler]; | |
55 | } else { | |
56 | set compiler_name $compiler; | |
57 | } | |
58 | ||
59 | # verify that the compiler exists | |
60 | if { $compiler_name != 0 } then { | |
61 | set tmp [remote_exec host "$compiler -v"] | |
62 | set status [lindex $tmp 0]; | |
63 | set output [lindex $tmp 1]; | |
fb0737c2 | 64 | regexp " version \[^\n\r\]*" $output version |
9dfcd609 JM |
65 | if { $status == 0 && [info exists version] } then { |
66 | clone_output "$compiler_name $version\n" | |
67 | } else { | |
68 | clone_output "Couldn't determine version of $compiler_name: $output\n" | |
69 | } | |
70 | } else { | |
71 | # compiler does not exist (this should have already been detected) | |
72 | warning "$compiler does not exist" | |
73 | } | |
74 | } | |
75 | ||
76 | # treelang_init -- called at the start of each .exp script. | |
77 | # | |
78 | # There currently isn't much to do, but always using it allows us to | |
79 | # make some enhancements without having to go back and rewrite the scripts. | |
80 | # | |
81 | ||
82 | set treelang_initialized 0 | |
83 | ||
84 | proc treelang_init { args } { | |
85 | global rootme | |
86 | global tmpdir | |
87 | global libdir | |
88 | global gluefile wrap_flags | |
89 | global treelang_initialized | |
90 | global TREELANG_UNDER_TEST | |
91 | global TOOL_EXECUTABLE | |
92 | global treelang_libgcc_s_path | |
93 | ||
94 | if { $treelang_initialized == 1 } { return; } | |
95 | ||
96 | if ![info exists TREELANG_UNDER_TEST] then { | |
97 | if [info exists TOOL_EXECUTABLE] { | |
98 | set TREELANG_UNDER_TEST $TOOL_EXECUTABLE; | |
99 | } else { | |
100 | set TREELANG_UNDER_TEST [find_gcc] | |
101 | } | |
102 | } | |
103 | ||
104 | if ![info exists tmpdir] then { | |
105 | set tmpdir /tmp | |
106 | } | |
8800e533 HPN |
107 | |
108 | treelang_maybe_build_wrapper "${tmpdir}/treelang-testglue.o" | |
9dfcd609 JM |
109 | |
110 | set treelang_libgcc_s_path "${rootme}" | |
111 | set compiler [lindex $TREELANG_UNDER_TEST 0] | |
112 | if { [is_remote host] == 0 && [which $compiler] != 0 } { | |
113 | foreach i "[exec $compiler --print-multi-lib]" { | |
114 | set mldir "" | |
115 | regexp -- "\[a-z0-9=/\.-\]*;" $i mldir | |
116 | set mldir [string trimright $mldir "\;@"] | |
117 | if { "$mldir" == "." } { | |
118 | continue | |
119 | } | |
1e02510f | 120 | if { [llength [glob -nocomplain ${rootme}/${mldir}/libgcc_s*.so.*]] >= 1 } { |
9dfcd609 JM |
121 | append treelang_libgcc_s_path ":${rootme}/${mldir}" |
122 | } | |
123 | } | |
124 | } | |
125 | } | |
126 | ||
127 | proc treelang_target_compile { source dest type options } { | |
128 | global rootme; | |
129 | global tmpdir; | |
130 | global gluefile wrap_flags; | |
131 | global srcdir | |
132 | global TREELANG_UNDER_TEST | |
133 | global TOOL_OPTIONS | |
134 | global ld_library_path | |
135 | global treelang_libgcc_s_path | |
136 | ||
137 | set ld_library_path ".:${treelang_libgcc_s_path}" | |
138 | lappend options "libs=-ltreelang" | |
139 | ||
140 | if { [target_info needs_status_wrapper]!="" && [info exists gluefile] } { | |
141 | lappend options "libs=${gluefile}" | |
142 | lappend options "ldflags=$wrap_flags" | |
143 | } | |
144 | ||
145 | # TOOL_OPTIONS must come first, so that it doesn't override testcase | |
146 | # specific options. | |
147 | if [info exists TOOL_OPTIONS] { | |
148 | set options [concat "additional_flags=$TOOL_OPTIONS" $options]; | |
149 | } | |
150 | ||
151 | # If we have built libtreelang along with the compiler (which usually | |
152 | # _is not_ the case on Mac OS X systems), point the test harness | |
153 | # at it (and associated headers). | |
154 | ||
155 | return [target_compile $source $dest $type $options] | |
156 | } | |
157 | ||
158 | # | |
159 | # treelang_pass -- utility to record a testcase passed | |
160 | # | |
161 | ||
162 | proc treelang_pass { testcase cflags } { | |
163 | if { "$cflags" == "" } { | |
164 | pass "$testcase" | |
165 | } else { | |
166 | pass "$testcase, $cflags" | |
167 | } | |
168 | } | |
169 | ||
170 | # | |
171 | # treelang_fail -- utility to record a testcase failed | |
172 | # | |
173 | ||
174 | proc treelang_fail { testcase cflags } { | |
175 | if { "$cflags" == "" } { | |
176 | fail "$testcase" | |
177 | } else { | |
178 | fail "$testcase, $cflags" | |
179 | } | |
180 | } | |
181 | ||
182 | # | |
183 | # treelang_finish -- called at the end of every .exp script that calls treelang_init | |
184 | # | |
185 | # The purpose of this proc is to hide all quirks of the testing environment | |
186 | # from the testsuites. It also exists to undo anything that treelang_init did | |
187 | # (that needs undoing). | |
188 | # | |
189 | ||
190 | proc treelang_finish { } { | |
191 | # The testing harness apparently requires this. | |
192 | global errorInfo; | |
193 | ||
194 | if [info exists errorInfo] then { | |
195 | unset errorInfo | |
196 | } | |
197 | ||
198 | # Might as well reset these (keeps our caller from wondering whether | |
199 | # s/he has to or not). | |
200 | global prms_id bug_id | |
201 | set prms_id 0 | |
202 | set bug_id 0 | |
203 | } | |
204 | ||
205 | proc treelang_exit { } { | |
206 | global gluefile; | |
207 | ||
208 | if [info exists gluefile] { | |
209 | file_on_build delete $gluefile; | |
210 | unset gluefile; | |
211 | } | |
212 | } | |
213 | ||
214 | # If this is an older version of dejagnu (without runtest_file_p), | |
215 | # provide one and assume the old syntax: foo1.exp bar1.c foo2.exp bar2.c. | |
216 | # This can be deleted after next dejagnu release. | |
217 | ||
218 | if { [info procs runtest_file_p] == "" } then { | |
219 | proc runtest_file_p { runtests testcase } { | |
220 | if { $runtests != "" && [regexp "\[.\]\[cC\]" $runtests] } then { | |
221 | if { [lsearch $runtests [file tail $testcase]] >= 0 } then { | |
222 | return 1 | |
223 | } else { | |
224 | return 0 | |
225 | } | |
226 | } | |
227 | return 1 | |
228 | } | |
229 | } | |
230 | ||
231 | # Provide a definition of this if missing (delete after next dejagnu release). | |
232 | ||
233 | if { [info procs prune_warnings] == "" } then { | |
234 | proc prune_warnings { text } { | |
235 | return $text | |
236 | } | |
237 | } | |
238 | ||
239 | # Utility used by mike-gcc.exp and c-torture.exp. | |
240 | # Check the compiler(/assembler/linker) output for text indicating that | |
241 | # the testcase should be marked as "unsupported". | |
242 | # | |
243 | # When dealing with a large number of tests, it's difficult to weed out the | |
244 | # ones that are too big for a particular cpu (eg: 16 bit with a small amount | |
245 | # of memory). There are various ways to deal with this. Here's one. | |
246 | # Fortunately, all of the cases where this is likely to happen will be using | |
247 | # gld so we can tell what the error text will look like. | |
248 | ||
249 | proc ${tool}_check_unsupported_p { output } { | |
250 | if [regexp "(^|\n)\[^\n\]*: region \[^\n\]* is full" $output] { | |
251 | return "memory full" | |
252 | } | |
253 | return "" | |
254 | } | |
255 | ||
256 | # Prune messages from treelang that aren't useful. | |
257 | ||
258 | proc prune_treelang_output { text } { | |
259 | #send_user "Before:$text\n" | |
260 | regsub -all "(^|\n)\[^\n\]*: In (function|method) \[^\n\]*" $text "" text | |
261 | regsub -all "(^|\n)\[^\n\]*: At top level:\[^\n\]*" $text "" text | |
262 | ||
263 | # It would be nice to avoid passing anything to treelang that would cause it to | |
264 | # issue these messages (since ignoring them seems like a hack on our part), | |
265 | # but that's too difficult in the general case. For example, sometimes | |
266 | # you need to use -B to point treelang at crt0.o, but there are some targets | |
267 | # that don't have crt0.o. | |
268 | regsub -all "(^|\n)\[^\n\]*file path prefix \[^\n\]* never used" $text "" text | |
269 | regsub -all "(^|\n)\[^\n\]*linker input file unused since linking not done" $text "" text | |
270 | ||
271 | #send_user "After:$text\n" | |
272 | ||
273 | return $text | |
274 | } | |
6cfea11b | 275 |