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