gcc/testsuite/g++.dg/modules/modules.exp

   1 # Copyright (C) 2017-2021 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 # 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
  38 set MOD_STD_LIST { 17 2a }
  39
  40 setenv CXX_MODULE_PATH "$srcdir/$subdir"
  41 dg-init
  42
  43 global module_do
  44 global module_cmis
  45 global module_headers
  46
  47 set DEFAULT_REPO "gcm.cache"
  48
  49 # Register the module name this produces.
  50 # dg-module-cmi !?=?NAME WHEN?
  51 # dg-module-cmi !?{} - header unit
  52 proc dg-module-cmi { args } {
  53     if { [llength $args] > 3 } {
  54         error "[lindex $args 0]: too many arguments"
  55         return
  56     }
  57     set spec [lindex $args 1]
  58     if { [llength $args] > 2 } {
  59         set when [lindex $args 2]
  60     } else {
  61         set when {}
  62     }
  63
  64     if { [string index $spec 0] == "!" } {
  65         set name [string range $spec 1 end]
  66         set not 1
  67     } else {
  68         set name $spec
  69         set not 0
  70     }
  71
  72     if { [string index $name 0] == "=" } {
  73         set cmi [string range $name 1 end]
  74     } else {
  75         if { $name == "" } {
  76             # get the source file name.  ick!
  77             upvar prog srcname
  78             set cmi "$srcname.gcm"
  79             if { [string index $cmi 0] == "/" } {
  80                 set cmi [string range $cmi 1 end]
  81             } else {
  82                 set cmi ",/$cmi"
  83             }
  84             set path [file split $cmi]
  85             # subst /../ -> /,,/
  86             # sadly tcl 8.5 does not have lmap
  87             set rplac {}
  88             foreach elt $path {lappend rplac [expr {$elt == ".." ? ",," : $elt}]}
  89             set cmi [file join {*}$rplac]
  90         } else {
  91             set cmi "[regsub : $name -].gcm"
  92         }
  93         global DEFAULT_REPO
  94         set cmi "$DEFAULT_REPO/$cmi"
  95     }
  96
  97     # delete file, so we don't get confused by a stale one.
  98     file_on_host delete "$cmi"
  99
 100     global module_cmis
 101     lappend module_cmis [list $spec $when $not $cmi]
 102 }
 103
 104 # check the expected module files exist (or not)
 105 # return list to delete
 106 proc module_cmi_p { src ifs } {
 107     set res {}
 108     foreach if_arg $ifs {
 109         set spec [lindex $if_arg 0]
 110         set when [lindex $if_arg 1]
 111         if { $when != "" } {
 112             switch [dg-process-target $when] {
 113                 "S" { }
 114                 "N" { continue }
 115                 "F" { setup_xfail "*-*-*" }
 116                 "P" { }
 117             }
 118         }
 119         set not [lindex $if_arg 2]
 120         set cmi [lindex $if_arg 3]
 121         global srcdir
 122         set relcmi [string map [list $srcdir "/\$srcdir"] $cmi]
 123         if { $not != [file_on_host exists $cmi] } {
 124             pass "$src module-cmi $spec ($relcmi)"
 125         } else {
 126             fail "$src module-cmi $spec ($relcmi)"
 127             set not [expr ! $not ]
 128         }
 129         if { ! $not } {
 130             lappend res $cmi
 131         }
 132     }
 133     return $res
 134 }
 135
 136 # Append required header unit names to module_headers var
 137 proc dg-module-headers { args } {
 138     if { [llength $args] != 3 } {
 139         error "[lindex $args 0]: wrong number of arguments"
 140         return
 141     }
 142 }
 143
 144 proc do_module_headers { srcdir subdir std flags} {
 145     global module_headers
 146     foreach header $module_headers {
 147         set kind [lindex $header 0]
 148         set hdr [lindex $header 1]
 149         verbose "Header $hdr $std" 1
 150         switch $kind {
 151             test {
 152                 global module_cmis
 153                 set module_cmis {}
 154                 dg-test -keep-output $srcdir/$subdir/$hdr "$std" $flags
 155                 global mod_files
 156                 lappend mod_files [module_cmi_p $subdir/$hdr $module_cmis]
 157             }
 158             system -
 159             user {
 160                 # FIXME
 161             }
 162             default {
 163                 error "$kind unknown header"
 164             }
 165         }
 166     }
 167 }
 168
 169 # link and maybe run a set of object files
 170 # dg-module-do WHAT WHEN
 171 proc dg-module-do { args } {
 172     if { [llength $args] > 3 } {
 173         error "[lindex $args 0]: too many arguments"
 174         return
 175     }
 176
 177     set do_what [lindex $args 1]
 178     set expected "P"
 179     if { [llength $args] > 2 } {
 180         set expected [dg-process-target [lindex $args 2]]
 181     }
 182
 183     global module_do
 184     set module_do [list $do_what $expected]
 185 }
 186
 187 proc module_do_it { do_what testcase std asm_list } {
 188     global tool
 189
 190     set run 0
 191     switch [lindex $do_what 0] {
 192         "compile" { return 1 }
 193         "link" { }
 194         "run" { set run 1 }
 195         default { error "unknown module-do action [lindex $do_what 0]" }
 196     }
 197
 198     set xfail {}
 199     switch [lindex $do_what 1] {
 200         "S" { }
 201         "N" { return 1 }
 202         "F" { set xfail {setup_xfail "*-*-*"} }
 203         "P" { }
 204     }
 205
 206     set ok 1
 207     # make sure all asms are around
 208     foreach asm $asm_list {
 209         if { ! [file_on_host exists $asm] } {
 210             set ok 0
 211         }
 212     }
 213
 214     set options { }
 215     set ident $testcase
 216     if { $std != "" } {
 217         lappend options "additional_flags=$std"
 218         set ident "$ident $std"
 219     }
 220     if { [llength $do_what] > 3 } {
 221         lappend options "additional_flags=[lindex $do_what 3]"
 222     }
 223
 224     set execname "./[file tail $testcase].exe"
 225
 226     # link it
 227     verbose "Linking $asm_list" 1
 228     if { !$ok } {
 229         unresolved "$identlink"
 230     } else {
 231         set out [${tool}_target_compile $asm_list \
 232                      $execname executable $options]
 233         eval $xfail
 234         if { $out == "" } {
 235             pass "$ident link"
 236         } else {
 237             fail "$ident link"
 238             set ok 0
 239         }
 240     }
 241
 242     # run it?
 243     if { !$run } {
 244     } elseif { !$ok } {
 245         unresolved "$ident execute"
 246     } else {
 247         set out [${tool}_load $execname "" ""]
 248         set status [lindex $out 0]
 249         eval $xfail
 250         $status "$ident execute"
 251         if { $status != "pass" } {
 252             set $ok 0
 253         }
 254     }
 255
 256     if { $ok } {
 257         file_on_host delete $execname
 258     }
 259
 260     return $ok
 261 }
 262
 263 # delete the specified set of module files
 264 proc cleanup_module_files { files } {
 265     foreach file $files {
 266         file_on_host delete $file
 267     }
 268 }
 269
 270 global testdir
 271 set testdir $srcdir/$subdir
 272 proc srcdir {} {
 273     global testdir
 274     return $testdir
 275 }
 276
 277 # Return set of std options to iterate over, taken from g++-dg.exp & compat.exp
 278 proc module-init { src } {
 279     set tmp [dg-get-options $src]
 280     set option_list {}
 281     global module_headers
 282     set module_headers {}
 283     set have_std 0
 284     set std_prefix "-std=c++"
 285
 286     foreach op $tmp {
 287         switch [lindex $op 0] {
 288             "dg-options" {
 289                 set std_prefix "-std=gnu++"
 290                 if { [string match "*-std=*" [lindex $op 2]] } {
 291                     set have_std 1
 292                 }
 293             }
 294             "dg-additional-options" {
 295                 if { [string match "*-std=*" [lindex $op 2]] } {
 296                     set have_std 1
 297                 }
 298             }
 299             "dg-module-headers" {
 300                 set kind [lindex $op 2]
 301                 foreach header [lindex $op 3] {
 302                     lappend module_headers [list $kind $header]
 303                 }
 304             }
 305         }
 306     }
 307
 308     if { !$have_std } {
 309         global MOD_STD_LIST
 310         foreach x $MOD_STD_LIST {
 311             lappend option_list "${std_prefix}$x"
 312         }
 313     } else {
 314         lappend option_list ""
 315     }
 316
 317     return $option_list
 318 }
 319
 320 # not grouped tests, sadly tcl doesn't have negated glob
 321 foreach test [prune [lsort [find $srcdir/$subdir {*.[CH]}]] \
 322                   "$srcdir/$subdir/*_?.\[CH\]"] {
 323     if [runtest_file_p $runtests $test] {
 324         set nshort [file tail [file dirname $test]]/[file tail $test]
 325
 326         set std_list [module-init $test]
 327         foreach std $std_list {
 328             do_module_headers $srcdir $subdir $std $DEFAULT_MODFLAGS
 329             set module_cmis {}
 330             verbose "Testing $nshort $std" 1
 331             dg-test $test "$std" $DEFAULT_MODFLAGS
 332             set testcase [string range $test [string length "$srcdir/"] end]
 333             cleanup_module_files [module_cmi_p $testcase $module_cmis]
 334         }
 335     }
 336 }
 337
 338 # grouped tests
 339 foreach src [lsort [find $srcdir/$subdir {*_a.[CH}]] {
 340     # use the FOO_a.C name as the parallelization key
 341     if [runtest_file_p $runtests $src] {
 342         set tests [lsort [find [file dirname $src] \
 343                               [regsub {_a.[CH]$} [file tail $src] {_[a-z].[CH]}]]]
 344
 345         set std_list [module-init $src]
 346         foreach std $std_list {
 347             set mod_files {}
 348             global module_do
 349             set module_do {"compile" "P"}
 350             set asm_list {}
 351             do_module_headers $srcdir $subdir $std $DEFAULT_MODFLAGS
 352             foreach test $tests {
 353                 if { [lindex $module_do 1] != "N" } {
 354                     set module_cmis {}
 355                     set nshort [file tail [file dirname $test]]/[file tail $test]
 356                     verbose "Testing $nshort $std" 1
 357                     if { [file extension $test] == ".C" } {
 358                         lappend asm_list [file rootname [file tail $test]].s
 359                     }
 360                     dg-test -keep-output $test "$std" $DEFAULT_MODFLAGS
 361                     set testcase [string range $test [string length "$srcdir/"] end]
 362                     lappend mod_files [module_cmi_p $testcase $module_cmis]
 363                 }
 364             }
 365             set ok 1
 366             set testcase [regsub {_a.[CH]} $src {}]
 367             set testcase \
 368                 [string range $testcase [string length "$srcdir/"] end]
 369             set ok [module_do_it $module_do $testcase $std $asm_list]
 370             if { $ok } {
 371                 foreach asm $asm_list {
 372                     file_on_host delete $asm
 373                 }
 374                 cleanup_module_files $mod_files
 375             }
 376         }
 377     }
 378 }
 379
 380 dg-finish