]>
Commit | Line | Data |
---|---|---|
fbd26352 | 1 | # Copyright (C) 2012-2019 Free Software Foundation, Inc. |
03385ed3 | 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 | # Test using the DMD testsuite. | |
18 | # Load support procs. | |
19 | load_lib gdc-dg.exp | |
20 | ||
21 | # | |
22 | # Convert DMD arguments to GDC equivalent | |
23 | # | |
24 | ||
25 | proc gdc-convert-args { args } { | |
26 | set out "" | |
27 | ||
28 | foreach arg [split [lindex $args 0] " "] { | |
29 | # List of switches kept in ASCII collated order. | |
dd5e32e7 | 30 | if [string match "-D" $arg] { |
31 | lappend out "-fdoc" | |
32 | ||
33 | } elseif { [regexp -- {^-I([\w+/-]+)} $arg pattern path] } { | |
03385ed3 | 34 | lappend out "-I$path" |
35 | ||
36 | } elseif { [regexp -- {^-J([\w+/-]+)} $arg pattern path] } { | |
37 | lappend out "-J$path" | |
38 | ||
39 | } elseif [string match "-allinst" $arg] { | |
40 | lappend out "-fall-instantiations" | |
41 | ||
42 | } elseif { [string match "-boundscheck" $arg] | |
43 | || [string match "-boundscheck=on" $arg] } { | |
44 | lappend out "-fbounds-check" | |
45 | ||
46 | } elseif { [string match "-boundscheck=off" $arg] | |
47 | || [string match "-noboundscheck" $arg] } { | |
48 | lappend out "-fno-bounds-check" | |
49 | ||
50 | } elseif [string match "-boundscheck=safeonly" $arg] { | |
51 | lappend out "-fbounds-check=safeonly" | |
52 | ||
53 | } elseif [string match "-c" $arg] { | |
54 | lappend out "-c" | |
55 | ||
56 | } elseif [string match "-d" $arg] { | |
57 | lappend out "-Wno-deprecated" | |
58 | ||
59 | } elseif [string match "-de" $arg] { | |
60 | lappend out "-Wdeprecated" | |
61 | lappend out "-Werror" | |
62 | ||
63 | } elseif [string match "-debug" $arg] { | |
64 | lappend out "-fdebug" | |
65 | ||
66 | } elseif [regexp -- {^-debug=(\w+)} $arg pattern value] { | |
67 | lappend out "-fdebug=$value" | |
68 | ||
69 | } elseif [string match "-dip1000" $arg] { | |
70 | lappend out "-ftransition=dip1000" | |
71 | ||
72 | } elseif [string match "-dip25" $arg] { | |
73 | lappend out "-ftransition=dip25" | |
74 | ||
75 | } elseif [string match "-dw" $arg] { | |
76 | lappend out "-Wdeprecated" | |
77 | lappend out "-Wno-error" | |
78 | ||
79 | } elseif [string match "-fPIC" $arg] { | |
80 | lappend out "-fPIC" | |
81 | ||
82 | } elseif { [string match "-g" $arg] | |
83 | || [string match "-gc" $arg] } { | |
84 | lappend out "-g" | |
85 | ||
86 | } elseif [string match "-inline" $arg] { | |
87 | lappend out "-finline-functions" | |
88 | ||
89 | } elseif [string match "-main" $arg] { | |
90 | lappend out "-fmain" | |
91 | ||
92 | } elseif [regexp -- {^-mv=([\w+=./-]+)} $arg pattern value] { | |
93 | lappend out "-fmodule-file=$value" | |
94 | ||
95 | } elseif [string match "-O" $arg] { | |
96 | lappend out "-O2" | |
97 | ||
98 | } elseif [string match "-release" $arg] { | |
99 | lappend out "-frelease" | |
100 | ||
101 | } elseif [regexp -- {^-transition=(\w+)} $arg pattern value] { | |
102 | lappend out "-ftransition=$value" | |
103 | ||
104 | } elseif [string match "-unittest" $arg] { | |
105 | lappend out "-funittest" | |
106 | ||
107 | } elseif [string match "-verrors=spec" $arg] { | |
108 | lappend out "-Wspeculative" | |
109 | ||
110 | } elseif [regexp -- {^-verrors=(\d+)} $arg pattern num] { | |
111 | lappend out "-fmax-errors=$num" | |
112 | ||
113 | } elseif [regexp -- {^-version=(\w+)} $arg pattern value] { | |
114 | lappend out "-fversion=$value" | |
115 | ||
116 | } elseif [string match "-vtls" $arg] { | |
117 | lappend out "-ftransition=tls" | |
118 | ||
119 | } elseif [string match "-w" $arg] { | |
120 | lappend out "-Wall" | |
121 | lappend out "-Werror" | |
122 | ||
123 | } elseif [string match "-wi" $arg] { | |
124 | lappend out "-Wall" | |
125 | lappend out "-Wno-error" | |
126 | ||
127 | } else { | |
128 | # print "Unhandled Argument: $arg" | |
129 | } | |
130 | } | |
131 | ||
132 | return $out | |
133 | } | |
134 | ||
135 | proc gdc-copy-extra { base extra } { | |
136 | # Split base, folder/file. | |
137 | set type [file dirname $extra] | |
138 | ||
139 | # print "Filename: $base - $extra" | |
140 | ||
141 | set fdin [open $base/$extra r] | |
142 | fconfigure $fdin -encoding binary | |
143 | ||
144 | file mkdir $type | |
145 | set fdout [open $extra w] | |
146 | fconfigure $fdout -encoding binary | |
147 | ||
148 | while { [gets $fdin copy_line] >= 0 } { | |
149 | set out_line $copy_line | |
150 | puts $fdout $out_line | |
151 | } | |
152 | ||
153 | close $fdin | |
154 | close $fdout | |
155 | ||
156 | return $extra | |
157 | } | |
158 | ||
159 | # | |
160 | # Translate DMD test directives to dejagnu equivalent. | |
161 | # | |
162 | # COMPILE_SEPARATELY: Not handled. | |
163 | # EXECUTE_ARGS: Parameters to add to the execution of the test. | |
164 | # COMPILED_IMPORTS: List of modules files that are imported by the main | |
165 | # source file that should be included in compilation. | |
166 | # Currently handled the same as EXTRA_SOURCES. | |
167 | # EXTRA_SOURCES: List of extra sources to build and link along with | |
168 | # the test. | |
169 | # EXTRA_FILES: List of extra files to copy for the test runs. | |
170 | # PERMUTE_ARGS: The set of arguments to permute in multiple compiler | |
171 | # invocations. An empty set means only one permutation | |
172 | # with no arguments. | |
173 | # TEST_OUTPUT: The output expected from the compilation. | |
174 | # POST_SCRIPT: Not handled. | |
175 | # REQUIRED_ARGS: Arguments to add to the compiler command line. | |
176 | # DISABLED: Not handled. | |
177 | # | |
178 | ||
179 | proc dmd2dg { base test } { | |
180 | global DEFAULT_DFLAGS | |
181 | global PERMUTE_ARGS | |
182 | global GDC_EXECUTE_ARGS | |
183 | ||
184 | set PERMUTE_ARGS $DEFAULT_DFLAGS | |
185 | set GDC_EXECUTE_ARGS "" | |
186 | ||
187 | # Split base, folder/file. | |
188 | set type [file dirname $test] | |
dd5e32e7 | 189 | set name [file tail $test] |
03385ed3 | 190 | |
191 | # print "Filename: $base - $test" | |
192 | ||
193 | set fdin [open $base/$test r] | |
194 | #fconfigure $fdin -encoding binary | |
195 | ||
196 | file mkdir $type | |
197 | set fdout [open $test w] | |
198 | #fconfigure $fdout -encoding binary | |
199 | ||
200 | while { [gets $fdin copy_line] >= 0 } { | |
201 | set out_line $copy_line | |
202 | ||
203 | if [regexp -- {COMPILE_SEPARATELY} $copy_line] { | |
204 | # COMPILE_SEPARATELY is not handled. | |
205 | regsub -- {COMPILE_SEPARATELY.*$} $copy_line "" out_line | |
206 | ||
207 | } elseif [regexp -- {DISABLED} $copy_line] { | |
208 | # DISABLED is not handled. | |
209 | regsub -- {DISABLED.*$} $copy_line "" out_line | |
210 | ||
211 | } elseif [regexp -- {POST_SCRIPT} $copy_line] { | |
212 | # POST_SCRIPT is not handled | |
213 | regsub -- {POST_SCRIPT.*$} $copy_line "" out_line | |
214 | ||
215 | } elseif [regexp -- {PERMUTE_ARGS\s*:\s*(.*)} $copy_line match args] { | |
216 | # PERMUTE_ARGS is handled by gdc-do-test. | |
217 | set PERMUTE_ARGS [gdc-convert-args $args] | |
218 | regsub -- {PERMUTE_ARGS.*$} $copy_line "" out_line | |
219 | ||
220 | } elseif [regexp -- {EXECUTE_ARGS\s*:\s*(.*)} $copy_line match args] { | |
221 | # EXECUTE_ARGS is handled by gdc_load. | |
222 | foreach arg $args { | |
223 | lappend GDC_EXECUTE_ARGS $arg | |
224 | } | |
225 | regsub -- {EXECUTE_ARGS.*$} $copy_line "" out_line | |
226 | ||
227 | } elseif [regexp -- {REQUIRED_ARGS\s*:\s*(.*)} $copy_line match args] { | |
228 | # Convert all listed arguments to from dmd to gdc-style. | |
229 | set new_option "{ dg-additional-options \"[gdc-convert-args $args]\" }" | |
230 | regsub -- {REQUIRED_ARGS.*$} $copy_line $new_option out_line | |
231 | ||
232 | } elseif [regexp -- {EXTRA_SOURCES\s*:\s*(.*)} $copy_line match sources] { | |
233 | # Copy all sources to the testsuite build directory. | |
234 | foreach import $sources { | |
235 | # print "Import: $base $type/$import" | |
236 | gdc-copy-extra $base "$type/$import" | |
237 | } | |
238 | set new_option "{ dg-additional-sources \"$sources\" }" | |
239 | regsub -- {EXTRA_SOURCES.*$} $copy_line $new_option out_line | |
240 | ||
241 | } elseif [regexp -- {EXTRA_CPP_SOURCES\s*:\s*(.*)} $copy_line match sources] { | |
242 | # Copy all sources to the testsuite build directory. | |
243 | foreach import $sources { | |
244 | # print "Import: $base $type/$import" | |
245 | gdc-copy-extra $base "$type/$import" | |
246 | } | |
247 | set new_option "{ dg-additional-sources \"$sources\" }" | |
248 | regsub -- {EXTRA_CPP_SOURCES.*$} $copy_line $new_option out_line | |
249 | ||
250 | } elseif [regexp -- {EXTRA_FILES\s*:\s*(.*)} $copy_line match files] { | |
251 | # Copy all files to the testsuite build directory. | |
252 | foreach import $files { | |
253 | # print "Import: $base $type/$import" | |
254 | gdc-copy-extra $base "$type/$import" | |
255 | } | |
256 | set new_option "{ dg-additional-files \"$files\" }" | |
257 | regsub -- {EXTRA_FILES.*$} $copy_line $new_option out_line | |
258 | ||
259 | } elseif [regexp -- {COMPILED_IMPORTS\s*:\s*(.*)} $copy_line match sources] { | |
260 | # Copy all sources to the testsuite build directory. | |
261 | foreach import $sources { | |
262 | # print "Import: $base $type/$import" | |
263 | gdc-copy-extra $base "$type/$import" | |
264 | } | |
265 | set new_option "{ dg-additional-sources \"$sources\" }" | |
266 | regsub -- {COMPILED_IMPORTS.*$} $copy_line $new_option out_line | |
267 | ||
268 | } | |
269 | ||
270 | puts $fdout $out_line | |
271 | } | |
272 | ||
273 | # Add specific options for test type | |
274 | ||
275 | # DMD's testsuite is extremely verbose, compiler messages from constructs | |
276 | # such as pragma(msg, ...) would otherwise cause tests to fail. | |
277 | set out_line "// { dg-prune-output .* }" | |
278 | puts $fdout $out_line | |
279 | ||
280 | # Since GCC 6-20160131 blank lines are not allowed in the output by default. | |
281 | dg-allow-blank-lines-in-output { 1 } | |
282 | ||
283 | # Compilable files are successful if an output is generated. | |
284 | # Fail compilable are successful if an output is not generated. | |
285 | # Runnable must compile, link, and return 0 to be successful by default. | |
dd5e32e7 | 286 | switch $type { |
03385ed3 | 287 | runnable { |
288 | if ![isnative] { | |
289 | set out_line "// { dg-final { output-exists } }" | |
290 | puts $fdout $out_line | |
291 | } | |
292 | } | |
293 | ||
294 | compilable { | |
295 | set out_line "// { dg-final { output-exists } }" | |
296 | puts $fdout $out_line | |
dd5e32e7 | 297 | |
298 | # Check that Ddoc tests also generate a html file. | |
299 | if [regexp -- "ddoc.*" $name] { | |
300 | set ddocfile "[file rootname $name].html" | |
301 | set out_line "// { dg-final { scan-file $ddocfile \"Generated by Ddoc from $test\" } }" | |
302 | puts $fdout $out_line | |
303 | # Cleanup extra generated files. | |
304 | set out_line "// { dg-final { file delete $ddocfile } }" | |
305 | puts $fdout $out_line | |
306 | } | |
03385ed3 | 307 | } |
308 | ||
309 | fail_compilation { | |
310 | set out_line "// { dg-final { output-exists-not } }" | |
311 | puts $fdout $out_line | |
312 | } | |
313 | } | |
314 | ||
315 | close $fdin | |
316 | close $fdout | |
317 | ||
318 | return $test | |
319 | } | |
320 | ||
321 | proc gdc-permute-options { options } { | |
322 | set result { } | |
323 | set n [expr 1<<[llength $options]] | |
324 | for { set i 0 } { $i<$n } { incr i } { | |
325 | set option "" | |
326 | for { set j 0 } { $j<[llength $options] } { incr j } { | |
327 | if [expr $i & 1 << $j] { | |
328 | append option [lindex $options $j] | |
329 | append option " " | |
330 | } | |
331 | } | |
332 | lappend result $option | |
333 | ||
334 | } | |
335 | return $result | |
336 | } | |
337 | ||
338 | ||
339 | proc gdc-do-test { } { | |
340 | global srcdir subdir | |
341 | global dg-do-what-default | |
342 | global verbose | |
343 | ||
344 | # If a testcase doesn't have special options, use these. | |
345 | global DEFAULT_DFLAGS | |
346 | if ![info exists DEFAULT_DFLAGS] then { | |
347 | set DEFAULT_DFLAGS "-g -O2 -frelease" | |
348 | #set DEFAULT_DFLAGS "-O2" | |
349 | } | |
350 | ||
351 | # These are special options to use on testcase, and override DEFAULT_DFLAGS | |
352 | global PERMUTE_ARGS | |
353 | ||
354 | # Set if an extra option should be passed to link to shared druntime. | |
355 | global SHARED_OPTION | |
356 | ||
357 | # Additional arguments for gdc_load | |
358 | global GDC_EXECUTE_ARGS | |
359 | ||
360 | # Initialize `dg'. | |
361 | dg-init | |
362 | ||
dc014eed | 363 | # Create gdc.test link so test names include that subdir. |
364 | catch { file link $subdir . } | |
365 | ||
03385ed3 | 366 | # Main loop. |
367 | ||
368 | # set verbose 1 | |
369 | # set dg-final-code "" | |
370 | # Find all tests and pass to routine. | |
371 | foreach test [lsort [find $srcdir/$subdir *]] { | |
372 | regexp -- "(.*)/(.+)/(.+)\.(.+)$" $test match base dir name ext | |
373 | ||
374 | # Skip invalid test directory | |
375 | if { [lsearch "runnable compilable fail_compilation" $dir] == -1 } { | |
376 | continue | |
377 | } | |
378 | ||
379 | # Skip invalid test extensions | |
380 | if { [lsearch "d" $ext] == -1 } { | |
381 | continue | |
382 | } | |
383 | ||
384 | # Convert to DG test. | |
385 | set imports [format "-I%s/%s" $base $dir] | |
dc014eed | 386 | # Include $subdir prefix so test names follow DejaGnu conventions. |
387 | set filename "$subdir/[dmd2dg $base $dir/$name.$ext]" | |
03385ed3 | 388 | |
389 | if { $dir == "runnable" } { | |
390 | append PERMUTE_ARGS " $SHARED_OPTION" | |
391 | } | |
392 | set options [gdc-permute-options $PERMUTE_ARGS] | |
393 | ||
394 | switch $dir { | |
395 | runnable { | |
396 | for { set i 0 } { $i<[llength $options] } { incr i } { | |
397 | set flags [lindex $options $i] | |
398 | if [isnative] { | |
399 | set dg-do-what-default "run" | |
400 | } else { | |
401 | set dg-do-what-default "link" | |
402 | } | |
403 | gdc-dg-runtest $filename $flags $imports | |
404 | } | |
405 | } | |
406 | ||
407 | compilable { | |
408 | for { set i 0 } { $i<[llength $options] } { incr i } { | |
409 | set flags [lindex $options $i] | |
dd5e32e7 | 410 | # Compilable test may require checking another kind of output file. |
411 | if [regexp -- "ddoc.*" $name] { | |
412 | set dg-do-what-default "compile" | |
413 | } else { | |
414 | set dg-do-what-default "assemble" | |
415 | } | |
03385ed3 | 416 | gdc-dg-runtest $filename $flags $imports |
417 | } | |
418 | } | |
419 | ||
420 | fail_compilation { | |
421 | for { set i 0 } { $i<[llength $options] } { incr i } { | |
422 | set flags [lindex $options $i] | |
423 | set dg-do-what-default "assemble" | |
424 | gdc-dg-runtest $filename $flags $imports | |
425 | } | |
426 | } | |
427 | } | |
428 | ||
429 | # Cleanup | |
dc014eed | 430 | file delete $filename |
03385ed3 | 431 | } |
432 | ||
433 | # All done. | |
434 | dg-finish | |
435 | } | |
436 | ||
437 | gdc-do-test | |
438 |