gcc/testsuite/rust/link/link.exp

   1 # Copyright (C) 2021-2024 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 # Execute tests, torture testing.
  18
  19 # Load support procs.
  20 load_lib rust-dg.exp
  21
  22 # Initialize `dg'.
  23 dg-init
  24
  25 # Main loop.
  26 set saved-dg-do-what-default ${dg-do-what-default}
  27
  28 set dg-do-what-default "assemble"
  29
  30 # rs-obj -- compile to an object file
  31 #
  32 # SOURCE is the source file
  33 # DEST is the object file
  34 # OPTALL is the list of compiler options to use with all tests
  35 # OPTFILE is the list of compiler options to use with this file
  36 # OPTSTR is the options to print with test messages
  37 # XFAILDATA is the xfail data to be passed to the compiler
  38 proc rs-obj { source dest optall optfile optstr xfaildata } {
  39     global tool
  40     global compiler_conditional_xfail_data
  41
  42     # Set up the options for compiling this file.
  43     set options ""
  44     lappend options "additional_flags=$optall $optfile"
  45
  46     set compiler_conditional_xfail_data $xfaildata
  47     set comp_output [${tool}_target_compile "$source" "$dest" object $options]
  48 }
  49
  50 # rs-execute -- compile multi-file tests
  51 #
  52 # SRC1 is the full pathname of the main file of the testcase.
  53 # SID identifies a test suite in the names of temporary files.
  54 proc rs-execute-1 { src1 } {
  55     global srcdir tmpdir
  56
  57     # Get extra flags for this test from the primary source file, and
  58     # process other dg-* options that this suite supports.  Warn about
  59     # unsupported flags.
  60     verbose "rs-execute: $src1" 1
  61     set compile_type "run"
  62     set compile_xfail(0) ""
  63
  64     # Set up the names of the other source files.
  65     set dir [file dirname $src1]
  66     set base [file rootname $src1]
  67     set base [string range $base [string length $dir] end]
  68     regsub "_0" $base "" base
  69     regsub "/" $base "" base
  70     set src_list $src1
  71     set i 1
  72     set done 0
  73     while { !$done } {
  74         set names [glob -nocomplain -types f -- "${dir}/${base}_${i}.*"]
  75         if { [llength ${names}] > 1 } {
  76             warning "rs-link-execute: more than one file matched ${dir}/${base}_${i}.*"
  77         }
  78         if { [llength ${names}] == 1 } {
  79             lappend src_list [lindex ${names} 0]
  80             incr i
  81         } else {
  82             set num_srcs ${i}
  83             set done 1
  84         }
  85     }
  86
  87
  88     # Define the names of the object files.
  89     set obj_list ""
  90     for {set i 0} {$i < $num_srcs} {incr i} {
  91         lappend obj_list "${base}_${i}.o"
  92     }
  93
  94     # Get the base name of this test, for use in messages.
  95     set testcase [lindex ${src_list} 0]
  96
  97     # Remove the $srcdir and $tmpdir prefixes from $src1.  (It would
  98     # be possible to use "regsub" here, if we were careful to escape
  99     # all regular expression characters in $srcdir and $tmpdir, but
 100     # that would be more complicated that this approach.)
 101     if {[string first "$srcdir/" "${testcase}"] == 0} {
 102         set testcase [string range "${testcase}" [string length "$srcdir/"] end]
 103     }
 104     if {[string first "$tmpdir/" "$testcase"] == 0} {
 105         set testcase [string range "$testcase" [string length "$tmpdir/"] end]
 106         set testcase "tmpdir-$testcase"
 107     }
 108     # If we couldn't rip $srcdir out of `src1' then just do the best we can.
 109     # The point is to reduce the unnecessary noise in the logs.  Don't strip
 110     # out too much because different testcases with the same name can confuse
 111     # `test-tool'.
 112     if [string match "/*" $testcase] then {
 113         set testcase "[file tail [file dirname $src1]]/[file tail $src1]"
 114     }
 115
 116     # Set up the base name of executable files so they'll be unique.
 117     regsub -all "\[./\]" $testcase "-" execbase
 118
 119     verbose "Testing $testcase - $obj_list - $src_list"
 120
 121     # There's a unique name for each executable we generate.
 122     set execname "${execbase}-1.exe"
 123
 124     # The LTO tests don't use dg-test, so testname_with_flags and
 125     # output_file need to be defined explicitly for each file.  scan-symbol
 126     # directives rely on both of these to be defined to find the symbol to
 127     # scan and for the text to print in the PASS/FAIL since they can also
 128     # be called from dg-test.  testname_with_flags is also used via
 129     # testname-for-summary when calling into generic function below to
 130     # clean temporary files.
 131     set output_file $execname
 132     set testname_with_flags $execname
 133
 134     file_on_host delete $execname
 135
 136     rs-obj [lindex ${src_list} 1] [lindex ${obj_list} 1] "" "" "" ""
 137     rs-obj [lindex ${src_list} 0] [lindex ${obj_list} 0] "" "" "" ""
 138
 139     gcc-dg-runtest [lindex ${src_list} 0] "" ""
 140
 141     # FIXME it would be ideal if we could link then execute these tests.
 142     # I was not able to figure out how to specify gc-dg-runtest to link
 143     # against the first object.
 144 }
 145
 146 proc rs-link-execute { src1 } {
 147     rs-execute-1 $src1
 148 }
 149
 150 # Main loop.
 151 foreach src [lsort [find $srcdir/$subdir *_0.rs]] {
 152     # If we're only testing specific files and this isn't one of them, skip it.
 153     if ![runtest_file_p $runtests $src] then {
 154         continue
 155     }
 156
 157     # To prevent 'runtest_file_p' being tested again (for example, via
 158     # 'gcc-dg-runtest'), with undesirable consequences due to its side effects,
 159     # interpose a dummy:
 160     rename runtest_file_p saved_runtest_file_p
 161     proc runtest_file_p { runtests testcase } {
 162         return 1
 163     }
 164     rs-link-execute $src
 165     rename runtest_file_p {}
 166     rename saved_runtest_file_p runtest_file_p
 167 }
 168
 169 set dg-do-what-default ${saved-dg-do-what-default}
 170
 171 # All done.
 172 dg-finish