]>
Commit | Line | Data |
---|---|---|
7adcbafe | 1 | # Copyright (C) 2017-2022 Free Software Foundation, Inc. |
1c6b86b5 NS |
2 | |
3 | # This program is free software; you can redistribute it and/or modify | |
4 | # it under the terms of the GNU General Public License as published by | |
5 | # the Free Software Foundation; either version 3 of the License, or | |
6 | # (at your option) any later version. | |
7 | # | |
8 | # This program is distributed in the hope that it will be useful, | |
9 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
10 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
11 | # GNU General Public License for more details. | |
12 | # | |
13 | # You should have received a copy of the GNU General Public License | |
14 | # along with GCC; see the file COPYING3. If not see | |
15 | # <http://www.gnu.org/licenses/>. | |
16 | # | |
17 | # Contributed by Nathan Sidwell <nathan@acm.org> while at Facebook | |
18 | ||
19 | ||
20 | # Test C++ modules, which requires multiple TUs | |
21 | # | |
22 | # A test case might consist of multiple source files, each is compiled | |
23 | # separately, in a well-defined order. The resulting object files might | |
24 | # be optionally linked and optionally executed. Grouping is indicated by | |
25 | # naming files '*_[a-z].[CH]' | |
26 | ||
27 | # { dg-module-cmi "[!]module-name" } # an interface file is (not) expected | |
28 | # { dg-module-do [link|run] [xfail] [options] } # link [and run] | |
29 | ||
30 | load_lib g++-dg.exp | |
31 | ||
32 | # If a testcase doesn't have special options, use these. | |
33 | global DEFAULT_CXXFLAGS | |
34 | if ![info exists DEFAULT_CXXFLAGS] then { | |
35 | set DEFAULT_CXXFLAGS " -pedantic-errors -Wno-long-long" | |
36 | } | |
37 | set DEFAULT_MODFLAGS $DEFAULT_CXXFLAGS | |
bc56d27d | 38 | set MOD_STD_LIST { 17 2a 2b } |
1c6b86b5 | 39 | |
1c6b86b5 NS |
40 | dg-init |
41 | ||
1f9db692 NS |
42 | if {[is_remote host]} { |
43 | # remote testing not functional here :( | |
44 | return | |
45 | } | |
46 | ||
1c6b86b5 NS |
47 | global module_do |
48 | global module_cmis | |
1c6b86b5 NS |
49 | |
50 | set DEFAULT_REPO "gcm.cache" | |
51 | ||
52 | # Register the module name this produces. | |
53 | # dg-module-cmi !?=?NAME WHEN? | |
54 | # dg-module-cmi !?{} - header unit | |
55 | proc dg-module-cmi { args } { | |
56 | if { [llength $args] > 3 } { | |
57 | error "[lindex $args 0]: too many arguments" | |
58 | return | |
59 | } | |
60 | set spec [lindex $args 1] | |
61 | if { [llength $args] > 2 } { | |
62 | set when [lindex $args 2] | |
63 | } else { | |
64 | set when {} | |
65 | } | |
66 | ||
67 | if { [string index $spec 0] == "!" } { | |
68 | set name [string range $spec 1 end] | |
69 | set not 1 | |
70 | } else { | |
71 | set name $spec | |
72 | set not 0 | |
73 | } | |
74 | ||
75 | if { [string index $name 0] == "=" } { | |
76 | set cmi [string range $name 1 end] | |
77 | } else { | |
78 | if { $name == "" } { | |
79 | # get the source file name. ick! | |
80 | upvar prog srcname | |
81 | set cmi "$srcname.gcm" | |
82 | if { [string index $cmi 0] == "/" } { | |
83 | set cmi [string range $cmi 1 end] | |
84 | } else { | |
85 | set cmi ",/$cmi" | |
86 | } | |
87 | set path [file split $cmi] | |
88 | # subst /../ -> /,,/ | |
89 | # sadly tcl 8.5 does not have lmap | |
90 | set rplac {} | |
91 | foreach elt $path {lappend rplac [expr {$elt == ".." ? ",," : $elt}]} | |
92 | set cmi [file join {*}$rplac] | |
93 | } else { | |
94 | set cmi "[regsub : $name -].gcm" | |
95 | } | |
96 | global DEFAULT_REPO | |
97 | set cmi "$DEFAULT_REPO/$cmi" | |
98 | } | |
99 | ||
100 | # delete file, so we don't get confused by a stale one. | |
101 | file_on_host delete "$cmi" | |
102 | ||
103 | global module_cmis | |
104 | lappend module_cmis [list $spec $when $not $cmi] | |
105 | } | |
106 | ||
107 | # check the expected module files exist (or not) | |
108 | # return list to delete | |
109 | proc module_cmi_p { src ifs } { | |
110 | set res {} | |
111 | foreach if_arg $ifs { | |
112 | set spec [lindex $if_arg 0] | |
113 | set when [lindex $if_arg 1] | |
114 | if { $when != "" } { | |
115 | switch [dg-process-target $when] { | |
116 | "S" { } | |
117 | "N" { continue } | |
118 | "F" { setup_xfail "*-*-*" } | |
119 | "P" { } | |
120 | } | |
121 | } | |
122 | set not [lindex $if_arg 2] | |
123 | set cmi [lindex $if_arg 3] | |
eee8ed2f NS |
124 | global srcdir |
125 | set relcmi [string map [list $srcdir "/\$srcdir"] $cmi] | |
1c6b86b5 | 126 | if { $not != [file_on_host exists $cmi] } { |
eee8ed2f | 127 | pass "$src module-cmi $spec ($relcmi)" |
1c6b86b5 | 128 | } else { |
eee8ed2f | 129 | fail "$src module-cmi $spec ($relcmi)" |
1c6b86b5 NS |
130 | set not [expr ! $not ] |
131 | } | |
132 | if { ! $not } { | |
133 | lappend res $cmi | |
134 | } | |
135 | } | |
136 | return $res | |
137 | } | |
138 | ||
1c6b86b5 NS |
139 | # link and maybe run a set of object files |
140 | # dg-module-do WHAT WHEN | |
141 | proc dg-module-do { args } { | |
142 | if { [llength $args] > 3 } { | |
143 | error "[lindex $args 0]: too many arguments" | |
144 | return | |
145 | } | |
146 | ||
147 | set do_what [lindex $args 1] | |
148 | set expected "P" | |
149 | if { [llength $args] > 2 } { | |
150 | set expected [dg-process-target [lindex $args 2]] | |
151 | } | |
152 | ||
153 | global module_do | |
154 | set module_do [list $do_what $expected] | |
155 | } | |
156 | ||
157 | proc module_do_it { do_what testcase std asm_list } { | |
158 | global tool | |
159 | ||
160 | set run 0 | |
161 | switch [lindex $do_what 0] { | |
162 | "compile" { return 1 } | |
163 | "link" { } | |
164 | "run" { set run 1 } | |
165 | default { error "unknown module-do action [lindex $do_what 0]" } | |
166 | } | |
167 | ||
168 | set xfail {} | |
169 | switch [lindex $do_what 1] { | |
170 | "S" { } | |
171 | "N" { return 1 } | |
172 | "F" { set xfail {setup_xfail "*-*-*"} } | |
173 | "P" { } | |
174 | } | |
175 | ||
176 | set ok 1 | |
177 | # make sure all asms are around | |
178 | foreach asm $asm_list { | |
179 | if { ! [file_on_host exists $asm] } { | |
180 | set ok 0 | |
181 | } | |
182 | } | |
183 | ||
184 | set options { } | |
eee8ed2f | 185 | set ident $testcase |
1c6b86b5 NS |
186 | if { $std != "" } { |
187 | lappend options "additional_flags=$std" | |
eee8ed2f | 188 | set ident "$ident $std" |
1c6b86b5 NS |
189 | } |
190 | if { [llength $do_what] > 3 } { | |
191 | lappend options "additional_flags=[lindex $do_what 3]" | |
192 | } | |
193 | ||
194 | set execname "./[file tail $testcase].exe" | |
195 | ||
196 | # link it | |
197 | verbose "Linking $asm_list" 1 | |
198 | if { !$ok } { | |
b3cc0c9a | 199 | unresolved "$ident link" |
1c6b86b5 NS |
200 | } else { |
201 | set out [${tool}_target_compile $asm_list \ | |
202 | $execname executable $options] | |
203 | eval $xfail | |
204 | if { $out == "" } { | |
eee8ed2f | 205 | pass "$ident link" |
1c6b86b5 | 206 | } else { |
eee8ed2f | 207 | fail "$ident link" |
1c6b86b5 NS |
208 | set ok 0 |
209 | } | |
210 | } | |
211 | ||
212 | # run it? | |
213 | if { !$run } { | |
214 | } elseif { !$ok } { | |
eee8ed2f | 215 | unresolved "$ident execute" |
1c6b86b5 NS |
216 | } else { |
217 | set out [${tool}_load $execname "" ""] | |
218 | set status [lindex $out 0] | |
219 | eval $xfail | |
eee8ed2f | 220 | $status "$ident execute" |
1c6b86b5 NS |
221 | if { $status != "pass" } { |
222 | set $ok 0 | |
223 | } | |
224 | } | |
225 | ||
226 | if { $ok } { | |
227 | file_on_host delete $execname | |
228 | } | |
229 | ||
230 | return $ok | |
231 | } | |
232 | ||
233 | # delete the specified set of module files | |
234 | proc cleanup_module_files { files } { | |
235 | foreach file $files { | |
236 | file_on_host delete $file | |
237 | } | |
238 | } | |
239 | ||
240 | global testdir | |
241 | set testdir $srcdir/$subdir | |
242 | proc srcdir {} { | |
243 | global testdir | |
244 | return $testdir | |
245 | } | |
246 | ||
247 | # Return set of std options to iterate over, taken from g++-dg.exp & compat.exp | |
248 | proc module-init { src } { | |
249 | set tmp [dg-get-options $src] | |
250 | set option_list {} | |
1c6b86b5 NS |
251 | set have_std 0 |
252 | set std_prefix "-std=c++" | |
253 | ||
254 | foreach op $tmp { | |
255 | switch [lindex $op 0] { | |
256 | "dg-options" { | |
257 | set std_prefix "-std=gnu++" | |
258 | if { [string match "*-std=*" [lindex $op 2]] } { | |
259 | set have_std 1 | |
260 | } | |
261 | } | |
262 | "dg-additional-options" { | |
263 | if { [string match "*-std=*" [lindex $op 2]] } { | |
264 | set have_std 1 | |
265 | } | |
266 | } | |
1c6b86b5 NS |
267 | } |
268 | } | |
269 | ||
270 | if { !$have_std } { | |
271 | global MOD_STD_LIST | |
272 | foreach x $MOD_STD_LIST { | |
273 | lappend option_list "${std_prefix}$x" | |
274 | } | |
275 | } else { | |
276 | lappend option_list "" | |
277 | } | |
278 | ||
279 | return $option_list | |
280 | } | |
281 | ||
1f9db692 NS |
282 | # cleanup any detritus from previous run |
283 | cleanup_module_files [find $DEFAULT_REPO *.gcm] | |
284 | ||
1c6b86b5 NS |
285 | # not grouped tests, sadly tcl doesn't have negated glob |
286 | foreach test [prune [lsort [find $srcdir/$subdir {*.[CH]}]] \ | |
287 | "$srcdir/$subdir/*_?.\[CH\]"] { | |
288 | if [runtest_file_p $runtests $test] { | |
289 | set nshort [file tail [file dirname $test]]/[file tail $test] | |
290 | ||
291 | set std_list [module-init $test] | |
292 | foreach std $std_list { | |
1f9db692 | 293 | global module_cmis |
1c6b86b5 NS |
294 | set module_cmis {} |
295 | verbose "Testing $nshort $std" 1 | |
296 | dg-test $test "$std" $DEFAULT_MODFLAGS | |
297 | set testcase [string range $test [string length "$srcdir/"] end] | |
298 | cleanup_module_files [module_cmi_p $testcase $module_cmis] | |
299 | } | |
300 | } | |
301 | } | |
302 | ||
303 | # grouped tests | |
1f9db692 | 304 | foreach src [lsort [find $srcdir/$subdir {*_a.[CHX}]] { |
1c6b86b5 NS |
305 | # use the FOO_a.C name as the parallelization key |
306 | if [runtest_file_p $runtests $src] { | |
307 | set tests [lsort [find [file dirname $src] \ | |
1f9db692 | 308 | [regsub {_a.[CHX]$} [file tail $src] {_[a-z].[CHX]}]]] |
1c6b86b5 NS |
309 | |
310 | set std_list [module-init $src] | |
311 | foreach std $std_list { | |
312 | set mod_files {} | |
313 | global module_do | |
314 | set module_do {"compile" "P"} | |
315 | set asm_list {} | |
1f9db692 NS |
316 | set any_hdrs 0 |
317 | global DEFAULT_REPO | |
318 | file_on_host delete $DEFAULT_REPO | |
1c6b86b5 NS |
319 | foreach test $tests { |
320 | if { [lindex $module_do 1] != "N" } { | |
1f9db692 | 321 | global module_cmis |
1c6b86b5 NS |
322 | set module_cmis {} |
323 | set nshort [file tail [file dirname $test]]/[file tail $test] | |
324 | verbose "Testing $nshort $std" 1 | |
1f9db692 NS |
325 | switch [file extension $test] { |
326 | ".C" { | |
327 | lappend asm_list [file rootname [file tail $test]].s | |
328 | } | |
329 | ".X" { | |
330 | set any_hdrs 1 | |
331 | } | |
1c6b86b5 NS |
332 | } |
333 | dg-test -keep-output $test "$std" $DEFAULT_MODFLAGS | |
334 | set testcase [string range $test [string length "$srcdir/"] end] | |
335 | lappend mod_files [module_cmi_p $testcase $module_cmis] | |
336 | } | |
337 | } | |
1c6b86b5 NS |
338 | set testcase [regsub {_a.[CH]} $src {}] |
339 | set testcase \ | |
340 | [string range $testcase [string length "$srcdir/"] end] | |
1f9db692 NS |
341 | module_do_it $module_do $testcase $std $asm_list |
342 | foreach asm $asm_list { | |
343 | file_on_host delete $asm | |
344 | } | |
345 | if { $any_hdrs } { | |
346 | set mod_files [find $DEFAULT_REPO *.gcm] | |
1c6b86b5 | 347 | } |
1f9db692 | 348 | cleanup_module_files $mod_files |
1c6b86b5 NS |
349 | } |
350 | } | |
351 | } | |
352 | ||
353 | dg-finish |