libphobos/testsuite/lib/libphobos.exp

   1 # Copyright (C) 2017-2023 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 #
  18 # DejaGnu does not have proper library search paths for load_lib.
  19 # We have to explicitly load everything that gdc.exp wants to load.
  20 #
  21
  22 proc load_gcc_lib { filename } {
  23     global srcdir loaded_libs
  24
  25     load_file $srcdir/../../gcc/testsuite/lib/$filename
  26     set loaded_libs($filename) ""
  27 }
  28
  29 load_lib dg.exp
  30 load_lib libgloss.exp
  31
  32 load_gcc_lib target-supports.exp
  33 load_gcc_lib target-supports-dg.exp
  34 load_gcc_lib dg-options.exp
  35 load_gcc_lib target-libpath.exp
  36 load_gcc_lib timeout.exp
  37 load_gcc_lib wrapper.exp
  38 load_gcc_lib target-utils.exp
  39 load_gcc_lib gcc-defs.exp
  40
  41 set TESTING_IN_BUILD_TREE 1
  42
  43 # Define libphobos callbacks for dg.exp.
  44
  45 proc libphobos-dg-test { prog do_what extra_tool_flags } {
  46     set compile_type ""
  47     set output_file ""
  48
  49     global libphobos_test_name
  50     upvar name name
  51     if { $libphobos_test_name != "" } {
  52         set name $libphobos_test_name
  53     }
  54
  55     # Set up the compiler flags, based on what we're going to do.
  56     switch $do_what {
  57         "compile" {
  58             set compile_type "assembly"
  59             set output_file "[file rootname [file tail $prog]].s"
  60         }
  61         "run" {
  62             set compile_type "executable"
  63             # FIXME: "./" is to cope with "." not being in $PATH.
  64             # Should this be handled elsewhere?
  65             # YES.
  66             set output_file "./[file rootname [file tail $prog]].exe"
  67             # This is the only place where we care if an executable was
  68             # created or not.  If it was, dg.exp will try to run it.
  69             catch { remote_file build delete $output_file }
  70         }
  71         "link" {
  72             set compile_type "executable"
  73             set output_file "./[file rootname [file tail $prog]].exe"
  74         }
  75         default {
  76             perror "$do_what: not a valid dg-do keyword"
  77             return ""
  78         }
  79     }
  80
  81     set select_compile "libphobos_target_compile"
  82     set options ""
  83     if { $extra_tool_flags != "" } {
  84         lappend options "additional_flags=$extra_tool_flags"
  85     }
  86
  87     set unsupported_message [libphobos_skipped_test_p $name]
  88     if { $unsupported_message != "" } {
  89         return [list "::unsupported::$unsupported_message" $output_file]
  90     }
  91
  92     set comp_output [$select_compile "$prog" "$output_file" "$compile_type" $options]
  93     return [list $comp_output $output_file]
  94 }
  95
  96 # Override the DejaGnu dg-test in order to clear flags after a test, as
  97 # is done for compiler tests in gcc-dg.exp.
  98
  99 if { [info procs saved-dg-test] == [list] } {
 100     rename dg-test saved-dg-test
 101
 102     proc dg-test { args } {
 103         global additional_prunes
 104         global errorInfo
 105         global testname_with_flags
 106         global shouldfail
 107
 108         if { [ catch { eval saved-dg-test $args } errmsg ] } {
 109             set saved_info $errorInfo
 110             set additional_prunes ""
 111             set shouldfail 0
 112             if [info exists testname_with_flags] {
 113                 unset testname_with_flags
 114             }
 115             unset_timeout_vars
 116             error $errmsg $saved_info
 117         }
 118         set additional_prunes ""
 119         set shouldfail 0
 120         unset_timeout_vars
 121         if [info exists testname_with_flags] {
 122             unset testname_with_flags
 123         }
 124     }
 125 }
 126
 127 # Prune messages from gdc that aren't useful.
 128
 129 set additional_prunes ""
 130
 131 proc libphobos-dg-prune { system text } {
 132
 133     global additional_prunes
 134
 135     foreach p $additional_prunes {
 136         if { [string length $p] > 0 } {
 137             # Following regexp matches a complete line containing $p.
 138             regsub -all "(^|\n)\[^\n\]*$p\[^\n\]*" $text "" text
 139         }
 140     }
 141
 142     # Ignore harmless warnings from Xcode.
 143     regsub -all "(^|\n)\[^\n\]*ld: warning: could not create compact unwind for\[^\n\]*" $text "" text
 144
 145     # Ignore dsymutil warning (tool bug is actually linker)
 146     regsub -all "(^|\n)\[^\n\]*could not find object file symbol for symbol\[^\n\]*" $text "" text
 147
 148     return $text
 149 }
 150
 151 #
 152 # libphobos_init
 153 #
 154
 155 proc libphobos_init { args } {
 156     global env
 157     global srcdir blddir objdir tool_root_dir
 158     global exeext
 159     global gdc gdcflags
 160     global gdcpaths gdcldflags
 161     global gluefile wrap_flags
 162     global ld_library_path
 163     global tool_timeout
 164     global DEFAULT_DFLAGS
 165
 166     # If a testcase doesn't have special options, use these.
 167     if ![info exists DEFAULT_DFLAGS] then {
 168         set DEFAULT_DFLAGS ""
 169     }
 170
 171     # By default, we assume we want to run program images.
 172     global dg-do-what-default
 173     if [isnative] {
 174         set dg-do-what-default "run"
 175     } else {
 176         set dg-do-what-default "link"
 177     }
 178
 179     # What arguments to pass to run program images.
 180     global libphobos_run_args
 181     set libphobos_run_args ""
 182
 183     # If the name of the test should be something else.
 184     global libphobos_test_name
 185     set libphobos_test_name ""
 186
 187     global libphobos_skip_tests
 188     set libphobos_skip_tests { }
 189
 190     # Default settings.
 191     set blddir [lookfor_file [get_multilibs] libphobos]
 192     set flags_file "${blddir}/testsuite/testsuite_flags"
 193     set shlib_ext [get_shlib_extension]
 194
 195     set gdc [transform "gdc"]
 196     set gdcflags "-fmessage-length=0"
 197     set gdcpaths "-I${srcdir}"
 198     set gdcldflags ""
 199
 200     if { [file exists $flags_file] } {
 201         set gdc [exec sh $flags_file --gdc]
 202         set gdcflags [exec sh $flags_file --gdcflags]
 203         set gdcpaths [exec sh $flags_file --gdcpaths]
 204         set gdcldflags [exec sh $flags_file --gdcldflags]
 205     }
 206
 207     set exeext ""
 208     if [info exists env(EXEEXT)] {
 209         set exeext $env(EXEEXT)
 210     }
 211
 212     # Compute what needs to be added to the existing LD_LIBRARY_PATH.
 213     set ld_library_path "."
 214
 215     set gccdir [lookfor_file $tool_root_dir gcc/libgcc.a]
 216     if {$gccdir != ""} {
 217         set gccdir [file dirname $gccdir]
 218         append ld_library_path ":${gccdir}"
 219     }
 220
 221     if { [file exists "${blddir}/src/.libs/libgphobos.${shlib_ext}"] } {
 222         append ld_library_path ":${blddir}/src/.libs"
 223     }
 224
 225     # Compute what needs to be added to the existing LD_LIBRARY_PATH.
 226     if {$gccdir != ""} {
 227         set compiler ${gccdir}/gdc
 228
 229         if { [is_remote host] == 0 && [which $compiler] != 0 } {
 230           foreach i "[exec $compiler --print-multi-lib]" {
 231             set mldir ""
 232             regexp -- "\[a-z0-9=_/\.-\]*;" $i mldir
 233             set mldir [string trimright $mldir "\;@"]
 234             if { "$mldir" == "." } {
 235               continue
 236             }
 237             if { [llength [glob -nocomplain ${gccdir}/${mldir}/libgcc_s*.so.*]] >= 1 } {
 238               append ld_library_path ":${gccdir}/${mldir}"
 239             }
 240           }
 241         }
 242     }
 243
 244     # Set the default timeout for phobos tests.
 245     set tool_timeout 600
 246
 247     set_ld_library_path_env_vars
 248
 249     libphobos_maybe_build_wrapper "${objdir}/testglue.o"
 250 }
 251
 252 #
 253 # libphobos_target_compile -- compile a source file.
 254 #
 255
 256 proc libphobos_target_compile { source dest type options } {
 257     global gdc gdcflags
 258     global gdcpaths gdcldflags
 259     global gluefile wrap_flags
 260
 261     lappend options "additional_flags=-fno-diagnostics-show-caret -fdiagnostics-color=never"
 262
 263     if { [target_info needs_status_wrapper] != "" && [info exists gluefile] } {
 264         lappend options "libs=${gluefile}"
 265         lappend options "ldflags=${wrap_flags}"
 266     }
 267
 268     # Flag setting based on type argument.
 269     if { $type == "executable" } {
 270         # Link the support objects into executables.
 271         lappend options "additional_flags=$gdcldflags"
 272     }
 273
 274     # Set the compiler, only add D flags and paths if building D sources.
 275     set gdc_final $gdc
 276     if [regexp ".*\.d\$" $source] {
 277         set gdc_final [concat $gdc_final $gdcflags]
 278         set gdc_final [concat $gdc_final $gdcpaths]
 279     }
 280
 281     lappend options "compiler=$gdc_final"
 282     lappend options "timeout=[timeout_value]"
 283
 284     set options [dg-additional-files-options $options $source]
 285     set comp_output [target_compile $source $dest $type $options]
 286
 287     return $comp_output
 288 }
 289
 290 #
 291 # Helper used by libphobos and libdruntime unittest runner, filters out
 292 # D sources that may contain a unittest function.
 293 #
 294
 295 proc filter_libphobos_unittests { list } {
 296     set res {}
 297     foreach filename $list {
 298         set fid [open $filename r]
 299         if [regexp -- {unittest} [read $fid [file size $filename]]] {
 300             lappend res $filename
 301         }
 302         close $fid
 303     }
 304     return $res
 305 }
 306
 307 # Skip the unittest (report it as UNSUPPORTED) if the module exists in
 308 # libphobos_skip_tests and its target list is matched by dg-process-target.
 309 #
 310 # The expected format of the libphobos_skip_tests file is:
 311 # { test { targets } }
 312 proc libphobos_skipped_test_p { test } {
 313     global libphobos_skip_tests
 314
 315     set row [lsearch -inline -index 0 $libphobos_skip_tests $test]
 316     if { $row eq "" } {
 317         return ""
 318     }
 319
 320     if { [llength $row] != 2 } {
 321         error "syntax error in libphobos_skip_tests: $row"
 322     }
 323
 324     set selector [list target [lindex $row 1]]
 325     if { [dg-process-target-1 $selector] != "S" } {
 326         return ""
 327     }
 328
 329     return "skipped test"
 330 }
 331
 332 # Prune any messages matching ARGS[1] (a regexp) from test output.
 333 proc dg-prune-output { args } {
 334     global additional_prunes
 335
 336     if { [llength $args] != 2 } {
 337         error "[lindex $args 1]: need one argument"
 338         return
 339     }
 340
 341     lappend additional_prunes [lindex $args 1]
 342 }
 343
 344 # Return true if the curl library is supported on the target.
 345 proc check_effective_target_libcurl_available { } {
 346     return [check_no_compiler_messages libcurl_available executable {
 347         int main (void) { return 0; }
 348     } "-lcurl"]
 349 }
 350
 351 # Return true if the target is linux version < 2.6.39
 352 proc check_effective_target_linux_pre_2639 { } {
 353     if { ![istarget *-*-linux*] } {
 354         return 0
 355     }
 356
 357     if { [check_no_compiler_messages linux_pre_2639 assembly {
 358         #include <linux/version.h>
 359         #if !defined LINUX_VERSION_CODE || LINUX_VERSION_CODE < KERNEL_VERSION(2,6,39)
 360         #error Yes, it is.
 361         #endif
 362     }] } {
 363         return 0
 364     }
 365     return 1
 366 }