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