From 1c6b86b50d4624e2bb665378a424f99a67831693 Mon Sep 17 00:00:00 2001 From: Nathan Sidwell Date: Fri, 11 Dec 2020 08:26:27 -0800 Subject: [PATCH] c++: module test harness Here is the module test harness -- but no tests. gcc/testsuite/ * g++.dg/modules/modules.exp: New. --- gcc/testsuite/g++.dg/modules/modules.exp | 376 +++++++++++++++++++++++++++++++ 1 file changed, 376 insertions(+) create mode 100644 gcc/testsuite/g++.dg/modules/modules.exp diff --git a/gcc/testsuite/g++.dg/modules/modules.exp b/gcc/testsuite/g++.dg/modules/modules.exp new file mode 100644 index 0000000..e2fd2a7 --- /dev/null +++ b/gcc/testsuite/g++.dg/modules/modules.exp @@ -0,0 +1,376 @@ +# Copyright (C) 2017, 2018 Free Software Foundation, Inc. + +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GCC; see the file COPYING3. If not see +# . +# +# Contributed by Nathan Sidwell while at Facebook + + +# Test C++ modules, which requires multiple TUs +# +# A test case might consist of multiple source files, each is compiled +# separately, in a well-defined order. The resulting object files might +# be optionally linked and optionally executed. Grouping is indicated by +# naming files '*_[a-z].[CH]' + +# { dg-module-cmi "[!]module-name" } # an interface file is (not) expected +# { dg-module-do [link|run] [xfail] [options] } # link [and run] + +load_lib g++-dg.exp + +# If a testcase doesn't have special options, use these. +global DEFAULT_CXXFLAGS +if ![info exists DEFAULT_CXXFLAGS] then { + set DEFAULT_CXXFLAGS " -pedantic-errors -Wno-long-long" +} +set DEFAULT_MODFLAGS $DEFAULT_CXXFLAGS +set MOD_STD_LIST { 17 2a } + +setenv CXX_MODULE_PATH "$srcdir/$subdir" +dg-init + +global module_do +global module_cmis +global module_headers + +set DEFAULT_REPO "gcm.cache" + +# Register the module name this produces. +# dg-module-cmi !?=?NAME WHEN? +# dg-module-cmi !?{} - header unit +proc dg-module-cmi { args } { + if { [llength $args] > 3 } { + error "[lindex $args 0]: too many arguments" + return + } + set spec [lindex $args 1] + if { [llength $args] > 2 } { + set when [lindex $args 2] + } else { + set when {} + } + + if { [string index $spec 0] == "!" } { + set name [string range $spec 1 end] + set not 1 + } else { + set name $spec + set not 0 + } + + if { [string index $name 0] == "=" } { + set cmi [string range $name 1 end] + } else { + if { $name == "" } { + # get the source file name. ick! + upvar prog srcname + set cmi "$srcname.gcm" + if { [string index $cmi 0] == "/" } { + set cmi [string range $cmi 1 end] + } else { + set cmi ",/$cmi" + } + set path [file split $cmi] + # subst /../ -> /,,/ + # sadly tcl 8.5 does not have lmap + set rplac {} + foreach elt $path {lappend rplac [expr {$elt == ".." ? ",," : $elt}]} + set cmi [file join {*}$rplac] + } else { + set cmi "[regsub : $name -].gcm" + } + global DEFAULT_REPO + set cmi "$DEFAULT_REPO/$cmi" + } + + # delete file, so we don't get confused by a stale one. + file_on_host delete "$cmi" + + global module_cmis + lappend module_cmis [list $spec $when $not $cmi] +} + +# check the expected module files exist (or not) +# return list to delete +proc module_cmi_p { src ifs } { + set res {} + foreach if_arg $ifs { + set spec [lindex $if_arg 0] + set when [lindex $if_arg 1] + if { $when != "" } { + switch [dg-process-target $when] { + "S" { } + "N" { continue } + "F" { setup_xfail "*-*-*" } + "P" { } + } + } + set not [lindex $if_arg 2] + set cmi [lindex $if_arg 3] + if { $not != [file_on_host exists $cmi] } { + pass "$src module-cmi $spec ($cmi)" + } else { + fail "$src module-cmi $spec ($cmi)" + set not [expr ! $not ] + } + if { ! $not } { + lappend res $cmi + } + } + return $res +} + +# Append required header unit names to module_headers var +proc dg-module-headers { args } { + if { [llength $args] != 3 } { + error "[lindex $args 0]: wrong number of arguments" + return + } +} + +proc do_module_headers { srcdir subdir std flags} { + global module_headers + foreach header $module_headers { + set kind [lindex $header 0] + set hdr [lindex $header 1] + verbose "Header $hdr $std" 1 + switch $kind { + test { + global module_cmis + set module_cmis {} + dg-test -keep-output $srcdir/$subdir/$hdr "$std" $flags + global mod_files + lappend mod_files [module_cmi_p $subdir/$hdr $module_cmis] + } + system - + user { + # FIXME + } + default { + error "$kind unknown header" + } + } + } +} + +# link and maybe run a set of object files +# dg-module-do WHAT WHEN +proc dg-module-do { args } { + if { [llength $args] > 3 } { + error "[lindex $args 0]: too many arguments" + return + } + + set do_what [lindex $args 1] + set expected "P" + if { [llength $args] > 2 } { + set expected [dg-process-target [lindex $args 2]] + } + + global module_do + set module_do [list $do_what $expected] +} + +proc module_do_it { do_what testcase std asm_list } { + global tool + + set run 0 + switch [lindex $do_what 0] { + "compile" { return 1 } + "link" { } + "run" { set run 1 } + default { error "unknown module-do action [lindex $do_what 0]" } + } + + set xfail {} + switch [lindex $do_what 1] { + "S" { } + "N" { return 1 } + "F" { set xfail {setup_xfail "*-*-*"} } + "P" { } + } + + set ok 1 + # make sure all asms are around + foreach asm $asm_list { + if { ! [file_on_host exists $asm] } { + set ok 0 + } + } + + set options { } + if { $std != "" } { + lappend options "additional_flags=$std" + } + if { [llength $do_what] > 3 } { + lappend options "additional_flags=[lindex $do_what 3]" + } + + set execname "./[file tail $testcase].exe" + + # link it + verbose "Linking $asm_list" 1 + if { !$ok } { + unresolved "$testcase link" + } else { + set out [${tool}_target_compile $asm_list \ + $execname executable $options] + eval $xfail + if { $out == "" } { + pass "$testcase link" + } else { + fail "$testcase link" + set ok 0 + } + } + + # run it? + if { !$run } { + } elseif { !$ok } { + unresolved "$testcase execute" + } else { + set out [${tool}_load $execname "" ""] + set status [lindex $out 0] + eval $xfail + $status "$testcase execute" + if { $status != "pass" } { + set $ok 0 + } + } + + if { $ok } { + file_on_host delete $execname + } + + return $ok +} + +# delete the specified set of module files +proc cleanup_module_files { files } { + foreach file $files { + file_on_host delete $file + } +} + +global testdir +set testdir $srcdir/$subdir +proc srcdir {} { + global testdir + return $testdir +} + +# Return set of std options to iterate over, taken from g++-dg.exp & compat.exp +proc module-init { src } { + set tmp [dg-get-options $src] + set option_list {} + global module_headers + set module_headers {} + set have_std 0 + set std_prefix "-std=c++" + + foreach op $tmp { + switch [lindex $op 0] { + "dg-options" { + set std_prefix "-std=gnu++" + if { [string match "*-std=*" [lindex $op 2]] } { + set have_std 1 + } + } + "dg-additional-options" { + if { [string match "*-std=*" [lindex $op 2]] } { + set have_std 1 + } + } + "dg-module-headers" { + set kind [lindex $op 2] + foreach header [lindex $op 3] { + lappend module_headers [list $kind $header] + } + } + } + } + + if { !$have_std } { + global MOD_STD_LIST + foreach x $MOD_STD_LIST { + lappend option_list "${std_prefix}$x" + } + } else { + lappend option_list "" + } + + return $option_list +} + +# not grouped tests, sadly tcl doesn't have negated glob +foreach test [prune [lsort [find $srcdir/$subdir {*.[CH]}]] \ + "$srcdir/$subdir/*_?.\[CH\]"] { + if [runtest_file_p $runtests $test] { + set nshort [file tail [file dirname $test]]/[file tail $test] + + set std_list [module-init $test] + foreach std $std_list { + do_module_headers $srcdir $subdir $std $DEFAULT_MODFLAGS + set module_cmis {} + verbose "Testing $nshort $std" 1 + dg-test $test "$std" $DEFAULT_MODFLAGS + set testcase [string range $test [string length "$srcdir/"] end] + cleanup_module_files [module_cmi_p $testcase $module_cmis] + } + } +} + +# grouped tests +foreach src [lsort [find $srcdir/$subdir {*_a.[CH}]] { + # use the FOO_a.C name as the parallelization key + if [runtest_file_p $runtests $src] { + set tests [lsort [find [file dirname $src] \ + [regsub {_a.[CH]$} [file tail $src] {_[a-z].[CH]}]]] + + set std_list [module-init $src] + foreach std $std_list { + set mod_files {} + global module_do + set module_do {"compile" "P"} + set asm_list {} + do_module_headers $srcdir $subdir $std $DEFAULT_MODFLAGS + foreach test $tests { + if { [lindex $module_do 1] != "N" } { + set module_cmis {} + set nshort [file tail [file dirname $test]]/[file tail $test] + verbose "Testing $nshort $std" 1 + if { [file extension $test] == ".C" } { + lappend asm_list [file rootname [file tail $test]].s + } + dg-test -keep-output $test "$std" $DEFAULT_MODFLAGS + set testcase [string range $test [string length "$srcdir/"] end] + lappend mod_files [module_cmi_p $testcase $module_cmis] + } + } + set ok 1 + set testcase [regsub {_a.[CH]} $src {}] + set testcase \ + [string range $testcase [string length "$srcdir/"] end] + set ok [module_do_it $module_do $testcase $std $asm_list] + if { $ok } { + foreach asm $asm_list { + file_on_host delete $asm + } + cleanup_module_files $mod_files + } + } + } +} + +dg-finish -- 2.7.4