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