gcc/testsuite/gdc.test/gdc-test.exp

   1 # Copyright (C) 2012-2018 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.
  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.
  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 "-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]
 189     set name [file tail $test]
 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.
 286     switch $type {
 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
 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             }
 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
 363     # Main loop.
 364
 365     # set verbose 1
 366     # set dg-final-code ""
 367     # Find all tests and pass to routine.
 368     foreach test [lsort [find $srcdir/$subdir *]] {
 369         regexp -- "(.*)/(.+)/(.+)\.(.+)$" $test match base dir name ext
 370
 371         # Skip invalid test directory
 372         if { [lsearch "runnable compilable fail_compilation" $dir] == -1 } {
 373             continue
 374         }
 375
 376         # Skip invalid test extensions
 377         if { [lsearch "d" $ext] == -1 } {
 378             continue
 379         }
 380
 381         # Convert to DG test.
 382         set imports [format "-I%s/%s" $base $dir]
 383         set filename [dmd2dg $base $dir/$name.$ext]
 384
 385         if { $dir == "runnable" } {
 386             append PERMUTE_ARGS " $SHARED_OPTION"
 387         }
 388         set options [gdc-permute-options $PERMUTE_ARGS]
 389
 390         switch $dir {
 391             runnable {
 392                 for { set i 0 } { $i<[llength $options] } { incr i } {
 393                     set flags [lindex $options $i]
 394                     if [isnative] {
 395                         set dg-do-what-default "run"
 396                     } else {
 397                         set dg-do-what-default "link"
 398                     }
 399                     gdc-dg-runtest $filename $flags $imports
 400                 }
 401             }
 402
 403             compilable {
 404                 for { set i 0 } { $i<[llength $options] } { incr i } {
 405                     set flags [lindex $options $i]
 406                     # Compilable test may require checking another kind of output file.
 407                     if [regexp -- "ddoc.*" $name] {
 408                         set dg-do-what-default "compile"
 409                     } else {
 410                         set dg-do-what-default "assemble"
 411                     }
 412                     gdc-dg-runtest $filename $flags $imports
 413                 }
 414             }
 415
 416             fail_compilation {
 417                 for { set i 0 } { $i<[llength $options] } { incr i } {
 418                     set flags [lindex $options $i]
 419                     set dg-do-what-default "assemble"
 420                     gdc-dg-runtest $filename $flags $imports
 421                 }
 422             }
 423         }
 424
 425         # Cleanup
 426         #file delete $filename
 427     }
 428
 429     # All done.
 430     dg-finish
 431 }
 432
 433 gdc-do-test
 434