URL
https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk
Subversion Repositories openrisc_me
Compare Revisions
- This comparison shows the changes necessary to convert path
/openrisc/trunk/gnu-src/gcc-4.5.1/gcc
- from Rev 305 to Rev 306
- ↔ Reverse comparison
Rev 305 → Rev 306
/testsuite/lib/copy-file.exp
0,0 → 1,35
# Copyright (C) 2003, 2007 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 |
# <http://www.gnu.org/licenses/>. |
|
# This file defines a proc for copying regular files as well as |
# symlinks. |
|
proc gcc_copy_files {srcfiles dstdir} { |
foreach f $srcfiles { |
if { [is_remote host] } { |
remote_download host $f $dstdir |
} elseif { [catch { set symlink [file readlink $f] } x] } then { |
file copy -force $f $dstdir |
} else { |
if { [regexp "^/" "$symlink"] } then { |
file copy -force $symlink $dstdir |
} else { |
set dirname [file dirname $f] |
file copy -force $dirname/$symlink $dstdir |
} |
} |
} |
} |
/testsuite/lib/profopt.exp
0,0 → 1,425
# Copyright (C) 2001, 2004, 2005, 2007, 2008 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 |
# <http://www.gnu.org/licenses/>. |
# |
# This script was submitted by Janis Johnson <janis187@us.ibm.com>. |
|
# Test the functionality and optionally, performance improvement, of |
# programs compiled with profile-directed optimizations. Compile and |
# run a test with profile options, compile it with options using the |
# profile feedback, and then run the test again. Optionally compile |
# and run a third time without the profile-directed optimization and |
# compare timing results of the program with normal optimization and |
# with the profile-directed optimization. Each test is run using |
# multiple sets of optimization and/or code generation options in |
# addition to the profiling and feedback options. |
|
# If perf_ext is defined and the performance value for the |
# profile-directed test run is nonzero then the performance check will |
# be done. |
|
load_lib dg.exp |
load_lib gcc-dg.exp |
|
global PROFOPT_OPTIONS perf_delta |
|
# The including .exp file must define these. |
global tool profile_option feedback_option prof_ext |
if ![info exists tool] { |
error "Tools is not specified." |
} |
if ![info exists prof_ext] { |
error "No profile data file extensions specified." |
} |
|
# The maximum perforance degradation can be defined in the including file. |
if ![info exists perf_delta] { |
set perf_delta 4 |
} |
|
# The default option list can be overridden by |
# PROFOPT_OPTIONS="{ { list1 } ... { list2 } }" |
|
if ![info exists PROFOPT_OPTIONS] { |
set PROFOPT_OPTIONS [list \ |
{ -g } \ |
{ -O0 } \ |
{ -O1 } \ |
{ -O2 } \ |
{ -O3 } \ |
{ -O3 -g } \ |
{ -Os } ] |
} |
|
set prof_option_list $PROFOPT_OPTIONS |
|
# |
# profopt-cleanup -- remove profiling or performance results files. |
# |
# TESTCASE is the name of the test |
# EXT is the extensions of files to remove |
# |
proc profopt-cleanup { testcase extlist } { |
set basename [file tail $testcase] |
set base [file rootname $basename] |
foreach ext $extlist { |
set files [glob -nocomplain $base.$ext] |
if { $files != "" } { |
eval "remote_file build delete $files" |
} |
} |
} |
|
# |
# profopt-perf-value -- get performance value for a test |
# |
# TESTCASE is the name of the test |
# PERF_EXT is the extension of the performance result file |
# OPTSTR is the string of compiler options |
# |
proc profopt-perf-value { testcase perf_ext optstr } { |
set basename [file tail $testcase] |
set base [file rootname $basename] |
set files [glob -nocomplain $base.$perf_ext] |
# The file doesn't exist; let the caller decide if that's a problem. |
if { $files == "" } { |
return -2 |
} |
remote_upload host $base.$perf_ext $base.$perf_ext |
set fd [open $base.$perf_ext r] |
gets $fd line |
set val -2 |
if [regexp "TIME" $line] { |
if [regexp "TIME -1" $line] { |
fail "$testcase perf check: no consistent time available, $optstr" |
set val -1 |
} elseif ![regexp "(\[0-9\]+)" "$line" val] { |
set val -2 |
} |
} |
# Report problems with an existing file. |
if { $val == -2 } { |
fail "$testcase perf check: file $base.$perf_ext has wrong format, $optstr" |
} |
close $fd |
profopt-cleanup $testcase $perf_ext |
return $val |
} |
|
# |
# dg-final-generate -- process code to run after the profile-generate step |
# |
# ARGS is the line number of the directive followed by the commands. |
# |
proc dg-final-generate { args } { |
global generate_final_code |
|
if { [llength $args] > 2 } { |
error "[lindex $args 0]: too many arguments" |
return |
} |
append generate_final_code "[lindex $args 1]\n" |
} |
|
# |
# dg-final-use -- process code to run after the profile-use step |
# |
# ARGS is the line number of the directive followed by the commands. |
# |
proc dg-final-use { args } { |
global use_final_code |
|
if { [llength $args] > 2 } { |
error "[lindex $args 0]: too many arguments" |
return |
} |
append use_final_code "[lindex $args 1]\n" |
} |
|
# |
# profopt-final-code -- run final code |
# |
# WHICH is "generate" or "use". |
# FINAL_CODE is the TCL code to run. |
# TESTCASE is the name of the test, for error messages. |
# |
proc profopt-final-code { which final_code name } { |
# This is copied from dg-test in dg.exp of DejaGnu. |
regsub -all "\\\\(\[{}\])" $final_code "\\1" final_code |
proc profopt-final-proc { args } $final_code |
if [catch "profopt-final-proc $name" errmsg] { |
perror "$name: error executing dg-final-${which}: $errmsg" |
unresolved "$name: Error executing dg-final-${which}: $errmsg" |
} |
} |
|
# |
# profopt-get-options -- process test directives |
# |
# SRC is the full pathname of the testcase. |
# |
proc profopt-get-options { src } { |
# dg-options sets a variable called dg-extra-tool-flags. |
set dg-extra-tool-flags "" |
|
# dg-require-* sets dg-do-what. |
upvar dg-do-what dg-do-what |
|
# current_compiler_flags reads tool_flags from the same stack frame |
# as dg-extra-tool-flags |
set tool_flags "" |
|
set tmp [dg-get-options $src] |
foreach op $tmp { |
set cmd [lindex $op 0] |
if { ![string compare "dg-options" $cmd] \ |
|| ![string compare "dg-skip-if" $cmd] \ |
|| ![string compare "dg-final-generate" $cmd] \ |
|| ![string compare "dg-final-use" $cmd] \ |
|| ![string compare "dg-additional-sources" $cmd] \ |
|| [string match "dg-require-*" $cmd] } { |
set status [catch "$op" errmsg] |
if { $status != 0 } { |
perror "$src: $errmsg for \"$op\"\n" |
unresolved "$src: $errmsg for \"$op\"" |
return |
} |
} else { |
# Ignore unrecognized dg- commands, but warn about them. |
warning "profopt.exp does not support $cmd" |
} |
} |
|
# Return flags to use for compiling the primary source file and for |
# linking. |
return ${dg-extra-tool-flags} |
} |
|
# |
# c-prof-execute -- compile for profiling and then feedback, then normal |
# |
# SRC is the full pathname of the testcase. |
# |
proc profopt-execute { src } { |
global srcdir tmpdir |
global prof_option_list |
global tool profile_option feedback_option prof_ext perf_ext perf_delta |
global generate_final_code use_final_code |
global verbose |
|
if ![info exists profile_option] { |
error "No profile option specified for first compile." |
} |
if ![info exists feedback_option] { |
error "No feedback option specified for second compile." |
} |
|
regsub "(?q)$srcdir/" $src "" testcase |
# If we couldn't rip $srcdir out of `src' then just do the best we can. |
# The point is to reduce the unnecessary noise in the logs. Don't strip |
# out too much because different testcases with the same name can confuse |
# `test-tool'. |
if [string match "/*" $testcase] { |
set testcase "[file tail [file dirname $src]]/[file tail $src]" |
} |
|
set executable $tmpdir/[file tail [file rootname $src].x] |
set basename [file tail $testcase] |
set base [file rootname $basename] |
|
set count 0 |
foreach option $prof_option_list { |
set execname1 "${executable}${count}1" |
set execname2 "${executable}${count}2" |
set execname3 "${executable}${count}3" |
incr count |
|
remote_file build delete $execname1 |
remote_file build delete $execname2 |
remote_file build delete $execname3 |
verbose "Testing $testcase, $option" 1 |
|
# Remove old profiling and performance data files. |
foreach ext $prof_ext { |
remote_file target delete $tmpdir/$base.$ext |
} |
if [info exists perf_ext] { |
profopt-cleanup $testcase $perf_ext |
} |
|
# Process test directives. |
|
set generate_final_code "" |
set use_final_code "" |
set dg-do-what [list "run" "" P] |
set extra_flags [profopt-get-options $src] |
if { [lindex ${dg-do-what} 1 ] == "N" } { |
unsupported "$src" |
verbose "$src not supported on this target, skipping it" 3 |
return |
} |
|
set extra_options [dg-additional-files-options "" "$src"] |
|
# Compile for profiling. |
|
set options "$extra_options" |
lappend options "additional_flags=$option $extra_flags $profile_option" |
set optstr "$option $profile_option" |
set comp_output [${tool}_target_compile "$src" "$execname1" executable $options] |
if ![${tool}_check_compile "$testcase compilation" $optstr $execname1 $comp_output] { |
unresolved "$testcase execution, $optstr" |
unresolved "$testcase compilation, $option $feedback_option" |
unresolved "$testcase execution, $option $feedback_option" |
continue |
} |
|
# Run the profiled test. |
|
set result [${tool}_load $execname1 "" ""] |
set status [lindex $result 0] |
set missing_file 0 |
# Make sure the profile data was generated, and fail if not. |
if { $status == "pass" } { |
foreach ext $prof_ext { |
remote_upload target $tmpdir/$base.$ext |
set files [glob -nocomplain $base.$ext] |
if { $files == "" } { |
set status "fail" |
set missing_file 1 |
fail "$testcase execution: file $base.$ext does not exist, $option $profile_option" |
} |
} |
} |
if { $missing_file == 0 } { |
$status "$testcase execution, $optstr" |
} |
|
# If there is dg-final code to execute for the generate step, do it |
# even if it failed; it might clean up temporary files. |
if ![string match $generate_final_code ""] { |
profopt-final-code "generate" $generate_final_code $testcase |
} |
|
remote_file build delete $execname1 |
|
# Quit for this round if it failed |
if { $status != "pass" } { |
unresolved "$testcase compilation, $option $feedback_option" |
unresolved "$testcase execution, $option $feedback_option" |
continue |
} |
|
# Compile with feedback-directed optimizations. |
|
set options "$extra_options" |
lappend options "additional_flags=$option $extra_flags $feedback_option" |
set optstr "$option $feedback_option" |
set comp_output [${tool}_target_compile "$src" "$execname2" "executable" $options] |
if ![${tool}_check_compile "$testcase compilation" $optstr $execname2 $comp_output] { |
unresolved "$testcase execution, $optstr" |
continue |
} |
|
# Run the profile-directed optimized test. |
|
set result [${tool}_load "$execname2" "" ""] |
set status [lindex $result 0] |
$status "$testcase execution, $optstr" |
|
# If there is dg-final code to execute for the use step, do it. |
if ![string match $use_final_code ""] { |
profopt-final-code "use" $use_final_code $testcase |
} |
|
# Remove the profiling data files. |
foreach ext $prof_ext { |
remote_file target delete $tmpdir/$base.$ext |
} |
|
if { $status != "pass" } { |
continue |
} |
|
# If the test is not expected to produce performance data then |
# we're done now. |
if ![info exists perf_ext] { |
remote_file build delete $execname2 |
continue |
} |
|
# Get the performance data from the test built with |
# profile-directed optimization. If the file doesn't exist or if |
# the value is zero, skip the performance comparison. |
set val2 [profopt-perf-value $testcase $perf_ext $optstr] |
if { $val2 <= 0 } { |
remote_file build delete $execname2 |
continue |
} |
|
# Compile with normal optimizations. |
|
set options "$extra_options" |
lappend options "additional_flags=$option" |
set optstr "$option" |
set comp_output [${tool}_target_compile "$src" "$execname3" "executable" $options] |
if ![${tool}_check_compile "$testcase compilation" $optstr $execname3 $comp_output] { |
unresolved "$testcase execution, $optstr" |
unresolved "$testcase perf check, $optstr" |
continue |
} |
|
# Run the test with normal optimizations. |
|
set result [${tool}_load "$execname3" "" ""] |
set status [lindex $result 0] |
$status "$testcase execution, $optstr" |
if { $status != "pass" } { |
unresolved "$testcase perf check, $optstr" |
continue |
} |
|
# Get the performance data from the test built with normal |
# optimization. |
set val1 [profopt-perf-value $testcase $perf_ext $optstr] |
if { $val1 < 0 } { |
if { $val1 == -2 } { |
# The data file existed with the profile-directed |
# optimization so this one should, too. |
fail "$testcase perf check: file $base.$perf_ext does not exist, $optstr" |
} |
continue |
} |
|
# Compare results of the two runs and fail if the time with the |
# profile-directed optimization is significantly more than the time |
# without it. |
set status "pass" |
if { $val2 > $val1 } { |
# Check for a performance degration outside of allowable limits. |
if { [expr $val2 - $val1] > [expr [expr $val1 * $perf_delta] / 100] } { |
set status "fail" |
} |
} |
if { $status == "fail" } { |
fail "$testcase perf check: orig: $val1 new: $val2, $optstr" |
} else { |
$status "$testcase perf check, $optstr" |
verbose "$testcase orig: $val1 new: $val2, $optstr" 2 |
remote_file build delete $execname2 |
remote_file build delete $execname3 |
} |
} |
} |
/testsuite/lib/gcc.exp
0,0 → 1,155
# Copyright (C) 1992, 1993, 1994, 1996, 1997, 1999, 2000, 2001, 2003, 2004, |
# 2007, 2008 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 |
# <http://www.gnu.org/licenses/>. |
|
# This file was written by Rob Savoye (rob@cygnus.com) |
# Currently maintained by Doug Evans (dje@cygnus.com) |
|
# This file is loaded by the tool init file (eg: unix.exp). It provides |
# default definitions for gcc_start, etc. and other supporting cast members. |
|
# These globals are used by gcc_start if no compiler arguments are provided. |
# They are also used by the various testsuites to define the environment: |
# where to find stdio.h, libc.a, etc. |
|
# we want to use libgloss so we can get find_gcc. |
load_lib libgloss.exp |
load_lib prune.exp |
load_lib gcc-defs.exp |
load_lib timeout.exp |
|
# |
# GCC_UNDER_TEST is the compiler under test. |
# |
|
# |
# default_gcc_version -- extract and print the version number of the compiler |
# |
|
proc default_gcc_version { } { |
global GCC_UNDER_TEST |
|
gcc_init |
|
# ignore any arguments after the command |
set compiler [lindex $GCC_UNDER_TEST 0] |
|
if ![is_remote host] { |
set compiler_name [which $compiler] |
} else { |
set compiler_name $compiler |
} |
|
# verify that the compiler exists |
if { $compiler_name != 0 } then { |
set tmp [remote_exec host "$compiler -v"] |
set status [lindex $tmp 0] |
set output [lindex $tmp 1] |
regexp " version \[^\n\r\]*" $output version |
if { $status == 0 && [info exists version] } then { |
clone_output "$compiler_name $version\n" |
} else { |
clone_output "Couldn't determine version of $compiler_name: $output\n" |
} |
} else { |
# compiler does not exist (this should have already been detected) |
warning "$compiler does not exist" |
} |
} |
|
# |
# gcc_version -- Call default_gcc_version, so we can override it if needed. |
# |
|
proc gcc_version { } { |
default_gcc_version |
} |
|
# |
# gcc_init -- called at the start of each .exp script. |
# |
# There currently isn't much to do, but always using it allows us to |
# make some enhancements without having to go back and rewrite the scripts. |
# |
|
set gcc_initialized 0 |
|
proc gcc_init { args } { |
global tmpdir |
global libdir |
global gluefile wrap_flags |
global gcc_initialized |
global GCC_UNDER_TEST |
global TOOL_EXECUTABLE |
global gcc_warning_prefix |
global gcc_error_prefix |
|
if { $gcc_initialized == 1 } { return; } |
|
if ![info exists GCC_UNDER_TEST] { |
if [info exists TOOL_EXECUTABLE] { |
set GCC_UNDER_TEST $TOOL_EXECUTABLE |
} else { |
set GCC_UNDER_TEST "[find_gcc]" |
} |
} |
|
if ![info exists tmpdir] then { |
set tmpdir /tmp |
} |
|
set gcc_warning_prefix "warning:" |
set gcc_error_prefix "error:" |
|
gcc_maybe_build_wrapper "${tmpdir}/gcc-testglue.o" |
} |
|
# |
# gcc_target_compile -- compile a source file |
# |
|
proc gcc_target_compile { source dest type options } { |
global tmpdir |
global gluefile wrap_flags |
global GCC_UNDER_TEST |
global TOOL_OPTIONS |
|
if {[target_info needs_status_wrapper] != "" && \ |
[target_info needs_status_wrapper] != "0" && \ |
[info exists gluefile] } { |
lappend options "libs=${gluefile}" |
lappend options "ldflags=$wrap_flags" |
} |
|
if [target_info exists gcc,stack_size] { |
lappend options "additional_flags=-DSTACK_SIZE=[target_info gcc,stack_size]" |
} |
if [target_info exists gcc,no_trampolines] { |
lappend options "additional_flags=-DNO_TRAMPOLINES" |
} |
if [target_info exists gcc,no_label_values] { |
lappend options "additional_flags=-DNO_LABEL_VALUES" |
} |
# TOOL_OPTIONS must come first, so that it doesn't override testcase |
# specific options. |
if [info exists TOOL_OPTIONS] { |
set options [concat "{additional_flags=$TOOL_OPTIONS}" $options] |
} |
lappend options "timeout=[timeout_value]" |
lappend options "compiler=$GCC_UNDER_TEST" |
set options [dg-additional-files-options $options $source] |
return [target_compile $source $dest $type $options] |
} |
/testsuite/lib/lto.exp
0,0 → 1,568
# Copyright (C) 2009, 2010 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 |
# <http://www.gnu.org/licenses/>. |
|
# Contributed by Diego Novillo <dnovillo@google.com> |
|
# Prune messages that aren't useful. |
|
proc lto_prune_warns { text } { |
|
verbose "lto_prune_warns: entry: $text" 2 |
|
# Many tests that use visibility will still pass on platforms that don't support it. |
regsub -all "(^|\n)\[^\n\]*: warning: visibility attribute not supported in this configuration; ignored\[^\n\]*" $text "" text |
|
# And any stray location lines. |
regsub -all "(^|\n)\[^\n\]*: In function \[^\n\]*" $text "" text |
regsub -all "(^|\n)In file included from \[^\n\]*" $text "" text |
regsub -all "(^|\n)\[ \t\]*from \[^\n\]*" $text "" text |
|
# Sun ld warns about common symbols with differing sizes. Unlike GNU ld |
# --warn-common (off by default), they cannot be disabled. |
regsub -all "(^|\n)ld: warning: symbol \[`'\]\[^\n\]*' has differing sizes:" $text "" text |
regsub -all "(^|\n)\[ \t\]*\[\(\]file \[^\n\]* value=\[^\n\]*; file \[^\n\]* value=\[^\n\]*\[)\];" $text "" text |
regsub -all "(^|\n)\[ \t\]*\[^\n\]* definition taken" $text "" text |
|
verbose "lto_prune_warns: exit: $text" 2 |
|
return $text |
} |
|
# lto_init -- called at the start of each subdir of tests |
|
proc lto_init { args } { |
global LTO_OPTIONS |
|
if {[info exists args] && $args == "no-mathlib"} { |
global board_info |
global saved_mathlib |
|
set dest [target_info name] |
if [board_info $dest exists mathlib] { |
set saved_mathlib [board_info $dest mathlib] |
} |
set board_info($dest,mathlib) " " |
} |
|
# Each test is run with the compiler options from this list. |
# The default option lists can be overridden by LTO_OPTIONS="[list |
# {opts_1} {opts_2}... {opts_n}]" where opts_i are lists of options. |
# You can put this in the environment before site.exp is written or |
# add it to site.exp directly. |
if ![info exists LTO_OPTIONS] { |
set LTO_OPTIONS [list \ |
{-O0 -fwhopr} \ |
{-O2 -fwhopr} \ |
{-O0 -flto} \ |
{-O2 -flto} \ |
] |
} |
} |
|
# |
# lto_finish -- called at the end of each subdir of tests if mathlib is |
# changed. |
# |
|
proc lto_finish { } { |
global board_info |
global saved_mathlib |
|
set dest [target_info name] |
if [info exists saved_mathlib] { |
set board_info($dest,mathlib) $saved_mathlib |
} elseif [board_info $dest exists mathlib] { |
unset board_info($dest,mathlib) |
} |
} |
|
# Subsets of tests can be selectively disabled by members of this list: |
# - ATTRIBUTE: disable all tests using the __attribute__ extension, |
# - COMPLEX: disable all tests using the complex types feature, |
# - COMPLEX_INT: disable all tests using the complex integral types extension, |
# - VA: disable all tests using the variable number of arguments feature, |
# - VLA_IN_STRUCT: disable all tests using the variable-length arrays as |
# structure members extension, |
# - ZERO_ARRAY: disable all tests using the zero-sized arrays extension. |
# The default skip lists can be overriden by |
# LTO_SKIPS="[list {skip_1}...{skip_n}]" |
# where skip_i are skip identifiers. You can put this in the environment |
# before site.exp is written or add it to site.exp directly. |
if ![info exists LTO_SKIPS] { |
set LTO_SKIPS [list {}] |
} |
|
global lto_skip_list |
set lto_skip_list $LTO_SKIPS |
|
load_lib dg.exp |
load_lib gcc-dg.exp |
|
# lto-obj -- compile to an object file |
# |
# SOURCE is the source file |
# DEST is the object file |
# OPTALL is the list of compiler options to use with all tests |
# OPTFILE is the list of compiler options to use with this file |
# OPTSTR is the options to print with test messages |
# XFAILDATA is the xfail data to be passed to the compiler |
proc lto-obj { source dest optall optfile optstr xfaildata } { |
global testcase |
global tool |
global compiler_conditional_xfail_data |
global lto_skip_list |
|
# Add the skip specifiers. |
foreach skip $lto_skip_list { |
if { ![string match $skip ""] } { |
lappend optall "-DSKIP_$skip" |
} |
} |
|
# Set up the options for compiling this file. |
set options "" |
lappend options "additional_flags=$optall $optfile" |
|
set compiler_conditional_xfail_data $xfaildata |
set comp_output [${tool}_target_compile "$source" "$dest" object $options] |
# Prune unimportant visibility warnings before checking output. |
set comp_output [lto_prune_warns $comp_output] |
${tool}_check_compile "$testcase $dest assemble" $optstr $dest $comp_output |
} |
|
# lto-link-and-maybe-run -- link the object files and run the executable |
# if compile_type is set to "run" |
# |
# TESTNAME is the mixture of object files to link |
# OBJLIST is the list of object files to link |
# DEST is the name of the executable |
# OPTALL is a list of compiler and linker options to use for all tests |
# OPTFILE is a list of compiler and linker options to use for this test |
# OPTSTR is the list of options to list in messages |
proc lto-link-and-maybe-run { testname objlist dest optall optfile optstr } { |
global testcase |
global tool |
global compile_type |
|
# Check that all of the objects were built successfully. |
foreach obj [split $objlist] { |
if ![file_on_host exists $obj] then { |
unresolved "$testcase $testname link $optstr" |
unresolved "$testcase $testname execute $optstr" |
return |
} |
} |
|
# Set up the options for linking this test. |
set options "" |
lappend options "additional_flags=$optall $optfile" |
|
# Link the objects into an executable. |
set comp_output [${tool}_target_compile "$objlist" $dest executable \ |
"$options"] |
|
# Prune unimportant visibility warnings before checking output. |
set comp_output [lto_prune_warns $comp_output] |
|
if ![${tool}_check_compile "$testcase $testname link" "" \ |
$dest $comp_output] then { |
unresolved "$testcase $testname execute $optstr" |
return |
} |
|
# Return if we only needed to link. |
if { ![string compare "link" $compile_type] } { |
return |
} |
|
# Run the self-checking executable. |
if ![string match "*/*" $dest] then { |
set dest "./$dest" |
} |
set result [${tool}_load $dest "" ""] |
set status [lindex $result 0] |
if { $status == "pass" } then { |
file_on_host delete $dest |
} |
$status "$testcase $testname execute $optstr" |
} |
|
# lto-get-options-main -- get target requirements for a test and |
# options for the primary source file and the test as a whole |
# |
# SRC is the full pathname of the primary source file. |
proc lto-get-options-main { src } { |
global compile_type |
global dg-extra-ld-options |
global dg-suppress-ld-options |
|
set dg-extra-ld-options "" |
set dg-suppress-ld-options "" |
|
# dg-options sets a variable called dg-extra-tool-flags. |
set dg-extra-tool-flags "" |
|
# dg-options sets a variable called tool_flags. |
set tool_flags "" |
|
# dg-require-* sets dg-do-what. |
upvar dg-do-what dg-do-what |
upvar dg-final-code dg-final-code |
set dg-final-code "" |
|
set tmp [dg-get-options $src] |
verbose "getting options for $src: $tmp" |
foreach op $tmp { |
set cmd [lindex $op 0] |
verbose "cmd is $cmd" |
if { [string match "dg-skip-if" $cmd] \ |
|| [string match "dg-require-*" $cmd] } { |
set status [catch "$op" errmsg] |
if { $status != 0 } { |
perror "src: $errmsg for \"$op\"\n" |
unresolved "$src: $errmsg for \"$op\"" |
return |
} |
} elseif { [string match "dg-lto-options" $cmd] } { |
set op [lreplace $op 0 0 "dg-options"] |
set status [catch "$op" errmsg] |
if { $status != 0 } { |
perror "src: $errmsg for \"$op\"\n" |
unresolved "$src: $errmsg for \"$op\"" |
return |
} |
} elseif { ![string compare "dg-xfail-if" $cmd] \ |
|| ![string compare "dg-options" $cmd] } { |
warning "lto.exp does not support $cmd in primary source file" |
} elseif { ![string compare "dg-lto-do" $cmd] } { |
if { [llength $op] > 3 } { |
set kw [lindex [lindex $op 3] 0] |
if [string match "target" $kw] { |
perror "$src: dg-lto-do does not support \"target\"" |
} elseif [string match "xfail" $kw] { |
perror "$src: dg-lto-do does not support \"xfail\"" |
} else { |
perror "$src: dg-lto-do takes a single argument" |
} |
} |
set dgdo [lindex $op 2] |
verbose "dg-lto-do command for \"$op\" is $dgdo" |
if { ![string compare "assemble" $dgdo] } { |
set compile_type "assemble" |
} elseif { ![string compare "run" $dgdo] } { |
set compile_type "run" |
} elseif { ![string compare "link" $dgdo] } { |
set compile_type "link" |
} else { |
warning "lto.exp does not support dg-lto-do $dgdo" |
} |
} elseif { ![string compare "dg-extra-ld-options" $cmd] } { |
set dg-extra-ld-options [lindex $op 2] |
verbose "dg-extra-ld-options for main is ${dg-extra-ld-options}" |
} elseif { ![string compare "dg-suppress-ld-options" $cmd] } { |
set dg-suppress-ld-options [lindex $op 2] |
verbose \ |
"dg-suppress-ld-options for main is ${dg-suppress-ld-options}" |
} elseif { ![string compare "dg-final" $cmd] } { |
if { [llength $op] > 3 } { |
error "[lindex $op 0]: too many arguments" |
} else { |
append dg-final-code "[lindex $op 2]\n" |
} |
} else { |
# Ignore unrecognized dg- commands, but warn about them. |
warning "lto.exp does not support $cmd" |
} |
} |
|
# Return flags to use for compiling the primary source file and for |
# linking. |
verbose "dg-extra-tool-flags for main is ${dg-extra-tool-flags}" |
return ${dg-extra-tool-flags} |
} |
|
|
# lto-get-options -- get special tool flags to use for a secondary |
# source file |
# |
# SRC is the full pathname of the source file. |
# The result is a list of options to use. |
# |
# This code is copied from proc dg-test in dg.exp from DejaGNU. |
proc lto-get-options { src } { |
# dg-options sets a variable called dg-extra-tool-flags. |
set dg-extra-tool-flags "" |
|
# dg-xfail-if sets compiler_conditional_xfail_data. |
global compiler_conditional_xfail_data |
set compiler_conditional_xfail_data "" |
|
# dg-xfail-if needs access to dg-do-what. |
upvar dg-do-what dg-do-what |
|
set tmp [dg-get-options $src] |
foreach op $tmp { |
set cmd [lindex $op 0] |
if { ![string compare "dg-options" $cmd] \ |
|| ![string compare "dg-xfail-if" $cmd] } { |
set status [catch "$op" errmsg] |
if { $status != 0 } { |
perror "src: $errmsg for \"$op\"\n" |
unresolved "$src: $errmsg for \"$op\"" |
return |
} |
} elseif { [string match "dg-require-*" $cmd] } { |
warning "lto.exp does not support $cmd in secondary source files" |
} else { |
# Ignore unrecognized dg- commands, but warn about them. |
warning "lto.exp does not support $cmd in secondary source files" |
} |
} |
|
return ${dg-extra-tool-flags} |
} |
|
# lto-execute -- compile multi-file tests |
# |
# SRC1 is the full pathname of the main file of the testcase. |
# SID identifies a test suite in the names of temporary files. |
proc lto-execute { src1 sid } { |
global srcdir tmpdir |
global lto_option_list |
global tool |
global verbose |
global testcase |
global gluefile |
global compiler_conditional_xfail_data |
global dg-do-what-default |
global compile_type |
global dg-extra-ld-options |
global dg-suppress-ld-options |
global LTO_OPTIONS |
global dg-final-code |
|
# Get extra flags for this test from the primary source file, and |
# process other dg-* options that this suite supports. Warn about |
# unsupported flags. |
verbose "lto-execute: $src1" 1 |
set compile_type "run" |
set dg-do-what [list ${dg-do-what-default} "" P] |
set extra_flags(0) [lto-get-options-main $src1] |
set compile_xfail(0) "" |
|
# If the main file defines dg-options, those flags are used to |
# overwrite the default lto_option_list taken from LTO_OPTIONS. |
if { [string length $extra_flags(0)] > 0 } { |
set lto_option_list $extra_flags(0) |
set extra_flags(0) "" |
} else { |
set lto_option_list $LTO_OPTIONS |
} |
|
# Check whether this test is supported for this target. |
if { [lindex ${dg-do-what} 1 ] == "N" } { |
unsupported "$src1" |
verbose "$src1 not supported on this target, skipping it" 3 |
return |
} |
|
# Set up the names of the other source files. |
set dir [file dirname $src1] |
set base [file rootname $src1] |
set base [string range $base [string length $dir] end] |
regsub "_0" $base "" base |
regsub "/" $base "" base |
set src_list $src1 |
set i 1 |
set done 0 |
while { !$done } { |
set names [glob -nocomplain -types f -- "${dir}/${base}_${i}.*"] |
if { [llength ${names}] > 1 } { |
warning "lto-execute: more than one file matched ${dir}/${base}_${i}.*" |
} |
if { [llength ${names}] == 1 } { |
lappend src_list [lindex ${names} 0] |
incr i |
} else { |
set num_srcs ${i} |
set done 1 |
} |
} |
|
# Use the dg-options mechanism to specify extra flags for each |
# of the secondary files. |
# The extra flags in each file are used to compile that file, and the |
# extra flags in *_0.* are also used for linking. |
verbose "\tsrc_list is: $src_list" |
for {set i 1} {$i < $num_srcs} {incr i} { |
set extra_flags($i) [lto-get-options [lindex $src_list $i]] |
set compile_xfail($i) $compiler_conditional_xfail_data |
} |
|
# Define the names of the object files. |
set obj_list "" |
for {set i 0} {$i < $num_srcs} {incr i} { |
lappend obj_list "${sid}_${base}_${i}.o" |
} |
|
# Get the base name of this test, for use in messages. |
set testcase [lindex ${src_list} 0] |
|
# Remove the $srcdir and $tmpdir prefixes from $src1. (It would |
# be possible to use "regsub" here, if we were careful to escape |
# all regular expression characters in $srcdir and $tmpdir, but |
# that would be more complicated that this approach.) |
if {[string first "$srcdir/" "${testcase}"] == 0} { |
set testcase [string range "${testcase}" [string length "$srcdir/"] end] |
} |
if {[string first "$tmpdir/" "$testcase"] == 0} { |
set testcase [string range "$testcase" [string length "$tmpdir/"] end] |
set testcase "tmpdir-$testcase" |
} |
regsub "_0.*" $testcase "" testcase |
|
# Set up the base name of executable files so they'll be unique. |
regsub -all "\[./\]" $testcase "-" execbase |
|
# If we couldn't rip $srcdir out of `src1' then just do the best we can. |
# The point is to reduce the unnecessary noise in the logs. Don't strip |
# out too much because different testcases with the same name can confuse |
# `test-tool'. |
if [string match "/*" $testcase] then { |
set testcase "[file tail [file dirname $src1]]/[file tail $src1]" |
} |
|
# Loop through all of the option lists used for this test. |
set count 0 |
foreach option $lto_option_list { |
verbose "Testing $testcase, $option" |
|
# There's a unique name for each executable we generate. |
set execname "${execbase}-${count}1" |
incr count |
|
file_on_host delete $execname |
|
# Compile pieces with the compiler under test. |
set i 0 |
foreach src $src_list obj $obj_list { |
lto-obj $src $obj $option $extra_flags($i) $option \ |
$compile_xfail($i) |
incr i |
} |
|
# Link (using the compiler under test), run, and clean up tests. |
if { ![string compare "run" $compile_type] \ |
|| ![string compare "link" $compile_type] } { |
|
# Filter out any link options we were asked to suppress. |
set reduced {} |
foreach x [split $option] { |
if {[lsearch ${dg-suppress-ld-options} $x] == -1} { |
lappend reduced $x |
} |
} |
set filtered [join $reduced " "] |
|
lto-link-and-maybe-run \ |
"[lindex $obj_list 0]-[lindex $obj_list end]" \ |
$obj_list $execname $filtered ${dg-extra-ld-options} \ |
$filtered |
} |
|
|
# Are there any further tests to perform? |
# Note that if the program has special run-time requirements, running |
# of the program can be delayed until here. Ditto for other situations. |
# It would be a bit cumbersome though. |
|
if ![string match ${dg-final-code} ""] { |
regsub -all "\\\\(\[{}\])" ${dg-final-code} "\\1" dg-final-code |
# Note that the use of `args' here makes this a varargs proc. |
proc dg-final-proc { args } ${dg-final-code} |
verbose "Running dg-final tests." 3 |
verbose "dg-final-proc:\n[info body dg-final-proc]" 4 |
if [catch "dg-final-proc $src1" errmsg] { |
perror "$name: error executing dg-final: $errmsg" |
# ??? The call to unresolved here is necessary to clear |
# `errcnt'. What we really need is a proc like perror that |
# doesn't set errcnt. It should also set exit_status to 1. |
unresolved "$name: error executing dg-final: $errmsg" |
} |
} |
|
# Clean up object files. |
set files [glob -nocomplain ${sid}_*.o] |
if { $files != "" } { |
foreach objfile $files { |
if { ![info exists gluefile] || $objfile != $gluefile } { |
eval "file_on_host delete $objfile" |
} |
} |
} |
|
if { ![string compare "run" $compile_type] \ |
|| ![string compare "link" $compile_type] } { |
file_on_host delete $execname |
} |
} |
} |
|
# Utility for scanning a symbol in the final executable, invoked via dg-final. |
# Call pass if pattern is present, otherwise fail. |
# |
# Argument 0 is the regexp to match. |
# Argument 1 handles expected failures and the like |
proc scan-symbol { args } { |
global nm |
global base_dir |
upvar 2 execname execname |
|
if { [llength $args] >= 2 } { |
switch [dg-process-target [lindex $args 1]] { |
"S" { } |
"N" { return } |
"F" { setup_xfail "*-*-*" } |
"P" { } |
} |
} |
|
# Find nm like we find g++ in g++.exp. |
if ![info exists nm] { |
set nm [findfile $base_dir/../../../binutils/nm \ |
$base_dir/../../../binutils/nm \ |
[findfile $base_dir/../../nm $base_dir/../../nm \ |
[findfile $base_dir/nm $base_dir/nm \ |
[transform nm]]]] |
verbose -log "nm is $nm" |
} |
|
set output_file "[glob -nocomplain $execname]" |
if { $output_file == "" } { |
fail "scan-symbol $args: dump file does not exist" |
return |
} |
|
set fd [open "| $nm $output_file" r] |
set text [read $fd] |
close $fd |
|
if [regexp -- [lindex $args 0] $text] { |
pass "scan-symbol $args" |
} else { |
fail "scan-symbol $args" |
} |
} |
/testsuite/lib/mike-g++.exp
0,0 → 1,262
# Copyright (C) 1988, 90, 91, 92, 95, 96, 1997, 2007 |
# 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 |
# <http://www.gnu.org/licenses/>. |
|
# This file was written by Mike Stump <mrs@cygnus.com> |
|
# |
# mike_cleanup -- remove any files that are created by the testcase |
# |
proc mike_cleanup { src_code output_file assembly_file } { |
remote_file build delete $output_file $assembly_file |
} |
|
# |
# prebase -- sets up a Mike Stump (mrs@cygnus.com) style G++ test |
# |
proc prebase { } { |
global compiler_output |
global not_compiler_output |
global compiler_result |
global not_compiler_result |
global program_output |
global groups |
global run |
global actions |
global target_regexp |
|
set compiler_output "^$" |
set not_compiler_output ".*Internal compiler error.*" |
set compiler_result "" |
set not_compiler_result "" |
set program_output ".*PASS.*" |
set groups {} |
set run no |
set actions assemble |
set target_regexp ".*" |
} |
|
# |
# run the test |
# |
proc postbase { src_code run groups args } { |
global verbose |
global srcdir |
global subdir |
global not_compiler_output |
global compiler_output |
global compiler_result |
global not_compiler_result |
global program_output |
global actions |
global target_regexp |
global host_triplet |
global target_triplet |
global tool |
global tmpdir |
global objdir |
global base_dir |
|
if ![regexp $target_regexp $target_triplet] { |
unsupported $subdir/$src_code |
return |
} |
|
if { [llength $args] > 0 } { |
set comp_options [lindex $args 0] |
} else { |
set comp_options "" |
} |
|
set fail_message $subdir/$src_code |
set pass_message $subdir/$src_code |
|
if [info exists GROUP] { |
if {[lsearch $groups $GROUP] == -1} { |
return |
} |
} |
|
if [string match $run yes] { |
set actions run |
} |
|
set output_file "$tmpdir/[file tail [file rootname $src_code]]" |
set assembly_file "$output_file" |
append assembly_file ".S" |
|
set compile_type "none" |
|
case $actions { |
compile |
{ |
set compile_type "assembly" |
set output_file $assembly_file |
} |
assemble |
{ |
set compile_type "object" |
append output_file ".o" |
} |
link |
{ |
set compile_type "executable" |
append output_file ".exe" |
} |
run |
{ |
set compile_type "executable" |
append output_file ".exe" |
set run yes |
} |
default |
{ |
set output_file "" |
set compile_type "none" |
} |
} |
|
set src_file "$srcdir/$subdir/$src_code" |
set options "" |
|
if { $comp_options != "" } { |
lappend options "additional_flags=$comp_options" |
} |
|
if ![ishost "*-dos-*"] { |
lappend options "libs=-lstdc++ -lg++" |
} else { |
lappend options "libs=-lstdcxx -lgxx" |
} |
|
set comp_output [g++_target_compile $src_file $output_file $compile_type $options] |
|
set pass no |
|
# Delete things like "ld.so warning" messages. |
set comp_output [prune_warnings $comp_output] |
|
if [regexp -- $not_compiler_output $comp_output] { |
if { $verbose > 1 } { |
send_user "\nChecking:\n$not_compiler_output\nto make sure it does not match:\n$comp_output\nbut it does.\n\n" |
} else { |
send_log "\nCompiler output:\n$comp_output\n\n" |
} |
fail $fail_message |
# The framework doesn't like to see any error remnants, |
# so remove them. |
uplevel { |
if [info exists errorInfo] { |
unset errorInfo |
} |
} |
mike_cleanup $src_code $output_file $assembly_file |
return |
} |
|
# remove any leftover CRs. |
regsub -all -- "\r" $comp_output "" comp_output |
|
regsub -all "(^|\n)\[^\n\]*linker input file unused since linking not done" $comp_output "" comp_output |
regsub -all "(^|\n)\[^\n\]*file path prefix \[^\n\]* never used" $comp_output "" comp_output |
|
set unsupported_message [${tool}_check_unsupported_p $comp_output] |
if { $unsupported_message != "" } { |
unsupported "$subdir/$src_code: $unsupported_message" |
mike_cleanup $src_code $output_file $assembly_file |
return |
} |
|
if { $verbose > 1 } { |
send_user "\nChecking:\n$compiler_output\nto see if it matches:\n$comp_output\n" |
} else { |
send_log "\nCompiler output:\n$comp_output\n\n" |
} |
if [regexp -- $compiler_output $comp_output] { |
if { $verbose > 1 } { |
send_user "Yes, it matches.\n\n" |
} |
set pass yes |
if [file exists [file rootname [file tail $src_code]].s] { |
set fd [open [file rootname [file tail $src_code]].s r] |
set dot_s [read $fd] |
close $fd |
if { $compiler_result != "" } { |
verbose "Checking .s file for $compiler_result" 2 |
if [regexp -- $compiler_result $dot_s] { |
verbose "Yes, it matches." 2 |
} else { |
verbose "Nope, doesn't match." 2 |
verbose $dot_s 4 |
set pass no |
} |
} |
if { $not_compiler_result != "" } { |
verbose "Checking .s file for not $not_compiler_result" 2 |
if ![regexp -- $not_compiler_result $dot_s] { |
verbose "Nope, not found (that's good)." 2 |
} else { |
verbose "Uh oh, it was found." 2 |
verbose $dot_s 4 |
set pass no |
} |
} |
} |
if [string match $run yes] { |
set result [g++_load $output_file] |
set status [lindex $result 0] |
set output [lindex $result 1] |
|
if { $status == -1 } { |
mike_cleanup $src_code $output_file $assembly_file |
return |
} |
if { $verbose > 1 } { |
send_user "Checking:\n$program_output\nto see if it matches:\n$output\n\n" |
} |
if ![regexp -- $program_output $output] { |
set pass no |
if { $verbose > 1 } { |
send_user "Nope, does not match.\n\n" |
} |
} else { |
if { $verbose > 1 } { |
send_user "Yes, it matches.\n\n" |
} |
} |
} |
} else { |
if { $verbose > 1 } { |
send_user "Nope, does not match.\n\n" |
} |
} |
|
if [string match $pass "yes"] { |
pass $pass_message |
} else { |
fail $fail_message |
} |
|
# The framework doesn't like to see any error remnants, |
# so remove them. |
uplevel { |
if [info exists errorInfo] { |
unset errorInfo |
} |
} |
|
mike_cleanup $src_code $output_file $assembly_file |
} |
/testsuite/lib/c-compat.exp
0,0 → 1,99
# Copyright (C) 2002, 2003, 2005, 2006, 2007, 2008 |
# 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 |
# <http://www.gnu.org/licenses/>. |
|
# Please email any bugs, comments, and/or additions to this file to: |
# gcc-patches@gcc.gnu.org |
|
# Globals. |
|
global compat_use_alt |
global compat_same_alt |
global compat_have_dfp |
global compat_skip_list |
|
# This file defines procs for determining features supported by both C |
# compilers for compatibility tests. |
|
load_lib target-supports.exp |
|
# |
# compat-use-alt-compiler -- make the alternate compiler the default |
# |
proc compat-use-alt-compiler { } { |
global GCC_UNDER_TEST ALT_CC_UNDER_TEST |
global compat_same_alt |
|
# We don't need to do this if the alternate compiler is actually |
# the same as the compiler under test. |
if { $compat_same_alt == 0 } then { |
set GCC_UNDER_TEST $ALT_CC_UNDER_TEST |
} |
} |
|
# |
# compat-use-tst-compiler -- make compiler under test the default |
# |
proc compat-use-tst-compiler { } { |
global GCC_UNDER_TEST compat_save_gcc_under_test |
global compat_same_alt |
|
# We don't need to do this if the alternate compiler is actually |
# the same as the compiler under test. |
|
if { $compat_same_alt == 0 } then { |
set GCC_UNDER_TEST $compat_save_gcc_under_test |
} |
} |
|
# Find out whether both compilers support decimal float types. |
proc compat_setup_dfp { } { |
global compat_use_alt |
global compat_same_alt |
global compat_have_dfp |
|
verbose "compat_setup_dfp: $compat_use_alt $compat_same_alt" 2 |
|
# Does the compiler under test support decimal float types? |
compat-use-tst-compiler |
set compat_have_dfp [check_effective_target_dfprt_nocache] |
verbose "compat_have_dfp for tst compiler: $compat_have_dfp" 2 |
|
# If there is an alternate compiler, does it support decimal float types? |
if { $compat_have_dfp == 1 && $compat_use_alt == 1 && $compat_same_alt == 0 } { |
compat-use-alt-compiler |
set compat_have_dfp [check_effective_target_dfprt_nocache] |
compat-use-tst-compiler |
verbose "compat_have_dfp for alt compiler: $compat_have_dfp" 2 |
} |
|
# If decimal float is not supported, add it to the skip list, which |
# affects code in the header files. |
if { $compat_have_dfp == 0 } { |
global compat_skip_list |
lappend compat_skip_list "DECIMAL_FLOAT" |
} |
} |
|
# If either compiler does not support decimal float types, skip this test. |
|
proc dg-require-compat-dfp { args } { |
global compat_have_dfp |
if { $compat_have_dfp == 0 } { |
upvar dg-do-what dg-do-what |
set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] |
} |
} |
/testsuite/lib/scanrtl.exp
0,0 → 1,141
# Copyright (C) 2006, 2007 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 |
# <http://www.gnu.org/licenses/>. |
|
# Various utilities for scanning rtl dump output, used by gcc-dg.exp and |
# g++-dg.exp. |
|
load_lib scandump.exp |
|
# Utility for scanning compiler result, invoked via dg-final. |
# Call pass if pattern is present, otherwise fail. |
# |
# Argument 0 is the regexp to match |
# Argument 1 is the name of the dumped rtl pass |
# Argument 2 handles expected failures and the like |
proc scan-rtl-dump { args } { |
|
if { [llength $args] < 2 } { |
error "scan-rtl-dump: too few arguments" |
return |
} |
if { [llength $args] > 3 } { |
error "scan-rtl-dump: too many arguments" |
return |
} |
if { [llength $args] >= 3 } { |
scan-dump "rtl" [lindex $args 0] "\[0-9\]\[0-9\]\[0-9\]r.[lindex $args 1]" [lindex $args 2] |
} else { |
scan-dump "rtl" [lindex $args 0] "\[0-9\]\[0-9\]\[0-9\]r.[lindex $args 1]" |
} |
} |
|
# Call pass if pattern is present given number of times, otherwise fail. |
# Argument 0 is the regexp to match |
# Argument 1 is number of times the regexp must be found |
# Argument 2 is the name of the dumped rtl pass |
# Argument 3 handles expected failures and the like |
proc scan-rtl-dump-times { args } { |
|
if { [llength $args] < 3 } { |
error "scan-rtl-dump: too few arguments" |
return |
} |
if { [llength $args] > 4 } { |
error "scan-rtl-dump: too many arguments" |
return |
} |
if { [llength $args] >= 4 } { |
scan-dump-times "rtl" [lindex $args 0] [lindex $args 1] \ |
"\[0-9\]\[0-9\]\[0-9\]r.[lindex $args 2]" [lindex $args 3] |
} else { |
scan-dump-times "rtl" [lindex $args 0] [lindex $args 1] \ |
"\[0-9\]\[0-9\]\[0-9\]r.[lindex $args 2]" |
} |
} |
|
# Call pass if pattern is not present, otherwise fail. |
# |
# Argument 0 is the regexp to match |
# Argument 1 is the name of the dumped rtl pass |
# Argument 2 handles expected failures and the like |
proc scan-rtl-dump-not { args } { |
|
if { [llength $args] < 2 } { |
error "scan-rtl-dump-not: too few arguments" |
return |
} |
if { [llength $args] > 3 } { |
error "scan-rtl-dump-not: too many arguments" |
return |
} |
if { [llength $args] >= 3 } { |
scan-dump-not "rtl" [lindex $args 0] \ |
"\[0-9\]\[0-9\]\[0-9\]r.[lindex $args 1]" [lindex $args 2] |
} else { |
scan-dump-not "rtl" [lindex $args 0] \ |
"\[0-9\]\[0-9\]\[0-9\]r.[lindex $args 1]" |
} |
} |
|
# Utility for scanning demangled compiler result, invoked via dg-final. |
# Call pass if pattern is present, otherwise fail. |
# |
# Argument 0 is the regexp to match |
# Argument 1 is the name of the dumped rtl pass |
# Argument 2 handles expected failures and the like |
proc scan-rtl-dump-dem { args } { |
|
if { [llength $args] < 2 } { |
error "scan-rtl-dump-dem: too few arguments" |
return |
} |
if { [llength $args] > 3 } { |
error "scan-rtl-dump-dem: too many arguments" |
return |
} |
if { [llength $args] >= 3 } { |
scan-dump-dem "rtl" [lindex $args 0] \ |
"\[0-9\]\[0-9\]\[0-9\]r.[lindex $args 1]" [lindex $args 2] |
} else { |
scan-dump-dem "rtl" [lindex $args 0] \ |
"\[0-9\]\[0-9\]\[0-9\]r.[lindex $args 1]" |
} |
} |
|
# Call pass if demangled pattern is not present, otherwise fail. |
# |
# Argument 0 is the regexp to match |
# Argument 1 is the name of the dumped rtl pass |
# Argument 2 handles expected failures and the like |
proc scan-rtl-dump-dem-not { args } { |
|
if { [llength $args] < 2 } { |
error "scan-rtl-dump-dem-not: too few arguments" |
return |
} |
if { [llength $args] > 3 } { |
error "scan-rtl-dump-dem-not: too many arguments" |
return |
} |
if { [llength $args] >= 3 } { |
scan-dump-dem-not "rtl" [lindex $args 0] \ |
"\[0-9\]\[0-9\]\[0-9\]r.[lindex $args 1]" \ |
[lindex $args 2] |
} else { |
scan-dump-dem-not "rtl" [lindex $args 0] \ |
"\[0-9\]\[0-9\]\[0-9\]r.[lindex $args 1]" |
} |
} |
/testsuite/lib/plugin-support.exp
0,0 → 1,109
# Copyright (C) 2009 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 |
# <http://www.gnu.org/licenses/>. |
# |
|
# This file contains the support procedures for testing the plugin mechanism. |
|
load_lib dg.exp |
load_lib gcc.exp |
|
# |
# plugin-get-options -- process test directives |
# |
# SRC is the full pathname of the plugin source file. |
# |
proc plugin-get-options { src } { |
# dg-options sets a variable called dg-extra-tool-flags. |
set dg-extra-tool-flags "" |
|
# dg-require-* sets dg-do-what. |
upvar dg-do-what dg-do-what |
|
set tmp [dg-get-options $src] |
foreach op $tmp { |
set cmd [lindex $op 0] |
if { ![string compare "dg-options" $cmd] } { |
set status [catch "$op" errmsg] |
if { $status != 0 } { |
perror "src: $errmsg for \"$op\"\n" |
unresolved "$src: $errmsg for \"$op\"" |
return |
} |
} else { |
# Ignore unrecognized dg- commands, but warn about them. |
warning "plugin.exp does not support $cmd" |
} |
} |
|
# Return flags to use for compiling the plugin source file |
return ${dg-extra-tool-flags} |
} |
|
# |
# plugin-test-execute -- build the plugin first and then compile the |
# test files with the plugin. |
# |
# PLUGIN_SRC is the full pathname of the plugin source file. |
# PLUGIN_TESTS is a list of input test source files. |
# |
proc plugin-test-execute { plugin_src plugin_tests } { |
global srcdir objdir |
global verbose |
global GMPINC |
global PLUGINCC |
global PLUGINCFLAGS |
|
set basename [file tail $plugin_src] |
set base [file rootname $basename] |
set plugin_lib $base.so |
|
verbose "Test the plugin $basename" 1 |
|
# Build the plugin itself |
set extra_flags [plugin-get-options $plugin_src] |
|
# Note that the plugin test support currently only works when the GCC |
# build tree is available. (We make sure that is the case in plugin.exp.) |
# Once we have figured out how/where to package/install GCC header files |
# for general plugin support, we should modify the following include paths |
# accordingly. |
set gcc_srcdir "$srcdir/../.." |
set gcc_objdir "$objdir/../../.." |
set includes "-I. -I${srcdir} -I${gcc_srcdir}/gcc -I${gcc_objdir}/gcc \ |
-I${gcc_srcdir}/include -I${gcc_srcdir}/libcpp/include \ |
$GMPINC" |
|
set optstr "$includes $extra_flags -DIN_GCC -fPIC -shared" |
|
# Temporarily switch to the environment for the plugin compiler. |
restore_ld_library_path_env_vars |
set status [remote_exec build "$PLUGINCC $PLUGINCFLAGS $plugin_src $optstr -o $plugin_lib"] |
set status [lindex $status 0] |
set_ld_library_path_env_vars |
|
if { $status != 0 } then { |
unresolved "$basename compilation, $optstr" |
return |
} |
|
# Compile the input source files with the plugin |
global default_flags |
set plugin_enabling_flags "-fplugin=./$plugin_lib" |
dg-runtest $plugin_tests $plugin_enabling_flags $default_flags |
|
# Clean up |
remote_file build delete $plugin_lib |
} |
/testsuite/lib/gfortran-dg.exp
0,0 → 1,178
# Copyright (C) 2004, 2005, 2006, 2007, 2008 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 |
# <http://www.gnu.org/licenses/>. |
|
load_lib gcc-dg.exp |
load_lib torture-options.exp |
|
# Define gfortran callbacks for dg.exp. |
|
proc gfortran-dg-test { prog do_what extra_tool_flags } { |
set result \ |
[gcc-dg-test-1 gfortran_target_compile $prog $do_what $extra_tool_flags] |
|
set comp_output [lindex $result 0] |
set output_file [lindex $result 1] |
|
# gfortran error messages look like this: |
# [name]:[locus]: |
# |
# some code |
# 1 |
# Error: Some error at (1) |
# or |
# [name]:[locus]: |
# |
# some code |
# 1 |
# [name]:[locus2]: |
# |
# some other code |
# 2 |
# Error: Some error at (1) and (2) |
# or |
# [name]:[locus]: |
# |
# some code and some more code |
# 1 2 |
# Error: Some error at (1) and (2) |
# |
# Where [locus] is either [line] or [line].[columns] . |
# |
# We collapse these to look like: |
# [name]:[line]: Error: Some error at (1) and (2) |
# or |
# [name]:[line]: Error: Some error at (1) and (2) |
# [name]:[line2]: Error: Some error at (1) and (2) |
# We proceed in two steps: first we deal with the form with two |
# different locus lines, then with the form with only one locus line. |
# |
# Note that these regexps only make sense in the combinations used below. |
# Note also that is imperative that we first deal with the form with |
# two loci. |
set locus_regexp "(\[^\n\]*):(\[0-9\]*)\[^\n\]*:\n\n\[^\n\]*\n\[^\n\]*\n" |
set diag_regexp "(\[^\n\]*)\n" |
|
set two_loci "$locus_regexp$locus_regexp$diag_regexp" |
set single_locus "$locus_regexp$diag_regexp" |
regsub -all $two_loci $comp_output "\\1:\\2: \\5\n\\3:\\4: \\5\n" comp_output |
regsub -all $single_locus $comp_output "\\1:\\2: \\3\n" comp_output |
|
return [list $comp_output $output_file] |
} |
|
proc gfortran-dg-prune { system text } { |
return [gcc-dg-prune $system $text] |
} |
|
# Utility routines. |
|
# Modified dg-runtest that can cycle through a list of optimization options |
# as c-torture does. |
proc gfortran-dg-runtest { testcases default-extra-flags } { |
global runtests |
global DG_TORTURE_OPTIONS torture_with_loops |
|
torture-init |
set-torture-options $DG_TORTURE_OPTIONS |
|
foreach test $testcases { |
# If we're only testing specific files and this isn't one of |
# them, skip it. |
if ![runtest_file_p $runtests $test] { |
continue |
} |
|
# look if this is dg-do-run test, in which case |
# we cycle through the option list, otherwise we don't |
if [expr [search_for $test "dg-do run"]] { |
set option_list $torture_with_loops |
} else { |
set option_list [list { -O } ] |
} |
|
set nshort [file tail [file dirname $test]]/[file tail $test] |
|
foreach flags $option_list { |
verbose "Testing $nshort, $flags" 1 |
dg-test $test $flags ${default-extra-flags} |
} |
} |
|
torture-finish |
} |
|
proc gfortran-dg-debug-runtest { target_compile trivial opt_opts testcases } { |
global srcdir subdir DEBUG_TORTURE_OPTIONS |
|
if ![info exists DEBUG_TORTURE_OPTIONS] { |
set DEBUG_TORTURE_OPTIONS "" |
set type_list [list "-gstabs" "-gstabs+" "-gxcoff" "-gxcoff+" "-gcoff" "-gdwarf-2" ] |
foreach type $type_list { |
set comp_output [$target_compile \ |
"$srcdir/$subdir/$trivial" "trivial.S" assembly \ |
"additional_flags=$type"] |
if { [string match "exit status *" $comp_output] } { |
continue |
} |
if { [string match \ |
"* target system does not support the * debug format*" \ |
$comp_output] |
} { |
continue |
} |
remove-build-file "trivial.S" |
foreach level {1 "" 3} { |
if { ($type == "-gdwarf-2") && ($level != "") } { |
lappend DEBUG_TORTURE_OPTIONS [list "${type}" "-g${level}"] |
foreach opt $opt_opts { |
lappend DEBUG_TORTURE_OPTIONS \ |
[list "${type}" "-g${level}" "$opt" ] |
} |
} else { |
lappend DEBUG_TORTURE_OPTIONS [list "${type}${level}"] |
foreach opt $opt_opts { |
lappend DEBUG_TORTURE_OPTIONS \ |
[list "${type}${level}" "$opt" ] |
} |
} |
} |
} |
} |
|
verbose -log "Using options $DEBUG_TORTURE_OPTIONS" |
|
global runtests |
|
foreach test $testcases { |
# If we're only testing specific files and this isn't one of |
# them, skip it. |
if ![runtest_file_p $runtests $test] { |
continue |
} |
|
set nshort [file tail [file dirname $test]]/[file tail $test] |
|
foreach flags $DEBUG_TORTURE_OPTIONS { |
set doit 1 |
# gcc-specific checking removed here |
|
if { $doit } { |
verbose -log "Testing $nshort, $flags" 1 |
dg-test $test $flags "" |
} |
} |
} |
} |
/testsuite/lib/dejapatches.exp
0,0 → 1,35
# Copyright (C) 2008 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 |
# <http://www.gnu.org/licenses/>. |
|
# Necessary procs and fallbacks for functionality not present in |
# pristine dejagnu-1.4.4. Make sure overrides here work with updated |
# dejagnu too. |
|
# The absence of sim_download will cause e.g. the libstdc++ testsuite |
# to expose about 59 more FAILs on simulator targets supporting |
# fileio. |
|
if { [info procs sim_download] == "" } { |
proc sim_download { dest file args } { |
return [remote_download host $file $args] |
} |
} |
|
if { [info procs sim_upload] == "" } { |
proc sim_upload { dest srcfile args } { |
return [remote_upload host $srcfile $args] |
} |
} |
/testsuite/lib/g++.exp
0,0 → 1,335
# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2002, 2003, |
# 2004, 2005, 2007, 2008 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 |
# <http://www.gnu.org/licenses/>. |
|
# This file was written by Rob Savoye (rob@cygnus.com) |
# Many modifications by Jeffrey Wheat (cassidy@cygnus.com) |
# With modifications by Mike Stump <mrs@cygnus.com>. |
|
# |
# g++ support library routines |
# |
load_lib prune.exp |
load_lib gcc-defs.exp |
load_lib timeout.exp |
load_lib target-libpath.exp |
|
# |
# GXX_UNDER_TEST is the compiler under test. |
# |
|
|
set gpp_compile_options "" |
|
# |
# g++_version -- extract and print the version number of the compiler |
# |
|
proc g++_version { } { |
global GXX_UNDER_TEST |
|
g++_init |
|
# ignore any arguments after the command |
set compiler [lindex $GXX_UNDER_TEST 0] |
|
# verify that the compiler exists |
if { [is_remote host] || [which $compiler] != 0 } then { |
set tmp [remote_exec host "$compiler -v"] |
set status [lindex $tmp 0] |
set output [lindex $tmp 1] |
regexp " version \[^\n\r\]*" $output version |
if { $status == 0 && [info exists version] } then { |
if [is_remote host] { |
clone_output "$compiler $version\n" |
} else { |
clone_output "[which $compiler] $version\n" |
} |
} else { |
clone_output "Couldn't determine version of [which $compiler]\n" |
} |
} else { |
# compiler does not exist (this should have already been detected) |
warning "$compiler does not exist" |
} |
} |
|
# |
# g++_include_flags -- provide new version of g++_include_flags |
# (originally from libgloss.exp) which knows about the gcc tree structure |
# |
proc g++_include_flags { paths } { |
global srcdir |
global HAVE_LIBSTDCXX_V3 |
global TESTING_IN_BUILD_TREE |
|
set flags "" |
|
if { [is_remote host] || ! [info exists TESTING_IN_BUILD_TREE] } { |
return "${flags}" |
} |
|
set gccpath ${paths} |
|
set odir [lookfor_file ${gccpath} libstdc++-v3] |
if { ${odir} != "" } { |
append flags [exec sh ${odir}/scripts/testsuite_flags --build-includes] |
} |
|
return "$flags" |
} |
|
# |
# g++_link_flags -- provide new version of g++_link_flags |
# (originally from libgloss.exp) which knows about the gcc tree structure |
# |
|
proc g++_link_flags { paths } { |
global srcdir |
global ld_library_path |
global GXX_UNDER_TEST |
global shlib_ext |
|
set gccpath ${paths} |
set libio_dir "" |
set flags "" |
set ld_library_path "." |
|
set shlib_ext [get_shlib_extension] |
verbose "shared lib extension: $shlib_ext" |
|
if { $gccpath != "" } { |
if [file exists "${gccpath}/lib/libstdc++.a"] { |
append ld_library_path ":${gccpath}/lib" |
} |
if [file exists "${gccpath}/libg++/libg++.a"] { |
append flags "-L${gccpath}/libg++ " |
append ld_library_path ":${gccpath}/libg++" |
} |
if [file exists "${gccpath}/libstdc++/libstdc++.a"] { |
append flags "-L${gccpath}/libstdc++ " |
append ld_library_path ":${gccpath}/libstdc++" |
} |
if [file exists "${gccpath}/libstdc++-v3/src/.libs/libstdc++.a"] { |
append flags " -L${gccpath}/libstdc++-v3/src/.libs " |
# Some targets use libstdc++.a%s in their specs, so they need a |
# -B option for uninstalled testing. |
append flags " -B${gccpath}/libstdc++-v3/src/.libs " |
append ld_library_path ":${gccpath}/libstdc++-v3/src/.libs" |
} |
# Look for libstdc++.${shlib_ext}. |
if [file exists "${gccpath}/libstdc++-v3/src/.libs/libstdc++.${shlib_ext}"] { |
append flags " -L${gccpath}/libstdc++-v3/src/.libs " |
append ld_library_path ":${gccpath}/libstdc++-v3/src/.libs" |
} |
|
if [file exists "${gccpath}/libiberty/libiberty.a"] { |
append flags "-L${gccpath}/libiberty " |
} |
if [file exists "${gccpath}/librx/librx.a"] { |
append flags "-L${gccpath}/librx " |
} |
append ld_library_path [gcc-set-multilib-library-path $GXX_UNDER_TEST] |
} else { |
global tool_root_dir |
|
set libgpp [lookfor_file ${tool_root_dir} libg++] |
if { $libgpp != "" } { |
append flags "-L${libgpp} " |
append ld_library_path ":${libgpp}" |
} |
set libstdcpp [lookfor_file ${tool_root_dir} libstdc++] |
if { $libstdcpp != "" } { |
append flags "-L${libstdcpp} " |
append ld_library_path ":${libstdcpp}" |
} |
set libiberty [lookfor_file ${tool_root_dir} libiberty] |
if { $libiberty != "" } { |
append flags "-L${libiberty} " |
} |
set librx [lookfor_file ${tool_root_dir} librx] |
if { $librx != "" } { |
append flags "-L${librx} " |
} |
} |
|
set_ld_library_path_env_vars |
|
return "$flags" |
} |
|
# |
# g++_init -- called at the start of each subdir of tests |
# |
|
proc g++_init { args } { |
global subdir |
global gpp_initialized |
global base_dir |
global tmpdir |
global libdir |
global gluefile wrap_flags |
global objdir srcdir |
global ALWAYS_CXXFLAGS |
global CXXFLAGS |
global TOOL_EXECUTABLE TOOL_OPTIONS |
global GXX_UNDER_TEST |
global TESTING_IN_BUILD_TREE |
global target_triplet |
global gcc_warning_prefix |
global gcc_error_prefix |
|
# We set LC_ALL and LANG to C so that we get the same error messages as expected. |
setenv LC_ALL C |
setenv LANG C |
|
# Many hosts now default to a non-ASCII C locale, however, so |
# they can set a charset encoding here if they need. |
if { [ishost "*-*-cygwin*"] } { |
setenv LC_ALL C.ASCII |
setenv LANG C.ASCII |
} |
|
if ![info exists GXX_UNDER_TEST] then { |
if [info exists TOOL_EXECUTABLE] { |
set GXX_UNDER_TEST $TOOL_EXECUTABLE |
} else { |
if { [is_remote host] || ! [info exists TESTING_IN_BUILD_TREE] } { |
set GXX_UNDER_TEST [transform c++] |
} else { |
set GXX_UNDER_TEST [findfile $base_dir/../../g++ "$base_dir/../../g++ -B$base_dir/../../" [findfile $base_dir/g++ "$base_dir/g++ -B$base_dir/" [transform c++]]] |
} |
} |
} |
|
# Bleah, nasty. Bad taste. |
if [ishost "*-dos-*" ] { |
regsub "c\\+\\+" "$GXX_UNDER_TEST" "gcc" GXX_UNDER_TEST |
} |
|
if ![is_remote host] { |
if { [which $GXX_UNDER_TEST] == 0 } then { |
perror "GXX_UNDER_TEST ($GXX_UNDER_TEST) does not exist" |
exit 1 |
} |
} |
if ![info exists tmpdir] { |
set tmpdir "/tmp" |
} |
|
if [info exists gluefile] { |
unset gluefile |
} |
|
g++_maybe_build_wrapper "${tmpdir}/g++-testglue.o" "-fexceptions" |
|
if {![info exists CXXFLAGS]} { |
set CXXFLAGS "" |
} |
|
set ALWAYS_CXXFLAGS "" |
|
if ![is_remote host] { |
if [info exists TOOL_OPTIONS] { |
lappend ALWAYS_CXXFLAGS "additional_flags=[g++_include_flags [get_multilibs ${TOOL_OPTIONS}] ]" |
lappend ALWAYS_CXXFLAGS "ldflags=[g++_link_flags [get_multilibs ${TOOL_OPTIONS}] ]" |
} else { |
lappend ALWAYS_CXXFLAGS "additional_flags=[g++_include_flags [get_multilibs] ]" |
lappend ALWAYS_CXXFLAGS "ldflags=[g++_link_flags [get_multilibs] ]" |
} |
} |
|
if [info exists TOOL_OPTIONS] { |
lappend ALWAYS_CXXFLAGS "additional_flags=$TOOL_OPTIONS" |
} |
|
# Make sure that lines are not wrapped. That can confuse the |
# error-message parsing machinery. |
lappend ALWAYS_CXXFLAGS "additional_flags=-fmessage-length=0" |
|
set gcc_warning_prefix "warning:" |
set gcc_error_prefix "error:" |
|
if { [string match "*-*-darwin*" $target_triplet] } { |
lappend ALWAYS_CXXFLAGS "ldflags=-multiply_defined suppress" |
} |
|
verbose -log "ALWAYS_CXXFLAGS set to $ALWAYS_CXXFLAGS" |
|
verbose "g++ is initialized" 3 |
} |
|
# |
# g++_target_compile -- compile a source file |
# |
|
proc g++_target_compile { source dest type options } { |
global tmpdir |
global gpp_compile_options |
global gluefile wrap_flags |
global ALWAYS_CXXFLAGS |
global GXX_UNDER_TEST |
|
if { [target_info needs_status_wrapper] != "" && [info exists gluefile] } { |
lappend options "libs=${gluefile}" |
lappend options "ldflags=${wrap_flags}" |
} |
|
lappend options "additional_flags=[libio_include_flags]" |
lappend options "compiler=$GXX_UNDER_TEST" |
lappend options "timeout=[timeout_value]" |
|
set options [concat $gpp_compile_options $options] |
|
set options [concat "$ALWAYS_CXXFLAGS" $options] |
|
if { [regexp "(^| )-frepo( |$)" $options] && \ |
[regexp "\.o(|bj)$" $dest] } then { |
regsub "\.o(|bj)$" $dest ".rpo" rponame |
exec rm -f $rponame |
} |
|
set options [dg-additional-files-options $options $source] |
|
set result [target_compile $source $dest $type $options] |
|
return $result |
} |
|
# |
# ${tool}_option_help |
# |
|
proc ${tool}_option_help { } { |
send_user " --additional_options,OPTIONS\t\tUse OPTIONS to compile the testcase files. OPTIONS should be comma-separated.\n" |
} |
|
# |
# ${tool}_option_proc |
# |
|
proc ${tool}_option_proc { option } { |
if [regexp "^--additional_options," $option] { |
global gpp_compile_options |
regsub "--additional_options," $option "" option |
foreach x [split $option ","] { |
lappend gpp_compile_options "additional_flags=$x" |
} |
return 1 |
} else { |
return 0 |
} |
} |
/testsuite/lib/obj-c++.exp
0,0 → 1,404
# Copyright (C) 2004, 2005, 2007, 2008 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 |
# <http://www.gnu.org/licenses/>. |
|
# This file was written by Rob Savoye (rob@cygnus.com) |
# Many modifications by Jeffrey Wheat (cassidy@cygnus.com) |
# With modifications by Mike Stump <mrs@cygnus.com>. |
|
# |
# obj-c++ support library routines |
# |
load_lib prune.exp |
load_lib gcc-defs.exp |
load_lib timeout.exp |
load_lib target-libpath.exp |
|
# |
# OBJCXX_UNDER_TEST is the compiler under test. |
# |
|
|
set gpp_compile_options "" |
|
# |
# obj-c++_version -- extract and print the version number of the compiler |
# |
|
proc obj-c++_version { } { |
global OBJCXX_UNDER_TEST |
|
obj-c++_init |
|
# Ignore any arguments after the command. |
set compiler [lindex $OBJCXX_UNDER_TEST 0] |
|
# Verify that the compiler exists. |
if { [is_remote host] || [which $compiler] != 0 } then { |
set tmp [remote_exec host "$compiler -v"] |
set status [lindex $tmp 0]; |
set output [lindex $tmp 1]; |
regexp " version \[^\n\r\]*" $output version |
if { $status == 0 && [info exists version] } then { |
if [is_remote host] { |
clone_output "$compiler $version\n" |
} else { |
clone_output "[which $compiler] $version\n" |
} |
} else { |
clone_output "Couldn't determine version of [which $compiler]\n" |
} |
} else { |
# Compiler does not exist (this should have already been detected) |
warning "$compiler does not exist" |
} |
} |
|
# |
# obj-c++_include_flags -- provide new version of obj-c++_include_flags |
# (originally from libgloss.exp) which knows about the gcc tree structure |
# |
proc obj-c++_include_flags { paths } { |
global srcdir |
global HAVE_LIBSTDCXX_V3 |
global TESTING_IN_BUILD_TREE |
|
set flags "" |
|
if { [is_remote host] || ! [info exists TESTING_IN_BUILD_TREE] } { |
return "${flags}" |
} |
|
set gccpath ${paths} |
|
set odir [lookfor_file ${gccpath} libstdc++-v3] |
if { ${odir} != "" } { |
append flags [exec sh ${odir}/scripts/testsuite_flags --build-includes] |
} |
|
return "$flags" |
} |
|
# |
# obj-c++_link_flags -- provide new version of obj-c++_link_flags |
# (originally from libgloss.exp) which knows about the gcc tree structure. |
# |
|
proc obj-c++_link_flags { paths } { |
global rootme |
global srcdir |
global ld_library_path |
global OBJCXX_UNDER_TEST |
global shlib_ext |
|
set gccpath ${paths} |
set libio_dir "" |
set flags "" |
set ld_library_path "." |
set shlib_ext [get_shlib_extension] |
verbose "shared lib extension: $shlib_ext" |
|
if { $gccpath != "" } { |
if [file exists "${gccpath}/lib/libstdc++.a"] { |
append ld_library_path ":${gccpath}/lib" |
} |
if [file exists "${gccpath}/libg++/libg++.a"] { |
append flags " -L${gccpath}/libg++ " |
append ld_library_path ":${gccpath}/libg++" |
} |
if [file exists "${gccpath}/libstdc++/libstdc++.a"] { |
append flags " -L${gccpath}/libstdc++ " |
append ld_library_path ":${gccpath}/libstdc++" |
} |
if [file exists "${gccpath}/libstdc++-v3/src/.libs/libstdc++.a"] { |
# Allow for %s spec substitutions |
append flags " -B${gccpath}/libstdc++-v3/src/.libs " |
append flags " -L${gccpath}/libstdc++-v3/src/.libs " |
append ld_library_path ":${gccpath}/libstdc++-v3/src/.libs" |
} |
# Look for libstdc++.${shlib_ext}. |
if [file exists "${gccpath}/libstdc++-v3/src/.libs/libstdc++.${shlib_ext}"] { |
# Allow for %s spec substitutions |
append flags " -B${gccpath}/libstdc++-v3/src/.libs " |
append flags " -L${gccpath}/libstdc++-v3/src/.libs " |
append ld_library_path ":${gccpath}/libstdc++-v3/src/.libs" |
} |
if [file exists "${gccpath}/libiberty/libiberty.a"] { |
append flags " -L${gccpath}/libiberty " |
} |
if [file exists "${gccpath}/librx/librx.a"] { |
append flags " -L${gccpath}/librx " |
} |
|
set objcpath "[get_multilibs]" |
set libobjc_dir [lookfor_file ${objcpath} libobjc/.libs/libobjc.a] |
if { $libobjc_dir == ""} { |
set libobjc_dir [lookfor_file ${objcpath} libobjc/.libs/libobjc-gnu.a] |
} |
# Now check if we have a shared only build. |
if { $libobjc_dir == ""} { |
set libobjc_dir [lookfor_file ${objcpath} libobjc/.libs/libobjc.${shlib_ext}] |
if { $libobjc_dir == ""} { |
set libobjc_dir [lookfor_file ${objcpath} libobjc/.libs/libobjc-gnu.${shlib_ext}] |
} |
} |
|
verbose "libobjc_dir: $libobjc_dir" |
|
if { $libobjc_dir != "" } { |
set libobjc_dir [file dirname ${libobjc_dir}] |
# Allow for %s spec substitutions |
append flags " -B${libobjc_dir} " |
append flags " -L${libobjc_dir} " |
append ld_library_path ":${libobjc_dir}" |
} |
append ld_library_path \ |
[gcc-set-multilib-library-path $OBJCXX_UNDER_TEST] |
} else { |
global tool_root_dir; |
|
set libgpp [lookfor_file ${tool_root_dir} libg++]; |
if { $libgpp != "" } { |
append flags "-L${libgpp} "; |
append ld_library_path ":${libgpp}" |
} |
set libstdcpp [lookfor_file ${tool_root_dir} libstdc++]; |
if { $libstdcpp != "" } { |
append flags "-L${libstdcpp} "; |
append ld_library_path ":${libstdcpp}" |
} |
set libiberty [lookfor_file ${tool_root_dir} libiberty]; |
if { $libiberty != "" } { |
append flags "-L${libiberty} "; |
} |
set librx [lookfor_file ${tool_root_dir} librx]; |
if { $librx != "" } { |
append flags "-L${librx} "; |
} |
} |
|
set_ld_library_path_env_vars |
|
return "$flags" |
} |
|
# |
# obj-c++_init -- called at the start of each subdir of tests |
# |
|
proc obj-c++_init { args } { |
global subdir |
global gpp_initialized |
global base_dir |
global tmpdir |
global libdir |
global gluefile wrap_flags; |
global objdir srcdir |
global ALWAYS_OBJCXXFLAGS |
global TOOL_EXECUTABLE TOOL_OPTIONS |
global OBJCXX_UNDER_TEST |
global TESTING_IN_BUILD_TREE |
global target_triplet |
|
if ![info exists OBJCXX_UNDER_TEST] then { |
if [info exists TOOL_EXECUTABLE] { |
set OBJCXX_UNDER_TEST $TOOL_EXECUTABLE; |
} else { |
if { [is_remote host] || ! [info exists TESTING_IN_BUILD_TREE] } { |
set OBJCXX_UNDER_TEST [transform c++] |
} else { |
set OBJCXX_UNDER_TEST [findfile $base_dir/../../g++ "$base_dir/../../g++ -B$base_dir/../../" [findfile $base_dir/g++ "$base_dir/g++ -B$base_dir/" [transform c++]]] |
} |
} |
} |
|
# Bleah, nasty. Bad taste. |
if [ishost "*-dos-*" ] { |
regsub "c\\+\\+" "$OBJCXX_UNDER_TEST" "gcc" OBJCXX_UNDER_TEST |
} |
|
if ![is_remote host] { |
if { [which $OBJCXX_UNDER_TEST] == 0 } then { |
perror "OBJCXX_UNDER_TEST ($OBJCXX_UNDER_TEST) does not exist" |
exit 1 |
} |
} |
if ![info exists tmpdir] { |
set tmpdir "/tmp" |
} |
|
if [info exists gluefile] { |
unset gluefile |
} |
|
obj-c++_maybe_build_wrapper "${tmpdir}/obj-c++-testglue.o" "-fexceptions" |
|
set ALWAYS_OBJCXXFLAGS "" |
|
if ![is_remote host] { |
if [info exists TOOL_OPTIONS] { |
lappend ALWAYS_OBJCXXFLAGS "additional_flags=[obj-c++_include_flags [get_multilibs ${TOOL_OPTIONS}] ]"; |
lappend ALWAYS_OBJCXXFLAGS "ldflags=[obj-c++_link_flags [get_multilibs ${TOOL_OPTIONS}] ]"; |
} else { |
lappend ALWAYS_OBJCXXFLAGS "additional_flags=[obj-c++_include_flags [get_multilibs] ]"; |
lappend ALWAYS_OBJCXXFLAGS "ldflags=[obj-c++_link_flags [get_multilibs] ]"; |
} |
} |
|
if [info exists TOOL_OPTIONS] { |
lappend ALWAYS_OBJCXXFLAGS "additional_flags=$TOOL_OPTIONS"; |
} |
|
# Make sure that lines are not wrapped. That can confuse the |
# error-message parsing machinery. |
lappend ALWAYS_OBJCXXFLAGS "additional_flags=-fmessage-length=0" |
|
if { [string match "*-*-darwin*" $target_triplet] } { |
lappend ALWAYS_OBJCXXFLAGS "ldflags=-multiply_defined suppress" |
} |
|
verbose -log "ALWAYS_OBJCXXFLAGS set to $ALWAYS_OBJCXXFLAGS" |
|
verbose "obj-c++ is initialized" 3 |
} |
|
# |
# obj-c++_target_compile -- compile a source file |
# |
|
proc obj-c++_target_compile { source dest type options } { |
global tmpdir |
global srcdir |
global gpp_compile_options |
global gluefile wrap_flags |
global ALWAYS_OBJCXXFLAGS |
global OBJCXX_UNDER_TEST |
global shlib_ext |
|
set shlib_ext [get_shlib_extension] |
verbose "input-options: $options" 4 |
|
# We have to figure out which runtime will be used on darwin because |
# we need to add the include path for the gnu runtime if that is in |
# use. |
# First, set the default... |
if { [istarget "*-*-darwin*"] } { |
set nextruntime 1 |
} else { |
set nextruntime 0 |
} |
verbose "initial next runtime state : $nextruntime" 2 |
# Next, see if we define the option in dg-options... |
foreach opt $options { |
if [regexp ".*-fnext-runtime.*" $opt] { |
set nextruntime 1 |
} |
if [regexp ".*-fgnu-runtime.*" $opt] { |
set nextruntime 0 |
} |
} |
verbose "next runtime state after dg opts: $nextruntime" 2 |
|
set tgt [target_info name] |
if [board_info $tgt exists multilib_flags] { |
set lb [board_info $tgt multilib_flags] |
verbose "board multilib_flags $lb" 2 |
foreach opt $lb { |
if [regexp ".*-fnext-runtime.*" $opt] { |
set nextruntime 1 |
} |
if [regexp ".*-fgnu-runtime.*" $opt] { |
set nextruntime 0 |
} |
} |
} |
verbose "next runtime state after any multilib opts: $nextruntime" 2 |
|
lappend options "libs=-lobjc" |
|
if { [target_info needs_status_wrapper] != "" && [info exists gluefile] } { |
lappend options "libs=${gluefile}" |
lappend options "ldflags=${wrap_flags}" |
} |
|
# If we have built libobjc along with the compiler, point the test harness |
# at it (and associated headers). |
|
set objcpath "[get_multilibs]" |
|
set libobjc_dir [lookfor_file ${objcpath} libobjc/.libs/libobjc.a] |
if { $libobjc_dir == ""} { |
set libobjc_dir [lookfor_file ${objcpath} libobjc/.libs/libobjc-gnu.a] |
} |
if { $libobjc_dir == ""} { |
set libobjc_dir [lookfor_file ${objcpath} libobjc/.libs/libobjc.${shlib_ext}] |
if { $libobjc_dir == ""} { |
set libobjc_dir [lookfor_file ${objcpath} libobjc/.libs/libobjc-gnu.${shlib_ext}] |
} |
} |
|
if { $libobjc_dir != "" } { |
# If we are using the gnu runtime, add its includes. |
if { $nextruntime == 0 } { |
set objc_include_dir "${srcdir}/../../libobjc" |
lappend options "additional_flags=-I${objc_include_dir}" |
} |
} |
|
lappend options "additional_flags=[libio_include_flags]" |
lappend options "compiler=$OBJCXX_UNDER_TEST"; |
lappend options "timeout=[timeout_value]" |
|
set options [concat $gpp_compile_options $options] |
|
set options [concat "$ALWAYS_OBJCXXFLAGS" $options]; |
|
if { [regexp "(^| )-frepo( |$)" $options] && \ |
[regexp "\.o(|bj)$" $dest] } then { |
regsub "\.o(|bj)$" $dest ".rpo" rponame |
exec rm -f $rponame |
} |
|
set options [dg-additional-files-options $options $source] |
|
set result [target_compile $source $dest $type $options] |
|
return $result |
} |
|
# |
# ${tool}_option_help |
# |
|
proc ${tool}_option_help { } { |
send_user " --additional_options,OPTIONS\t\tUse OPTIONS to compile the testcase files. OPTIONS should be comma-separated.\n" |
} |
|
# |
# ${tool}_option_proc |
# |
|
proc ${tool}_option_proc { option } { |
if [regexp "^--additional_options," $option] { |
global gpp_compile_options |
regsub "--additional_options," $option "" option |
foreach x [split $option ","] { |
lappend gpp_compile_options "additional_flags=$x" |
} |
return 1; |
} else { |
return 0 |
} |
} |
/testsuite/lib/wrapper.exp
0,0 → 1,46
# Copyright (C) 2004, 2007 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 |
# <http://www.gnu.org/licenses/>. |
|
# This file contains GCC-specifics for status wrappers for test programs. |
|
# ${tool}_maybe_build_wrapper -- Build wrapper object if the target |
# needs it. FILENAME is the path to the wrapper file. If there are |
# additional arguments, they are command-line options to provide to |
# the compiler when compiling FILENAME. |
|
proc ${tool}_maybe_build_wrapper { filename args } { |
global gluefile wrap_flags |
|
if { [target_info needs_status_wrapper] != "" \ |
&& [target_info needs_status_wrapper] != "0" \ |
&& ![info exists gluefile] } { |
set_ld_library_path_env_vars |
set saved_wrap_compile_flags [target_info wrap_compile_flags] |
set flags [join $args " "] |
# The wrapper code may contain code that gcc objects on. This |
# became true for dejagnu-1.4.4. The set of warnings and code |
# that gcc objects on may change, so just make sure -w is always |
# passed to turn off all warnings. |
set_currtarget_info wrap_compile_flags \ |
"$saved_wrap_compile_flags -w $flags" |
set result [build_wrapper $filename] |
set_currtarget_info wrap_compile_flags "$saved_wrap_compile_flags" |
if { $result != "" } { |
set gluefile [lindex $result 0] |
set wrap_flags [lindex $result 1] |
} |
} |
} |
/testsuite/lib/gnat-dg.exp
0,0 → 1,66
# Copyright (C) 2006, 2007, 2010 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 |
# <http://www.gnu.org/licenses/>. |
|
load_lib gcc-dg.exp |
|
# Define gcc callbacks for dg.exp. |
|
proc gnat-dg-test { prog do_what extra_tool_flags } { |
if { $do_what == "compile" } { |
lappend extra_tool_flags "-c" |
} |
return [gcc-dg-test-1 gnat_target_compile $prog $do_what $extra_tool_flags] |
} |
|
proc gnat-dg-prune { system text } { |
global additional_prunes |
|
lappend additional_prunes "gnatmake" |
lappend additional_prunes "compilation abandoned" |
lappend additional_prunes "fatal error: maximum errors reached" |
lappend additional_prunes "linker input file" |
|
return [gcc-dg-prune $system $text] |
} |
|
# Utility routines. |
|
# Modified dg-runtest that can cycle through a list of optimization options |
# as c-torture does. |
proc gnat-dg-runtest { testcases default-extra-flags } { |
return [gcc-dg-runtest $testcases ${default-extra-flags}] |
} |
|
# |
# gnat_load -- wrapper around default gnat_load to declare tasking tests |
# unsupported on platforms that lack such support |
# |
|
if { [info procs gnat_load] != [list] \ |
&& [info procs prev_gnat_load] == [list] } { |
rename gnat_load prev_gnat_load |
|
proc gnat_load { program args } { |
upvar name testcase |
|
set result [eval [list prev_gnat_load $program] $args] |
set output [lindex $result 1] |
if { [regexp "tasking not implemented" $output] } { |
return [list "unsupported" $output] |
} |
return $result |
} |
} |
/testsuite/lib/compat.exp
0,0 → 1,399
# Copyright (C) 2002, 2003, 2004, 2005, 2007, 2008 |
# 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 |
# <http://www.gnu.org/licenses/>. |
|
# This file was written by Janis Johnson, <janis187@us.ibm.com> |
|
|
# Test interoperability of two compilers that follow the same ABI, or |
# compatibility of two versions of GCC. |
# |
# Each test has a main program that does nothing but call a function, |
# plus two additional source files that contain parts of a program that |
# rely on the ABI. those source files are compiled into relocatable |
# object files with both compilers. Executables are built using various |
# combinations of those object files, with the main program compiled |
# with the compiler under test and using that compiler's runtime support. |
|
# The including .exp file must define these callback procedures. |
if [string match "" [info procs "compat-use-alt-compiler"]] then { |
error "Proc compat-use-alt-compiler is not defined." |
} |
if [string match "" [info procs "compat-use-tst-compiler"]] then { |
error "Proc compat-use-tst-compiler is not defined." |
} |
|
# Each test is run with each pair of compiler options from this list. |
# The first set of options in each pair is used by the compiler under |
# test, and the second set is used by the alternate compiler. |
# The default option lists can be overridden by |
# COMPAT_OPTIONS="[list [list {tst_1} {alt_1}]...[list {tst_n} {alt_n}]]" |
# where tst_i and alt_i are lists of options. You can put this in the |
# environment before site.exp is written or add it to site.exp directly. |
if ![info exists COMPAT_OPTIONS] { |
set COMPAT_OPTIONS [list \ |
[list {} {}]] |
} |
|
set compat_option_list $COMPAT_OPTIONS |
|
# Subsets of tests can be selectively disabled by members of this list: |
# - ATTRIBUTE: disable all tests using the __attribute__ extension, |
# - COMPLEX: disable all tests using the complex types feature, |
# - COMPLEX_INT: disable all tests using the complex integral types extension, |
# - VA: disable all tests using the variable number of arguments feature, |
# - VLA_IN_STRUCT: disable all tests using the variable-length arrays as |
# structure members extension, |
# - ZERO_ARRAY: disable all tests using the zero-sized arrays extension. |
# The default skip lists can be overriden by |
# COMPAT_SKIPS="[list {skip_1}...{skip_n}]" |
# where skip_i are skip identifiers. You can put this in the environment |
# before site.exp is written or add it to site.exp directly. |
if ![info exists COMPAT_SKIPS] { |
set COMPAT_SKIPS [list {}] |
} |
|
global compat_skip_list |
set compat_skip_list $COMPAT_SKIPS |
|
load_lib dg.exp |
load_lib gcc-dg.exp |
|
# |
# compat-obj -- compile to an object file |
# |
# SOURCE is the source file |
# DEST is the object file |
# OPTALL is the list of compiler options to use with all tests |
# OPTFILE is the list of compiler options to use with this file |
# OPTSTR is the options to print with test messages |
# XFAILDATA is the xfail data to be passed to the compiler |
# |
proc compat-obj { source dest optall optfile optstr xfaildata } { |
global testcase |
global tool |
global compiler_conditional_xfail_data |
global compat_skip_list |
|
# Add the skip specifiers. |
foreach skip $compat_skip_list { |
if { ![string match $skip ""] } { |
lappend optall "-DSKIP_$skip" |
} |
} |
|
# Set up the options for compiling this file. |
set options "" |
lappend options "additional_flags=$optfile $optall" |
|
set compiler_conditional_xfail_data $xfaildata |
set comp_output [${tool}_target_compile "$source" "$dest" object $options] |
${tool}_check_compile "$testcase $dest compile" $optstr $dest $comp_output |
} |
|
# compat-run -- link and run an executable |
# |
# TESTNAME is the mixture of object files to link |
# OBJLIST is the list of object files to link |
# DEST is the name of the executable |
# OPTALL is a list of compiler and linker options to use for all tests |
# OPTFILE is a list of compiler and linker options to use for this test |
# OPTSTR is the list of options to list in messages |
# |
proc compat-run { testname objlist dest optall optfile optstr } { |
global testcase |
global tool |
|
# Check that all of the objects were built successfully. |
foreach obj [split $objlist] { |
if ![file_on_host exists $obj] then { |
unresolved "$testcase $testname link $optstr" |
unresolved "$testcase $testname execute $optstr" |
return |
} |
} |
|
# Set up the options for linking this test. |
set options "" |
lappend options "additional_flags=$optfile $optall" |
|
# Link the objects into an executable. |
set comp_output [${tool}_target_compile "$objlist" $dest executable \ |
"$options"] |
if ![${tool}_check_compile "$testcase $testname link" "" \ |
$dest $comp_output] then { |
unresolved "$testcase $testname execute $optstr" |
return |
} |
|
# Run the self-checking executable. |
if ![string match "*/*" $dest] then { |
set dest "./$dest" |
} |
set result [${tool}_load $dest "" ""] |
set status [lindex $result 0] |
if { $status == "pass" } then { |
file_on_host delete $dest |
} |
$status "$testcase $testname execute $optstr" |
} |
|
# |
# compat-get-options-main -- get target requirements for a test and |
# options for the primary source file and the test as a whole |
# |
# SRC is the full pathname of the primary source file. |
# |
proc compat-get-options-main { src } { |
# dg-options sets a variable called dg-extra-tool-flags. |
set dg-extra-tool-flags "" |
# dg-options sets a variable called tool_flags. |
set tool_flags "" |
|
# dg-require-* sets dg-do-what. |
upvar dg-do-what dg-do-what |
|
set tmp [dg-get-options $src] |
foreach op $tmp { |
set cmd [lindex $op 0] |
if { ![string compare "dg-options" $cmd] \ |
|| [string match "dg-prune-output" $cmd] \ |
|| [string match "dg-skip-if" $cmd] \ |
|| [string match "dg-require-*" $cmd] } { |
set status [catch "$op" errmsg] |
if { $status != 0 } { |
perror "src: $errmsg for \"$op\"\n" |
unresolved "$src: $errmsg for \"$op\"" |
return |
} |
} elseif { ![string compare "dg-xfail-if" $cmd] } { |
warning "compat.exp does not support $cmd in primary source file" |
} else { |
# Ignore unrecognized dg- commands, but warn about them. |
warning "compat.exp does not support $cmd" |
} |
} |
|
# Return flags to use for compiling the primary source file and for |
# linking. |
return ${dg-extra-tool-flags} |
} |
|
# |
# compat-get-options -- get special tool flags to use for a secondary |
# source file |
# |
# SRC is the full pathname of the source file. |
# The result is a list of options to use. |
# |
# This code is copied from proc dg-test in dg.exp from DejaGNU. |
# |
proc compat-get-options { src } { |
# dg-options sets a variable called dg-extra-tool-flags. |
set dg-extra-tool-flags "" |
|
# dg-xfail-if sets compiler_conditional_xfail_data. |
global compiler_conditional_xfail_data |
set compiler_conditional_xfail_data "" |
|
# dg-xfail-if needs access to dg-do-what. |
upvar dg-do-what dg-do-what |
|
set tmp [dg-get-options $src] |
foreach op $tmp { |
set cmd [lindex $op 0] |
if { ![string compare "dg-options" $cmd] \ |
|| ![string compare "dg-prune-output" $cmd] \ |
|| ![string compare "dg-xfail-if" $cmd] } { |
set status [catch "$op" errmsg] |
if { $status != 0 } { |
perror "src: $errmsg for \"$op\"\n" |
unresolved "$src: $errmsg for \"$op\"" |
return |
} |
} elseif { [string match "dg-require-*" $cmd] } { |
warning "compat.exp does not support $cmd in secondary source files" |
} else { |
# Ignore unrecognized dg- commands, but warn about them. |
warning "compat.exp does not support $cmd" |
} |
} |
|
return ${dg-extra-tool-flags} |
} |
|
# |
# compat-execute -- compile with compatible compilers |
# |
# SRC1 is the full pathname of the main file of the testcase. |
# SID identifies a test suite in the names of temporary files. |
# USE_ALT is nonzero if we're using an alternate compiler as well as |
# the compiler under test. |
# |
proc compat-execute { src1 sid use_alt } { |
global srcdir tmpdir |
global compat_option_list |
global tool |
global verbose |
global testcase |
global gluefile |
global compiler_conditional_xfail_data |
global dg-do-what-default |
|
# Get extra flags for this test from the primary source file, and |
# process other dg-* options that this suite supports. Warn about |
# unsupported flags. |
verbose "compat-execute: $src1" 1 |
set dg-do-what [list ${dg-do-what-default} "" P] |
set extra_flags_1 [compat-get-options-main $src1] |
|
# Check whether this test is supported for this target. |
if { [lindex ${dg-do-what} 1 ] == "N" } { |
unsupported "$src1" |
verbose "$src1 not supported on this target, skipping it" 3 |
return |
} |
|
# Set up the names of the other source files. |
set dir [file dirname $src1] |
set ext [file extension $src1] |
set base [file rootname $src1] |
set base [string range $base [string length $dir] end] |
regsub "_main" $base "" base |
set src2 "${dir}/${base}_x${ext}" |
set src3 "${dir}/${base}_y${ext}" |
|
# Use the dg-options mechanism to specify extra flags for this test. |
# The extra flags in each file are used to compile that file, and the |
# extra flags in *_main.* are also used for linking. |
set extra_flags_2 [compat-get-options $src2] |
set compile_xfail_2 $compiler_conditional_xfail_data |
set extra_flags_3 [compat-get-options $src3] |
set compile_xfail_3 $compiler_conditional_xfail_data |
|
# On the SPU, most of the compat test cases exceed local store size. |
# Use automatic overlay support to make them fit. |
if { [check_effective_target_spu_auto_overlay] } { |
set extra_flags_1 "$extra_flags_1 -Wl,--auto-overlay" |
set extra_flags_1 "$extra_flags_1 -ffunction-sections" |
set extra_flags_2 "$extra_flags_2 -ffunction-sections" |
set extra_flags_3 "$extra_flags_3 -ffunction-sections" |
} |
|
# Define the names of the object files. |
regsub "sid" "sid_main_tst.o" $sid obj1 |
regsub "sid" "sid_x_tst.o" $sid obj2_tst |
regsub "sid" "sid_x_alt.o" $sid obj2_alt |
regsub "sid" "sid_y_tst.o" $sid obj3_tst |
regsub "sid" "sid_y_alt.o" $sid obj3_alt |
|
# Get the base name of this test, for use in messages. |
set testcase "$src1" |
# Remove the $srcdir and $tmpdir prefixes from $src1. (It would |
# be possible to use "regsub" here, if we were careful to escape |
# all regular expression characters in $srcdir and $tmpdir, but |
# that would be more complicated that this approach.) |
if {[string first "$srcdir/" "$src1"] == 0} { |
set testcase [string range "$src1" [string length "$srcdir/"] end] |
} |
if {[string first "$tmpdir/" "$testcase"] == 0} { |
set testcase [string range "$testcase" [string length "$tmpdir/"] end] |
set testcase "tmpdir-$testcase" |
} |
regsub "_main.*" $testcase "" testcase |
# Set up the base name of executable files so they'll be unique. |
regsub -all "\[./\]" $testcase "-" execbase |
|
# If we couldn't rip $srcdir out of `src1' then just do the best we can. |
# The point is to reduce the unnecessary noise in the logs. Don't strip |
# out too much because different testcases with the same name can confuse |
# `test-tool'. |
if [string match "/*" $testcase] then { |
set testcase "[file tail [file dirname $src1]]/[file tail $src1]" |
} |
|
# Loop through all of the option lists used for this test. |
|
set count 0 |
foreach option_pair $compat_option_list { |
|
# Pick out each set of options. |
set tst_option [lindex $option_pair 0] |
set alt_option [lindex $option_pair 1] |
set optstr "" |
if { ![string match $tst_option ""] \ |
|| ![string match $alt_option ""] } then { |
set optstr "\"$tst_option\",\"$alt_option\"" |
} |
verbose "Testing $testcase, $optstr" 1 |
|
# There's a unique name for each executable we generate, based on |
# the set of options and how the pieces of the tests are compiled. |
set execname1 "${execbase}-${count}1.exe" |
set execname2 "${execbase}-${count}2.exe" |
set execname3 "${execbase}-${count}3.exe" |
set execname4 "${execbase}-${count}4.exe" |
incr count |
|
file_on_host delete $execname1 |
file_on_host delete $execname2 |
file_on_host delete $execname3 |
file_on_host delete $execname4 |
|
# Compile pieces with the alternate compiler; we'll catch problems |
# later. Skip this if we don't have an alternate compiler. |
if { $use_alt != 0 } then { |
compat-use-alt-compiler |
compat-obj "$src2" "$obj2_alt" $alt_option $extra_flags_2 \ |
$optstr $compile_xfail_2 |
compat-obj "$src3" "$obj3_alt" $alt_option $extra_flags_3 \ |
$optstr $compile_xfail_3 |
} |
|
# Compile pieces with the compiler under test. |
compat-use-tst-compiler |
compat-obj "$src1" "$obj1" $tst_option $extra_flags_1 $optstr "" |
compat-obj "$src2" "$obj2_tst" $tst_option $extra_flags_2 \ |
$optstr $compile_xfail_2 |
compat-obj "$src3" "$obj3_tst" $tst_option $extra_flags_3 \ |
$optstr $compile_xfail_3 |
|
# Link (using the compiler under test), run, and clean up tests. |
compat-run "${obj2_tst}-${obj3_tst}" \ |
"$obj1 $obj2_tst $obj3_tst" $execname1 \ |
$tst_option $extra_flags_1 $optstr |
|
# If we've got an alternate compiler try some combinations. |
if { $use_alt != 0 } then { |
compat-run "${obj2_tst}-${obj3_alt}" "$obj1 $obj2_tst $obj3_alt" \ |
$execname2 $tst_option $extra_flags_1 $optstr |
compat-run "${obj2_alt}-${obj3_tst}" "$obj1 $obj2_alt $obj3_tst" \ |
$execname3 $tst_option $extra_flags_1 $optstr |
compat-run "${obj2_alt}-${obj3_alt}" "$obj1 $obj2_alt $obj3_alt" \ |
$execname4 $tst_option $extra_flags_1 $optstr |
} |
|
# Clean up object files. |
set files [glob -nocomplain ${sid}_*.o] |
if { $files != "" } { |
foreach objfile $files { |
if { ![info exists gluefile] || $objfile != $gluefile } { |
eval "file_on_host delete $objfile" |
} |
} |
} |
} |
} |
/testsuite/lib/gcc-dg.exp
0,0 → 1,722
# Copyright (C) 1997, 1999, 2000, 2003, 2004, 2005, 2006, 2007, 2008, 2009 |
# 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 |
# <http://www.gnu.org/licenses/>. |
|
load_lib dg.exp |
load_lib file-format.exp |
load_lib target-supports.exp |
load_lib target-supports-dg.exp |
load_lib scanasm.exp |
load_lib scanrtl.exp |
load_lib scantree.exp |
load_lib scanipa.exp |
load_lib timeout.exp |
load_lib timeout-dg.exp |
load_lib prune.exp |
load_lib libgloss.exp |
load_lib target-libpath.exp |
load_lib torture-options.exp |
|
# We set LC_ALL and LANG to C so that we get the same error messages as expected. |
setenv LC_ALL C |
setenv LANG C |
|
# Many hosts now default to a non-ASCII C locale, however, so |
# they can set a charset encoding here if they need. |
if { [ishost "*-*-cygwin*"] } { |
setenv LC_ALL C.ASCII |
setenv LANG C.ASCII |
} |
|
if [info exists TORTURE_OPTIONS] { |
set DG_TORTURE_OPTIONS $TORTURE_OPTIONS |
} else { |
# It is theoretically beneficial to group all of the O2/O3 options together, |
# as in many cases the compiler will generate identical executables for |
# all of them--and the c-torture testsuite will skip testing identical |
# executables multiple times. |
# Also note that -finline-functions is explicitly included in one of the |
# items below, even though -O3 is also specified, because some ports may |
# choose to disable inlining functions by default, even when optimizing. |
set DG_TORTURE_OPTIONS [list \ |
{ -O0 } \ |
{ -O1 } \ |
{ -O2 } \ |
{ -O3 -fomit-frame-pointer } \ |
{ -O3 -fomit-frame-pointer -funroll-loops } \ |
{ -O3 -fomit-frame-pointer -funroll-all-loops -finline-functions } \ |
{ -O3 -g } \ |
{ -Os } ] |
} |
|
if [info exists ADDITIONAL_TORTURE_OPTIONS] { |
set DG_TORTURE_OPTIONS \ |
[concat $DG_TORTURE_OPTIONS $ADDITIONAL_TORTURE_OPTIONS] |
} |
|
set LTO_TORTURE_OPTIONS "" |
if [check_effective_target_lto] { |
set LTO_TORTURE_OPTIONS [list \ |
{ -O2 -flto } \ |
{ -O2 -fwhopr } |
] |
} |
|
|
global GCC_UNDER_TEST |
if ![info exists GCC_UNDER_TEST] { |
set GCC_UNDER_TEST "[find_gcc]" |
} |
|
global orig_environment_saved |
|
# This file may be sourced, so don't override environment settings |
# that have been previously setup. |
if { $orig_environment_saved == 0 } { |
append ld_library_path [gcc-set-multilib-library-path $GCC_UNDER_TEST] |
set_ld_library_path_env_vars |
} |
|
# Define gcc callbacks for dg.exp. |
|
proc gcc-dg-test-1 { target_compile prog do_what extra_tool_flags } { |
# Set up the compiler flags, based on what we're going to do. |
|
set options [list] |
|
# Tests should be able to use "dg-do repo". However, the dg test |
# driver checks the argument to dg-do against a list of acceptable |
# options, and "repo" is not among them. Therefore, we resort to |
# this ugly approach. |
if [string match "*-frepo*" $extra_tool_flags] then { |
set do_what "repo" |
} |
|
switch $do_what { |
"preprocess" { |
set compile_type "preprocess" |
set output_file "[file rootname [file tail $prog]].i" |
} |
"compile" { |
set compile_type "assembly" |
set output_file "[file rootname [file tail $prog]].s" |
} |
"assemble" { |
set compile_type "object" |
set output_file "[file rootname [file tail $prog]].o" |
} |
"precompile" { |
set compile_type "precompiled_header" |
set output_file "[file tail $prog].gch" |
} |
"link" { |
set compile_type "executable" |
set output_file "[file rootname [file tail $prog]].exe" |
# The following line is needed for targets like the i960 where |
# the default output file is b.out. Sigh. |
} |
"repo" { |
set compile_type "object" |
set output_file "[file rootname [file tail $prog]].o" |
} |
"run" { |
set compile_type "executable" |
# FIXME: "./" is to cope with "." not being in $PATH. |
# Should this be handled elsewhere? |
# YES. |
set output_file "./[file rootname [file tail $prog]].exe" |
# This is the only place where we care if an executable was |
# created or not. If it was, dg.exp will try to run it. |
catch { remote_file build delete $output_file } |
} |
default { |
perror "$do_what: not a valid dg-do keyword" |
return "" |
} |
} |
|
if { $extra_tool_flags != "" } { |
lappend options "additional_flags=$extra_tool_flags" |
} |
|
set comp_output [$target_compile "$prog" "$output_file" "$compile_type" $options] |
|
# Look for an internal compiler error, which sometimes masks the fact |
# that we didn't get an expected error message. XFAIL an ICE via |
# dg-xfail-if and use { dg-prune-output ".*internal compiler error.*" } |
# to avoid a second failure for excess errors. |
if [string match "*internal compiler error*" $comp_output] { |
upvar 2 name name |
fail "$name (internal compiler error)" |
} |
|
if { $do_what == "repo" } { |
set object_file "$output_file" |
set output_file "[file rootname [file tail $prog]].exe" |
set comp_output \ |
[ concat $comp_output \ |
[$target_compile "$object_file" "$output_file" \ |
"executable" $options] ] |
} |
|
return [list $comp_output $output_file] |
} |
|
proc gcc-dg-test { prog do_what extra_tool_flags } { |
return [gcc-dg-test-1 gcc_target_compile $prog $do_what $extra_tool_flags] |
} |
|
proc gcc-dg-prune { system text } { |
global additional_prunes |
|
set text [prune_gcc_output $text] |
|
foreach p $additional_prunes { |
if { [string length $p] > 0 } { |
# Following regexp matches a complete line containing $p. |
regsub -all "(^|\n)\[^\n\]*$p\[^\n\]*" $text "" text |
} |
} |
|
# If we see "region xxx is full" then the testcase is too big for ram. |
# This is tricky to deal with in a large testsuite like c-torture so |
# deal with it here. Just mark the testcase as unsupported. |
if [regexp "(^|\n)\[^\n\]*: region \[^\n\]* is full" $text] { |
# The format here is important. See dg.exp. |
return "::unsupported::memory full" |
} |
|
# Likewise, if we see ".text exceeds local store range" or |
# similar. |
if {[string match "spu-*" $system] && \ |
[string match "*exceeds local store*" $text]} { |
# The format here is important. See dg.exp. |
return "::unsupported::memory full" |
} |
|
return $text |
} |
|
# Replace ${tool}_load with a wrapper to provide for an expected nonzero |
# exit status. Multiple languages include this file so this handles them |
# all, not just gcc. |
if { [info procs ${tool}_load] != [list] \ |
&& [info procs saved_${tool}_load] == [list] } { |
rename ${tool}_load saved_${tool}_load |
|
proc ${tool}_load { program args } { |
global tool |
global shouldfail |
set result [eval [list saved_${tool}_load $program] $args] |
if { $shouldfail != 0 } { |
switch [lindex $result 0] { |
"pass" { set status "fail" } |
"fail" { set status "pass" } |
} |
set result [list $status [lindex $result 1]] |
} |
return $result |
} |
} |
|
# Utility routines. |
|
# |
# search_for -- looks for a string match in a file |
# |
proc search_for { file pattern } { |
set fd [open $file r] |
while { [gets $fd cur_line]>=0 } { |
if [string match "*$pattern*" $cur_line] then { |
close $fd |
return 1 |
} |
} |
close $fd |
return 0 |
} |
|
# Modified dg-runtest that can cycle through a list of optimization options |
# as c-torture does. |
proc gcc-dg-runtest { testcases default-extra-flags } { |
global runtests |
|
# Some callers set torture options themselves; don't override those. |
set existing_torture_options [torture-options-exist] |
if { $existing_torture_options == 0 } { |
global DG_TORTURE_OPTIONS LTO_TORTURE_OPTIONS |
torture-init |
set-torture-options $DG_TORTURE_OPTIONS [list {}] $LTO_TORTURE_OPTIONS |
} |
dump-torture-options |
|
foreach test $testcases { |
global torture_with_loops torture_without_loops |
# If we're only testing specific files and this isn't one of |
# them, skip it. |
if ![runtest_file_p $runtests $test] { |
continue |
} |
|
# Look for a loop within the source code - if we don't find one, |
# don't pass -funroll[-all]-loops. |
if [expr [search_for $test "for*("]+[search_for $test "while*("]] { |
set option_list $torture_with_loops |
} else { |
set option_list $torture_without_loops |
} |
|
set nshort [file tail [file dirname $test]]/[file tail $test] |
|
foreach flags $option_list { |
verbose "Testing $nshort, $flags" 1 |
dg-test $test $flags ${default-extra-flags} |
} |
} |
|
if { $existing_torture_options == 0 } { |
torture-finish |
} |
} |
|
proc gcc-dg-debug-runtest { target_compile trivial opt_opts testcases } { |
global srcdir subdir |
|
if ![info exists DEBUG_TORTURE_OPTIONS] { |
set DEBUG_TORTURE_OPTIONS "" |
foreach type {-gdwarf-2 -gstabs -gstabs+ -gxcoff -gxcoff+ -gcoff} { |
set comp_output [$target_compile \ |
"$srcdir/$subdir/$trivial" "trivial.S" assembly \ |
"additional_flags=$type"] |
if { ! [string match "*: target system does not support the * debug format*" \ |
$comp_output] } { |
remove-build-file "trivial.S" |
foreach level {1 "" 3} { |
if { ($type == "-gdwarf-2") && ($level != "") } { |
lappend DEBUG_TORTURE_OPTIONS [list "${type}" "-g${level}"] |
foreach opt $opt_opts { |
lappend DEBUG_TORTURE_OPTIONS \ |
[list "${type}" "-g${level}" "$opt" ] |
} |
} else { |
lappend DEBUG_TORTURE_OPTIONS [list "${type}${level}"] |
foreach opt $opt_opts { |
lappend DEBUG_TORTURE_OPTIONS \ |
[list "${type}${level}" "$opt" ] |
} |
} |
} |
} |
} |
} |
|
verbose -log "Using options $DEBUG_TORTURE_OPTIONS" |
|
global runtests |
|
foreach test $testcases { |
# If we're only testing specific files and this isn't one of |
# them, skip it. |
if ![runtest_file_p $runtests $test] { |
continue |
} |
|
set nshort [file tail [file dirname $test]]/[file tail $test] |
|
foreach flags $DEBUG_TORTURE_OPTIONS { |
set doit 1 |
|
# These tests check for information which may be deliberately |
# suppressed at -g1. |
if { ([string match {*/debug-[126].c} "$nshort"] \ |
|| [string match {*/enum-1.c} "$nshort"] \ |
|| [string match {*/enum-[12].C} "$nshort"]) \ |
&& ([string match "*1" [lindex "$flags" 0] ] |
|| [lindex "$flags" 1] == "-g1") } { |
set doit 0 |
} |
|
# High optimization can remove the variable whose existence is tested. |
# Dwarf debugging with commentary (-dA) preserves the symbol name in the |
# assembler output, but stabs debugging does not. |
# http://gcc.gnu.org/ml/gcc-regression/2003-04/msg00095.html |
if { [string match {*/debug-[12].c} "$nshort"] \ |
&& [string match "*O*" "$flags"] \ |
&& ( [string match "*coff*" "$flags"] \ |
|| [string match "*stabs*" "$flags"] ) } { |
set doit 0 |
} |
|
if { $doit } { |
verbose -log "Testing $nshort, $flags" 1 |
dg-test $test $flags "" |
} |
} |
} |
} |
|
# Prune any messages matching ARGS[1] (a regexp) from test output. |
proc dg-prune-output { args } { |
global additional_prunes |
|
if { [llength $args] != 2 } { |
error "[lindex $args 1]: need one argument" |
return |
} |
|
lappend additional_prunes [lindex $args 1] |
} |
|
# Remove files matching the pattern from the build machine. |
proc remove-build-file { pat } { |
verbose "remove-build-file `$pat'" 2 |
set file_list "[glob -nocomplain $pat]" |
verbose "remove-build-file `$file_list'" 2 |
foreach output_file $file_list { |
if [is_remote host] { |
# Ensure the host knows the file is gone by deleting there |
# first. |
remote_file host delete $output_file |
} |
remote_file build delete $output_file |
} |
} |
|
# Remove runtime-generated profile file for the current test. |
proc cleanup-profile-file { } { |
remove-build-file "mon.out" |
remove-build-file "gmon.out" |
} |
|
# Remove compiler-generated coverage files for the current test. |
proc cleanup-coverage-files { } { |
# This assumes that we are two frames down from dg-test or some other proc |
# that stores the filename of the testcase in a local variable "name". |
# A cleaner solution would require a new DejaGnu release. |
upvar 2 name testcase |
remove-build-file "[file rootname [file tail $testcase]].gc??" |
|
# Clean up coverage files for additional source files. |
if [info exists additional_sources] { |
foreach srcfile $additional_sources { |
remove-build-file "[file rootname [file tail $srcfile]].gc??" |
} |
} |
} |
|
# Remove compiler-generated files from -repo for the current test. |
proc cleanup-repo-files { } { |
# This assumes that we are two frames down from dg-test or some other proc |
# that stores the filename of the testcase in a local variable "name". |
# A cleaner solution would require a new DejaGnu release. |
upvar 2 name testcase |
remove-build-file "[file rootname [file tail $testcase]].o" |
remove-build-file "[file rootname [file tail $testcase]].rpo" |
|
# Clean up files for additional source files. |
if [info exists additional_sources] { |
foreach srcfile $additional_sources { |
remove-build-file "[file rootname [file tail $srcfile]].o" |
remove-build-file "[file rootname [file tail $srcfile]].rpo" |
} |
} |
} |
|
# Remove compiler-generated RTL dump files for the current test. |
# |
# SUFFIX is the filename suffix pattern. |
proc cleanup-rtl-dump { suffix } { |
cleanup-dump "\[0-9\]\[0-9\]\[0-9\]r.$suffix" |
} |
|
# Remove a specific tree dump file for the current test. |
# |
# SUFFIX is the tree dump file suffix pattern. |
proc cleanup-tree-dump { suffix } { |
cleanup-dump "\[0-9\]\[0-9\]\[0-9\]t.$suffix" |
} |
|
# Remove a specific ipa dump file for the current test. |
# |
# SUFFIX is the ipa dump file suffix pattern. |
proc cleanup-ipa-dump { suffix } { |
cleanup-dump "\[0-9\]\[0-9\]\[0-9\]i.$suffix" |
} |
|
# Remove all dump files with the provided suffix. |
proc cleanup-dump { suffix } { |
# This assumes that we are three frames down from dg-test or some other |
# proc that stores the filename of the testcase in a local variable |
# "name". A cleaner solution would require a new DejaGnu release. |
upvar 3 name testcase |
# The name might include a list of options; extract the file name. |
set src [file tail [lindex $testcase 0]] |
remove-build-file "[file tail $src].$suffix" |
# -fcompare-debug dumps |
remove-build-file "[file tail $src].gk.$suffix" |
|
# Clean up dump files for additional source files. |
if [info exists additional_sources] { |
foreach srcfile $additional_sources { |
remove-build-file "[file tail $srcfile].$suffix" |
# -fcompare-debug dumps |
remove-build-file "[file tail $srcfile].gk.$suffix" |
} |
} |
} |
|
# Remove files kept by --save-temps for the current test. |
# |
# Currently this is only .i, .ii, .s and .o files, but more can be added |
# if there are tests generating them. |
# ARGS is a list of suffixes to NOT delete. |
proc cleanup-saved-temps { args } { |
global additional_sources |
set suffixes {} |
|
# add the to-be-kept suffixes |
foreach suffix {".ii" ".i" ".s" ".o" ".gkd"} { |
if {[lsearch $args $suffix] < 0} { |
lappend suffixes $suffix |
} |
} |
|
# This assumes that we are two frames down from dg-test or some other proc |
# that stores the filename of the testcase in a local variable "name". |
# A cleaner solution would require a new DejaGnu release. |
upvar 2 name testcase |
foreach suffix $suffixes { |
remove-build-file "[file rootname [file tail $testcase]]$suffix" |
# -fcompare-debug dumps |
remove-build-file "[file rootname [file tail $testcase]].gk$suffix" |
} |
|
# Clean up saved temp files for additional source files. |
if [info exists additional_sources] { |
foreach srcfile $additional_sources { |
foreach suffix $suffixes { |
remove-build-file "[file rootname [file tail $srcfile]]$suffix" |
# -fcompare-debug dumps |
remove-build-file "[file rootname [file tail $srcfile]].gk$suffix" |
} |
} |
} |
} |
|
# Remove files for specified Fortran modules. |
proc cleanup-modules { modlist } { |
foreach modname $modlist { |
remove-build-file [string tolower $modname].mod |
} |
} |
|
# Scan Fortran modules for a given regexp. |
# |
# Argument 0 is the module name |
# Argument 1 is the regexp to match |
proc scan-module { args } { |
set modfilename [string tolower [lindex $args 0]].mod |
set fd [open $modfilename r] |
set text [read $fd] |
close $fd |
|
upvar 2 name testcase |
if [regexp -- [lindex $args 1] $text] { |
pass "$testcase scan-module [lindex $args 1]" |
} else { |
fail "$testcase scan-module [lindex $args 1]" |
} |
} |
|
# Verify that the compiler output file exists, invoked via dg-final. |
proc output-exists { args } { |
# Process an optional target or xfail list. |
if { [llength $args] >= 1 } { |
switch [dg-process-target [lindex $args 0]] { |
"S" { } |
"N" { return } |
"F" { setup_xfail "*-*-*" } |
"P" { } |
} |
} |
|
# Access variables from gcc-dg-test-1. |
upvar 2 name testcase |
upvar 2 output_file output_file |
|
if [file exists $output_file] { |
pass "$testcase output-exists $output_file" |
} else { |
fail "$testcase output-exists $output_file" |
} |
} |
|
# Verify that the compiler output file does not exist, invoked via dg-final. |
proc output-exists-not { args } { |
# Process an optional target or xfail list. |
if { [llength $args] >= 1 } { |
switch [dg-process-target [lindex $args 0]] { |
"S" { } |
"N" { return } |
"F" { setup_xfail "*-*-*" } |
"P" { } |
} |
} |
|
# Access variables from gcc-dg-test-1. |
upvar 2 name testcase |
upvar 2 output_file output_file |
|
if [file exists $output_file] { |
fail "$testcase output-exists-not $output_file" |
} else { |
pass "$testcase output-exists-not $output_file" |
} |
} |
|
# We need to make sure that additional_* are cleared out after every |
# test. It is not enough to clear them out *before* the next test run |
# because gcc-target-compile gets run directly from some .exp files |
# (outside of any test). (Those uses should eventually be eliminated.) |
|
# Because the DG framework doesn't provide a hook that is run at the |
# end of a test, we must replace dg-test with a wrapper. |
|
if { [info procs saved-dg-test] == [list] } { |
rename dg-test saved-dg-test |
|
proc dg-test { args } { |
global additional_files |
global additional_sources |
global additional_prunes |
global errorInfo |
global compiler_conditional_xfail_data |
global shouldfail |
|
if { [ catch { eval saved-dg-test $args } errmsg ] } { |
set saved_info $errorInfo |
set additional_files "" |
set additional_sources "" |
set additional_prunes "" |
set shouldfail 0 |
if [info exists compiler_conditional_xfail_data] { |
unset compiler_conditional_xfail_data |
} |
unset_timeout_vars |
error $errmsg $saved_info |
} |
set additional_files "" |
set additional_sources "" |
set additional_prunes "" |
set shouldfail 0 |
unset_timeout_vars |
if [info exists compiler_conditional_xfail_data] { |
unset compiler_conditional_xfail_data |
} |
} |
} |
|
if { [info procs saved-dg-warning] == [list] \ |
&& [info exists gcc_warning_prefix] } { |
rename dg-warning saved-dg-warning |
|
proc dg-warning { args } { |
# Make this variable available here and to the saved proc. |
upvar dg-messages dg-messages |
global gcc_warning_prefix |
|
process-message saved-dg-warning "$gcc_warning_prefix" "$args" |
} |
} |
|
if { [info procs saved-dg-error] == [list] \ |
&& [info exists gcc_error_prefix] } { |
rename dg-error saved-dg-error |
|
proc dg-error { args } { |
# Make this variable available here and to the saved proc. |
upvar dg-messages dg-messages |
global gcc_error_prefix |
|
process-message saved-dg-error "$gcc_error_prefix" "$args" |
} |
|
# Override dg-bogus at the same time. It doesn't handle a prefix |
# but its expression should include a column number. Otherwise the |
# line number can match the column number for other messages, leading |
# to insanity. |
rename dg-bogus saved-dg-bogus |
|
proc dg-bogus { args } { |
upvar dg-messages dg-messages |
process-message saved-dg-bogus "" $args |
} |
} |
|
# Modify the regular expression saved by a DejaGnu message directive to |
# include a prefix and to force the expression to match a single line. |
# MSGPROC is the procedure to call. |
# MSGPREFIX is the prefix to prepend. |
# DGARGS is the original argument list. |
|
proc process-message { msgproc msgprefix dgargs } { |
upvar dg-messages dg-messages |
|
# Process the dg- directive, including adding the regular expression |
# to the new message entry in dg-messages. |
set msgcnt [llength ${dg-messages}] |
catch { eval $msgproc $dgargs } |
|
# If the target expression wasn't satisfied there is no new message. |
if { [llength ${dg-messages}] == $msgcnt } { |
return; |
} |
|
# Get the entry for the new message. Prepend the message prefix to |
# the regular expression and make it match a single line. |
set newentry [lindex ${dg-messages} end] |
set expmsg [lindex $newentry 2] |
|
# Handle column numbers from the specified expression (if there is |
# one) and set up the search expression that will be used by DejaGnu. |
if [regexp "^(\[0-9\]+):" $expmsg "" column] { |
# The expression in the directive included a column number. |
# Remove "COLUMN:" from the original expression and move it |
# to the proper place in the search expression. |
regsub "^\[0-9\]+:" $expmsg "" expmsg |
set expmsg "$column: $msgprefix\[^\n\]*$expmsg" |
} elseif [string match "" [lindex $newentry 0]] { |
# The specified line number is 0; don't expect a column number. |
set expmsg "$msgprefix\[^\n\]*$expmsg" |
} else { |
# There is no column number in the search expression, but we |
# should expect one in the message itself. |
set expmsg "\[0-9\]+: $msgprefix\[^\n\]*$expmsg" |
} |
|
set newentry [lreplace $newentry 2 2 $expmsg] |
set dg-messages [lreplace ${dg-messages} end end $newentry] |
verbose "process-message:\n${dg-messages}" 2 |
} |
|
# Look for messages that don't have standard prefixes. |
|
proc dg-message { args } { |
upvar dg-messages dg-messages |
process-message saved-dg-warning "" $args |
} |
|
set additional_prunes "" |
/testsuite/lib/c-torture.exp
0,0 → 1,325
# Copyright (C) 1992-1998, 1999, 2000, 2007, 2008 |
# 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 |
# <http://www.gnu.org/licenses/>. |
|
# This file was written by Rob Savoye. (rob@cygnus.com) |
|
load_lib target-supports.exp |
load_lib file-format.exp |
load_lib target-libpath.exp |
|
# The default option list can be overridden by |
# TORTURE_OPTIONS="{ { list1 } ... { listN } }" |
|
if [info exists TORTURE_OPTIONS] { |
set C_TORTURE_OPTIONS $TORTURE_OPTIONS |
} else { |
# It is theoretically beneficial to group all of the O2/O3 options together, |
# as in many cases the compiler will generate identical executables for |
# all of them--and the c-torture testsuite will skip testing identical |
# executables multiple times. |
# Also note that -finline-functions is explicitly included in one of the |
# items below, even though -O3 is also specified, because some ports may |
# choose to disable inlining functions by default, even when optimizing. |
set C_TORTURE_OPTIONS [list \ |
{ -O0 } \ |
{ -O1 } \ |
{ -O2 } \ |
{ -O3 -fomit-frame-pointer } \ |
{ -O3 -fomit-frame-pointer -funroll-loops } \ |
{ -O3 -fomit-frame-pointer -funroll-all-loops -finline-functions } \ |
{ -O3 -g } \ |
{ -Os } ] |
} |
|
if [info exists ADDITIONAL_TORTURE_OPTIONS] { |
set C_TORTURE_OPTIONS \ |
[concat $C_TORTURE_OPTIONS $ADDITIONAL_TORTURE_OPTIONS] |
} |
|
set LTO_TORTURE_OPTIONS "" |
if [check_effective_target_lto] { |
set LTO_TORTURE_OPTIONS [list \ |
{ -O2 -flto } \ |
{ -O2 -fwhopr } |
] |
} |
|
global GCC_UNDER_TEST |
if ![info exists GCC_UNDER_TEST] { |
set GCC_UNDER_TEST "[find_gcc]" |
} |
|
global orig_environment_saved |
|
# This file may be sourced, so don't override environment settings |
# that have been previously setup. |
if { $orig_environment_saved == 0 } { |
append ld_library_path [gcc-set-multilib-library-path $GCC_UNDER_TEST] |
set_ld_library_path_env_vars |
} |
|
# |
# c-torture-compile -- runs the Tege C-torture test |
# |
# SRC is the full pathname of the testcase. |
# OPTION is the specific compiler flag we're testing (eg: -O2). |
# |
proc c-torture-compile { src option } { |
global output |
global srcdir tmpdir |
global host_triplet |
|
set output "$tmpdir/[file tail [file rootname $src]].o" |
|
regsub "(?q)$srcdir/" $src "" testcase |
# If we couldn't rip $srcdir out of `src' then just do the best we can. |
# The point is to reduce the unnecessary noise in the logs. Don't strip |
# out too much because different testcases with the same name can confuse |
# `test-tool'. |
if [string match "/*" $testcase] { |
set testcase "[file tail [file dirname $src]]/[file tail $src]" |
} |
|
verbose "Testing $testcase, $option" 1 |
|
# Run the compiler and analyze the results. |
set options "" |
lappend options "additional_flags=-w $option" |
|
set comp_output [gcc_target_compile "$src" "$output" object $options] |
gcc_check_compile $testcase $option $output $comp_output |
file_on_host delete $output |
} |
|
# |
# c-torture-execute -- utility to compile and execute a testcase |
# |
# SOURCES is a list of full pathnames to the test source files. |
# The first filename in this list forms the "testcase". |
# |
# If the testcase has an associated .x file, we source that to run the |
# test instead. We use .x so that we don't lengthen the existing filename |
# to more than 14 chars. |
# |
proc c-torture-execute { sources args } { |
global tmpdir tool srcdir output compiler_conditional_xfail_data |
|
# Use the first source filename given as the filename under test. |
set src [lindex $sources 0] |
|
if { [llength $args] > 0 } { |
set additional_flags [lindex $args 0] |
} else { |
set additional_flags "" |
} |
# Check for alternate driver. |
if [file exists [file rootname $src].x] { |
verbose "Using alternate driver [file rootname [file tail $src]].x" 2 |
set done_p 0 |
catch "set done_p \[source [file rootname $src].x\]" |
if { $done_p } { |
return |
} |
} |
|
# Look for a loop within the source code - if we don't find one, |
# don't pass -funroll[-all]-loops. |
global torture_with_loops torture_without_loops |
if [expr [search_for $src "for*("]+[search_for $src "while*("]] then { |
set option_list $torture_with_loops |
} else { |
set option_list $torture_without_loops |
} |
|
set executable $tmpdir/[file tail [file rootname $src].x] |
|
regsub "(?q)$srcdir/" $src "" testcase |
# If we couldn't rip $srcdir out of `src' then just do the best we can. |
# The point is to reduce the unnecessary noise in the logs. Don't strip |
# out too much because different testcases with the same name can confuse |
# `test-tool'. |
if [string match "/*" $testcase] { |
set testcase "[file tail [file dirname $src]]/[file tail $src]" |
} |
|
set count 0 |
set oldstatus "foo" |
foreach option $option_list { |
if { $count > 0 } { |
set oldexec $execname |
} |
set execname "${executable}${count}" |
incr count |
|
# torture_{compile,execute}_xfail are set by the .x script |
# (if present) |
if [info exists torture_compile_xfail] { |
setup_xfail $torture_compile_xfail |
} |
|
# torture_execute_before_{compile,execute} can be set by the .x script |
# (if present) |
if [info exists torture_eval_before_compile] { |
set ignore_me [eval $torture_eval_before_compile] |
} |
|
file_on_host delete $execname |
verbose "Testing $testcase, $option" 1 |
|
set options "" |
lappend options "additional_flags=-w $option" |
if { $additional_flags != "" } { |
lappend options "additional_flags=$additional_flags" |
} |
set comp_output [gcc_target_compile "$sources" "${execname}" executable $options] |
|
if ![gcc_check_compile "$testcase compilation" $option $execname $comp_output] { |
unresolved "$testcase execution, $option" |
file_on_host delete $execname |
continue |
} |
|
# See if this source file uses "long long" types, if it does, and |
# no_long_long is set, skip execution of the test. |
if [target_info exists no_long_long] then { |
if [expr [search_for $src "long long"]] then { |
unsupported "$testcase execution, $option" |
continue |
} |
} |
|
if [info exists torture_execute_xfail] { |
setup_xfail $torture_execute_xfail |
} |
|
if [info exists torture_eval_before_execute] { |
set ignore_me [eval $torture_eval_before_execute] |
} |
|
|
# Sometimes we end up creating identical executables for two |
# consecutive sets of different of compiler options. |
# |
# In such cases we know the result of this test will be identical |
# to the result of the last test. |
# |
# So in cases where the time to load and run/simulate the test |
# is relatively high, compare the two binaries and avoid rerunning |
# tests if the executables are identical. |
# |
# Do not do this for native testing since the cost to load/execute |
# the test is fairly small and the comparison step actually slows |
# the entire process down because it usually does not "hit". |
set skip 0 |
if { ![isnative] && [info exists oldexec] } { |
if { [file_on_host cmp $oldexec $execname] == 0 } { |
set skip 1 |
} |
} |
if { $skip == 0 } { |
set result [gcc_load "$execname" "" ""] |
set status [lindex $result 0] |
set output [lindex $result 1] |
} |
if { $oldstatus == "pass" } { |
file_on_host delete $oldexec |
} |
$status "$testcase execution, $option" |
set oldstatus $status |
} |
if [info exists status] { |
if { $status == "pass" } { |
file_on_host delete $execname |
} |
} |
} |
|
# |
# search_for -- looks for a string match in a file |
# |
proc search_for { file pattern } { |
set fd [open $file r] |
while { [gets $fd cur_line]>=0 } { |
if [string match "*$pattern*" $cur_line] then { |
close $fd |
return 1 |
} |
} |
close $fd |
return 0 |
} |
|
# |
# c-torture -- the c-torture testcase source file processor |
# |
# This runs compilation only tests (no execute tests). |
# SRC is the full pathname of the testcase, or just a file name in which case |
# we prepend $srcdir/$subdir. |
# |
# If the testcase has an associated .x file, we source that to run the |
# test instead. We use .x so that we don't lengthen the existing filename |
# to more than 14 chars. |
# |
proc c-torture { args } { |
global srcdir subdir compiler_conditional_xfail_data |
|
set src [lindex $args 0] |
if { [llength $args] > 1 } { |
set options [lindex $args 1] |
} else { |
set options "" |
} |
|
# Prepend $srdir/$subdir if missing. |
if ![string match "*/*" $src] { |
set src "$srcdir/$subdir/$src" |
} |
|
# Check for alternate driver. |
if [file exists [file rootname $src].x] { |
verbose "Using alternate driver [file rootname [file tail $src]].x" 2 |
set done_p 0 |
catch "set done_p \[source [file rootname $src].x\]" |
if { $done_p } { |
return |
} |
} |
|
# Look for a loop within the source code - if we don't find one, |
# don't pass -funroll[-all]-loops. |
global torture_with_loops torture_without_loops |
if [expr [search_for $src "for*("]+[search_for $src "while*("]] then { |
set option_list $torture_with_loops |
} else { |
set option_list $torture_without_loops |
} |
|
# loop through all the options |
foreach option $option_list { |
# torture_compile_xfail is set by the .x script (if present) |
if [info exists torture_compile_xfail] { |
setup_xfail $torture_compile_xfail |
} |
|
# torture_execute_before_compile is set by the .x script (if present) |
if [info exists torture_eval_before_compile] { |
set ignore_me [eval $torture_eval_before_compile] |
} |
|
c-torture-compile $src "$option $options" |
} |
} |
/testsuite/lib/scanasm.exp
0,0 → 1,293
# Copyright (C) 2000, 2002, 2003, 2007, 2008 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 |
# <http://www.gnu.org/licenses/>. |
|
# Various utilities for scanning assembler output, used by gcc-dg.exp and |
# g++-dg.exp. |
|
# Utility for scanning compiler result, invoked via dg-final. |
|
# Transform newline and similar characters into their escaped form. |
proc make_pattern_printable { pattern } { |
return [string map {\t \\t \n \\n \r \\r \\ \\\\} $pattern] |
} |
|
# Scan the OUTPUT_FILE for a pattern. If it is present and POSITIVE |
# is non-zero, or it is not present and POSITIVE is zero, the test |
# passes. The ORIG_ARGS is the list of arguments provided by dg-final |
# to scan-assembler. The first element in ORIG_ARGS is the regular |
# expression to look for in the file. The second element, if present, |
# is a DejaGNU target selector. |
|
proc dg-scan { name positive testcase output_file orig_args } { |
if { [llength $orig_args] < 1 } { |
error "$name: too few arguments" |
return |
} |
if { [llength $orig_args] > 2 } { |
error "$name: too many arguments" |
return |
} |
if { [llength $orig_args] >= 2 } { |
switch [dg-process-target [lindex $orig_args 1]] { |
"S" { } |
"N" { return } |
"F" { setup_xfail "*-*-*" } |
"P" { } |
} |
} |
|
if { [is_remote host] } { |
remote_upload host "$output_file" |
} |
set fd [open $output_file r] |
set text [read $fd] |
close $fd |
|
set pattern [lindex $orig_args 0] |
set printable_pattern [make_pattern_printable $pattern] |
|
set match [regexp -- $pattern $text] |
if { $match == $positive } { |
pass "$testcase $name $printable_pattern" |
} else { |
fail "$testcase $name $printable_pattern" |
} |
} |
|
# Look for a pattern in the .s file produced by the compiler. See |
# dg-scan for details. |
|
proc scan-assembler { args } { |
upvar 2 name testcase |
set testcase [lindex $testcase 0] |
set output_file "[file rootname [file tail $testcase]].s" |
|
dg-scan "scan-assembler" 1 $testcase $output_file $args |
} |
|
# Check that a pattern is not present in the .s file produced by the |
# compiler. See dg-scan for details. |
|
proc scan-assembler-not { args } { |
upvar 2 name testcase |
set testcase [lindex $testcase 0] |
set output_file "[file rootname [file tail $testcase]].s" |
|
dg-scan "scan-assembler-not" 0 $testcase $output_file $args |
} |
|
# Return the scan for the assembly for hidden visibility. |
|
proc hidden-scan-for { symbol } { |
|
set objformat [gcc_target_object_format] |
|
switch $objformat { |
elf { return "hidden\[ \t_\]*$symbol" } |
mach-o { return "private_extern\[ \t_\]*_?$symbol" } |
default { return "" } |
} |
|
} |
|
|
# Check that a symbol is defined as a hidden symbol in the .s file |
# produced by the compiler. |
|
proc scan-hidden { args } { |
upvar 2 name testcase |
set testcase [lindex $testcase 0] |
set output_file "[file rootname [file tail $testcase]].s" |
|
set symbol [lindex $args 0] |
|
set hidden_scan [hidden-scan-for $symbol] |
|
set args [lreplace $args 0 0 "$hidden_scan"] |
|
dg-scan "scan-hidden" 1 $testcase $output_file $args |
} |
|
# Check that a symbol is not defined as a hidden symbol in the .s file |
# produced by the compiler. |
|
proc scan-not-hidden { args } { |
upvar 2 name testcase |
set testcase [lindex $testcase 0] |
set output_file "[file rootname [file tail $testcase]].s" |
|
set symbol [lindex $args 0] |
set hidden_scan [hidden-scan-for $symbol] |
|
set args [lreplace $args 0 0 "$hidden_scan"] |
|
dg-scan "scan-not-hidden" 0 $testcase $output_file $args |
} |
|
# Look for a pattern in OUTPUT_FILE. See dg-scan for details. |
|
proc scan-file { output_file args } { |
upvar 2 name testcase |
set testcase [lindex $testcase 0] |
dg-scan "scan-file" 1 $testcase $output_file $args |
} |
|
# Check that a pattern is not present in the OUTPUT_FILE. See dg-scan |
# for details. |
|
proc scan-file-not { output_file args } { |
upvar 2 name testcase |
set testcase [lindex $testcase 0] |
dg-scan "scan-file-not" 0 $testcase $output_file $args |
} |
|
# Call pass if pattern is present given number of times, otherwise fail. |
proc scan-assembler-times { args } { |
if { [llength $args] < 2 } { |
error "scan-assembler: too few arguments" |
return |
} |
if { [llength $args] > 3 } { |
error "scan-assembler: too many arguments" |
return |
} |
if { [llength $args] >= 3 } { |
switch [dg-process-target [lindex $args 2]] { |
"S" { } |
"N" { return } |
"F" { setup_xfail "*-*-*" } |
"P" { } |
} |
} |
|
# This assumes that we are two frames down from dg-test, and that |
# it still stores the filename of the testcase in a local variable "name". |
# A cleaner solution would require a new dejagnu release. |
upvar 2 name testcase |
set testcase [lindex $testcase 0] |
|
# This must match the rule in gcc-dg.exp. |
set output_file "[file rootname [file tail $testcase]].s" |
|
set fd [open $output_file r] |
set text [read $fd] |
close $fd |
|
set pattern [lindex $args 0] |
set pp_pattern [make_pattern_printable $pattern] |
if { [llength [regexp -inline -all -- $pattern $text]] == [lindex $args 1]} { |
pass "$testcase scan-assembler-times $pp_pattern [lindex $args 1]" |
} else { |
fail "$testcase scan-assembler-times $pp_pattern [lindex $args 1]" |
} |
} |
|
# Utility for scanning demangled compiler result, invoked via dg-final. |
# Call pass if pattern is present, otherwise fail. |
proc scan-assembler-dem { args } { |
global cxxfilt |
global base_dir |
|
if { [llength $args] < 1 } { |
error "scan-assembler-dem: too few arguments" |
return |
} |
if { [llength $args] > 2 } { |
error "scan-assembler-dem: too many arguments" |
return |
} |
if { [llength $args] >= 2 } { |
switch [dg-process-target [lindex $args 1]] { |
"S" { } |
"N" { return } |
"F" { setup_xfail "*-*-*" } |
"P" { } |
} |
} |
|
# Find c++filt like we find g++ in g++.exp. |
if ![info exists cxxfilt] { |
set cxxfilt [findfile $base_dir/../../../binutils/cxxfilt \ |
$base_dir/../../../binutils/cxxfilt \ |
[findfile $base_dir/../../c++filt $base_dir/../../c++filt \ |
[findfile $base_dir/c++filt $base_dir/c++filt \ |
[transform c++filt]]]] |
verbose -log "c++filt is $cxxfilt" |
} |
|
upvar 2 name testcase |
set testcase [lindex $testcase 0] |
set output_file "[file rootname [file tail $testcase]].s" |
|
set output [remote_exec host "$cxxfilt" "" "$output_file"] |
set text [lindex $output 1] |
|
set pattern [lindex $args 0] |
set pp_pattern [make_pattern_printable $pattern] |
if [regexp -- $pattern $text] { |
pass "$testcase scan-assembler-dem $pp_pattern" |
} else { |
fail "$testcase scan-assembler-dem $pp_pattern" |
} |
} |
|
# Call pass if demangled pattern is not present, otherwise fail. |
proc scan-assembler-dem-not { args } { |
global cxxfilt |
global base_dir |
|
if { [llength $args] < 1 } { |
error "scan-assembler-dem-not: too few arguments" |
return |
} |
if { [llength $args] > 2 } { |
error "scan-assembler-dem-not: too many arguments" |
return |
} |
if { [llength $args] >= 2 } { |
switch [dg-process-target [lindex $args 1]] { |
"S" { } |
"N" { return } |
"F" { setup_xfail "*-*-*" } |
"P" { } |
} |
} |
|
# Find c++filt like we find g++ in g++.exp. |
if ![info exists cxxfilt] { |
set cxxfilt [findfile $base_dir/../../../binutils/cxxfilt \ |
$base_dir/../../../binutils/cxxfilt \ |
[findfile $base_dir/../../c++filt $base_dir/../../c++filt \ |
[findfile $base_dir/c++filt $base_dir/c++filt \ |
[transform c++filt]]]] |
verbose -log "c++filt is $cxxfilt" |
} |
|
upvar 2 name testcase |
set testcase [lindex $testcase 0] |
set output_file "[file rootname [file tail $testcase]].s" |
|
set output [remote_exec host "$cxxfilt" "" "$output_file"] |
set text [lindex $output 1] |
|
set pattern [lindex $args 0] |
set pp_pattern [make_pattern_printable $pattern] |
if ![regexp -- $pattern $text] { |
pass "$testcase scan-assembler-dem-not $pp_pattern" |
} else { |
fail "$testcase scan-assembler-dem-not $pp_pattern" |
} |
} |
/testsuite/lib/timeout.exp
0,0 → 1,81
# Copyright (C) 2008 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 |
# <http://www.gnu.org/licenses/>. |
|
# |
# unset_timeout_vars -- Unset variables used for timeouts |
# |
|
proc unset_timeout_vars { args } { |
global individual_timeout |
global timeout_factor |
|
if [info exists individual_timeout] { |
unset individual_timeout |
} |
if [info exists timeout_factor] { |
unset timeout_factor |
} |
} |
|
# |
# timeout_value -- Return the integer timeout value to use for this test |
# |
|
proc timeout_value { args } { |
global tool_timeout |
global individual_timeout |
global timeout_factor |
|
# Find the current timeout limit, in seconds. |
if [info exists individual_timeout] { |
set val $individual_timeout |
} elseif [info exists tool_timeout] { |
set val $tool_timeout |
} elseif [target_info exists gcc,timeout] { |
set val [target_info gcc,timeout] |
} else { |
# This is really, REALLY ugly, but this is the default from |
# remote.exp deep within DejaGnu. |
set val 300 |
} |
|
# If the test specified a timeout factor, adjust by that. |
if [info exists timeout_factor] { |
set val [expr int([expr $val * $timeout_factor])] |
} |
|
return $val |
} |
|
# |
# standard_wait -- Set the timeout value used by DejaGnu |
# |
|
# Override standard_wait from DejaGnu to use timeout value specified by |
# by the user or by the target board, possibly multiplied by a factor |
# for a particular test. |
|
if { [info procs standard_wait] != [list] \ |
&& [info procs saved_standard_wait] == [list] } { |
rename standard_wait saved_standard_wait |
proc standard_wait { dest timeout } { |
set val [timeout_value] |
if { $val != 0 } { |
set timeout $val |
} |
saved_standard_wait $dest $timeout |
} |
} |
/testsuite/lib/gnat.exp
0,0 → 1,312
# Copyright (C) 2006, 2007, 2008, 2009, 2010 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 |
# <http://www.gnu.org/licenses/>. |
|
# This file was written by James A. Morrison (ja2morri@uwaterloo.ca) |
# based on gcc.exp written by Rob Savoye (rob@cygnus.com). |
|
# This file is loaded by the tool init file (eg: unix.exp). It provides |
# default definitions for gnat_start, etc. and other supporting cast members. |
|
# These globals are used if no compiler arguments are provided. |
# They are also used by the various testsuites to define the environment: |
# where to find stdio.h, libc.a, etc. |
|
load_lib libgloss.exp |
load_lib prune.exp |
load_lib gcc-defs.exp |
load_lib timeout.exp |
|
# |
# GNAT_UNDER_TEST is the compiler under test. |
# |
|
# |
# default_gnat_version -- extract and print the version number of the compiler |
# |
|
proc default_gnat_version { } { |
global GNAT_UNDER_TEST |
|
gnat_init |
|
# ignore any arguments after the command |
set compiler [lindex $GNAT_UNDER_TEST 0] |
|
if ![is_remote host] { |
set compiler_name [which $compiler] |
} else { |
set compiler_name $compiler |
} |
|
# verify that the compiler exists |
if { $compiler_name != 0 } then { |
set tmp [remote_exec host "$compiler -v"] |
set status [lindex $tmp 0] |
set output [lindex $tmp 1] |
regexp " version \[^\n\r\]*" $output version |
if { $status == 0 && [info exists version] } then { |
clone_output "$compiler_name $version\n" |
} else { |
clone_output "Couldn't determine version of $compiler_name: $output\n" |
} |
} else { |
# compiler does not exist (this should have already been detected) |
warning "$compiler does not exist" |
} |
} |
|
# gnat_init -- called at the start of each .exp script. |
# |
# There currently isn't much to do, but always using it allows us to |
# make some enhancements without having to go back and rewrite the scripts. |
# |
|
set gnat_initialized 0 |
|
proc gnat_init { args } { |
global rootme |
global tmpdir |
global libdir |
global gluefile wrap_flags |
global gnat_initialized |
global GNAT_UNDER_TEST |
global TOOL_EXECUTABLE |
global gnat_libgcc_s_path |
global gnat_target_current |
|
set gnat_target_current "" |
|
if { $gnat_initialized == 1 } { return } |
|
if ![info exists GNAT_UNDER_TEST] then { |
if [info exists TOOL_EXECUTABLE] { |
set GNAT_UNDER_TEST "$TOOL_EXECUTABLE" |
} else { |
set GNAT_UNDER_TEST "[local_find_gnatmake]" |
} |
} |
|
if ![info exists tmpdir] then { |
set tmpdir /tmp |
} |
|
set gnat_libgcc_s_path "${rootme}" |
# Leave this here since Ada should support multilibs at some point. |
set compiler [lindex $GNAT_UNDER_TEST 0] |
# if { [is_remote host] == 0 && [which $compiler] != 0 } { |
# foreach i "[exec $compiler --print-multi-lib]" { |
# set mldir "" |
# regexp -- "\[a-z0-9=/\.-\]*;" $i mldir |
# set mldir [string trimright $mldir "\;@"] |
# if { "$mldir" == "." } { |
# continue |
# } |
# if { [llength [glob -nocomplain ${rootme}/${mldir}/libgcc_s*.so.*]] >= 1 } { |
# append gnat_libgcc_s_path ":${rootme}/${mldir}" |
# } |
# } |
# } |
} |
|
proc gnat_target_compile { source dest type options } { |
global rootme |
global tmpdir |
global gluefile wrap_flags |
global srcdir |
global GNAT_UNDER_TEST |
global TOOL_OPTIONS |
global ld_library_path |
global gnat_libgcc_s_path |
global gnat_target_current |
|
# If we detect a change of target, we need to recompute both |
# GNAT_UNDER_TEST and the appropriate RTS. |
if { $gnat_target_current!="[current_target_name]" } { |
set gnat_target_current "[current_target_name]" |
if [info exists TOOL_OPTIONS] { |
set rtsdir "[get_multilibs ${TOOL_OPTIONS}]/libada" |
} else { |
set rtsdir "[get_multilibs]/libada" |
} |
if [info exists TOOL_EXECUTABLE] { |
set GNAT_UNDER_TEST "$TOOL_EXECUTABLE" |
} else { |
set GNAT_UNDER_TEST "[local_find_gnatmake]" |
} |
set GNAT_UNDER_TEST "$GNAT_UNDER_TEST --RTS=$rtsdir" |
|
# gnatlink looks for system.ads itself and has no --RTS option, so |
# specify via environment |
setenv ADA_INCLUDE_PATH "$rtsdir/adainclude" |
setenv ADA_OBJECTS_PATH "$rtsdir/adainclude" |
} |
|
set ld_library_path ".:${gnat_libgcc_s_path}" |
lappend options "compiler=$GNAT_UNDER_TEST -q -f" |
lappend options "timeout=[timeout_value]" |
|
if { [target_info needs_status_wrapper]!="" && [info exists gluefile] } { |
lappend options "libs=${gluefile}" |
lappend options "ldflags=$wrap_flags" |
} |
|
# TOOL_OPTIONS must come first, so that it doesn't override testcase |
# specific options. |
if [info exists TOOL_OPTIONS] { |
set options [concat "additional_flags=$TOOL_OPTIONS" $options] |
} |
|
# If we have built libada along with the compiler, point the test harness |
# at it (and associated headers). |
|
# set sourcename [string range $source 0 [expr [string length $source] - 5]] |
# set dest "" |
|
return [target_compile $source $dest $type $options] |
} |
|
# |
# gnat_pass -- utility to record a testcase passed |
# |
|
proc gnat_pass { testcase cflags } { |
if { "$cflags" == "" } { |
pass "$testcase" |
} else { |
pass "$testcase, $cflags" |
} |
} |
|
# |
# gnat_fail -- utility to record a testcase failed |
# |
|
proc gnat_fail { testcase cflags } { |
if { "$cflags" == "" } { |
fail "$testcase" |
} else { |
fail "$testcase, $cflags" |
} |
} |
|
# |
# gnat_finish -- called at the end of every .exp script that calls gnat_init |
# |
# The purpose of this proc is to hide all quirks of the testing environment |
# from the testsuites. It also exists to undo anything that gnat_init did |
# (that needs undoing). |
# |
|
proc gnat_finish { } { |
# The testing harness apparently requires this. |
global errorInfo |
|
if [info exists errorInfo] then { |
unset errorInfo |
} |
|
# Might as well reset these (keeps our caller from wondering whether |
# s/he has to or not). |
global prms_id bug_id |
set prms_id 0 |
set bug_id 0 |
} |
|
proc gnat_exit { } { |
global gluefile |
|
if [info exists gluefile] { |
file_on_build delete $gluefile |
unset gluefile |
} |
} |
|
# Prune messages from GNAT that aren't useful. |
|
proc prune_gnat_output { text } { |
#send_user "Before:$text\n" |
regsub -all "(^|\n)\[^\n\]*: In (function|method) \[^\n\]*" $text "" text |
regsub -all "(^|\n)\[^\n\]*: At top level:\[^\n\]*" $text "" text |
|
# prune the output from gnatmake. |
regsub -all "(^|\n)\[^\n\]*gnatmake: [^\n\]*" $text "" text |
|
# It would be nice to avoid passing anything to gnat that would cause it to |
# issue these messages (since ignoring them seems like a hack on our part), |
# but that's too difficult in the general case. For example, sometimes |
# you need to use -B to point gnat at crt0.o, but there are some targets |
# that don't have crt0.o. |
regsub -all "(^|\n)\[^\n\]*file path prefix \[^\n\]* never used" $text "" text |
regsub -all "(^|\n)\[^\n\]*linker input file unused since linking not done" $text "" text |
|
#send_user "After:$text\n" |
|
return $text |
} |
|
# find_gnatmake for some version of DejaGnu will hardcode a -I...rts/ada flag |
# which prevent multilib from working, so define a new one. |
|
proc local_find_gnatmake {} { |
global tool_root_dir |
|
if ![is_remote host] { |
set file [lookfor_file $tool_root_dir gnatmake] |
if { $file == "" } { |
set file [lookfor_file $tool_root_dir gcc/gnatmake] |
} |
if { $file != "" } { |
set root [file dirname $file] |
# Need to pass full --GCC, including multilib flags, to gnatlink, |
# otherwise gcc from PATH is invoked. |
set dest [target_info name] |
set gnatlink_gcc "--GCC=$root/xgcc -B$root [board_info $dest multilib_flags]" |
# Escape blanks to get them through DejaGnu's exec machinery. |
regsub -all {\s} "$gnatlink_gcc" {\\&} gnatlink_gcc |
set CC "$file --GCC=$root/xgcc --GNATBIND=$root/gnatbind --GNATLINK=$root/gnatlink -cargs -B$root -largs $gnatlink_gcc -margs"; |
} else { |
set CC [transform gnatmake] |
} |
} else { |
set CC [transform gnatmake] |
} |
return $CC |
} |
|
# If this is an older version of DejaGnu (without runtest_file_p), |
# provide one and assume the old syntax: foo1.exp bar1.c foo2.exp bar2.c. |
# This can be deleted after next DejaGnu release. |
|
if { [info procs runtest_file_p] == "" } then { |
proc runtest_file_p { runtests testcase } { |
if { $runtests != "" && [regexp "\[.\]\[cC\]" $runtests] } then { |
if { [lsearch $runtests [file tail $testcase]] >= 0 } then { |
return 1 |
} else { |
return 0 |
} |
} |
return 1 |
} |
} |
|
# Provide a definition of this if missing (delete after next DejaGnu release). |
|
if { [info procs prune_warnings] == "" } then { |
proc prune_warnings { text } { |
return $text |
} |
} |
/testsuite/lib/prune.exp
0,0 → 1,62
# Copyright (C) 1997, 1999, 2000, 2002, 2004, 2007, 2008 |
# 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 |
# <http://www.gnu.org/licenses/>. |
|
# Prune messages from gcc that aren't useful. |
|
proc prune_gcc_output { text } { |
#send_user "Before:$text\n" |
|
regsub -all "(^|\n)(\[^\n\]*: )?In ((static member |lambda )?function|member|method|(copy )?constructor|destructor|instantiation|program|subroutine|block-data)\[^\n\]*" $text "" text |
regsub -all "(^|\n)\[^\n\]*(: )?At (top level|global scope):\[^\n\]*" $text "" text |
regsub -all "(^|\n)\[^\n\]*: instantiated from \[^\n\]*" $text "" text |
regsub -all "(^|\n) inlined from \[^\n\]*" $text "" text |
regsub -all "(^|\n)collect2: ld returned \[^\n\]*" $text "" text |
regsub -all "(^|\n)collect: re(compiling|linking)\[^\n\]*" $text "" text |
regsub -all "(^|\n)Please submit.*instructions\[^\n\]*" $text "" text |
regsub -all "(^|\n)\[0-9\]\[0-9\]* errors\." $text "" text |
|
# Ignore harmless -fpic warnings. |
regsub -all "(^|\n)\[^\n\]*: warning: -f(pic|PIC) ignored for target\[^\n\]*" $text "" text |
regsub -all "(^|\n)\[^\n\]*: warning: -f(pic|PIC)( and -fpic are| is)? not supported\[^\n\]*" $text "" text |
|
# Ignore errata warning from IA64 assembler. |
regsub -all "(^|\n)\[^\n\]*: Additional NOP may be necessary to workaround Itanium processor A/B step errata" $text "" text |
regsub -all "(^|\n)\[^\n*\]*: Assembler messages:\[^\n\]*" $text "" text |
|
# Ignore harmless VTA note. |
regsub -all "(^|\n)\[^\n\]*: note: variable tracking size limit exceeded with -fvar-tracking-assignments, retrying without\[^\n\]*" $text "" text |
|
# It would be nice to avoid passing anything to gcc that would cause it to |
# issue these messages (since ignoring them seems like a hack on our part), |
# but that's too difficult in the general case. For example, sometimes |
# you need to use -B to point gcc at crt0.o, but there are some targets |
# that don't have crt0.o. |
regsub -all "(^|\n)\[^\n\]*file path prefix \[^\n\]* never used" $text "" text |
regsub -all "(^|\n)\[^\n\]*linker input file unused since linking not done" $text "" text |
|
#send_user "After:$text\n" |
|
return $text |
} |
|
# Provide a definition of this if missing (delete after next dejagnu release). |
|
if { [info procs prune_warnings] == "" } then { |
proc prune_warnings { text } { |
return $text |
} |
} |
/testsuite/lib/options.exp
0,0 → 1,76
# Copyright (C) 2009 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 |
# <http://www.gnu.org/licenses/>. |
|
# We set LC_ALL and LANG to C so that we get the same error messages as expected. |
setenv LC_ALL C |
setenv LANG C |
|
# Many hosts now default to a non-ASCII C locale, however, so |
# they can set a charset encoding here if they need. |
if { [ishost "*-*-cygwin*"] } { |
setenv LC_ALL C.ASCII |
setenv LANG C.ASCII |
} |
|
# Run the LANGUAGE compiler with GCC_OPTIONS and inspect the compiler |
# output to make sure that they match the newline-separated patterns |
# in COMPILER_PATTERNS but not the patterns in COMPILER_NON_PATTERNS. |
# In case of failure, xfail if XFAIL is nonempty. |
|
proc check_for_options {language gcc_options compiler_patterns compiler_non_patterns expected_failure} { |
set filename test-[pid] |
set fd [open $filename.c w] |
puts $fd "int main (void) { return 0; }" |
close $fd |
remote_download host $filename.c |
|
set test "compiler driver $gcc_options option(s):" |
set gcc_options "\{additional_flags=$gcc_options\}" |
|
switch "$language" { |
"c" { set compiler cc1 } |
default { error "unknown language" } |
} |
set gcc_output [gcc_target_compile $filename.c $filename.x executable $gcc_options] |
remote_file build delete $filename.c $filename.x $filename.gcno |
|
foreach pattern [split $compiler_patterns "\n"] { |
if {$pattern != ""} { |
if {[regexp -- "$pattern" $gcc_output]} { |
pass "$test $pattern" |
} else { |
if {$expected_failure != ""} { |
xfail "$test $pattern" |
} else { |
fail "$test $pattern" |
} |
} |
} |
} |
foreach pattern [split $compiler_non_patterns "\n"] { |
if {$pattern != ""} { |
if {![regexp -- "$pattern" $gcc_output]} { |
pass "$test $pattern" |
} else { |
if {$expected_failure != ""} { |
xfail "$test $pattern" |
} else { |
fail "$test $pattern" |
} |
} |
} |
} |
} |
/testsuite/lib/torture-options.exp
0,0 → 1,120
# Copyright (C) 2008 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 |
# <http://www.gnu.org/licenses/>. |
|
# Prepare to use a new set of torture options. |
# |
# Letting options leak from one set of tests to another can be confusing. |
# Make sure variables are not set at the time we're called, because that |
# would mean they were set without being cleared. |
proc torture-init { args } { |
global torture_without_loops global_with_loops |
|
if [info exists torture_without_loops] { |
error "torture-init: torture_without_loops is not empty as expected" |
} |
if [info exists torture_with_loops] { |
error "torture-init: torture_with_loops is not empty as expected" |
} |
} |
|
# Return 1 if torture options have already been set, 0 otherwise. |
proc torture-options-exist { args } { |
global torture_with_loops |
return [info exists torture_with_loops] |
} |
|
# Return 1 if compiler option ARG only affects loops, 0 otherwise. |
proc contains-loop-option-p { arg } { |
switch -glob -- $arg { |
"*loop*" { return 1 } |
default { return 0 } |
} |
} |
|
# Set torture options variables for tests with and without loops. |
# |
# Argument 0 is the list to use as torture options |
# Argument 1 is the list to combine with the torture options. |
# Argument 2 is the list to be appended to the torture options after |
# combining argument 0 and 1. |
proc set-torture-options { args } { |
global torture_with_loops torture_without_loops |
|
set torture_list [lindex $args 0] |
|
if { [llength $args] > 1 } { |
set other_list [lindex $args 1] |
} else { |
set other_list [list {}] |
} |
|
set torture_with_loops "" |
set torture_without_loops "" |
foreach torture_opts $torture_list { |
foreach other_opts $other_list { |
# Remove trailing space[s] to match previous output. |
set torture_opts [string trimright $torture_opts] |
if ![contains-loop-option-p $torture_opts] { |
lappend torture_without_loops "$torture_opts $other_opts" |
} |
lappend torture_with_loops "$torture_opts $other_opts" |
} |
} |
|
if { [llength $args] > 2 } { |
set append_list [lindex $args 2] |
append torture_with_loops " $append_list" |
append torture_without_loops " $append_list" |
} |
} |
|
# Finish up after using a set of torture options. |
# |
# Letting options leak from one set of tests to another can be confusing. |
# Make sure variables are set at the time we're called, and then unset |
# them to prevent interference with other sets of tests. |
proc torture-finish { args } { |
global torture_without_loops torture_with_loops |
|
if [info exists torture_without_loops] { |
unset torture_without_loops |
} else { |
error "torture-finish: torture_without_loops is not defined" |
} |
|
if [info exists torture_with_loops] { |
unset torture_with_loops |
} else { |
error "torture-finish: torture_with_loops is not defined" |
} |
} |
|
# Useful for debugging .exp files. |
proc dump-torture-options { args } { |
global torture_without_loops torture_with_loops |
|
if [info exists torture_without_loops] { |
verbose "torture_without_loops = \"${torture_without_loops}\"" 1 |
} else { |
verbose "torture_without_loops is not defined" 1 |
} |
|
if [info exists torture_with_loops] { |
verbose "torture_with_loops = \"${torture_with_loops}\"" 1 |
} else { |
verbose "torture_with_loops is not defined" 1 |
} |
} |
/testsuite/lib/gcov.exp
0,0 → 1,302
# Copyright (C) 1997, 2001, 2007 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 |
# <http://www.gnu.org/licenses/>. |
|
# Verify various kinds of gcov output: line counts, branch percentages, |
# and call return percentages. None of this is language-specific. |
|
global GCOV |
|
# |
# clean-gcov -- delete the working files the compiler creates for gcov |
# |
# TESTCASE is the name of the test. |
# |
proc clean-gcov { testcase } { |
set basename [file tail $testcase] |
set base [file rootname $basename] |
remote_file host delete $base.gcno $base.gcda \ |
$basename.gcov $base.h.gcov |
} |
|
# |
# verify-lines -- check that line counts are as expected |
# |
# TESTCASE is the name of the test. |
# FILE is the name of the gcov output file. |
# |
proc verify-lines { testcase file } { |
#send_user "verify-lines\n" |
set failed 0 |
set fd [open $file r] |
while { [gets $fd line] >= 0 } { |
# We want to match both "-" and "#####" as count as well as numbers, |
# since we want to detect lines that shouldn't be marked as covered. |
if [regexp "^ *(\[^:]*): *(\[0-9\\-#]+):.*count\\((\[0-9\\-#]+)\\)" \ |
"$line" all is n shouldbe] { |
if { $is == "" } { |
fail "$n:no data available for this line" |
incr failed |
} elseif { $is != $shouldbe } { |
fail "$n:is $is:should be $shouldbe" |
incr failed |
} |
} |
} |
close $fd |
return $failed |
} |
|
# |
# verify-branches -- check that branch percentages are as expected |
# |
# TESTCASE is the name of the test. |
# FILE is the name of the gcov output file. |
# |
# Checks are based on comments in the source file. This means to look for |
# branch percentages 10 or 90, 20 or 80, and # 70 or 30: |
# /* branch(10, 20, 70) */ |
# This means that all specified percentages should have been seen by now: |
# /* branch(end) */ |
# All specified percentages must also be seen by the next branch(n) or |
# by the end of the file. |
# |
# Each check depends on the compiler having generated the expected |
# branch instructions. Don't check for branches that might be |
# optimized away or replaced with predicated instructions. |
# |
proc verify-branches { testcase file } { |
#send_user "verify-branches\n" |
set failed 0 |
set shouldbe "" |
set fd [open $file r] |
set n 0 |
while { [gets $fd line] >= 0 } { |
regexp "^\[^:\]+: *(\[0-9\]+):" "$line" all n |
if [regexp "branch" $line] { |
verbose "Processing branch line $n: $line" 3 |
if [regexp "branch\\((\[0-9 \]+)\\)" "$line" all new_shouldbe] { |
# All percentages in the current list should have been seen. |
if {[llength $shouldbe] != 0} { |
fail "$n: expected branch percentages not found: $shouldbe" |
incr failed |
set shouldbe "" |
} |
set shouldbe $new_shouldbe |
#send_user "$n: looking for: $shouldbe\n" |
# Record the percentages to check for. Replace percentage |
# n > 50 with 100-n, since block ordering affects the |
# direction of a branch. |
for {set i 0} {$i < [llength $shouldbe]} {incr i} { |
set num [lindex $shouldbe $i] |
if {$num > 50} { |
set shouldbe [lreplace $shouldbe $i $i [expr 100 - $num]] |
} |
} |
} elseif [regexp "branch +\[0-9\]+ taken (-\[0-9\]+)%" "$line" \ |
all taken] { |
# Percentages should never be negative. |
fail "$n: negative percentage: $taken" |
incr failed |
} elseif [regexp "branch +\[0-9\]+ taken (\[0-9\]+)%" "$line" \ |
all taken] { |
#send_user "$n: taken = $taken\n" |
# Percentages should never be greater than 100. |
if {$taken > 100} { |
fail "$n: percentage greater than 100: $taken" |
incr failed |
} |
if {$taken > 50} { |
set taken [expr 100 - $taken] |
} |
# If this percentage is one to check for then remove it |
# from the list. It's normal to ignore some reports. |
set i [lsearch $shouldbe $taken] |
if {$i != -1} { |
set shouldbe [lreplace $shouldbe $i $i] |
} |
} elseif [regexp "branch\\(end\\)" "$line"] { |
# All percentages in the list should have been seen by now. |
if {[llength $shouldbe] != 0} { |
fail "$n: expected branch percentages not found: $shouldbe" |
incr failed |
} |
set shouldbe "" |
} |
} |
} |
# All percentages in the list should have been seen. |
if {[llength $shouldbe] != 0} { |
fail "$n: expected branch percentages not found: $shouldbe" |
incr failed |
} |
close $fd |
return $failed |
} |
|
# |
# verify-calls -- check that call return percentages are as expected |
# |
# TESTCASE is the name of the test. |
# FILE is the name of the gcov output file. |
# |
# Checks are based on comments in the source file. This means to look for |
# call return percentages 50, 20, 33: |
# /* returns(50, 20, 33) */ |
# This means that all specified percentages should have been seen by now: |
# /* returns(end) */ |
# All specified percentages must also be seen by the next returns(n) or |
# by the end of the file. |
# |
# Each check depends on the compiler having generated the expected |
# call instructions. Don't check for calls that are inserted by the |
# compiler or that might be inlined. |
# |
proc verify-calls { testcase file } { |
#send_user "verify-calls\n" |
set failed 0 |
set shouldbe "" |
set fd [open $file r] |
set n 0 |
while { [gets $fd line] >= 0 } { |
regexp "^\[^:\]+: *(\[0-9\]+):" "$line" all n |
if [regexp "return" $line] { |
verbose "Processing returns line $n: $line" 3 |
if [regexp "returns\\((\[0-9 \]+)\\)" "$line" all new_shouldbe] { |
# All percentages in the current list should have been seen. |
if {[llength $shouldbe] != 0} { |
fail "$n: expected return percentages not found: $shouldbe" |
incr failed |
set shouldbe "" |
} |
# Record the percentages to check for. |
set shouldbe $new_shouldbe |
} elseif [regexp "call +\[0-9\]+ returned (-\[0-9\]+)%" "$line" \ |
all returns] { |
# Percentages should never be negative. |
fail "$n: negative percentage: $returns" |
incr failed |
} elseif [regexp "call +\[0-9\]+ returned (\[0-9\]+)%" "$line" \ |
all returns] { |
# For branches we check that percentages are not greater than |
# 100 but call return percentages can be, as for setjmp(), so |
# don't count that as an error. |
# |
# If this percentage is one to check for then remove it |
# from the list. It's normal to ignore some reports. |
set i [lsearch $shouldbe $returns] |
if {$i != -1} { |
set shouldbe [lreplace $shouldbe $i $i] |
} |
} elseif [regexp "returns\\(end\\)" "$line"] { |
# All percentages in the list should have been seen by now. |
if {[llength $shouldbe] != 0} { |
fail "$n: expected return percentages not found: $shouldbe" |
incr failed |
} |
set shouldbe "" |
} |
} |
} |
# All percentages in the list should have been seen. |
if {[llength $shouldbe] != 0} { |
fail "$n: expected return percentages not found: $shouldbe" |
incr failed |
} |
close $fd |
return $failed |
} |
|
# Called by dg-final to run gcov and analyze the results. |
# |
# ARGS consists of the optional strings "branches" and/or "calls", |
# (indicating that these things should be verified) followed by a |
# list of arguments to provide to gcov, including the name of the |
# source file. |
|
proc run-gcov { args } { |
global GCOV |
global srcdir subdir |
|
set gcov_args [lindex $args end] |
|
set gcov_verify_calls 0 |
set gcov_verify_branches 0 |
set gcov_execute_xfail "" |
set gcov_verify_xfail "" |
|
foreach a $args { |
if { $a == "calls" } { |
set gcov_verify_calls 1 |
} elseif { $a == "branches" } { |
set gcov_verify_branches 1 |
} |
} |
|
# Extract the test name from the arguments. |
set testcase [lindex $gcov_args end] |
|
if { $gcov_execute_xfail != "" } { |
eval setup_xfail [split $gcov_execute_xfail] |
} |
|
verbose "Running $GCOV $testcase" 2 |
set testcase [remote_download host $testcase] |
set result [remote_exec host $GCOV $gcov_args] |
if { [lindex $result 0] != 0 } { |
fail "$subdir/$testcase gcov failed: [lindex $result 1]" |
clean-gcov $testcase |
return |
} |
|
# Get the gcov output file after making sure it exists. |
set files [glob -nocomplain $testcase.gcov] |
if { $files == "" } { |
fail "$subdir/$testcase gcov failed: $testcase.gcov does not exist" |
clean-gcov $testcase |
return |
} |
remote_upload host $testcase.gcov $testcase.gcov |
|
if { $gcov_verify_xfail != "" } { |
eval setup_xfail [split $gcov_verify_xfail] |
} |
|
# Check that line execution counts are as expected. |
set lfailed [verify-lines $testcase $testcase.gcov] |
|
# If requested via the .x file, check that branch and call information |
# is correct. |
if { $gcov_verify_branches } { |
set bfailed [verify-branches $testcase $testcase.gcov] |
} else { |
set bfailed 0 |
} |
if { $gcov_verify_calls } { |
set cfailed [verify-calls $testcase $testcase.gcov] |
} else { |
set cfailed 0 |
} |
|
# Report whether the gcov test passed or failed. If there were |
# multiple failures then the message is a summary. |
set tfailed [expr $lfailed + $bfailed + $cfailed] |
if { $tfailed > 0 } { |
fail "$subdir/$testcase gcov: $lfailed failures in line counts, $bfailed in branch percentages, $cfailed in return percentages" |
} else { |
pass "$subdir/$testcase gcov" |
clean-gcov $testcase |
} |
} |
/testsuite/lib/dg-pch.exp
0,0 → 1,92
# Copyright (C) 2003, 2007, 2008 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 |
# <http://www.gnu.org/licenses/>. |
|
load_lib copy-file.exp |
|
proc dg-flags-pch { subdir test otherflags options suffix } { |
global runtests dg-do-what-default |
|
# If we're only testing specific files and this isn't one of them, skip it. |
if ![runtest_file_p $runtests $test] { |
return |
} |
set nshort "$subdir/[file tail $test]" |
set bname "[file rootname [file tail $nshort]]" |
|
catch { file_on_host delete "$bname$suffix.gch" } |
catch { file_on_host delete "$bname.s" } |
catch { file_on_host delete "$bname.s-gch" } |
|
# We don't try to use the loop-optimizing options, since they are highly |
# unlikely to make any difference to PCH. |
foreach flags $options { |
verbose "Testing $nshort, $otherflags $flags" 1 |
|
# For the header files, the default is to precompile. |
set dg-do-what-default precompile |
catch { file_on_host delete "$bname$suffix" } |
gcc_copy_files "[file rootname $test]${suffix}s" "$bname$suffix" |
dg-test -keep-output "./$bname$suffix" "$otherflags $flags" "" |
|
# For the rest, the default is to compile to .s. |
set dg-do-what-default compile |
|
set have_errs [llength [grep $test "{\[ \t\]\+dg-error\[ \t\]\+.*\[ \t\]\+}"]] |
|
if { [ file_on_host exists "$bname$suffix.gch" ] } { |
# Ensure that the PCH file is used, not the original header. |
file_on_host delete "$bname$suffix" |
|
dg-test -keep-output $test "$otherflags $flags -I." "" |
file_on_host delete "$bname$suffix.gch" |
if { !$have_errs } { |
if { [ file_on_host exists "$bname.s" ] } { |
remote_upload host "$bname.s" "$bname.s-gch" |
remote_download host "$bname.s-gch" |
gcc_copy_files "[file rootname $test]${suffix}s" "$bname$suffix" |
dg-test -keep-output $test "$otherflags $flags -I." "" |
remote_upload host "$bname.s" |
set tmp [ diff "$bname.s" "$bname.s-gch" ] |
if { $tmp == 0 } { |
verbose -log "assembly file '$bname.s', '$bname.s-gch' comparison error" |
fail "$nshort $otherflags $flags assembly comparison" |
} elseif { $tmp == 1 } { |
pass "$nshort $otherflags $flags assembly comparison" |
} else { |
fail "$nshort $otherflags $flags assembly comparison" |
} |
file_on_host delete "$bname$suffix" |
file_on_host delete "$bname.s" |
file_on_host delete "$bname.s-gch" |
} else { |
verbose -log "assembly file '$bname.s' missing" |
fail "$nshort $flags assembly comparison" |
} |
} |
} else { |
verbose -log "pch file '$bname$suffix.gch' missing" |
fail "$nshort $flags" |
if { !$have_errs } { |
verbose -log "assembly file '$bname.s' missing" 1 |
fail "$nshort $flags assembly comparison" |
} |
} |
} |
} |
|
proc dg-pch { subdir test options suffix } { |
return [dg-flags-pch $subdir $test "" $options $suffix] |
} |
/testsuite/lib/gcc-gdb-test.exp
0,0 → 1,91
# Copyright (C) 2009 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 |
# <http://www.gnu.org/licenses/>. |
|
# Utility for testing variable values using gdb, invoked via dg-final. |
# Call pass if variable has the desired value, otherwise fail. |
# |
# Argument 0 is the line number on which to put a breakpoint |
# Argument 1 is the name of the variable to be checked |
# Argument 2 is the expected value of the variable |
# Argument 3 handles expected failures and the like |
proc gdb-test { args } { |
if { ![isnative] || [is_remote target] } { return } |
|
if { [llength $args] >= 4 } { |
switch [dg-process-target [lindex $args 3]] { |
"S" { } |
"N" { return } |
"F" { setup_xfail "*-*-*" } |
"P" { } |
} |
} |
|
# This assumes that we are three frames down from dg-test, and that |
# it still stores the filename of the testcase in a local variable "name". |
# A cleaner solution would require a new DejaGnu release. |
upvar 2 name testcase |
upvar 2 prog prog |
|
set gdb_name $::env(GUALITY_GDB_NAME) |
set testname "$testcase line [lindex $args 0] [lindex $args 1] == [lindex $args 2]" |
set output_file "[file rootname [file tail $prog]].exe" |
set cmd_file "[file rootname [file tail $prog]].gdb" |
|
set fd [open $cmd_file "w"] |
puts $fd "break [lindex $args 0]" |
puts $fd "run" |
puts $fd "print [lindex $args 1]" |
puts $fd "print [lindex $args 2]" |
puts $fd "quit" |
close $fd |
|
send_log "Spawning: $gdb_name -nx -nw -quiet -x $cmd_file ./$output_file\n" |
set res [remote_spawn target "$gdb_name -nx -nw -quiet -x $cmd_file ./$output_file"] |
if { $res < 0 || $res == "" } { |
unsupported "$testname" |
return |
} |
|
remote_expect target [timeout_value] { |
-re {[\n\r]\$1 = ([^\n\r]*)[\n\r]+\$2 = ([^\n\r]*)[\n\r]} { |
set first $expect_out(1,string) |
set second $expect_out(2,string) |
if { $first == $second } { |
pass "$testname" |
} else { |
send_log "$first != $second\n" |
fail "$testname" |
} |
remote_close target |
return |
} |
# Too old GDB |
-re "Unhandled dwarf expression|Error in sourced command file" { |
unsupported "$testname" |
remote_close target |
return |
} |
timeout { |
unsupported "$testname" |
remote_close target |
return |
} |
} |
|
remote_close target |
unsupported "$testname" |
return |
} |
/testsuite/lib/g++-dg.exp
0,0 → 1,28
# Copyright (C) 1997, 1999, 2000, 2003, 2007 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 |
# <http://www.gnu.org/licenses/>. |
|
# Define g++ callbacks for dg.exp. |
|
load_lib gcc-dg.exp |
|
proc g++-dg-test { prog do_what extra_tool_flags } { |
return [gcc-dg-test-1 g++_target_compile $prog $do_what $extra_tool_flags] |
} |
|
|
proc g++-dg-prune { system text } { |
return [gcc-dg-prune $system $text] |
} |
/testsuite/lib/scantree.exp
0,0 → 1,142
# Copyright (C) 2000, 2002, 2003, 2005, 2006, 2007 |
# 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 |
# <http://www.gnu.org/licenses/>. |
|
# Various utilities for scanning tree dump output, used by gcc-dg.exp and |
# g++-dg.exp. |
|
load_lib scandump.exp |
|
# Utility for scanning compiler result, invoked via dg-final. |
# Call pass if pattern is present, otherwise fail. |
# |
# Argument 0 is the regexp to match |
# Argument 1 is the name of the dumped tree pass |
# Argument 2 handles expected failures and the like |
proc scan-tree-dump { args } { |
|
if { [llength $args] < 2 } { |
error "scan-tree-dump: too few arguments" |
return |
} |
if { [llength $args] > 3 } { |
error "scan-tree-dump: too many arguments" |
return |
} |
if { [llength $args] >= 3 } { |
scan-dump "tree" [lindex $args 0] "\[0-9\]\[0-9\]\[0-9\]t.[lindex $args 1]" [lindex $args 2] |
} else { |
scan-dump "tree" [lindex $args 0] "\[0-9\]\[0-9\]\[0-9\]t.[lindex $args 1]" |
} |
} |
|
# Call pass if pattern is present given number of times, otherwise fail. |
# Argument 0 is the regexp to match |
# Argument 1 is number of times the regexp must be found |
# Argument 2 is the name of the dumped tree pass |
# Argument 3 handles expected failures and the like |
proc scan-tree-dump-times { args } { |
|
if { [llength $args] < 3 } { |
error "scan-tree-dump: too few arguments" |
return |
} |
if { [llength $args] > 4 } { |
error "scan-tree-dump: too many arguments" |
return |
} |
if { [llength $args] >= 4 } { |
scan-dump-times "tree" [lindex $args 0] [lindex $args 1] \ |
"\[0-9\]\[0-9\]\[0-9\]t.[lindex $args 2]" [lindex $args 3] |
} else { |
scan-dump-times "tree" [lindex $args 0] [lindex $args 1] \ |
"\[0-9\]\[0-9\]\[0-9\]t.[lindex $args 2]" |
} |
} |
|
# Call pass if pattern is not present, otherwise fail. |
# |
# Argument 0 is the regexp to match |
# Argument 1 is the name of the dumped tree pass |
# Argument 2 handles expected failures and the like |
proc scan-tree-dump-not { args } { |
|
if { [llength $args] < 2 } { |
error "scan-tree-dump-not: too few arguments" |
return |
} |
if { [llength $args] > 3 } { |
error "scan-tree-dump-not: too many arguments" |
return |
} |
if { [llength $args] >= 3 } { |
scan-dump-not "tree" [lindex $args 0] \ |
"\[0-9\]\[0-9\]\[0-9\]t.[lindex $args 1]" [lindex $args 2] |
} else { |
scan-dump-not "tree" [lindex $args 0] \ |
"\[0-9\]\[0-9\]\[0-9\]t.[lindex $args 1]" |
} |
} |
|
# Utility for scanning demangled compiler result, invoked via dg-final. |
# Call pass if pattern is present, otherwise fail. |
# |
# Argument 0 is the regexp to match |
# Argument 1 is the name of the dumped tree pass |
# Argument 2 handles expected failures and the like |
proc scan-tree-dump-dem { args } { |
|
if { [llength $args] < 2 } { |
error "scan-tree-dump-dem: too few arguments" |
return |
} |
if { [llength $args] > 3 } { |
error "scan-tree-dump-dem: too many arguments" |
return |
} |
if { [llength $args] >= 3 } { |
scan-dump-dem "tree" [lindex $args 0] \ |
"\[0-9\]\[0-9\]\[0-9\]t.[lindex $args 1]" [lindex $args 2] |
} else { |
scan-dump-dem "tree" [lindex $args 0] \ |
"\[0-9\]\[0-9\]\[0-9\]t.[lindex $args 1]" |
} |
} |
|
# Call pass if demangled pattern is not present, otherwise fail. |
# |
# Argument 0 is the regexp to match |
# Argument 1 is the name of the dumped tree pass |
# Argument 2 handles expected failures and the like |
proc scan-tree-dump-dem-not { args } { |
|
if { [llength $args] < 2 } { |
error "scan-tree-dump-dem-not: too few arguments" |
return |
} |
if { [llength $args] > 3 } { |
error "scan-tree-dump-dem-not: too many arguments" |
return |
} |
if { [llength $args] >= 3 } { |
scan-dump-dem-not "tree" [lindex $args 0] \ |
"\[0-9\]\[0-9\]\[0-9\]t.[lindex $args 1]" \ |
[lindex $args 2] |
} else { |
scan-dump-dem-not "tree" [lindex $args 0] \ |
"\[0-9\]\[0-9\]\[0-9\]t.[lindex $args 1]" |
} |
} |
/testsuite/lib/objc-dg.exp
0,0 → 1,35
# Copyright (C) 1997, 1999, 2000, 2001, 2003, 2007 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 |
# <http://www.gnu.org/licenses/>. |
|
load_lib gcc-dg.exp |
|
# Define gcc callbacks for dg.exp. |
|
proc objc-dg-test { prog do_what extra_tool_flags } { |
return [gcc-dg-test-1 objc_target_compile $prog $do_what $extra_tool_flags] |
} |
|
proc objc-dg-prune { system text } { |
return [gcc-dg-prune $system $text] |
} |
|
# Utility routines. |
|
# Modified dg-runtest that can cycle through a list of optimization options |
# as c-torture does. |
proc objc-dg-runtest { testcases default-extra-flags } { |
return [gcc-dg-runtest $testcases ${default-extra-flags}] |
} |
/testsuite/lib/file-format.exp
0,0 → 1,90
# Copyright (C) 1999, 2007 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 |
# <http://www.gnu.org/licenses/>. |
|
# Please email any bugs, comments, and/or additions to this file to: |
# gcc-bugs@gcc.gnu.org |
|
# This file defines a proc for determining the file format in use by the |
# target. This is useful for tests that are only supported by certain file |
# formats. This procedure is defined in a separate file so that it can be |
# included by other expect library files. |
|
proc gcc_target_object_format { } { |
global gcc_target_object_format_saved |
global target_triplet |
global tool |
|
if [info exists gcc_target_object_format_saved] { |
verbose "gcc_target_object_format returning saved $gcc_target_object_format_saved" 2 |
} elseif { [string match "*-*-darwin*" $target_triplet] } { |
# Darwin doesn't necessarily have objdump, so hand-code it. |
set gcc_target_object_format_saved mach-o |
} elseif { [string match "hppa*-*-hpux*" $target_triplet] } { |
# HP-UX doesn't necessarily have objdump, so hand-code it. |
if { [string match "hppa*64*-*-hpux*" $target_triplet] } { |
set gcc_target_object_format_saved elf |
} else { |
set gcc_target_object_format_saved som |
} |
} else { |
set objdump_name [find_binutils_prog objdump] |
set open_file [open objfmtst.c w] |
puts $open_file "void foo(void) { }" |
close $open_file |
|
${tool}_target_compile objfmtst.c objfmtst.o object "" |
file delete objfmtst.c |
|
set output [remote_exec host "$objdump_name" "--file-headers objfmtst.o"] |
set output [lindex $output 1] |
|
file delete objfmtst.o |
|
if ![ regexp "file format (.*)arch" $output dummy objformat ] { |
verbose "Could not parse objdump output" 2 |
set gcc_target_object_format_saved unknown |
} else { |
switch -regexp $objformat { |
elf { |
set gcc_target_object_format_saved elf |
} |
ecoff { |
set gcc_target_object_format_saved ecoff |
} |
coff { |
set gcc_target_object_format_saved coff |
} |
a\.out { |
set gcc_target_object_format_saved a.out |
} |
pe { |
set gcc_target_object_format_saved pe |
} |
som { |
set gcc_target_object_format_saved som |
} |
default { |
verbose "Unknown file format: $objformat" 3 |
set gcc_target_object_format_saved unknown |
} |
} |
|
verbose "gcc_target_object_format returning $gcc_target_object_format_saved" 2 |
} |
} |
|
return $gcc_target_object_format_saved |
} |
/testsuite/lib/target-libpath.exp
0,0 → 1,286
# Copyright (C) 2004, 2005, 2007, 2009 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 |
# <http://www.gnu.org/licenses/>. |
|
# This file was contributed by John David Anglin (dave.anglin@nrc-cnrc.gc.ca) |
|
set orig_environment_saved 0 |
set orig_ld_library_path_saved 0 |
set orig_ld_run_path_saved 0 |
set orig_shlib_path_saved 0 |
set orig_ld_libraryn32_path_saved 0 |
set orig_ld_library64_path_saved 0 |
set orig_ld_library_path_32_saved 0 |
set orig_ld_library_path_64_saved 0 |
set orig_dyld_library_path_saved 0 |
set orig_gcc_exec_prefix_saved 0 |
set orig_gcc_exec_prefix_checked 0 |
|
|
####################################### |
# proc set_ld_library_path_env_vars { } |
####################################### |
|
proc set_ld_library_path_env_vars { } { |
global ld_library_path |
global orig_environment_saved |
global orig_ld_library_path_saved |
global orig_ld_run_path_saved |
global orig_shlib_path_saved |
global orig_ld_libraryn32_path_saved |
global orig_ld_library64_path_saved |
global orig_ld_library_path_32_saved |
global orig_ld_library_path_64_saved |
global orig_dyld_library_path_saved |
global orig_gcc_exec_prefix_saved |
global orig_gcc_exec_prefix_checked |
global orig_ld_library_path |
global orig_ld_run_path |
global orig_shlib_path |
global orig_ld_libraryn32_path |
global orig_ld_library64_path |
global orig_ld_library_path_32 |
global orig_ld_library_path_64 |
global orig_dyld_library_path |
global orig_gcc_exec_prefix |
global TEST_GCC_EXEC_PREFIX |
global env |
|
# Save the original GCC_EXEC_PREFIX. |
if { $orig_gcc_exec_prefix_checked == 0 } { |
if [info exists env(GCC_EXEC_PREFIX)] { |
set orig_gcc_exec_prefix "$env(GCC_EXEC_PREFIX)" |
set orig_gcc_exec_prefix_saved 1 |
} |
set orig_gcc_exec_prefix_checked 1 |
} |
|
# Set GCC_EXEC_PREFIX for the compiler under test to pick up files not in |
# the build tree from a specified location (normally the install tree). |
if [info exists TEST_GCC_EXEC_PREFIX] { |
setenv GCC_EXEC_PREFIX "$TEST_GCC_EXEC_PREFIX" |
} |
|
# Setting the ld library path causes trouble when testing cross-compilers. |
if { [is_remote target] } { |
return |
} |
|
if { $orig_environment_saved == 0 } { |
set orig_environment_saved 1 |
|
# Save the original environment. |
if [info exists env(LD_LIBRARY_PATH)] { |
set orig_ld_library_path "$env(LD_LIBRARY_PATH)" |
set orig_ld_library_path_saved 1 |
} |
if [info exists env(LD_RUN_PATH)] { |
set orig_ld_run_path "$env(LD_RUN_PATH)" |
set orig_ld_run_path_saved 1 |
} |
if [info exists env(SHLIB_PATH)] { |
set orig_shlib_path "$env(SHLIB_PATH)" |
set orig_shlib_path_saved 1 |
} |
if [info exists env(LD_LIBRARYN32_PATH)] { |
set orig_ld_libraryn32_path "$env(LD_LIBRARYN32_PATH)" |
set orig_ld_libraryn32_path_saved 1 |
} |
if [info exists env(LD_LIBRARY64_PATH)] { |
set orig_ld_library64_path "$env(LD_LIBRARY64_PATH)" |
set orig_ld_library64_path_saved 1 |
} |
if [info exists env(LD_LIBRARY_PATH_32)] { |
set orig_ld_library_path_32 "$env(LD_LIBRARY_PATH_32)" |
set orig_ld_library_path_32_saved 1 |
} |
if [info exists env(LD_LIBRARY_PATH_64)] { |
set orig_ld_library_path_64 "$env(LD_LIBRARY_PATH_64)" |
set orig_ld_library_path_64_saved 1 |
} |
if [info exists env(DYLD_LIBRARY_PATH)] { |
set orig_dyld_library_path "$env(DYLD_LIBRARY_PATH)" |
set orig_dyld_library_path_saved 1 |
} |
} |
|
# We need to set ld library path in the environment. Currently, |
# unix.exp doesn't set the environment correctly for all systems. |
# It only sets SHLIB_PATH and LD_LIBRARY_PATH when it executes a |
# program. We also need the environment set for compilations, etc. |
# |
# On IRIX 6, we have to set variables akin to LD_LIBRARY_PATH, but |
# called LD_LIBRARYN32_PATH (for the N32 ABI) and LD_LIBRARY64_PATH |
# (for the 64-bit ABI). The same applies to Darwin (DYLD_LIBRARY_PATH), |
# Solaris 32 bit (LD_LIBRARY_PATH_32), Solaris 64 bit (LD_LIBRARY_PATH_64), |
# and HP-UX (SHLIB_PATH). In some cases, the variables are independent |
# of LD_LIBRARY_PATH, and in other cases LD_LIBRARY_PATH is used if the |
# variable is not defined. |
# |
# Doing this is somewhat of a hack as ld_library_path gets repeated in |
# SHLIB_PATH and LD_LIBRARY_PATH when unix_load sets these variables. |
if { $orig_ld_library_path_saved } { |
setenv LD_LIBRARY_PATH "$ld_library_path:$orig_ld_library_path" |
} else { |
setenv LD_LIBRARY_PATH "$ld_library_path" |
} |
if { $orig_ld_run_path_saved } { |
setenv LD_RUN_PATH "$ld_library_path:$orig_ld_run_path" |
} else { |
setenv LD_RUN_PATH "$ld_library_path" |
} |
# The default shared library dynamic path search for 64-bit |
# HP-UX executables searches LD_LIBRARY_PATH before SHLIB_PATH. |
# LD_LIBRARY_PATH isn't used for 32-bit executables. Thus, we |
# set LD_LIBRARY_PATH and SHLIB_PATH as if they were independent. |
if { $orig_shlib_path_saved } { |
setenv SHLIB_PATH "$ld_library_path:$orig_shlib_path" |
} else { |
setenv SHLIB_PATH "$ld_library_path" |
} |
if { $orig_ld_libraryn32_path_saved } { |
setenv LD_LIBRARYN32_PATH "$ld_library_path:$orig_ld_libraryn32_path" |
} elseif { $orig_ld_library_path_saved } { |
setenv LD_LIBRARYN32_PATH "$ld_library_path:$orig_ld_library_path" |
} else { |
setenv LD_LIBRARYN32_PATH "$ld_library_path" |
} |
if { $orig_ld_library64_path_saved } { |
setenv LD_LIBRARY64_PATH "$ld_library_path:$orig_ld_library64_path" |
} elseif { $orig_ld_library_path_saved } { |
setenv LD_LIBRARY64_PATH "$ld_library_path:$orig_ld_library_path" |
} else { |
setenv LD_LIBRARY64_PATH "$ld_library_path" |
} |
if { $orig_ld_library_path_32_saved } { |
setenv LD_LIBRARY_PATH_32 "$ld_library_path:$orig_ld_library_path_32" |
} elseif { $orig_ld_library_path_saved } { |
setenv LD_LIBRARY_PATH_32 "$ld_library_path:$orig_ld_library_path" |
} else { |
setenv LD_LIBRARY_PATH_32 "$ld_library_path" |
} |
if { $orig_ld_library_path_64_saved } { |
setenv LD_LIBRARY_PATH_64 "$ld_library_path:$orig_ld_library_path_64" |
} elseif { $orig_ld_library_path_saved } { |
setenv LD_LIBRARY_PATH_64 "$ld_library_path:$orig_ld_library_path" |
} else { |
setenv LD_LIBRARY_PATH_64 "$ld_library_path" |
} |
if { $orig_dyld_library_path_saved } { |
setenv DYLD_LIBRARY_PATH "$ld_library_path:$orig_dyld_library_path" |
} else { |
setenv DYLD_LIBRARY_PATH "$ld_library_path" |
} |
|
verbose -log "set_ld_library_path_env_vars: ld_library_path=$ld_library_path" |
} |
|
####################################### |
# proc restore_ld_library_path_env_vars { } |
####################################### |
|
proc restore_ld_library_path_env_vars { } { |
global orig_environment_saved |
global orig_ld_library_path_saved |
global orig_ld_run_path_saved |
global orig_shlib_path_saved |
global orig_ld_libraryn32_path_saved |
global orig_ld_library64_path_saved |
global orig_ld_library_path_32_saved |
global orig_ld_library_path_64_saved |
global orig_dyld_library_path_saved |
global orig_gcc_exec_prefix_saved |
global orig_ld_library_path |
global orig_ld_run_path |
global orig_shlib_path |
global orig_ld_libraryn32_path |
global orig_ld_library64_path |
global orig_ld_library_path_32 |
global orig_ld_library_path_64 |
global orig_dyld_library_path |
global orig_gcc_exec_prefix |
global env |
|
if { $orig_gcc_exec_prefix_saved } { |
setenv GCC_EXEC_PREFIX "$orig_gcc_exec_prefix" |
} elseif [info exists env(GCC_EXEC_PREFIX)] { |
unsetenv GCC_EXEC_PREFIX |
} |
|
if { $orig_environment_saved == 0 } { |
return |
} |
|
if { $orig_ld_library_path_saved } { |
setenv LD_LIBRARY_PATH "$orig_ld_library_path" |
} elseif [info exists env(LD_LIBRARY_PATH)] { |
unsetenv LD_LIBRARY_PATH |
} |
if { $orig_ld_run_path_saved } { |
setenv LD_RUN_PATH "$orig_ld_run_path" |
} elseif [info exists env(LD_RUN_PATH)] { |
unsetenv LD_RUN_PATH |
} |
if { $orig_shlib_path_saved } { |
setenv SHLIB_PATH "$orig_shlib_path" |
} elseif [info exists env(SHLIB_PATH)] { |
unsetenv SHLIB_PATH |
} |
if { $orig_ld_libraryn32_path_saved } { |
setenv LD_LIBRARYN32_PATH "$orig_ld_libraryn32_path" |
} elseif [info exists env(LD_LIBRARYN32_PATH)] { |
unsetenv LD_LIBRARYN32_PATH |
} |
if { $orig_ld_library64_path_saved } { |
setenv LD_LIBRARY64_PATH "$orig_ld_library64_path" |
} elseif [info exists env(LD_LIBRARY64_PATH)] { |
unsetenv LD_LIBRARY64_PATH |
} |
if { $orig_ld_library_path_32_saved } { |
setenv LD_LIBRARY_PATH_32 "$orig_ld_library_path_32" |
} elseif [info exists env(LD_LIBRARY_PATH_32)] { |
unsetenv LD_LIBRARY_PATH_32 |
} |
if { $orig_ld_library_path_64_saved } { |
setenv LD_LIBRARY_PATH_64 "$orig_ld_library_path_64" |
} elseif [info exists env(LD_LIBRARY_PATH_64)] { |
unsetenv LD_LIBRARY_PATH_64 |
} |
if { $orig_dyld_library_path_saved } { |
setenv DYLD_LIBRARY_PATH "$orig_dyld_library_path" |
} elseif [info exists env(DYLD_LIBRARY_PATH)] { |
unsetenv DYLD_LIBRARY_PATH |
} |
} |
|
####################################### |
# proc get_shlib_extension { } |
####################################### |
|
proc get_shlib_extension { } { |
global shlib_ext |
|
if { [ istarget *-*-darwin* ] } { |
set shlib_ext "dylib" |
} elseif { [ istarget *-*-cygwin* ] || [ istarget *-*-mingw* ] } { |
set shlib_ext "dll" |
} elseif { [ istarget hppa*-*-hpux* ] } { |
set shlib_ext "sl" |
} else { |
set shlib_ext "so" |
} |
return $shlib_ext |
} |
|
/testsuite/lib/obj-c++-dg.exp
0,0 → 1,28
# Copyright (C) 2004, 2007 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 |
# <http://www.gnu.org/licenses/>. |
|
# Define obj-c++ callbacks for dg.exp. |
|
load_lib gcc-dg.exp |
|
proc obj-c++-dg-test { prog do_what extra_tool_flags } { |
return [gcc-dg-test-1 obj-c++_target_compile $prog $do_what $extra_tool_flags] |
} |
|
|
proc obj-c++-dg-prune { system text } { |
return [gcc-dg-prune $system $text] |
} |
/testsuite/lib/scandump.exp
0,0 → 1,257
# Copyright (C) 2000, 2002, 2003, 2005, 2007, 2008 |
# 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 |
# <http://www.gnu.org/licenses/>. |
|
# Various utilities for scanning dump output, used by gcc-dg.exp and |
# g++-dg.exp. |
# |
# This is largely borrowed from scanasm.exp. |
|
# Extract the constant part of the dump file suffix from the regexp. |
# Argument 0 is the regular expression. |
proc dump-suffix { arg } { |
set idx [expr [string last "." $arg] + 1] |
return [string range $arg $idx end] |
} |
|
# Utility for scanning compiler result, invoked via dg-final. |
# Call pass if pattern is present, otherwise fail. |
# |
# Argument 0 is the type of dump we are searching (rtl, tree, ipa) |
# Argument 1 is the regexp to match. |
# Argument 2 is the suffix for the dump file |
# Argument 3 handles expected failures and the like |
proc scan-dump { args } { |
|
if { [llength $args] >= 4 } { |
switch [dg-process-target [lindex $args 3]] { |
"S" { } |
"N" { return } |
"F" { setup_xfail "*-*-*" } |
"P" { } |
} |
} |
|
# This assumes that we are three frames down from dg-test, and that |
# it still stores the filename of the testcase in a local variable "name". |
# A cleaner solution would require a new DejaGnu release. |
upvar 3 name testcase |
|
set suf [dump-suffix [lindex $args 2]] |
set testname "$testcase scan-[lindex $args 0]-dump $suf \"[lindex $args 1]\"" |
set src [file tail [lindex $testcase 0]] |
set output_file "[glob -nocomplain $src.[lindex $args 2]]" |
if { $output_file == "" } { |
fail "$testname: dump file does not exist" |
return |
} |
|
set fd [open $output_file r] |
set text [read $fd] |
close $fd |
|
if [regexp -- [lindex $args 1] $text] { |
pass "$testname" |
} else { |
fail "$testname" |
} |
} |
|
# Call pass if pattern is present given number of times, otherwise fail. |
# Argument 0 is the type of dump we are searching (rtl, tree, ipa) |
# Argument 1 is the regexp to match. |
# Argument 2 is number of times the regexp must be found |
# Argument 3 is the suffix for the dump file |
# Argument 4 handles expected failures and the like |
proc scan-dump-times { args } { |
|
if { [llength $args] >= 5 } { |
switch [dg-process-target [lindex $args 4]] { |
"S" { } |
"N" { return } |
"F" { setup_xfail "*-*-*" } |
"P" { } |
} |
} |
|
# This assumes that we are three frames down from dg-test, and that |
# it still stores the filename of the testcase in a local variable "name". |
# A cleaner solution would require a new DejaGnu release. |
upvar 3 name testcase |
|
set suf [dump-suffix [lindex $args 3]] |
set testname "$testcase scan-[lindex $args 0]-dump-times $suf \"[lindex $args 1]\" [lindex $args 2]" |
set src [file tail [lindex $testcase 0]] |
set output_file "[glob -nocomplain $src.[lindex $args 3]]" |
if { $output_file == "" } { |
fail "$testname: dump file does not exist" |
return |
} |
|
set fd [open $output_file r] |
set text [read $fd] |
close $fd |
|
if { [llength [regexp -inline -all -- [lindex $args 1] $text]] == [lindex $args 2]} { |
pass "$testname" |
} else { |
fail "$testname" |
} |
} |
|
# Call pass if pattern is not present, otherwise fail. |
# |
# Argument 0 is the type of dump we are searching (rtl, tree, ipa) |
# Argument 1 is the regexp to match. |
# Argument 2 is the suffix for the dump file |
# Argument 3 handles expected failures and the like |
proc scan-dump-not { args } { |
|
if { [llength $args] >= 4 } { |
switch [dg-process-target [lindex $args 3]] { |
"S" { } |
"N" { return } |
"F" { setup_xfail "*-*-*" } |
"P" { } |
} |
} |
|
# This assumes that we are three frames down from dg-test, and that |
# it still stores the filename of the testcase in a local variable "name". |
# A cleaner solution would require a new DejaGnu release. |
upvar 3 name testcase |
|
set suf [dump-suffix [lindex $args 2]] |
set testname "$testcase scan-[lindex $args 0]-dump-not $suf \"[lindex $args 1]\"" |
set src [file tail [lindex $testcase 0]] |
set output_file "[glob -nocomplain $src.[lindex $args 2]]" |
if { $output_file == "" } { |
fail "$testname: dump file does not exist" |
return |
} |
|
set fd [open $output_file r] |
set text [read $fd] |
close $fd |
|
if ![regexp -- [lindex $args 1] $text] { |
pass "$testname" |
} else { |
fail "$testname" |
} |
} |
|
# Utility for scanning demangled compiler result, invoked via dg-final. |
# Call pass if pattern is present, otherwise fail. |
# |
# Argument 0 is the type of dump we are searching (rtl, tree, ipa) |
# Argument 1 is the regexp to match. |
# Argument 2 is the suffix for the dump file |
# Argument 3 handles expected failures and the like |
proc scan-dump-dem { args } { |
global cxxfilt |
global base_dir |
|
if { [llength $args] >= 4 } { |
switch [dg-process-target [lindex $args 3]] { |
"S" { } |
"N" { return } |
"F" { setup_xfail "*-*-*" } |
"P" { } |
} |
} |
|
# Find c++filt like we find g++ in g++.exp. |
if ![info exists cxxfilt] { |
set cxxfilt [findfile $base_dir/../../../binutils/cxxfilt \ |
$base_dir/../../../binutils/cxxfilt \ |
[findfile $base_dir/../../c++filt $base_dir/../../c++filt \ |
[findfile $base_dir/c++filt $base_dir/c++filt \ |
[transform c++filt]]]] |
verbose -log "c++filt is $cxxfilt" |
} |
|
upvar 3 name testcase |
set suf [dump-suffix [lindex $args 2]] |
set testname "$testcase scan-[lindex $args 0]-dump-dem $suf \"[lindex $args 1]\"" |
set src [file tail [lindex $testcase 0]] |
set output_file "[glob -nocomplain $src.[lindex $args 2]]" |
if { $output_file == "" } { |
fail "$testname: dump file does not exist" |
return |
} |
|
set fd [open "| $cxxfilt < $output_file" r] |
set text [read $fd] |
close $fd |
|
if [regexp -- [lindex $args 1] $text] { |
pass "$testname" |
} else { |
fail "$testname" |
} |
} |
|
# Call pass if demangled pattern is not present, otherwise fail. |
# |
# Argument 0 is the type of dump we are searching (rtl, tree, ipa) |
# Argument 1 is the regexp to match. |
# Argument 2 is the suffix for the dump file |
# Argument 3 handles expected failures and the like |
proc scan-dump-dem-not { args } { |
global cxxfilt |
global base_dir |
|
if { [llength $args] >= 4 } { |
switch [dg-process-target [lindex $args 3]] { |
"S" { } |
"N" { return } |
"F" { setup_xfail "*-*-*" } |
"P" { } |
} |
} |
|
# Find c++filt like we find g++ in g++.exp. |
if ![info exists cxxfilt] { |
set cxxfilt [findfile $base_dir/../../../binutils/cxxfilt \ |
$base_dir/../../../binutils/cxxfilt \ |
[findfile $base_dir/../../c++filt $base_dir/../../c++filt \ |
[findfile $base_dir/c++filt $base_dir/c++filt \ |
[transform c++filt]]]] |
verbose -log "c++filt is $cxxfilt" |
} |
|
upvar 3 name testcase |
|
set suf [dump-suffix [lindex $args 2]] |
set testname "$testcase scan-[lindex $args 0]-dump-dem-not $suf \"[lindex $args 1]\"" |
set src [file tail [lindex $testcase 0]] |
set output_file "[glob -nocomplain $src.[lindex $args 2]]" |
if { $output_file == "" } { |
fail "$testname: dump file does not exist" |
return |
} |
|
set fd [open "| $cxxfilt < $output_file" r] |
set text [read $fd] |
close $fd |
|
if ![regexp -- [lindex $args 1] $text] { |
pass "$testname" |
} else { |
fail "$testname" |
} |
} |
/testsuite/lib/target-supports-dg.exp
0,0 → 1,505
# Copyright (C) 1997, 1999, 2000, 2003, 2004, 2005, 2007, 2008, 2009, 2010 |
# 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 |
# <http://www.gnu.org/licenses/>. |
|
# DejaGnu's dg-test defines extra flags that are used to compile a test. |
# Access them for directives that need to examine all options that are |
# used for a test, including checks for non-cached effective targets. |
# We don't know how far up the call chain it is but we know we'll hit |
# it eventually, and that we're at least 3 calls down. |
|
proc current_compiler_flags { } { |
set frames 2 |
while { ![info exists flags1] } { |
set frames [expr $frames + 1] |
upvar $frames dg-extra-tool-flags flags1 |
} |
upvar $frames tool_flags flags2 |
return "$flags1 $flags2" |
} |
|
# If this target does not support weak symbols, skip this test. |
|
proc dg-require-weak { args } { |
set weak_available [ check_weak_available ] |
if { $weak_available == -1 } { |
upvar name name |
unresolved "$name" |
} |
if { $weak_available != 1 } { |
upvar dg-do-what dg-do-what |
set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] |
} |
} |
|
# If this target does not support overriding weak symbols, skip this |
# test. |
|
proc dg-require-weak-override { args } { |
set weak_override_available [ check_weak_override_available ] |
if { $weak_override_available == -1 } { |
upvar name name |
unresolved "$name" |
} |
if { $weak_override_available != 1 } { |
upvar dg-do-what dg-do-what |
set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] |
} |
} |
|
# If this target does not support the "visibility" attribute, skip this |
# test. |
|
proc dg-require-visibility { args } { |
set visibility_available [ check_visibility_available [lindex $args 1 ] ] |
if { $visibility_available == -1 } { |
upvar name name |
unresolved "$name" |
} |
if { $visibility_available != 1 } { |
upvar dg-do-what dg-do-what |
set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] |
} |
} |
|
# If this target does not support the "alias" attribute, skip this |
# test. |
|
proc dg-require-alias { args } { |
set alias_available [ check_alias_available ] |
if { $alias_available == -1 } { |
upvar name name |
unresolved "$name" |
} |
if { $alias_available < 2 } { |
upvar dg-do-what dg-do-what |
set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] |
} |
} |
|
# If this target's linker does not support the --gc-sections flag, |
# skip this test. |
|
proc dg-require-gc-sections { args } { |
if { ![ check_gc_sections_available ] } { |
upvar dg-do-what dg-do-what |
set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] |
} |
} |
|
# If this target does not support profiling, skip this test. |
|
proc dg-require-profiling { args } { |
if { ![ check_profiling_available ${args} ] } { |
upvar dg-do-what dg-do-what |
set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] |
} |
} |
|
# If this target does not support DLL attributes skip this test. |
|
proc dg-require-dll { args } { |
global target_triplet |
# As a special case, the mcore-*-elf supports these attributes. |
# All Symbian OS targets also support these attributes. |
if { [string match "mcore-*-elf" $target_triplet] |
|| [string match "*-*-symbianelf" $target_triplet]} { |
return |
} |
# PE/COFF targets support dllimport/dllexport. |
if { [gcc_target_object_format] == "pe" } { |
return |
} |
|
upvar dg-do-what dg-do-what |
set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] |
} |
|
proc dg-require-iconv { args } { |
if { ![ check_iconv_available ${args} ] } { |
upvar dg-do-what dg-do-what |
set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] |
} |
} |
|
# If this target does not support named sections skip this test. |
|
proc dg-require-named-sections { args } { |
if { ![ check_named_sections_available ] } { |
upvar dg-do-what dg-do-what |
set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] |
} |
} |
|
# If the target does not match the required effective target, skip this test. |
# Only apply this if the optional selector matches. |
|
proc dg-require-effective-target { args } { |
set args [lreplace $args 0 0] |
# Verify the number of arguments. The last is optional. |
if { [llength $args] < 1 || [llength $args] > 2 } { |
error "syntax error, need a single effective-target keyword with optional selector" |
} |
|
# Evaluate selector if present. |
if { [llength $args] == 2 } { |
switch [dg-process-target [lindex $args 1]] { |
"S" { } |
"N" { return } |
} |
} |
|
if { ![is-effective-target [lindex $args 0]] } { |
upvar dg-do-what dg-do-what |
set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] |
} |
} |
|
# If this target does not have fork, skip this test. |
|
proc dg-require-fork { args } { |
if { ![check_fork_available] } { |
upvar dg-do-what dg-do-what |
set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] |
} |
} |
|
# If this target does not have mkfifo, skip this test. |
|
proc dg-require-mkfifo { args } { |
if { ![check_mkfifo_available] } { |
upvar dg-do-what dg-do-what |
set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] |
} |
} |
|
# If this target does not use __cxa_atexit, skip this test. |
|
proc dg-require-cxa-atexit { args } { |
if { ![ check_cxa_atexit_available ] } { |
upvar dg-do-what dg-do-what |
set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] |
} |
} |
|
# If the host is remote rather than the same as the build system, skip |
# this test. Some tests are incompatible with DejaGnu's handling of |
# remote hosts, which involves copying the source file to the host and |
# compiling it with a relative path and "-o a.out". |
|
proc dg-require-host-local { args } { |
if [ is_remote host ] { |
upvar dg-do-what dg-do-what |
set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] |
} |
} |
|
# Add any target-specific flags needed for accessing the given list |
# of features. This must come after all dg-options. |
|
proc dg-add-options { args } { |
upvar dg-extra-tool-flags extra-tool-flags |
|
foreach arg [lrange $args 1 end] { |
if { [info procs add_options_for_$arg] != "" } { |
set extra-tool-flags \ |
[eval [list add_options_for_$arg ${extra-tool-flags}]] |
} else { |
error "Unrecognized option type: $arg" |
} |
} |
} |
|
# Compare flags for a test directive against flags that will be used to |
# compile the test: multilib flags, flags for torture options, and either |
# the default flags for this group of tests or flags specified with a |
# previous dg-options directive. |
|
proc check-flags { args } { |
global compiler_flags |
global TOOL_OPTIONS |
|
# The args are within another list; pull them out. |
set args [lindex $args 0] |
|
# Start the list with a dummy tool name so the list will match "*" |
# if there are no flags. |
set compiler_flags " toolname " |
append compiler_flags [current_compiler_flags] |
# If running a subset of the test suite, $TOOL_OPTIONS may not exist. |
catch {append compiler_flags " $TOOL_OPTIONS "} |
set dest [target_info name] |
if [board_info $dest exists multilib_flags] { |
append compiler_flags "[board_info $dest multilib_flags] " |
} |
|
# The next two arguments are optional. If they were not specified, |
# use the defaults. |
if { [llength $args] == 2 } { |
lappend $args [list "*"] |
} |
if { [llength $args] == 3 } { |
lappend $args [list ""] |
} |
|
# If the option strings are the defaults, or the same as the |
# defaults, there is no need to call check_conditional_xfail to |
# compare them to the actual options. |
if { [string compare [lindex $args 2] "*"] == 0 |
&& [string compare [lindex $args 3] "" ] == 0 } { |
set result 1 |
} else { |
# The target list might be an effective-target keyword, so replace |
# the original list with "*-*-*", since we already know it matches. |
set result [check_conditional_xfail [lreplace $args 1 1 "*-*-*"]] |
} |
|
# Any value in this variable was left over from an earlier test. |
set compiler_flags "" |
|
return $result |
} |
|
# Skip the test (report it as UNSUPPORTED) if the target list and |
# included flags are matched and the excluded flags are not matched. |
# |
# The first argument is the line number of the dg-skip-if directive |
# within the test file. Remaining arguments are as for xfail lists: |
# message { targets } { include } { exclude } |
# |
# This tests against multilib flags plus either the default flags for this |
# group of tests or flags specified with a previous dg-options command. |
|
proc dg-skip-if { args } { |
# Verify the number of arguments. The last two are optional. |
set args [lreplace $args 0 0] |
if { [llength $args] < 2 || [llength $args] > 4 } { |
error "dg-skip-if 2: need 2, 3, or 4 arguments" |
} |
|
# Don't bother if we're already skipping the test. |
upvar dg-do-what dg-do-what |
if { [lindex ${dg-do-what} 1] == "N" } { |
return |
} |
|
set selector [list target [lindex $args 1]] |
if { [dg-process-target $selector] == "S" } { |
if [check-flags $args] { |
upvar dg-do-what dg-do-what |
set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] |
} |
} |
} |
|
# Like check_conditional_xfail, but callable from a dg test. |
|
proc dg-xfail-if { args } { |
# Verify the number of arguments. The last three are optional. |
set args [lreplace $args 0 0] |
if { [llength $args] < 2 || [llength $args] > 4 } { |
error "dg-xfail-if: need 2, 3, or 4 arguments" |
} |
|
# Don't change anything if we're already skipping the test. |
upvar dg-do-what dg-do-what |
if { [lindex ${dg-do-what} 1] == "N" } { |
return |
} |
|
set selector [list target [lindex $args 1]] |
if { [dg-process-target $selector] == "S" } { |
global compiler_conditional_xfail_data |
|
# The target list might be an effective-target keyword. Replace |
# the original list with "*-*-*", since we already know it matches. |
set args [lreplace $args 1 1 "*-*-*"] |
|
# Supply default values for unspecified optional arguments. |
if { [llength $args] == 2 } { |
lappend $args [list "*"] |
} |
if { [llength $args] == 3 } { |
lappend $args [list ""] |
} |
|
set compiler_conditional_xfail_data $args |
} |
} |
|
# Like dg-xfail-if but for the execute step. |
|
proc dg-xfail-run-if { args } { |
# Verify the number of arguments. The last two are optional. |
set args [lreplace $args 0 0] |
if { [llength $args] < 2 || [llength $args] > 4 } { |
error "dg-xfail-run-if: need 2, 3, or 4 arguments" |
} |
|
# Don't bother if we're already skipping the test. |
upvar dg-do-what dg-do-what |
if { [lindex ${dg-do-what} 1] == "N" } { |
return |
} |
|
set selector [list target [lindex $args 1]] |
if { [dg-process-target $selector] == "S" } { |
if [check-flags $args] { |
upvar dg-do-what dg-do-what |
set dg-do-what [list [lindex ${dg-do-what} 0] "S" "F"] |
} |
} |
} |
|
# Record whether the program is expected to return a nonzero status. |
|
set shouldfail 0 |
|
proc dg-shouldfail { args } { |
# Don't bother if we're already skipping the test. |
upvar dg-do-what dg-do-what |
if { [lindex ${dg-do-what} 1] == "N" } { |
return |
} |
|
global shouldfail |
|
set args [lreplace $args 0 0] |
if { [llength $args] > 1 } { |
set selector [list target [lindex $args 1]] |
if { [dg-process-target $selector] == "S" } { |
# The target matches, now check the flags. |
if [check-flags $args] { |
set shouldfail 1 |
} |
} |
} else { |
set shouldfail 1 |
} |
} |
|
# Intercept the call to the DejaGnu version of dg-process-target to |
# support use of an effective-target keyword in place of a list of |
# target triplets to xfail or skip a test. |
# |
# selector is one of: |
# xfail target-triplet-1 ... |
# xfail effective-target-keyword |
# xfail selector-expression |
# target target-triplet-1 ... |
# target effective-target-keyword |
# target selector-expression |
# |
# For a target list the result is "S" if the target is selected, "N" otherwise. |
# For an xfail list the result is "F" if the target is affected, "P" otherwise. |
# |
# A selector expression appears within curly braces and uses a single logical |
# operator: !, &&, or ||. An operand is another selector expression, an |
# effective-target keyword, or a list of target triplets within quotes or |
# curly braces. |
|
if { [info procs saved-dg-process-target] == [list] } { |
rename dg-process-target saved-dg-process-target |
|
# Evaluate an operand within a selector expression. |
proc selector_opd { op } { |
set selector "target" |
lappend selector $op |
set answer [ expr { [dg-process-target $selector] == "S" } ] |
verbose "selector_opd: `$op' $answer" 2 |
return $answer |
} |
|
# Evaluate a target triplet list within a selector expression. |
# Unlike other operands, this needs to be expanded from a list to |
# the same string as "target". |
proc selector_list { op } { |
set selector "target [join $op]" |
set answer [ expr { [dg-process-target $selector] == "S" } ] |
verbose "selector_list: `$op' $answer" 2 |
return $answer |
} |
|
# Evaluate a selector expression. |
proc selector_expression { exp } { |
if { [llength $exp] == 2 } { |
if [string match "!" [lindex $exp 0]] { |
set op1 [lindex $exp 1] |
set answer [expr { ! [selector_opd $op1] }] |
} else { |
# Assume it's a list of target triplets. |
set answer [selector_list $exp] |
} |
} elseif { [llength $exp] == 3 } { |
set op1 [lindex $exp 0] |
set opr [lindex $exp 1] |
set op2 [lindex $exp 2] |
if [string match "&&" $opr] { |
set answer [expr { [selector_opd $op1] && [selector_opd $op2] }] |
} elseif [string match "||" $opr] { |
set answer [expr { [selector_opd $op1] || [selector_opd $op2] }] |
} else { |
# Assume it's a list of target triplets. |
set answer [selector_list $exp] |
} |
} else { |
# Assume it's a list of target triplets. |
set answer [selector_list $exp] |
} |
|
verbose "selector_expression: `$exp' $answer" 2 |
return $answer |
} |
|
proc dg-process-target { args } { |
verbose "replacement dg-process-target: `$args'" 2 |
|
# Extract the 'what' keyword from the argument list. |
set selector [string trim [lindex $args 0]] |
if [regexp "^xfail " $selector] { |
set what "xfail" |
} elseif [regexp "^target " $selector] { |
set what "target" |
} else { |
error "syntax error in target selector \"$selector\"" |
} |
|
# Extract the rest of the list, which might be a keyword. |
regsub "^${what}" $selector "" rest |
set rest [string trim $rest] |
|
if [is-effective-target-keyword $rest] { |
# The selector is an effective target keyword. |
if [is-effective-target $rest] { |
return [expr { $what == "xfail" ? "F" : "S" }] |
} else { |
return [expr { $what == "xfail" ? "P" : "N" }] |
} |
} |
|
if [string match "{*}" $rest] { |
if [selector_expression [lindex $rest 0]] { |
return [expr { $what == "xfail" ? "F" : "S" }] |
} else { |
return [expr { $what == "xfail" ? "P" : "N" }] |
} |
} |
|
# The selector is not an effective-target keyword, so process |
# the list of target triplets. |
return [saved-dg-process-target $selector] |
} |
} |
/testsuite/lib/gcc-defs.exp
0,0 → 1,269
# Copyright (C) 2001, 2003, 2004, 2007 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 |
# <http://www.gnu.org/licenses/>. |
|
load_lib target-libpath.exp |
|
load_lib wrapper.exp |
|
# |
# ${tool}_check_compile -- Reports and returns pass/fail for a compilation |
# |
|
proc ${tool}_check_compile {testcase option objname gcc_output} { |
global tool |
set fatal_signal "*cc: Internal compiler error: program*got fatal signal" |
|
if [string match "$fatal_signal 6" $gcc_output] then { |
${tool}_fail $testcase "Got Signal 6, $option" |
return 0 |
} |
|
if [string match "$fatal_signal 11" $gcc_output] then { |
${tool}_fail $testcase "Got Signal 11, $option" |
return 0 |
} |
|
if [string match "*internal compiler error*" $gcc_output] then { |
${tool}_fail $testcase "$option (internal compiler error)" |
return 0 |
} |
|
# We shouldn't get these because of -w, but just in case. |
if [string match "*cc:*warning:*" $gcc_output] then { |
warning "$testcase: (with warnings) $option" |
send_log "$gcc_output\n" |
unresolved "$testcase, $option" |
return 0 |
} |
|
set gcc_output [prune_warnings $gcc_output] |
|
if { [info proc ${tool}-dg-prune] != "" } { |
global target_triplet |
set gcc_output [${tool}-dg-prune $target_triplet $gcc_output] |
} |
|
set unsupported_message [${tool}_check_unsupported_p $gcc_output] |
if { $unsupported_message != "" } { |
unsupported "$testcase: $unsupported_message" |
return 0 |
} |
|
# remove any leftover LF/CR to make sure any output is legit |
regsub -all -- "\[\r\n\]*" $gcc_output "" gcc_output |
|
# If any message remains, we fail. |
if ![string match "" $gcc_output] then { |
${tool}_fail $testcase $option |
return 0 |
} |
|
# fail if the desired object file doesn't exist. |
# FIXME: there's no way of checking for existence on a remote host. |
if {$objname != "" && ![is3way] && ![file exists $objname]} { |
${tool}_fail $testcase $option |
return 0 |
} |
|
${tool}_pass $testcase $option |
return 1 |
} |
|
# |
# ${tool}_pass -- utility to record a testcase passed |
# |
|
proc ${tool}_pass { testcase cflags } { |
if { "$cflags" == "" } { |
pass "$testcase" |
} else { |
pass "$testcase, $cflags" |
} |
} |
|
# |
# ${tool}_fail -- utility to record a testcase failed |
# |
|
proc ${tool}_fail { testcase cflags } { |
if { "$cflags" == "" } { |
fail "$testcase" |
} else { |
fail "$testcase, $cflags" |
} |
} |
|
# |
# ${tool}_finish -- called at the end of every script that calls ${tool}_init |
# |
# Hide all quirks of the testing environment from the testsuites. Also |
# undo anything that ${tool}_init did that needs undoing. |
# |
|
proc ${tool}_finish { } { |
# The testing harness apparently requires this. |
global errorInfo |
|
if [info exists errorInfo] then { |
unset errorInfo |
} |
|
# Might as well reset these (keeps our caller from wondering whether |
# s/he has to or not). |
global prms_id bug_id |
set prms_id 0 |
set bug_id 0 |
} |
|
# |
# ${tool}_exit -- Does final cleanup when testing is complete |
# |
|
proc ${tool}_exit { } { |
global gluefile |
|
if [info exists gluefile] { |
file_on_build delete $gluefile |
unset gluefile |
} |
} |
|
# |
# ${tool}_check_unsupported_p -- Check the compiler(/assembler/linker) output |
# for text indicating that the testcase should be marked as "unsupported" |
# |
# Utility used by mike-gcc.exp and c-torture.exp. |
# When dealing with a large number of tests, it's difficult to weed out the |
# ones that are too big for a particular cpu (eg: 16 bit with a small amount |
# of memory). There are various ways to deal with this. Here's one. |
# Fortunately, all of the cases where this is likely to happen will be using |
# gld so we can tell what the error text will look like. |
# |
|
proc ${tool}_check_unsupported_p { output } { |
if [regexp "(^|\n)\[^\n\]*: region \[^\n\]* is full" $output] { |
return "memory full" |
} |
if {[istarget spu-*-*] && \ |
[string match "*exceeds local store*" $output]} { |
return "memory full" |
} |
return "" |
} |
|
# |
# runtest_file_p -- Provide a definition for older dejagnu releases |
# and assume the old syntax: foo1.exp bar1.c foo2.exp bar2.c. |
# (delete after next dejagnu release). |
# |
|
if { [info procs runtest_file_p] == "" } then { |
proc runtest_file_p { runtests testcase } { |
if { $runtests != "" && [regexp "\[.\]\[cC\]" $runtests] } then { |
if { [lsearch $runtests [file tail $testcase]] >= 0 } then { |
return 1 |
} else { |
return 0 |
} |
} |
return 1 |
} |
} |
|
# Record additional sources files that must be compiled along with the |
# main source file. |
|
set additional_sources "" |
|
proc dg-additional-sources { args } { |
global additional_sources |
set additional_sources [lindex $args 1] |
} |
|
# Record additional files -- other than source files -- that must be |
# present on the system where the compiler runs. |
|
set additional_files "" |
|
proc dg-additional-files { args } { |
global additional_files |
set additional_files [lindex $args 1] |
} |
|
# Return an updated version of OPTIONS that mentions any additional |
# source files registered with dg-additional-sources. SOURCE is the |
# name of the test case. |
|
proc dg-additional-files-options { options source } { |
global additional_sources |
global additional_files |
set to_download [list] |
if { $additional_sources != "" } then { |
if [is_remote host] { |
lappend options "additional_flags=$additional_sources" |
} |
regsub -all "^| " $additional_sources " [file dirname $source]/" additional_sources |
if ![is_remote host] { |
lappend options "additional_flags=$additional_sources" |
} |
set to_download [concat $to_download $additional_sources] |
set additional_sources "" |
} |
if { $additional_files != "" } then { |
regsub -all " " $additional_files " [file dirname $source]/" additional_files |
set to_download [concat $to_download $additional_files] |
set additional_files "" |
} |
if [is_remote host] { |
foreach file $to_download { |
remote_download host $file |
} |
} |
|
return $options |
} |
|
# Return a colon-separate list of directories to search for libraries |
# for COMPILER, including multilib directories. |
|
proc gcc-set-multilib-library-path { compiler } { |
global rootme |
|
# ??? rootme will not be set when testing an installed compiler. |
# In that case, we should perhaps use some other method to find |
# libraries. |
if {![info exists rootme]} { |
return "" |
} |
|
set libpath ":${rootme}" |
set compiler [lindex $compiler 0] |
if { [is_remote host] == 0 && [which $compiler] != 0 } { |
foreach i "[exec $compiler --print-multi-lib]" { |
set mldir "" |
regexp -- "\[a-z0-9=_/\.-\]*;" $i mldir |
set mldir [string trimright $mldir "\;@"] |
if { "$mldir" == "." } { |
continue |
} |
if { [llength [glob -nocomplain ${rootme}/${mldir}/libgcc_s*.so.*]] >= 1 } { |
append libpath ":${rootme}/${mldir}" |
} |
} |
} |
|
return $libpath |
} |
/testsuite/lib/fortran-torture.exp
0,0 → 1,427
# Copyright (C) 2003, 2006, 2007, 2008, 2010 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 |
# <http://www.gnu.org/licenses/>. |
|
# Please email any bugs, comments, and/or additions to this file to |
# the author. |
|
# This file was written by Steven Bosscher (s.bosscher@student.tudelft.nl) |
# based on f-torture.exp, which was written by Rob Savoye. |
|
load_lib target-supports.exp |
|
# Return the list of options to use for fortran torture tests. |
# The default option list can be overridden by |
# TORTURE_OPTIONS="{ { list1 } ... { listN } }" |
proc get-fortran-torture-options { } { |
global TORTURE_OPTIONS |
|
if [info exists TORTURE_OPTIONS] { |
return $TORTURE_OPTIONS |
} |
|
# determine if host supports vectorization, and the necessary set |
# of options, based on code from testsuite/vect/vect.exp |
|
set vectorizer_options [list "-O2" "-ftree-vectorize"] |
|
if { [istarget "powerpc*-*-*"] |
&& [is-effective-target powerpc_altivec_ok] |
&& [check_vmx_hw_available] } { |
lappend vectorizer_options "-maltivec" |
set test_tree_vectorize 1 |
} elseif { [istarget "spu-*-*"] } { |
set test_tree_vectorize 1 |
} elseif { ( [istarget "i?86-*-*"] || [istarget "x86_64-*-*"] ) |
&& [check_effective_target_sse2] |
&& [check_sse2_hw_available] |
&& [check_sse_os_support_available] } { |
lappend vectorizer_options "-msse2" |
set test_tree_vectorize 1 |
} elseif { [istarget "mips*-*-*"] |
&& [check_effective_target_mpaired_single] |
&& [check_effective_target_nomips16] } { |
lappend vectorizer_options "-mpaired-single" |
set test_tree_vectorize 1 |
} elseif { [istarget "sparc*-*-*"] |
&& [check_effective_target_ultrasparc_hw] } { |
lappend vectorizer_options "-mcpu=ultrasparc" "-mvis" |
set test_tree_vectorize 1 |
} elseif { [istarget "alpha*-*-*"] |
&& [check_alpha_max_hw_available] } { |
lappend vectorizer_options "-mmax" |
set test_tree_vectorize 1 |
} elseif [istarget "ia64-*-*"] { |
set test_tree_vectorize 1 |
} else { |
set test_tree_vectorize 0 |
} |
|
set options {} |
|
lappend options \ |
{ -O0 } \ |
{ -O1 } \ |
{ -O2 } \ |
{ -O2 -fomit-frame-pointer -finline-functions } \ |
{ -O2 -fomit-frame-pointer -finline-functions -funroll-loops } \ |
{ -O2 -fbounds-check } \ |
{ -O3 -g } \ |
{ -Os } |
if { $test_tree_vectorize } { |
lappend options $vectorizer_options |
} |
|
if [info exists ADDITIONAL_TORTURE_OPTIONS] { |
set options [concat $options $ADDITIONAL_TORTURE_OPTIONS] |
} |
|
return $options |
} |
|
|
# |
# fortran-torture-compile -- compile a gfortran.fortran-torture testcase. |
# |
# SRC is the full pathname of the testcase. |
# OPTION is the specific compiler flag we're testing (eg: -O2). |
# |
proc fortran-torture-compile { src option } { |
global output |
global srcdir tmpdir |
global host_triplet |
|
set output "$tmpdir/[file tail [file rootname $src]].o" |
|
regsub "(?q)$srcdir/" $src "" testcase |
|
# If we couldn't rip $srcdir out of `src' then just do the best we can. |
# The point is to reduce the unnecessary noise in the logs. Don't strip |
# out too much because different testcases with the same name can confuse |
# `test-tool'. |
if [string match "/*" $testcase] { |
set testcase "[file tail [file dirname $src]]/[file tail $src]" |
} |
|
verbose "Testing $testcase, $option" 1 |
|
# Run the compiler and get results in comp_output. |
set options "" |
lappend options "additional_flags=-w $option" |
|
set comp_output [gfortran_target_compile "$src" "$output" object $options] |
|
# See if we got something bad. |
set fatal_signal "*95*: Internal compiler error: program*got fatal signal" |
|
if [string match "$fatal_signal 6" $comp_output] then { |
gfortran_fail $testcase "Got Signal 6, $option" |
catch { remote_file build delete $output } |
return |
} |
|
if [string match "$fatal_signal 11" $comp_output] then { |
gfortran_fail $testcase "Got Signal 11, $option" |
catch { remote_file build delete $output } |
return |
} |
|
if [string match "*internal compiler error*" $comp_output] then { |
gfortran_fail $testcase "$option (internal compiler error)" |
catch { remote_file build delete $output } |
return |
} |
|
# We shouldn't get these because of -w, but just in case. |
if [string match "*95*:*warning:*" $comp_output] then { |
warning "$testcase: (with warnings) $option" |
send_log "$comp_output\n" |
unresolved "$testcase, $option" |
catch { remote_file build delete $output } |
return |
} |
|
# Prune warnings we know are unwanted. |
set comp_output [prune_warnings $comp_output] |
|
# Report if the testcase is not supported. |
set unsupported_message [gfortran_check_unsupported_p $comp_output] |
if { $unsupported_message != "" } { |
unsupported "$testcase: $unsupported_message" |
catch { remote_file build delete $output } |
return |
} |
|
# remove any leftover LF/CR to make sure any output is legit |
regsub -all -- "\[\r\n\]*" $comp_output "" comp_output |
|
# If any message remains, we fail. |
if ![string match "" $comp_output] then { |
gfortran_fail $testcase $option |
catch { remote_file build delete $output } |
return |
} |
|
gfortran_pass $testcase $option |
catch { remote_file build delete $output } |
} |
|
|
# |
# fortran-torture-execute -- compile and execute a testcase. |
# |
# SRC is the full pathname of the testcase. |
# |
# If the testcase has an associated .x file, we source that to run the |
# test instead. We use .x so that we don't lengthen the existing filename |
# to more than 14 chars. |
# |
proc fortran-torture-execute { src } { |
global output |
global srcdir tmpdir |
global tool |
global compiler_conditional_xfail_data |
global torture_with_loops |
|
# Check for alternate driver. |
set additional_flags "" |
if [file exists [file rootname $src].x] { |
verbose "Using alternate driver [file rootname [file tail $src]].x" 2 |
set done_p 0 |
catch "set done_p \[source [file rootname $src].x\]" |
if { $done_p } { |
return |
} |
} |
|
# Setup the options for the testcase run. |
set option_list $torture_with_loops |
set executable $tmpdir/[file tail [file rootname $src].x] |
regsub "(?q)$srcdir/" $src "" testcase |
|
# If we couldn't rip $srcdir out of `src' then just do the best we can. |
# The point is to reduce the unnecessary noise in the logs. Don't strip |
# out too much because different testcases with the same name can confuse |
# `test-tool'. |
if [string match "/*" $testcase] { |
set testcase "[file tail [file dirname $src]]/[file tail $src]" |
} |
|
# Walk the list of options and copmile and run the testcase for all |
# options that are not explicitly disabled by the .x script (if present). |
foreach option $option_list { |
|
# Torture_{compile,execute}_xfail are set by the .x script. |
if [info exists torture_compile_xfail] { |
setup_xfail $torture_compile_xfail |
} |
|
# Torture_execute_before_{compile,execute} can be set by the .x script. |
if [info exists torture_eval_before_compile] { |
set ignore_me [eval $torture_eval_before_compile] |
} |
|
# FIXME: We should make sure that the modules required by this testcase |
# exist. If not, the testcase should XFAIL. |
|
# Compile the testcase. |
catch { remote_file build delete $executable } |
verbose "Testing $testcase, $option" 1 |
|
set options "" |
lappend options "additional_flags=-w $option" |
if { $additional_flags != "" } { |
lappend options "additional_flags=$additional_flags" |
} |
set comp_output [gfortran_target_compile "$src" "$executable" executable $options] |
|
# See if we got something bad. |
set fatal_signal "*95*: Internal compiler error: program*got fatal signal" |
|
if [string match "$fatal_signal 6" $comp_output] then { |
gfortran_fail $testcase "Got Signal 6, $option" |
catch { remote_file build delete $executable } |
continue |
} |
|
if [string match "$fatal_signal 11" $comp_output] then { |
gfortran_fail $testcase "Got Signal 11, $option" |
catch { remote_file build delete $executable } |
continue |
} |
|
if [string match "*internal compiler error*" $comp_output] then { |
gfortran_fail $testcase "$option (internal compiler error)" |
catch { remote_file build delete $executable } |
continue |
} |
|
# We shouldn't get these because of -w, but just in case. |
if [string match "*95*:*warning:*" $comp_output] then { |
warning "$testcase: (with warnings) $option" |
send_log "$comp_output\n" |
unresolved "$testcase, $option" |
catch { remote_file build delete $executable } |
continue |
} |
|
# Prune warnings we know are unwanted. |
set comp_output [prune_warnings $comp_output] |
|
# Report if the testcase is not supported. |
set unsupported_message [gfortran_check_unsupported_p $comp_output] |
if { $unsupported_message != "" } { |
unsupported "$testcase: $unsupported_message" |
continue |
} elseif ![file exists $executable] { |
if ![is3way] { |
fail "$testcase compilation, $option" |
untested "$testcase execution, $option" |
continue |
} else { |
# FIXME: since we can't test for the existence of a remote |
# file without short of doing an remote file list, we assume |
# that since we got no output, it must have compiled. |
pass "$testcase compilation, $option" |
} |
} else { |
pass "$testcase compilation, $option" |
} |
|
# See if this source file uses INTEGER(KIND=8) types, if it does, and |
# no_long_long is set, skip execution of the test. |
# FIXME: We should also look for F95 style "_8" or select_int_kind() |
# integers, but that is obviously much harder than just regexping this. |
# So maybe we should just avoid those in testcases. |
if [target_info exists no_long_long] then { |
if [expr [search_for_re $src "integer\*8"] \ |
+[search_for_re $src "integer *( *8 *)"] \ |
+[search_for_re $src "integer *( *kind *= *8 *)"]] \ |
then { |
untested "$testcase execution, $option" |
continue |
} |
} |
|
if [info exists torture_execute_xfail] { |
setup_xfail $torture_execute_xfail |
} |
|
if [info exists torture_eval_before_execute] { |
set ignore_me [eval $torture_eval_before_execute] |
} |
|
# Run the testcase, and analyse the output. |
set result [gfortran_load "$executable" "" ""] |
set status [lindex $result 0] |
set output [lindex $result 1] |
if { $status == "pass" } { |
catch { remote_file build delete $executable } |
} |
$status "$testcase execution, $option" |
} |
} |
|
|
# |
# search_for_re -- looks for a string match in a file |
# |
proc search_for_re { file pattern } { |
set fd [open $file r] |
while { [gets $fd cur_line]>=0 } { |
set lower [string tolower $cur_line] |
if [regexp "$pattern" $lower] then { |
close $fd |
return 1 |
} |
} |
close $fd |
return 0 |
} |
|
|
# |
# fortran-torture -- the fortran-torture testcase source file processor |
# |
# This runs compilation only tests (no execute tests). |
# |
# SRC is the full pathname of the testcase, or just a file name in which |
# case we prepend $srcdir/$subdir. |
# |
# If the testcase has an associated .x file, we source that to run the |
# test instead. We use .x so that we don't lengthen the existing filename |
# to more than 14 chars. |
# |
proc fortran-torture { args } { |
global srcdir subdir |
global compiler_conditional_xfail_data |
global torture_with_loops |
|
set src [lindex $args 0] |
if { [llength $args] > 1 } { |
set options [lindex $args 1] |
} else { |
set options "" |
} |
|
# Prepend $srdir/$subdir if missing. |
if ![string match "*/*" $src] { |
set src "$srcdir/$subdir/$src" |
} |
|
# Check for alternate driver. |
if [file exists [file rootname $src].x] { |
verbose "Using alternate driver [file rootname [file tail $src]].x" 2 |
set done_p 0 |
catch "set done_p \[source [file rootname $src].x\]" |
if { $done_p } { |
return |
} |
} |
|
# loop through all the options |
set option_list $torture_with_loops |
foreach option $option_list { |
|
# torture_compile_xfail is set by the .x script (if present) |
if [info exists torture_compile_xfail] { |
setup_xfail $torture_compile_xfail |
} |
|
# torture_execute_before_compile is set by the .x script (if present) |
if [info exists torture_eval_before_compile] { |
set ignore_me [eval $torture_eval_before_compile] |
} |
|
fortran-torture-compile $src "$option $options" |
} |
} |
|
# |
# add-ieee-options -- add options necessary for 100% ieee conformance. |
# |
proc add-ieee-options { } { |
# Ensure that excess precision does not cause problems. |
if { [istarget "i?86-*-*"] |
|| [istarget "m68k-*-*"] } then { |
uplevel 1 lappend additional_flags "-ffloat-store" |
} |
|
# Enable full IEEE compliance mode. |
if { [istarget "alpha*-*-*"] |
|| [istarget "sh*-*-*"] } then { |
uplevel 1 lappend additional_flags "-mieee" |
} |
} |
/testsuite/lib/objc.exp
0,0 → 1,372
# Copyright (C) 1992, 1993, 1994, 1996, 1997, 2000, 2001, 2002, 2004, 2005, |
# 2007, 2008 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 |
# <http://www.gnu.org/licenses/>. |
|
# This file was written by Rob Savoye (rob@cygnus.com) |
# Currently maintained by Doug Evans (dje@cygnus.com) |
|
# This file is loaded by the tool init file (eg: unix.exp). It provides |
# default definitions for objc_start, etc. and other supporting cast members. |
|
# These globals are used by objc_start if no compiler arguments are provided. |
# They are also used by the various testsuites to define the environment: |
# where to find stdio.h, libc.a, etc. |
|
load_lib libgloss.exp |
load_lib prune.exp |
load_lib gcc-defs.exp |
load_lib timeout.exp |
load_lib target-libpath.exp |
|
# |
# OBJC_UNDER_TEST is the compiler under test. |
# |
|
# |
# default_objc_version -- extract and print the version number of the compiler |
# |
|
proc default_objc_version { } { |
global OBJC_UNDER_TEST |
|
objc_init |
|
# Ignore any arguments after the command. |
set compiler [lindex $OBJC_UNDER_TEST 0] |
|
if ![is_remote host] { |
set compiler_name [which $compiler] |
} else { |
set compiler_name $compiler |
} |
|
# Verify that the compiler exists. |
if { $compiler_name != 0 } then { |
set tmp [remote_exec host "$compiler -v"] |
set status [lindex $tmp 0] |
set output [lindex $tmp 1] |
regexp " version \[^\n\r\]*" $output version |
if { $status == 0 && [info exists version] } then { |
clone_output "$compiler_name $version\n" |
} else { |
clone_output "Couldn't determine version of $compiler_name: $output\n" |
} |
} else { |
# Compiler does not exist (this should have already been detected). |
warning "$compiler does not exist" |
} |
} |
|
# |
# Call objc_version. We do it this way so we can override it if needed. |
# |
proc objc_version { } { |
default_objc_version |
} |
|
# |
# objc_init -- called at the start of each .exp script. |
# |
# There currently isn't much to do, but always using it allows us to |
# make some enhancements without having to go back and rewrite the scripts. |
# |
|
set objc_initialized 0 |
|
proc objc_init { args } { |
global rootme |
global tmpdir |
global libdir |
global gluefile wrap_flags |
global objc_initialized |
global OBJC_UNDER_TEST |
global TOOL_EXECUTABLE |
global objc_libgcc_s_path |
global gcc_warning_prefix |
global gcc_error_prefix |
|
# We set LC_ALL and LANG to C so that we get the same error messages as |
# expected. |
setenv LC_ALL C |
setenv LANG C |
|
# Many hosts now default to a non-ASCII C locale, however, so |
# they can set a charset encoding here if they need. |
if { [ishost "*-*-cygwin*"] } { |
setenv LC_ALL C.ASCII |
setenv LANG C.ASCII |
} |
|
if { $objc_initialized == 1 } { return; } |
|
if ![info exists OBJC_UNDER_TEST] then { |
if [info exists TOOL_EXECUTABLE] { |
set OBJC_UNDER_TEST $TOOL_EXECUTABLE |
} else { |
set OBJC_UNDER_TEST [find_gcc] |
} |
} |
|
if ![info exists tmpdir] then { |
set tmpdir /tmp |
} |
|
set gcc_warning_prefix "warning:" |
set gcc_error_prefix "error:" |
|
objc_maybe_build_wrapper "${tmpdir}/objc-testglue.o" |
|
set objc_libgcc_s_path [gcc-set-multilib-library-path $OBJC_UNDER_TEST] |
} |
|
proc objc_target_compile { source dest type options } { |
global rootme |
global tmpdir |
global gluefile wrap_flags |
global srcdir |
global OBJC_UNDER_TEST |
global TOOL_OPTIONS |
global ld_library_path |
global objc_libgcc_s_path |
global shlib_ext |
|
set shlib_ext [get_shlib_extension] |
set ld_library_path ".:${objc_libgcc_s_path}" |
|
# We have to figure out which runtime will be used on darwin because |
# we need to add the include path for the gnu runtime if that is in |
# use. |
# First set the default... |
if { [istarget "*-*-darwin*"] } { |
set nextruntime 1 |
} else { |
set nextruntime 0 |
} |
verbose "initial next runtime state : $nextruntime" 2 |
# Next, see if we define the option in dg-options... |
foreach opt $options { |
if [regexp ".*-fnext-runtime.*" $opt] { |
set nextruntime 1 |
} |
if [regexp ".*-fgnu-runtime.*" $opt] { |
set nextruntime 0 |
} |
} |
verbose "next runtime state after dg opts: $nextruntime" 2 |
|
set tgt [target_info name] |
if [board_info $tgt exists multilib_flags] { |
set lb [board_info $tgt multilib_flags] |
verbose "board multilib_flags $lb" 2 |
foreach opt $lb { |
if [regexp ".*-fnext-runtime.*" $opt] { |
set nextruntime 1 |
} |
if [regexp ".*-fgnu-runtime.*" $opt] { |
set nextruntime 0 |
} |
} |
} |
verbose "next runtime state after any multilib opts: $nextruntime" 2 |
|
lappend options "libs=-lobjc" |
verbose "shared lib extension: $shlib_ext" 3 |
|
if { [target_info needs_status_wrapper]!="" && [info exists gluefile] } { |
lappend options "libs=${gluefile}" |
lappend options "ldflags=$wrap_flags" |
} |
|
if [target_info exists objc,stack_size] { |
lappend options "additional_flags=-DSTACK_SIZE=[target_info objc,stack_size]" |
} |
if [target_info exists objc,no_trampolines] { |
lappend options "additional_flags=-DNO_TRAMPOLINES" |
} |
if [target_info exists objc,no_label_values] { |
lappend options "additional_flags=-DNO_LABEL_VALUES" |
} |
# TOOL_OPTIONS must come first, so that it doesn't override testcase |
# specific options. |
if [info exists TOOL_OPTIONS] { |
set options [concat "{additional_flags=$TOOL_OPTIONS}" $options] |
} |
|
# If we have built libobjc along with the compiler, point the test harness |
# at it (and associated headers). |
|
set objcpath "[get_multilibs]" |
|
set libobjc_dir [lookfor_file ${objcpath} libobjc/.libs/libobjc.a] |
if { $libobjc_dir == "" } { |
# On darwin there is, potentially, a gnu runtime too. |
set libobjc_dir [lookfor_file ${objcpath} libobjc/.libs/libobjc-gnu.a] |
} |
# Perhaps we didn't build static libs. |
if { $libobjc_dir == "" } { |
set libobjc_dir [lookfor_file ${objcpath} libobjc/.libs/libobjc.${shlib_ext}] |
# On darwin there is, potentially, a gnu runtime too. |
if { $libobjc_dir == "" } { |
set libobjc_dir [lookfor_file ${objcpath} libobjc/.libs/libobjc-gnu.${shlib_ext}] |
} |
} |
|
if { $libobjc_dir != "" } { |
# If we are using the gnu runtime, add its includes. |
if { $nextruntime == 0 } { |
set objc_include_dir "${srcdir}/../../libobjc" |
lappend options "additional_flags=-I${objc_include_dir}" |
verbose "adding gnu runtime include dir: $objc_include_dir " |
} |
set libobjc_dir [file dirname ${libobjc_dir}] |
# Allow for %s spec substitutions.. |
set objc_link_flags " -B${libobjc_dir} " |
lappend options "additional_flags=${objc_link_flags}" |
set objc_link_flags " -L${libobjc_dir} " |
lappend options "additional_flags=${objc_link_flags}" |
append ld_library_path ":${libobjc_dir}" |
} |
if { $type == "precompiled_header" } { |
# If we generating a precompiled header, we have say this is an |
# objective-C header. |
set source [concat "-x objective-c-header" $source] |
} |
lappend options "compiler=$OBJC_UNDER_TEST" |
lappend options "timeout=[timeout_value]" |
|
set_ld_library_path_env_vars |
|
return [target_compile $source $dest $type $options] |
} |
|
# |
# objc_pass -- utility to record a testcase passed. |
# |
|
proc objc_pass { testcase cflags } { |
if { "$cflags" == "" } { |
pass "$testcase" |
} else { |
pass "$testcase, $cflags" |
} |
} |
|
# |
# objc_fail -- utility to record a testcase failed |
# |
|
proc objc_fail { testcase cflags } { |
if { "$cflags" == "" } { |
fail "$testcase" |
} else { |
fail "$testcase, $cflags" |
} |
} |
|
# |
# objc_finish -- called at the end of every .exp script that calls objc_init |
# |
# The purpose of this proc is to hide all quirks of the testing environment |
# from the testsuites. It also exists to undo anything that objc_init did |
# (that needs undoing). |
# |
|
proc objc_finish { } { |
# The testing harness apparently requires this. |
global errorInfo |
|
if [info exists errorInfo] then { |
unset errorInfo |
} |
|
# Might as well reset these (keeps our caller from wondering whether |
# s/he has to or not). |
global prms_id bug_id |
set prms_id 0 |
set bug_id 0 |
} |
|
proc objc_exit { } { |
global gluefile |
|
if [info exists gluefile] { |
file_on_build delete $gluefile |
unset gluefile |
} |
} |
|
# If this is an older version of dejagnu (without runtest_file_p), |
# provide one and assume the old syntax: foo1.exp bar1.c foo2.exp bar2.c. |
# This can be deleted after next dejagnu release. |
|
if { [info procs runtest_file_p] == "" } then { |
proc runtest_file_p { runtests testcase } { |
if { $runtests != "" && [regexp "\[.\]\[cC\]" $runtests] } then { |
if { [lsearch $runtests [file tail $testcase]] >= 0 } then { |
return 1 |
} else { |
return 0 |
} |
} |
return 1 |
} |
} |
|
# Provide a definition of this if missing (delete after next dejagnu release). |
|
if { [info procs prune_warnings] == "" } then { |
proc prune_warnings { text } { |
return $text |
} |
} |
|
# Utility used by mike-gcc.exp and c-torture.exp. |
# Check the compiler(/assembler/linker) output for text indicating that |
# the testcase should be marked as "unsupported". |
# |
# When dealing with a large number of tests, it's difficult to weed out the |
# ones that are too big for a particular cpu (eg: 16 bit with a small amount |
# of memory). There are various ways to deal with this. Here's one. |
# Fortunately, all of the cases where this is likely to happen will be using |
# gld so we can tell what the error text will look like. |
|
proc ${tool}_check_unsupported_p { output } { |
if [regexp "(^|\n)\[^\n\]*: region \[^\n\]* is full" $output] { |
return "memory full" |
} |
return "" |
} |
|
# Prune messages from objc that aren't useful. |
|
proc prune_objc_output { text } { |
#send_user "Before:$text\n" |
regsub -all "(^|\n)\[^\n\]*: In (function|method) \[^\n\]*" $text "" text |
regsub -all "(^|\n)\[^\n\]*: At top level:\[^\n\]*" $text "" text |
|
# It would be nice to avoid passing anything to objc that would cause it to |
# issue these messages (since ignoring them seems like a hack on our part), |
# but that's too difficult in the general case. For example, sometimes |
# you need to use -B to point objc at crt0.o, but there are some targets |
# that don't have crt0.o. |
regsub -all "(^|\n)\[^\n\]*file path prefix \[^\n\]* never used" $text "" text |
regsub -all "(^|\n)\[^\n\]*linker input file unused since linking not done" $text "" text |
|
#send_user "After:$text\n" |
|
return $text |
} |
|
/testsuite/lib/timeout-dg.exp
0,0 → 1,49
# Copyright (C) 2008 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 |
# <http://www.gnu.org/licenses/>. |
|
# |
# dg-timeout -- Set the timout limit, in seconds, for a particular test |
# |
|
proc dg-timeout { args } { |
global individual_timeout |
|
set args [lreplace $args 0 0] |
if { [llength $args] > 1 } { |
if { [dg-process-target [lindex $args 1]] == "S" } { |
set individual_timeout [lindex $args 0] |
} |
} else { |
set individual_timeout [lindex $args 0] |
} |
} |
|
# |
# dg-timeout-factor -- Scale the timeout limit for a particular test |
# |
|
proc dg-timeout-factor { args } { |
global timeout_factor |
|
set args [lreplace $args 0 0] |
if { [llength $args] > 1 } { |
if { [dg-process-target [lindex $args 1]] == "S" } { |
set timeout_factor [lindex $args 0] |
} |
} else { |
set timeout_factor [lindex $args 0] |
} |
} |
/testsuite/lib/scanipa.exp
0,0 → 1,141
# Copyright (C) 2000, 2002, 2003, 2005, 2007 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 |
# <http://www.gnu.org/licenses/>. |
|
# Various utilities for scanning ipa dump output, used by gcc-dg.exp and |
# g++-dg.exp. |
|
load_lib scandump.exp |
|
# Utility for scanning compiler result, invoked via dg-final. |
# Call pass if pattern is present, otherwise fail. |
# |
# Argument 0 is the regexp to match |
# Argument 1 is the name of the dumped ipa pass |
# Argument 2 handles expected failures and the like |
proc scan-ipa-dump { args } { |
|
if { [llength $args] < 2 } { |
error "scan-ipa-dump: too few arguments" |
return |
} |
if { [llength $args] > 3 } { |
error "scan-ipa-dump: too many arguments" |
return |
} |
if { [llength $args] >= 3 } { |
scan-dump "ipa" [lindex $args 0] "\[0-9\]\[0-9\]\[0-9\]i.[lindex $args 1]" [lindex $args 2] |
} else { |
scan-dump "ipa" [lindex $args 0] "\[0-9\]\[0-9\]\[0-9\]i.[lindex $args 1]" |
} |
} |
|
# Call pass if pattern is present given number of times, otherwise fail. |
# Argument 0 is the regexp to match |
# Argument 1 is number of times the regexp must be found |
# Argument 2 is the name of the dumped ipa pass |
# Argument 3 handles expected failures and the like |
proc scan-ipa-dump-times { args } { |
|
if { [llength $args] < 3 } { |
error "scan-ipa-dump: too few arguments" |
return |
} |
if { [llength $args] > 4 } { |
error "scan-ipa-dump: too many arguments" |
return |
} |
if { [llength $args] >= 4 } { |
scan-dump-times "ipa" [lindex $args 0] [lindex $args 1] \ |
"\[0-9\]\[0-9\]\[0-9\]i.[lindex $args 2]" [lindex $args 3] |
} else { |
scan-dump-times "ipa" [lindex $args 0] [lindex $args 1] \ |
"\[0-9\]\[0-9\]\[0-9\]i.[lindex $args 2]" |
} |
} |
|
# Call pass if pattern is not present, otherwise fail. |
# |
# Argument 0 is the regexp to match |
# Argument 1 is the name of the dumped ipa pass |
# Argument 2 handles expected failures and the like |
proc scan-ipa-dump-not { args } { |
|
if { [llength $args] < 2 } { |
error "scan-ipa-dump-not: too few arguments" |
return |
} |
if { [llength $args] > 3 } { |
error "scan-ipa-dump-not: too many arguments" |
return |
} |
if { [llength $args] >= 3 } { |
scan-dump-not "ipa" [lindex $args 0] \ |
"\[0-9\]\[0-9\]\[0-9\]i.[lindex $args 1]" [lindex $args 2] |
} else { |
scan-dump-not "ipa" [lindex $args 0] \ |
"\[0-9\]\[0-9\]\[0-9\]i.[lindex $args 1]" |
} |
} |
|
# Utility for scanning demangled compiler result, invoked via dg-final. |
# Call pass if pattern is present, otherwise fail. |
# |
# Argument 0 is the regexp to match |
# Argument 1 is the name of the dumped ipa pass |
# Argument 2 handles expected failures and the like |
proc scan-ipa-dump-dem { args } { |
|
if { [llength $args] < 2 } { |
error "scan-ipa-dump-dem: too few arguments" |
return |
} |
if { [llength $args] > 3 } { |
error "scan-ipa-dump-dem: too many arguments" |
return |
} |
if { [llength $args] >= 3 } { |
scan-dump-dem "ipa" [lindex $args 0] \ |
"\[0-9\]\[0-9\]\[0-9\]i.[lindex $args 1]" [lindex $args 2] |
} else { |
scan-dump-dem "ipa" [lindex $args 0] \ |
"\[0-9\]\[0-9\]\[0-9\]i.[lindex $args 1]" |
} |
} |
|
# Call pass if demangled pattern is not present, otherwise fail. |
# |
# Argument 0 is the regexp to match |
# Argument 1 is the name of the dumped ipa pass |
# Argument 2 handles expected failures and the like |
proc scan-ipa-dump-dem-not { args } { |
|
if { [llength $args] < 2 } { |
error "scan-ipa-dump-dem-not: too few arguments" |
return |
} |
if { [llength $args] > 3 } { |
error "scan-ipa-dump-dem-not: too many arguments" |
return |
} |
if { [llength $args] >= 3 } { |
scan-dump-dem-not "ipa" [lindex $args 0] \ |
"\[0-9\]\[0-9\]\[0-9\]i.[lindex $args 1]" \ |
[lindex $args 2] |
} else { |
scan-dump-dem-not "ipa" [lindex $args 0] \ |
"\[0-9\]\[0-9\]\[0-9\]i.[lindex $args 1]" |
} |
} |
/testsuite/lib/mike-gcc.exp
0,0 → 1,260
# Copyright (C) 1988, 90, 91, 92, 95, 96, 1997, 2007 |
# 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 |
# <http://www.gnu.org/licenses/>. |
|
# This file was derived from mike-g++.exp written by Mike Stump <mrs@cygnus.com> |
|
# |
# mike_cleanup -- remove any files that are created by the testcase |
# |
proc mike_cleanup { src_code output_file assembly_file } { |
remote_file build delete $output_file $assembly_file |
} |
|
# |
# prebase -- sets up a Mike Stump (mrs@cygnus.com) style gcc test |
# |
proc prebase { } { |
global compiler_output |
global not_compiler_output |
global compiler_result |
global not_compiler_result |
global program_output |
global groups |
global run |
global actions |
global target_regexp |
|
set compiler_output "^$" |
set not_compiler_output ".*Internal compiler error.*" |
set compiler_result "" |
set not_compiler_result "" |
set program_output ".*PASS.*" |
set groups {} |
set run no |
set actions assemble |
set target_regexp ".*" |
} |
|
# |
# run the test |
# |
proc postbase { src_code run groups args } { |
global verbose |
global srcdir |
global subdir |
global not_compiler_output |
global compiler_output |
global compiler_result |
global not_compiler_result |
global program_output |
global actions |
global target_regexp |
global host_triplet |
global target_triplet |
global tool |
global tmpdir |
global GCC_UNDER_TEST |
global GROUP |
|
if ![info exists GCC_UNDER_TEST] { |
error "No compiler specified for testing." |
} |
|
if ![regexp $target_regexp $target_triplet] { |
unsupported $subdir/$src_code |
return |
} |
|
if { [llength $args] > 0 } { |
set comp_options [lindex $args 0] |
} else { |
set comp_options "" |
} |
|
set fail_message $subdir/$src_code |
set pass_message $subdir/$src_code |
|
if [info exists GROUP] { |
if {[lsearch $groups $GROUP] == -1} { |
return |
} |
} |
|
if [string match $run yes] { |
set actions run |
} |
|
set output_file "$tmpdir/[file tail [file rootname $src_code]]" |
set assembly_file "$output_file" |
append assembly_file ".S" |
|
set compile_type "none" |
|
case $actions { |
compile |
{ |
set compile_type "assembly" |
set output_file $assembly_file |
} |
assemble |
{ |
set compile_type "object" |
append output_file ".o" |
} |
link |
{ |
set compile_type "executable" |
append output_file ".exe" |
} |
run |
{ |
set compile_type "executable" |
append output_file ".exe" |
set run yes |
} |
default |
{ |
set output_file "" |
set compile_type "none" |
} |
} |
|
set src_file "$srcdir/$subdir/$src_code" |
set options "" |
lappend options "compiler=$GCC_UNDER_TEST" |
|
if { $comp_options != "" } { |
lappend options "additional_flags=$comp_options" |
} |
|
set comp_output [gcc_target_compile $src_file $output_file $compile_type $options] |
|
set pass no |
|
# Delete things like "ld.so warning" messages. |
set comp_output [prune_warnings $comp_output] |
|
if [regexp -- $not_compiler_output $comp_output] { |
if { $verbose > 1 } { |
send_user "\nChecking:\n$not_compiler_output\nto make sure it does not match:\n$comp_output\nbut it does.\n\n" |
} else { |
send_log "\nCompiler output:\n$comp_output\n\n" |
} |
fail $fail_message |
# The framework doesn't like to see any error remnants, |
# so remove them. |
uplevel { |
if [info exists errorInfo] { |
unset errorInfo |
} |
} |
mike_cleanup $src_code $output_file $assembly_file |
return |
} |
|
# remove any leftover CRs. |
regsub -all -- "\r" $comp_output "" comp_output |
|
regsub -all "(^|\n)\[^\n\]*linker input file unused since linking not done" $comp_output "" comp_output |
regsub -all "(^|\n)\[^\n\]*file path prefix \[^\n\]* never used" $comp_output "" comp_output |
|
set unsupported_message [${tool}_check_unsupported_p $comp_output] |
if { $unsupported_message != "" } { |
unsupported "$subdir/$src_code: $unsupported_message" |
mike_cleanup $src_code $output_file $assembly_file |
return |
} |
|
if { $verbose > 1 } { |
send_user "\nChecking:\n$compiler_output\nto see if it matches:\n$comp_output\n" |
} else { |
send_log "\nCompiler output:\n$comp_output\n\n" |
} |
if [regexp -- $compiler_output $comp_output] { |
if { $verbose > 1 } { |
send_user "Yes, it matches.\n\n" |
} |
set pass yes |
if [file exists [file rootname [file tail $src_code]].s] { |
set fd [open [file rootname [file tail $src_code]].s r] |
set dot_s [read $fd] |
close $fd |
if { $compiler_result != "" } { |
verbose "Checking .s file for $compiler_result" 2 |
if [regexp -- $compiler_result $dot_s] { |
verbose "Yes, it matches." 2 |
} else { |
verbose "Nope, doesn't match." 2 |
verbose $dot_s 4 |
set pass no |
} |
} |
if { $not_compiler_result != "" } { |
verbose "Checking .s file for not $not_compiler_result" 2 |
if ![regexp -- $not_compiler_result $dot_s] { |
verbose "Nope, not found (that's good)." 2 |
} else { |
verbose "Uh oh, it was found." 2 |
verbose $dot_s 4 |
set pass no |
} |
} |
} |
if [string match $run yes] { |
set result [gcc_load $output_file] |
set status [lindex $result 0] |
set output [lindex $result 1] |
if { $status == -1 } { |
mike_cleanup $src_code $output_file $assembly_file |
return |
} |
if { $verbose > 1 } { |
send_user "Checking:\n$program_output\nto see if it matches:\n$output\n\n" |
} |
if ![regexp -- $program_output $output] { |
set pass no |
if { $verbose > 1 } { |
send_user "Nope, does not match.\n\n" |
} |
} else { |
if { $verbose > 1 } { |
send_user "Yes, it matches.\n\n" |
} |
} |
} |
} else { |
if { $verbose > 1 } { |
send_user "Nope, does not match.\n\n" |
} |
} |
|
if [string match $pass "yes"] { |
pass $pass_message |
} else { |
fail $fail_message |
} |
|
# The framework doesn't like to see any error remnants, |
# so remove them. |
uplevel { |
if [info exists errorInfo] { |
unset errorInfo |
} |
} |
|
mike_cleanup $src_code $output_file $assembly_file |
} |
/testsuite/lib/objc-torture.exp
0,0 → 1,384
# Copyright (C) 1992-1998, 1999, 2000, 2007, 2008 |
# 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 |
# <http://www.gnu.org/licenses/>. |
|
# This file was written by Rob Savoye. (rob@cygnus.com) |
|
load_lib file-format.exp |
load_lib target-supports.exp |
|
# Make sure that the runtime list is re-evaluated for each multilib. |
proc objc-set-runtime-options { dowhat args } { |
global OBJC_RUNTIME_OPTIONS |
if ![info exists OBJC_RUNTIME_OPTIONS] { |
set rtlist [list "-fgnu-runtime" "-fnext-runtime" ] |
} else { |
set rtlist [list "-fgnu-runtime" "-fnext-runtime" ] |
foreach other $OBJC_RUNTIME_OPTIONS { |
# Don't do tests twice... |
if { ( $other == "-fnext-runtime" || $other == "-fgnu-runtime" ) } { |
continue |
} |
lappend rtlist $other |
} |
} |
|
set OBJC_RUNTIME_OPTIONS "" |
|
foreach type $rtlist { |
global srcdir subdir target_triplet tmpdir |
|
set options "additional_flags=$type" |
if [info exists args] { |
lappend options $args |
} |
verbose "options $options" |
if [info exists dowhat] { |
switch $dowhat { |
"compile" { |
set compile_type "assembly" |
set output_file "trivial.s" |
set comp_output [objc_target_compile \ |
"$srcdir/$subdir/trivial.m" "$output_file" "$compile_type" $options] |
|
remote_file build delete $output_file |
# If we get any error, then we failed. |
if ![string match "" $comp_output] then { |
continue; |
} |
} |
"execute" { |
set test_obj "trivial.exe" |
set comp_output [objc_target_compile \ |
"$srcdir/$subdir/trivial.m" $test_obj "executable" $options] |
|
# If we get any error, then we failed. |
if ![string match "" $comp_output] then { |
remote_file build delete $test_obj |
continue; |
} |
set result [objc_load "$tmpdir/$test_obj" "" ""] |
set status [lindex $result 0] |
set output [lindex $result 1] |
remote_file build delete $test_obj |
if { $status != "pass" } { |
verbose -log "trivial execute failed with $status $output" |
continue; |
} |
} |
default { |
perror "$dowhat: not a valid objc-torture action" |
return "" |
} |
} |
} else { |
set test_obj "trivial.exe" |
set comp_output [objc_target_compile \ |
"$srcdir/$subdir/trivial.m" $test_obj executable $options] |
|
# If we get any error, then we failed. |
remote_file build delete $test_obj |
if ![string match "" $comp_output] then { |
continue; |
} |
} |
lappend OBJC_RUNTIME_OPTIONS $type |
} |
|
verbose -log "Using the following runtimes: $OBJC_RUNTIME_OPTIONS" |
} |
|
# The default option list can be overridden by |
# TORTURE_OPTIONS="{ { list1 } ... { listN } }" |
|
if [info exists TORTURE_OPTIONS] { |
set OBJC_TORTURE_OPTIONS $TORTURE_OPTIONS |
} else { |
# It is theoretically beneficial to group all of the O2/O3 options together, |
# as in many cases the compiler will generate identical executables for |
# all of them--and the objc-torture testsuite will skip testing identical |
# executables multiple times. |
# Also note that -finline-functions is explicitly included in one of the |
# items below, even though -O3 is also specified, because some ports may |
# choose to disable inlining functions by default, even when optimizing. |
set OBJC_TORTURE_OPTIONS [list \ |
" -O0 " \ |
" -O1 " \ |
" -O2 " \ |
" -O3 -fomit-frame-pointer " \ |
" -O3 -fomit-frame-pointer -funroll-loops " \ |
" -O3 -fomit-frame-pointer -funroll-all-loops -finline-functions " \ |
" -O3 -g " \ |
" -Os " ] |
} |
|
if [info exists ADDITIONAL_TORTURE_OPTIONS] { |
set OBJC_TORTURE_OPTIONS \ |
[concat $OBJC_TORTURE_OPTIONS $ADDITIONAL_TORTURE_OPTIONS] |
} |
|
# |
# objc-torture-compile -- runs the Tege OBJC-torture test |
# |
# SRC is the full pathname of the testcase. |
# OPTION is the specific compiler flag we're testing (eg: -O2). |
# |
proc objc-torture-compile { src option } { |
global output |
global srcdir tmpdir |
global host_triplet |
|
set output "$tmpdir/[file tail [file rootname $src]].o" |
|
regsub "(?q)$srcdir/" $src "" testcase |
# If we couldn't rip $srcdir out of `src' then just do the best we can. |
# The point is to reduce the unnecessary noise in the logs. Don't strip |
# out too much because different testcases with the same name can confuse |
# `test-tool'. |
if [string match "/*" $testcase] { |
set testcase "[file tail [file dirname $src]]/[file tail $src]" |
} |
|
verbose "Testing $testcase, $option" 1 |
|
# Run the compiler and analyze the results. |
set options "" |
lappend options "additional_flags=-w $option" |
|
set comp_output [objc_target_compile "$src" "$output" object $options] |
objc_check_compile $testcase $option $output $comp_output |
remote_file build delete $output |
} |
|
# |
# objc-torture-execute -- utility to compile and execute a testcase |
# |
# SRC is the full pathname of the testcase. |
# |
# If the testcase has an associated .x file, we source that to run the |
# test instead. We use .x so that we don't lengthen the existing filename |
# to more than 14 chars. |
# |
proc objc-torture-execute { src args } { |
global tmpdir tool srcdir output compiler_conditional_xfail_data |
|
if { [llength $args] > 0 } { |
set additional_flags [lindex $args 0] |
} else { |
set additional_flags "" |
} |
# Check for alternate driver. |
if [file exists [file rootname $src].x] { |
verbose "Using alternate driver [file rootname [file tail $src]].x" 2 |
set done_p 0 |
catch "set done_p \[source [file rootname $src].x\]" |
if { $done_p } { |
return |
} |
} |
|
# Look for a loop within the source code - if we don't find one, |
# don't pass -funroll[-all]-loops. |
global torture_with_loops torture_without_loops |
if [expr [search_for $src "for*("]+[search_for $src "while*("]] then { |
set option_list $torture_with_loops |
} else { |
set option_list $torture_without_loops |
} |
|
set executable $tmpdir/[file tail [file rootname $src].x] |
|
regsub "(?q)$srcdir/" $src "" testcase |
# If we couldn't rip $srcdir out of `src' then just do the best we can. |
# The point is to reduce the unnecessary noise in the logs. Don't strip |
# out too much because different testcases with the same name can confuse |
# `test-tool'. |
if [string match "/*" $testcase] { |
set testcase "[file tail [file dirname $src]]/[file tail $src]" |
} |
|
set count 0 |
set oldstatus "foo" |
foreach option $option_list { |
if { $count > 0 } { |
if [info exists oldexec] { |
remote_file build delete $oldexec |
} |
set oldexec $execname |
} |
set execname "${executable}${count}" |
incr count |
|
# torture_{compile,execute}_xfail are set by the .x script |
# (if present) |
if [info exists torture_compile_xfail] { |
setup_xfail $torture_compile_xfail |
} |
|
# torture_execute_before_{compile,execute} can be set by the .x script |
# (if present) |
if [info exists torture_eval_before_compile] { |
set ignore_me [eval $torture_eval_before_compile] |
} |
|
remote_file build delete $execname |
verbose "Testing $testcase, $option" 1 |
|
set options "" |
lappend options "additional_flags=-w $option" |
if { $additional_flags != "" } { |
lappend options "additional_flags=$additional_flags" |
} |
set comp_output [objc_target_compile "$src" "${execname}" executable $options] |
|
if ![objc_check_compile "$testcase compilation" $option $execname $comp_output] { |
unresolved "$testcase execution, $option" |
remote_file build delete $execname |
continue |
} |
|
# See if this source file uses "long long" types, if it does, and |
# no_long_long is set, skip execution of the test. |
if [target_info exists no_long_long] then { |
if [expr [search_for $src "long long"]] then { |
unsupported "$testcase execution, $option" |
remote_file build delete $execname |
continue |
} |
} |
|
if [info exists torture_execute_xfail] { |
setup_xfail $torture_execute_xfail |
} |
|
if [info exists torture_eval_before_execute] { |
set ignore_me [eval $torture_eval_before_execute] |
} |
|
|
# Sometimes we end up creating identical executables for two |
# consecutive sets of different of compiler options. |
# |
# In such cases we know the result of this test will be identical |
# to the result of the last test. |
# |
# So in cases where the time to load and run/simulate the test |
# is relatively high, compare the two binaries and avoid rerunning |
# tests if the executables are identical. |
# |
# Do not do this for native testing since the cost to load/execute |
# the test is fairly small and the comparison step actually slows |
# the entire process down because it usually does not "hit". |
set skip 0 |
if { ![isnative] && [info exists oldexec] } { |
if { [remote_file build cmp $oldexec $execname] == 0 } { |
set skip 1 |
set status $oldstatus |
} |
} |
if { $skip == 0 } { |
set result [objc_load "$execname" "" ""] |
set status [lindex $result 0] |
set output [lindex $result 1] |
} |
$status "$testcase execution, $option" |
set oldstatus $status |
# for each option |
} |
# tidy up |
if [info exists execname] { |
remote_file build delete $execname |
} |
if [info exists oldexec] { |
remote_file build delete $oldexec |
} |
} |
|
# |
# search_for -- looks for a string match in a file |
# |
proc search_for { file pattern } { |
set fd [open $file r] |
while { [gets $fd cur_line]>=0 } { |
if [string match "*$pattern*" $cur_line] then { |
close $fd |
return 1 |
} |
} |
close $fd |
return 0 |
} |
|
# |
# objc-torture -- the objc-torture testcase source file processor |
# |
# This runs compilation only tests (no execute tests). |
# SRC is the full pathname of the testcase, or just a file name in which case |
# we prepend $srcdir/$subdir. |
# |
# If the testcase has an associated .x file, we source that to run the |
# test instead. We use .x so that we don't lengthen the existing filename |
# to more than 14 chars. |
# |
proc objc-torture { args } { |
global srcdir subdir compiler_conditional_xfail_data |
|
set src [lindex $args 0] |
if { [llength $args] > 1 } { |
set options [lindex $args 1] |
} else { |
set options "" |
} |
|
# Prepend $srdir/$subdir if missing. |
if ![string match "*/*" $src] { |
set src "$srcdir/$subdir/$src" |
} |
|
# Check for alternate driver. |
if [file exists [file rootname $src].x] { |
verbose "Using alternate driver [file rootname [file tail $src]].x" 2 |
set done_p 0 |
catch "set done_p \[source [file rootname $src].x\]" |
if { $done_p } { |
return |
} |
} |
|
# Look for a loop within the source code - if we don't find one, |
# don't pass -funroll[-all]-loops. |
global torture_with_loops torture_without_loops |
if [expr [search_for $src "for*("]+[search_for $src "while*("]] then { |
set option_list $torture_with_loops |
} else { |
set option_list $torture_without_loops |
} |
|
# loop through all the options |
foreach option $option_list { |
# torture_compile_xfail is set by the .x script (if present) |
if [info exists torture_compile_xfail] { |
setup_xfail $torture_compile_xfail |
} |
|
# torture_execute_before_compile is set by the .x script (if present) |
if [info exists torture_eval_before_compile] { |
set ignore_me [eval $torture_eval_before_compile] |
} |
|
objc-torture-compile $src "$option $options" |
} |
} |
/testsuite/lib/gfortran.exp
0,0 → 1,221
# Copyright (C) 2003, 2004, 2005, 2007, 2008, 2009 |
# 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 |
# <http://www.gnu.org/licenses/>. |
|
# This file is just 'sed -e 's/77/fortran/g' \ |
# -e 's/f2c/gfortran' g77.exp > gfortran.exp' |
# |
# with some minor modifications to make it work. |
|
# |
# gfortran support library routines |
# |
load_lib prune.exp |
load_lib gcc-defs.exp |
load_lib timeout.exp |
load_lib target-libpath.exp |
load_lib target-supports.exp |
|
# |
# GFORTRAN_UNDER_TEST is the compiler under test. |
# |
|
|
set gpp_compile_options "" |
|
|
# |
# gfortran_version -- extract and print the version number of the compiler |
# |
|
proc gfortran_version { } { |
global GFORTRAN_UNDER_TEST |
|
gfortran_init |
|
# ignore any arguments after the command |
set compiler [lindex $GFORTRAN_UNDER_TEST 0] |
|
# verify that the compiler exists |
if { [is_remote host] || [which $compiler] != 0 } then { |
set tmp [remote_exec host "$compiler -v"] |
set status [lindex $tmp 0] |
set output [lindex $tmp 1] |
regexp " version \[^\n\r\]*" $output version |
if { $status == 0 && [info exists version] } then { |
if [is_remote host] { |
clone_output "$compiler $version\n" |
} else { |
clone_output "[which $compiler] $version\n" |
} |
} else { |
clone_output "Couldn't determine version of [which $compiler]\n" |
} |
} else { |
# compiler does not exist (this should have already been detected) |
warning "$compiler does not exist" |
} |
} |
|
# |
# gfortran_link_flags -- provide new version of gfortran_link_flags |
# (originally from libgloss.exp) which knows about the gcc tree structure |
# |
|
proc gfortran_link_flags { paths } { |
global srcdir |
global ld_library_path |
global GFORTRAN_UNDER_TEST |
global shlib_ext |
|
set gccpath ${paths} |
set libio_dir "" |
set flags "" |
set ld_library_path "." |
set shlib_ext [get_shlib_extension] |
verbose "shared lib extension: $shlib_ext" |
|
if { $gccpath != "" } { |
if [file exists "${gccpath}/libgfortran/.libs/libgfortran.a"] { |
# Some targets use libgfortran.a%s in their specs, so they need a -B option |
# for uninstalled testing. |
append flags "-B${gccpath}/libgfortran/.libs " |
append flags "-L${gccpath}/libgfortran/.libs " |
append ld_library_path ":${gccpath}/libgfortran/.libs" |
} |
if [file exists "${gccpath}/libgfortran/.libs/libgfortran.${shlib_ext}"] { |
append flags "-L${gccpath}/libgfortran/.libs " |
append ld_library_path ":${gccpath}/libgfortran/.libs" |
} |
if [file exists "${gccpath}/libgfortran/libgforbegin.a"] { |
append flags "-L${gccpath}/libgfortran " |
} |
if [file exists "${gccpath}/libiberty/libiberty.a"] { |
append flags "-L${gccpath}/libiberty " |
} |
append ld_library_path \ |
[gcc-set-multilib-library-path $GFORTRAN_UNDER_TEST] |
} |
|
set_ld_library_path_env_vars |
|
return "$flags" |
} |
|
# |
# gfortran_init -- called at the start of each subdir of tests |
# |
|
proc gfortran_init { args } { |
global subdir |
global gpp_initialized |
global base_dir |
global tmpdir |
global libdir |
global gluefile wrap_flags |
global objdir srcdir |
global ALWAYS_GFORTRANFLAGS |
global TOOL_EXECUTABLE TOOL_OPTIONS |
global GFORTRAN_UNDER_TEST |
global TESTING_IN_BUILD_TREE |
|
# We set LC_ALL and LANG to C so that we get the same error messages as expected. |
setenv LC_ALL C |
setenv LANG C |
|
# Many hosts now default to a non-ASCII C locale, however, so |
# they can set a charset encoding here if they need. |
if { [ishost "*-*-cygwin*"] } { |
setenv LC_ALL C.ASCII |
setenv LANG C.ASCII |
} |
|
if ![info exists GFORTRAN_UNDER_TEST] then { |
if [info exists TOOL_EXECUTABLE] { |
set GFORTRAN_UNDER_TEST $TOOL_EXECUTABLE |
} else { |
if { [is_remote host] || ! [info exists TESTING_IN_BUILD_TREE] } { |
set GFORTRAN_UNDER_TEST [transform gfortran] |
} else { |
set GFORTRAN_UNDER_TEST [findfile $base_dir/../../gfortran "$base_dir/../../gfortran -B$base_dir/../../" [findfile $base_dir/gfortran "$base_dir/gfortran -B$base_dir/" [transform gfortran]]] |
} |
} |
} |
|
if ![is_remote host] { |
if { [which $GFORTRAN_UNDER_TEST] == 0 } then { |
perror "GFORTRAN_UNDER_TEST ($GFORTRAN_UNDER_TEST) does not exist" |
exit 1 |
} |
} |
if ![info exists tmpdir] { |
set tmpdir "/tmp" |
} |
|
if [info exists gluefile] { |
unset gluefile |
} |
|
gfortran_maybe_build_wrapper "${tmpdir}/gfortran-testglue.o" |
|
set ALWAYS_GFORTRANFLAGS "" |
|
if ![is_remote host] { |
if [info exists TOOL_OPTIONS] { |
lappend ALWAYS_GFORTRANFLAGS "ldflags=[gfortran_link_flags [get_multilibs ${TOOL_OPTIONS}] ]" |
} else { |
lappend ALWAYS_GFORTRANFLAGS "ldflags=[gfortran_link_flags [get_multilibs] ]" |
} |
} |
|
if [info exists TOOL_OPTIONS] { |
lappend ALWAYS_GFORTRANFLAGS "additional_flags=$TOOL_OPTIONS" |
} |
|
# On the SPU, most of the fortran test cases exceed local store size. |
# Use automatic overlay support to make them fit. |
if { [check_effective_target_spu_auto_overlay] } { |
lappend ALWAYS_GFORTRANFLAGS "ldflags=-Wl,--auto-overlay" |
lappend ALWAYS_GFORTRANFLAGS "ldflags=-Wl,--reserved-space=131072" |
} |
|
verbose -log "ALWAYS_GFORTRANFLAGS set to $ALWAYS_GFORTRANFLAGS" |
|
verbose "gfortran is initialized" 3 |
} |
|
# |
# gfortran_target_compile -- compile a source file |
# |
|
proc gfortran_target_compile { source dest type options } { |
global tmpdir |
global gluefile wrap_flags |
global ALWAYS_GFORTRANFLAGS |
global GFORTRAN_UNDER_TEST |
|
if { [target_info needs_status_wrapper] != "" && [info exists gluefile] } { |
lappend options "libs=${gluefile}" |
lappend options "ldflags=${wrap_flags}" |
} |
|
lappend options "compiler=$GFORTRAN_UNDER_TEST" |
lappend options "timeout=[timeout_value]" |
|
set options [concat "$ALWAYS_GFORTRANFLAGS" $options] |
set options [dg-additional-files-options $options $source] |
return [target_compile $source $dest $type $options] |
} |
/testsuite/lib/target-supports.exp
0,0 → 1,3334
# Copyright (C) 1999, 2001, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 |
# 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 |
# <http://www.gnu.org/licenses/>. |
|
# Please email any bugs, comments, and/or additions to this file to: |
# gcc-patches@gcc.gnu.org |
|
# This file defines procs for determining features supported by the target. |
|
# Try to compile the code given by CONTENTS into an output file of |
# type TYPE, where TYPE is as for target_compile. Return a list |
# whose first element contains the compiler messages and whose |
# second element is the name of the output file. |
# |
# BASENAME is a prefix to use for source and output files. |
# If ARGS is not empty, its first element is a string that |
# should be added to the command line. |
# |
# Assume by default that CONTENTS is C code. |
# Otherwise, code should contain: |
# "// C++" for c++, |
# "! Fortran" for Fortran code, |
# "/* ObjC", for ObjC |
# and "// ObjC++" for ObjC++ |
# If the tool is ObjC/ObjC++ then we overide the extension to .m/.mm to |
# allow for ObjC/ObjC++ specific flags. |
proc check_compile {basename type contents args} { |
global tool |
verbose "check_compile tool: $tool for $basename" |
|
if { [llength $args] > 0 } { |
set options [list "additional_flags=[lindex $args 0]"] |
} else { |
set options "" |
} |
switch -glob -- $contents { |
"*! Fortran*" { set src ${basename}[pid].f90 } |
"*// C++*" { set src ${basename}[pid].cc } |
"*// ObjC++*" { set src ${basename}[pid].mm } |
"*/* ObjC*" { set src ${basename}[pid].m } |
default { |
switch -- $tool { |
"objc" { set src ${basename}[pid].m } |
"obj-c++" { set src ${basename}[pid].mm } |
default { set src ${basename}[pid].c } |
} |
} |
} |
|
set compile_type $type |
switch -glob $type { |
assembly { set output ${basename}[pid].s } |
object { set output ${basename}[pid].o } |
executable { set output ${basename}[pid].exe } |
"rtl-*" { |
set output ${basename}[pid].s |
lappend options "additional_flags=-fdump-$type" |
set compile_type assembly |
} |
} |
set f [open $src "w"] |
puts $f $contents |
close $f |
set lines [${tool}_target_compile $src $output $compile_type "$options"] |
file delete $src |
|
set scan_output $output |
# Don't try folding this into the switch above; calling "glob" before the |
# file is created won't work. |
if [regexp "rtl-(.*)" $type dummy rtl_type] { |
set scan_output "[glob $src.\[0-9\]\[0-9\]\[0-9\]r.$rtl_type]" |
file delete $output |
} |
|
return [list $lines $scan_output] |
} |
|
proc current_target_name { } { |
global target_info |
if [info exists target_info(target,name)] { |
set answer $target_info(target,name) |
} else { |
set answer "" |
} |
return $answer |
} |
|
# Implement an effective-target check for property PROP by invoking |
# the Tcl command ARGS and seeing if it returns true. |
|
proc check_cached_effective_target { prop args } { |
global et_cache |
|
set target [current_target_name] |
if {![info exists et_cache($prop,target)] |
|| $et_cache($prop,target) != $target} { |
verbose "check_cached_effective_target $prop: checking $target" 2 |
set et_cache($prop,target) $target |
set et_cache($prop,value) [uplevel eval $args] |
} |
set value $et_cache($prop,value) |
verbose "check_cached_effective_target $prop: returning $value for $target" 2 |
return $value |
} |
|
# Like check_compile, but delete the output file and return true if the |
# compiler printed no messages. |
proc check_no_compiler_messages_nocache {args} { |
set result [eval check_compile $args] |
set lines [lindex $result 0] |
set output [lindex $result 1] |
remote_file build delete $output |
return [string match "" $lines] |
} |
|
# Like check_no_compiler_messages_nocache, but cache the result. |
# PROP is the property we're checking, and doubles as a prefix for |
# temporary filenames. |
proc check_no_compiler_messages {prop args} { |
return [check_cached_effective_target $prop { |
eval [list check_no_compiler_messages_nocache $prop] $args |
}] |
} |
|
# Like check_compile, but return true if the compiler printed no |
# messages and if the contents of the output file satisfy PATTERN. |
# If PATTERN has the form "!REGEXP", the contents satisfy it if they |
# don't match regular expression REGEXP, otherwise they satisfy it |
# if they do match regular expression PATTERN. (PATTERN can start |
# with something like "[!]" if the regular expression needs to match |
# "!" as the first character.) |
# |
# Delete the output file before returning. The other arguments are |
# as for check_compile. |
proc check_no_messages_and_pattern_nocache {basename pattern args} { |
global tool |
|
set result [eval [list check_compile $basename] $args] |
set lines [lindex $result 0] |
set output [lindex $result 1] |
|
set ok 0 |
if { [string match "" $lines] } { |
set chan [open "$output"] |
set invert [regexp {^!(.*)} $pattern dummy pattern] |
set ok [expr { [regexp $pattern [read $chan]] != $invert }] |
close $chan |
} |
|
remote_file build delete $output |
return $ok |
} |
|
# Like check_no_messages_and_pattern_nocache, but cache the result. |
# PROP is the property we're checking, and doubles as a prefix for |
# temporary filenames. |
proc check_no_messages_and_pattern {prop pattern args} { |
return [check_cached_effective_target $prop { |
eval [list check_no_messages_and_pattern_nocache $prop $pattern] $args |
}] |
} |
|
# Try to compile and run an executable from code CONTENTS. Return true |
# if the compiler reports no messages and if execution "passes" in the |
# usual DejaGNU sense. The arguments are as for check_compile, with |
# TYPE implicitly being "executable". |
proc check_runtime_nocache {basename contents args} { |
global tool |
|
set result [eval [list check_compile $basename executable $contents] $args] |
set lines [lindex $result 0] |
set output [lindex $result 1] |
|
set ok 0 |
if { [string match "" $lines] } { |
# No error messages, everything is OK. |
set result [remote_load target "./$output" "" ""] |
set status [lindex $result 0] |
verbose "check_runtime_nocache $basename: status is <$status>" 2 |
if { $status == "pass" } { |
set ok 1 |
} |
} |
remote_file build delete $output |
return $ok |
} |
|
# Like check_runtime_nocache, but cache the result. PROP is the |
# property we're checking, and doubles as a prefix for temporary |
# filenames. |
proc check_runtime {prop args} { |
global tool |
|
return [check_cached_effective_target $prop { |
eval [list check_runtime_nocache $prop] $args |
}] |
} |
|
############################### |
# proc check_weak_available { } |
############################### |
|
# weak symbols are only supported in some configs/object formats |
# this proc returns 1 if they're supported, 0 if they're not, or -1 if unsure |
|
proc check_weak_available { } { |
global target_triplet |
global target_cpu |
|
# All mips targets should support it |
|
if { [ string first "mips" $target_cpu ] >= 0 } { |
return 1 |
} |
|
# All solaris2 targets should support it |
|
if { [regexp ".*-solaris2.*" $target_triplet] } { |
return 1 |
} |
|
# DEC OSF/1/Digital UNIX/Tru64 UNIX supports it |
|
if { [regexp "alpha.*osf.*" $target_triplet] } { |
return 1 |
} |
|
# Windows targets Cygwin and MingW32 support it |
|
if { [regexp ".*mingw32|.*cygwin" $target_triplet] } { |
return 1 |
} |
|
# HP-UX 10.X doesn't support it |
|
if { [istarget "hppa*-*-hpux10*"] } { |
return 0 |
} |
|
# ELF and ECOFF support it. a.out does with gas/gld but may also with |
# other linkers, so we should try it |
|
set objformat [gcc_target_object_format] |
|
switch $objformat { |
elf { return 1 } |
ecoff { return 1 } |
a.out { return 1 } |
mach-o { return 1 } |
som { return 1 } |
unknown { return -1 } |
default { return 0 } |
} |
} |
|
############################### |
# proc check_weak_override_available { } |
############################### |
|
# Like check_weak_available, but return 0 if weak symbol definitions |
# cannot be overridden. |
|
proc check_weak_override_available { } { |
if { [istarget "*-*-mingw*"] } { |
return 0 |
} |
return [check_weak_available] |
} |
|
############################### |
# proc check_visibility_available { what_kind } |
############################### |
|
# The visibility attribute is only support in some object formats |
# This proc returns 1 if it is supported, 0 if not. |
# The argument is the kind of visibility, default/protected/hidden/internal. |
|
proc check_visibility_available { what_kind } { |
global tool |
global target_triplet |
|
# On NetWare, support makes no sense. |
if { [istarget *-*-netware*] } { |
return 0 |
} |
|
if [string match "" $what_kind] { set what_kind "hidden" } |
|
return [check_no_compiler_messages visibility_available_$what_kind object " |
void f() __attribute__((visibility(\"$what_kind\"))); |
void f() {} |
"] |
} |
|
############################### |
# proc check_alias_available { } |
############################### |
|
# Determine if the target toolchain supports the alias attribute. |
|
# Returns 2 if the target supports aliases. Returns 1 if the target |
# only supports weak aliased. Returns 0 if the target does not |
# support aliases at all. Returns -1 if support for aliases could not |
# be determined. |
|
proc check_alias_available { } { |
global alias_available_saved |
global tool |
|
if [info exists alias_available_saved] { |
verbose "check_alias_available returning saved $alias_available_saved" 2 |
} else { |
set src alias[pid].c |
set obj alias[pid].o |
verbose "check_alias_available compiling testfile $src" 2 |
set f [open $src "w"] |
# Compile a small test program. The definition of "g" is |
# necessary to keep the Solaris assembler from complaining |
# about the program. |
puts $f "#ifdef __cplusplus\nextern \"C\"\n#endif\n" |
puts $f "void g() {} void f() __attribute__((alias(\"g\")));" |
close $f |
set lines [${tool}_target_compile $src $obj object ""] |
file delete $src |
remote_file build delete $obj |
|
if [string match "" $lines] then { |
# No error messages, everything is OK. |
set alias_available_saved 2 |
} else { |
if [regexp "alias definitions not supported" $lines] { |
verbose "check_alias_available target does not support aliases" 2 |
|
set objformat [gcc_target_object_format] |
|
if { $objformat == "elf" } { |
verbose "check_alias_available but target uses ELF format, so it ought to" 2 |
set alias_available_saved -1 |
} else { |
set alias_available_saved 0 |
} |
} else { |
if [regexp "only weak aliases are supported" $lines] { |
verbose "check_alias_available target supports only weak aliases" 2 |
set alias_available_saved 1 |
} else { |
set alias_available_saved -1 |
} |
} |
} |
|
verbose "check_alias_available returning $alias_available_saved" 2 |
} |
|
return $alias_available_saved |
} |
|
# Returns true if --gc-sections is supported on the target. |
|
proc check_gc_sections_available { } { |
global gc_sections_available_saved |
global tool |
|
if {![info exists gc_sections_available_saved]} { |
# Some targets don't support gc-sections despite whatever's |
# advertised by ld's options. |
if { [istarget alpha*-*-*] |
|| [istarget ia64-*-*] } { |
set gc_sections_available_saved 0 |
return 0 |
} |
|
# elf2flt uses -q (--emit-relocs), which is incompatible with |
# --gc-sections. |
if { [board_info target exists ldflags] |
&& [regexp " -elf2flt\[ =\]" " [board_info target ldflags] "] } { |
set gc_sections_available_saved 0 |
return 0 |
} |
|
# VxWorks kernel modules are relocatable objects linked with -r, |
# while RTP executables are linked with -q (--emit-relocs). |
# Both of these options are incompatible with --gc-sections. |
if { [istarget *-*-vxworks*] } { |
set gc_sections_available_saved 0 |
return 0 |
} |
|
# Check if the ld used by gcc supports --gc-sections. |
set gcc_spec [${tool}_target_compile "-dumpspecs" "" "none" ""] |
regsub ".*\n\\*linker:\[ \t\]*\n(\[^ \t\n\]*).*" "$gcc_spec" {\1} linker |
set gcc_ld [lindex [${tool}_target_compile "-print-prog-name=$linker" "" "none" ""] 0] |
set ld_output [remote_exec host "$gcc_ld" "--help"] |
if { [ string first "--gc-sections" $ld_output ] >= 0 } { |
set gc_sections_available_saved 1 |
} else { |
set gc_sections_available_saved 0 |
} |
} |
return $gc_sections_available_saved |
} |
|
# Return 1 if according to target_info struct and explicit target list |
# target is supposed to support trampolines. |
|
proc check_effective_target_trampolines { } { |
if [target_info exists no_trampolines] { |
return 0 |
} |
if { [istarget avr-*-*] |
|| [istarget hppa2.0w-hp-hpux11.23] |
|| [istarget hppa64-hp-hpux11.23] } { |
return 0; |
} |
return 1 |
} |
|
# Return 1 if according to target_info struct and explicit target list |
# target is supposed to keep null pointer checks. This could be due to |
# use of option fno-delete-null-pointer-checks or hardwired in target. |
|
proc check_effective_target_keeps_null_pointer_checks { } { |
if [target_info exists keeps_null_pointer_checks] { |
return 1 |
} |
if { [istarget avr-*-*] } { |
return 1; |
} |
return 0 |
} |
|
# Return true if profiling is supported on the target. |
|
proc check_profiling_available { test_what } { |
global profiling_available_saved |
|
verbose "Profiling argument is <$test_what>" 1 |
|
# These conditions depend on the argument so examine them before |
# looking at the cache variable. |
|
# Support for -p on solaris2 relies on mcrt1.o which comes with the |
# vendor compiler. We cannot reliably predict the directory where the |
# vendor compiler (and thus mcrt1.o) is installed so we can't |
# necessarily find mcrt1.o even if we have it. |
if { [istarget *-*-solaris2*] && [lindex $test_what 1] == "-p" } { |
return 0 |
} |
|
# Support for -p on irix relies on libprof1.a which doesn't appear to |
# exist on any irix6 system currently posting testsuite results. |
# Support for -pg on irix relies on gcrt1.o which doesn't exist yet. |
# See: http://gcc.gnu.org/ml/gcc/2002-10/msg00169.html |
if { [istarget mips*-*-irix*] |
&& ([lindex $test_what 1] == "-p" || [lindex $test_what 1] == "-pg") } { |
return 0 |
} |
|
# We don't yet support profiling for MIPS16. |
if { [istarget mips*-*-*] |
&& ![check_effective_target_nomips16] |
&& ([lindex $test_what 1] == "-p" |
|| [lindex $test_what 1] == "-pg") } { |
return 0 |
} |
|
# MinGW does not support -p. |
if { [istarget *-*-mingw*] && [lindex $test_what 1] == "-p" } { |
return 0 |
} |
|
# cygwin does not support -p. |
if { [istarget *-*-cygwin*] && [lindex $test_what 1] == "-p" } { |
return 0 |
} |
|
# uClibc does not have gcrt1.o. |
if { [check_effective_target_uclibc] |
&& ([lindex $test_what 1] == "-p" |
|| [lindex $test_what 1] == "-pg") } { |
return 0 |
} |
|
# Now examine the cache variable. |
if {![info exists profiling_available_saved]} { |
# Some targets don't have any implementation of __bb_init_func or are |
# missing other needed machinery. |
if { [istarget mmix-*-*] |
|| [istarget arm*-*-eabi*] |
|| [istarget picochip-*-*] |
|| [istarget *-*-netware*] |
|| [istarget arm*-*-elf] |
|| [istarget arm*-*-symbianelf*] |
|| [istarget avr-*-*] |
|| [istarget bfin-*-*] |
|| [istarget powerpc-*-eabi*] |
|| [istarget powerpc-*-elf] |
|| [istarget cris-*-*] |
|| [istarget crisv32-*-*] |
|| [istarget fido-*-elf] |
|| [istarget h8300-*-*] |
|| [istarget lm32-*-*] |
|| [istarget m32c-*-elf] |
|| [istarget m68k-*-elf] |
|| [istarget m68k-*-uclinux*] |
|| [istarget mep-*-elf] |
|| [istarget mips*-*-elf*] |
|| [istarget moxie-*-elf*] |
|| [istarget rx-*-*] |
|| [istarget xstormy16-*] |
|| [istarget xtensa*-*-elf] |
|| [istarget *-*-rtems*] |
|| [istarget *-*-vxworks*] } { |
set profiling_available_saved 0 |
} else { |
set profiling_available_saved 1 |
} |
} |
|
return $profiling_available_saved |
} |
|
# Check to see if a target is "freestanding". This is as per the definition |
# in Section 4 of C99 standard. Effectively, it is a target which supports no |
# extra headers or libraries other than what is considered essential. |
proc check_effective_target_freestanding { } { |
if { [istarget picochip-*-*] } then { |
return 1 |
} else { |
return 0 |
} |
} |
|
# Return 1 if target has packed layout of structure members by |
# default, 0 otherwise. Note that this is slightly different than |
# whether the target has "natural alignment": both attributes may be |
# false. |
|
proc check_effective_target_default_packed { } { |
return [check_no_compiler_messages default_packed assembly { |
struct x { char a; long b; } c; |
int s[sizeof (c) == sizeof (char) + sizeof (long) ? 1 : -1]; |
}] |
} |
|
# Return 1 if target has PCC_BITFIELD_TYPE_MATTERS defined. See |
# documentation, where the test also comes from. |
|
proc check_effective_target_pcc_bitfield_type_matters { } { |
# PCC_BITFIELD_TYPE_MATTERS isn't just about unnamed or empty |
# bitfields, but let's stick to the example code from the docs. |
return [check_no_compiler_messages pcc_bitfield_type_matters assembly { |
struct foo1 { char x; char :0; char y; }; |
struct foo2 { char x; int :0; char y; }; |
int s[sizeof (struct foo1) != sizeof (struct foo2) ? 1 : -1]; |
}] |
} |
|
# Return 1 if thread local storage (TLS) is supported, 0 otherwise. |
|
proc check_effective_target_tls {} { |
return [check_no_compiler_messages tls assembly { |
__thread int i; |
int f (void) { return i; } |
void g (int j) { i = j; } |
}] |
} |
|
# Return 1 if *native* thread local storage (TLS) is supported, 0 otherwise. |
|
proc check_effective_target_tls_native {} { |
# VxWorks uses emulated TLS machinery, but with non-standard helper |
# functions, so we fail to automatically detect it. |
global target_triplet |
if { [regexp ".*-.*-vxworks.*" $target_triplet] } { |
return 0 |
} |
|
return [check_no_messages_and_pattern tls_native "!emutls" assembly { |
__thread int i; |
int f (void) { return i; } |
void g (int j) { i = j; } |
}] |
} |
|
# Return 1 if TLS executables can run correctly, 0 otherwise. |
|
proc check_effective_target_tls_runtime {} { |
return [check_runtime tls_runtime { |
__thread int thr = 0; |
int main (void) { return thr; } |
}] |
} |
|
# Return 1 if compilation with -fgraphite is error-free for trivial |
# code, 0 otherwise. |
|
proc check_effective_target_fgraphite {} { |
return [check_no_compiler_messages fgraphite object { |
void foo (void) { } |
} "-O1 -fgraphite"] |
} |
|
# Return 1 if compilation with -fopenmp is error-free for trivial |
# code, 0 otherwise. |
|
proc check_effective_target_fopenmp {} { |
return [check_no_compiler_messages fopenmp object { |
void foo (void) { } |
} "-fopenmp"] |
} |
|
# Return 1 if compilation with -pthread is error-free for trivial |
# code, 0 otherwise. |
|
proc check_effective_target_pthread {} { |
return [check_no_compiler_messages pthread object { |
void foo (void) { } |
} "-pthread"] |
} |
|
# Return 1 if compilation with -mpe-aligned-commons is error-free |
# for trivial code, 0 otherwise. |
|
proc check_effective_target_pe_aligned_commons {} { |
if { [istarget *-*-cygwin*] || [istarget *-*-mingw*] } { |
return [check_no_compiler_messages pe_aligned_commons object { |
int foo; |
} "-mpe-aligned-commons"] |
} |
return 0 |
} |
|
# Return 1 if the target supports -static |
proc check_effective_target_static {} { |
return [check_no_compiler_messages static executable { |
int main (void) { return 0; } |
} "-static"] |
} |
|
# Return 1 if the target supports -fstack-protector |
proc check_effective_target_fstack_protector {} { |
return [check_runtime fstack_protector { |
int main (void) { return 0; } |
} "-fstack-protector"] |
} |
|
# Return 1 if compilation with -freorder-blocks-and-partition is error-free |
# for trivial code, 0 otherwise. |
|
proc check_effective_target_freorder {} { |
return [check_no_compiler_messages freorder object { |
void foo (void) { } |
} "-freorder-blocks-and-partition"] |
} |
|
# Return 1 if -fpic and -fPIC are supported, as in no warnings or errors |
# emitted, 0 otherwise. Whether a shared library can actually be built is |
# out of scope for this test. |
|
proc check_effective_target_fpic { } { |
# Note that M68K has a multilib that supports -fpic but not |
# -fPIC, so we need to check both. We test with a program that |
# requires GOT references. |
foreach arg {fpic fPIC} { |
if [check_no_compiler_messages $arg object { |
extern int foo (void); extern int bar; |
int baz (void) { return foo () + bar; } |
} "-$arg"] { |
return 1 |
} |
} |
return 0 |
} |
|
# Return true if the target supports -mpaired-single (as used on MIPS). |
|
proc check_effective_target_mpaired_single { } { |
return [check_no_compiler_messages mpaired_single object { |
void foo (void) { } |
} "-mpaired-single"] |
} |
|
# Return true if the target has access to FPU instructions. |
|
proc check_effective_target_hard_float { } { |
if { [istarget mips*-*-*] } { |
return [check_no_compiler_messages hard_float assembly { |
#if (defined __mips_soft_float || defined __mips16) |
#error FOO |
#endif |
}] |
} |
|
# This proc is actually checking the availabilty of FPU |
# support for doubles, so on the RX we must fail if the |
# 64-bit double multilib has been selected. |
if { [istarget rx-*-*] } { |
return 0 |
# return [check_no_compiler_messages hard_float assembly { |
#if defined __RX_64_BIT_DOUBLES__ |
#error FOO |
#endif |
# }] |
} |
|
# The generic test equates hard_float with "no call for adding doubles". |
return [check_no_messages_and_pattern hard_float "!\\(call" rtl-expand { |
double a (double b, double c) { return b + c; } |
}] |
} |
|
# Return true if the target is a 64-bit MIPS target. |
|
proc check_effective_target_mips64 { } { |
return [check_no_compiler_messages mips64 assembly { |
#ifndef __mips64 |
#error FOO |
#endif |
}] |
} |
|
# Return true if the target is a MIPS target that does not produce |
# MIPS16 code. |
|
proc check_effective_target_nomips16 { } { |
return [check_no_compiler_messages nomips16 object { |
#ifndef __mips |
#error FOO |
#else |
/* A cheap way of testing for -mflip-mips16. */ |
void foo (void) { asm ("addiu $20,$20,1"); } |
void bar (void) { asm ("addiu $20,$20,1"); } |
#endif |
}] |
} |
|
# Add the options needed for MIPS16 function attributes. At the moment, |
# we don't support MIPS16 PIC. |
|
proc add_options_for_mips16_attribute { flags } { |
return "$flags -mno-abicalls -fno-pic -DMIPS16=__attribute__((mips16))" |
} |
|
# Return true if we can force a mode that allows MIPS16 code generation. |
# We don't support MIPS16 PIC, and only support MIPS16 -mhard-float |
# for o32 and o64. |
|
proc check_effective_target_mips16_attribute { } { |
return [check_no_compiler_messages mips16_attribute assembly { |
#ifdef PIC |
#error FOO |
#endif |
#if defined __mips_hard_float \ |
&& (!defined _ABIO32 || _MIPS_SIM != _ABIO32) \ |
&& (!defined _ABIO64 || _MIPS_SIM != _ABIO64) |
#error FOO |
#endif |
} [add_options_for_mips16_attribute ""]] |
} |
|
# Return 1 if the target supports long double larger than double when |
# using the new ABI, 0 otherwise. |
|
proc check_effective_target_mips_newabi_large_long_double { } { |
return [check_no_compiler_messages mips_newabi_large_long_double object { |
int dummy[sizeof(long double) > sizeof(double) ? 1 : -1]; |
} "-mabi=64"] |
} |
|
# Return 1 if the current multilib does not generate PIC by default. |
|
proc check_effective_target_nonpic { } { |
return [check_no_compiler_messages nonpic assembly { |
#if __PIC__ |
#error FOO |
#endif |
}] |
} |
|
# Return 1 if the target does not use a status wrapper. |
|
proc check_effective_target_unwrapped { } { |
if { [target_info needs_status_wrapper] != "" \ |
&& [target_info needs_status_wrapper] != "0" } { |
return 0 |
} |
return 1 |
} |
|
# Return true if iconv is supported on the target. In particular IBM1047. |
|
proc check_iconv_available { test_what } { |
global libiconv |
|
# If the tool configuration file has not set libiconv, try "-liconv" |
if { ![info exists libiconv] } { |
set libiconv "-liconv" |
} |
set test_what [lindex $test_what 1] |
return [check_runtime_nocache $test_what [subst { |
#include <iconv.h> |
int main (void) |
{ |
iconv_t cd; |
|
cd = iconv_open ("$test_what", "UTF-8"); |
if (cd == (iconv_t) -1) |
return 1; |
return 0; |
} |
}] $libiconv] |
} |
|
# Return true if named sections are supported on this target. |
|
proc check_named_sections_available { } { |
return [check_no_compiler_messages named_sections assembly { |
int __attribute__ ((section("whatever"))) foo; |
}] |
} |
|
# Return 1 if the target supports Fortran real kinds larger than real(8), |
# 0 otherwise. |
# |
# When the target name changes, replace the cached result. |
|
proc check_effective_target_fortran_large_real { } { |
return [check_no_compiler_messages fortran_large_real executable { |
! Fortran |
integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1) |
real(kind=k) :: x |
x = cos (x) |
end |
}] |
} |
|
# Return 1 if the target supports Fortran integer kinds larger than |
# integer(8), 0 otherwise. |
# |
# When the target name changes, replace the cached result. |
|
proc check_effective_target_fortran_large_int { } { |
return [check_no_compiler_messages fortran_large_int executable { |
! Fortran |
integer,parameter :: k = selected_int_kind (range (0_8) + 1) |
integer(kind=k) :: i |
end |
}] |
} |
|
# Return 1 if the target supports Fortran integer(16), 0 otherwise. |
# |
# When the target name changes, replace the cached result. |
|
proc check_effective_target_fortran_integer_16 { } { |
return [check_no_compiler_messages fortran_integer_16 executable { |
! Fortran |
integer(16) :: i |
end |
}] |
} |
|
# Return 1 if we can statically link libgfortran, 0 otherwise. |
# |
# When the target name changes, replace the cached result. |
|
proc check_effective_target_static_libgfortran { } { |
return [check_no_compiler_messages static_libgfortran executable { |
! Fortran |
print *, 'test' |
end |
} "-static"] |
} |
|
# Return 1 if the target supports executing 750CL paired-single instructions, 0 |
# otherwise. Cache the result. |
|
proc check_750cl_hw_available { } { |
return [check_cached_effective_target 750cl_hw_available { |
# If this is not the right target then we can skip the test. |
if { ![istarget powerpc-*paired*] } { |
expr 0 |
} else { |
check_runtime_nocache 750cl_hw_available { |
int main() |
{ |
#ifdef __MACH__ |
asm volatile ("ps_mul v0,v0,v0"); |
#else |
asm volatile ("ps_mul 0,0,0"); |
#endif |
return 0; |
} |
} "-mpaired" |
} |
}] |
} |
|
# Return 1 if the target OS supports running SSE executables, 0 |
# otherwise. Cache the result. |
|
proc check_sse_os_support_available { } { |
return [check_cached_effective_target sse_os_support_available { |
# If this is not the right target then we can skip the test. |
if { !([istarget x86_64-*-*] || [istarget i?86-*-*]) } { |
expr 0 |
} elseif { [istarget i?86-*-solaris2*] } { |
# The Solaris 2 kernel doesn't save and restore SSE registers |
# before Solaris 9 4/04. Before that, executables die with SIGILL. |
check_runtime_nocache sse_os_support_available { |
int main () |
{ |
__asm__ volatile ("movss %xmm2,%xmm1"); |
return 0; |
} |
} "-msse" |
} else { |
expr 1 |
} |
}] |
} |
|
# Return 1 if the target supports executing SSE instructions, 0 |
# otherwise. Cache the result. |
|
proc check_sse_hw_available { } { |
return [check_cached_effective_target sse_hw_available { |
# If this is not the right target then we can skip the test. |
if { !([istarget x86_64-*-*] || [istarget i?86-*-*]) } { |
expr 0 |
} else { |
check_runtime_nocache sse_hw_available { |
#include "cpuid.h" |
int main () |
{ |
unsigned int eax, ebx, ecx, edx = 0; |
if (__get_cpuid (1, &eax, &ebx, &ecx, &edx)) |
return !(edx & bit_SSE); |
return 1; |
} |
} "" |
} |
}] |
} |
|
# Return 1 if the target supports executing SSE2 instructions, 0 |
# otherwise. Cache the result. |
|
proc check_sse2_hw_available { } { |
return [check_cached_effective_target sse2_hw_available { |
# If this is not the right target then we can skip the test. |
if { !([istarget x86_64-*-*] || [istarget i?86-*-*]) } { |
expr 0 |
} else { |
check_runtime_nocache sse2_hw_available { |
#include "cpuid.h" |
int main () |
{ |
unsigned int eax, ebx, ecx, edx = 0; |
if (__get_cpuid (1, &eax, &ebx, &ecx, &edx)) |
return !(edx & bit_SSE2); |
return 1; |
} |
} "" |
} |
}] |
} |
|
# Return 1 if the target supports running SSE executables, 0 otherwise. |
|
proc check_effective_target_sse_runtime { } { |
if { [check_sse_hw_available] && [check_sse_os_support_available] } { |
return 1 |
} else { |
return 0 |
} |
} |
|
# Return 1 if the target supports running SSE2 executables, 0 otherwise. |
|
proc check_effective_target_sse2_runtime { } { |
if { [check_sse2_hw_available] && [check_sse_os_support_available] } { |
return 1 |
} else { |
return 0 |
} |
} |
|
# Return 1 if the target supports executing VSX instructions, 0 |
# otherwise. Cache the result. |
|
proc check_vsx_hw_available { } { |
return [check_cached_effective_target vsx_hw_available { |
# Some simulators are known to not support VSX instructions. |
# For now, disable on Darwin |
if { [istarget powerpc-*-eabi] || [istarget powerpc*-*-eabispe] || [istarget *-*-darwin*]} { |
expr 0 |
} else { |
set options "-mvsx" |
check_runtime_nocache vsx_hw_available { |
int main() |
{ |
#ifdef __MACH__ |
asm volatile ("xxlor vs0,vs0,vs0"); |
#else |
asm volatile ("xxlor 0,0,0"); |
#endif |
return 0; |
} |
} $options |
} |
}] |
} |
|
# Return 1 if the target supports executing AltiVec instructions, 0 |
# otherwise. Cache the result. |
|
proc check_vmx_hw_available { } { |
return [check_cached_effective_target vmx_hw_available { |
# Some simulators are known to not support VMX instructions. |
if { [istarget powerpc-*-eabi] || [istarget powerpc*-*-eabispe] } { |
expr 0 |
} else { |
# Most targets don't require special flags for this test case, but |
# Darwin does. Just to be sure, make sure VSX is not enabled for |
# the altivec tests. |
if { [istarget *-*-darwin*] |
|| [istarget *-*-aix*] } { |
set options "-maltivec -mno-vsx" |
} else { |
set options "-mno-vsx" |
} |
check_runtime_nocache vmx_hw_available { |
int main() |
{ |
#ifdef __MACH__ |
asm volatile ("vor v0,v0,v0"); |
#else |
asm volatile ("vor 0,0,0"); |
#endif |
return 0; |
} |
} $options |
} |
}] |
} |
|
# Return 1 if the target supports executing AltiVec and Cell PPU |
# instructions, 0 otherwise. Cache the result. |
|
proc check_effective_target_cell_hw { } { |
return [check_cached_effective_target cell_hw_available { |
# Some simulators are known to not support VMX and PPU instructions. |
if { [istarget powerpc-*-eabi*] } { |
expr 0 |
} else { |
# Most targets don't require special flags for this test |
# case, but Darwin and AIX do. |
if { [istarget *-*-darwin*] |
|| [istarget *-*-aix*] } { |
set options "-maltivec -mcpu=cell" |
} else { |
set options "-mcpu=cell" |
} |
check_runtime_nocache cell_hw_available { |
int main() |
{ |
#ifdef __MACH__ |
asm volatile ("vor v0,v0,v0"); |
asm volatile ("lvlx v0,r0,r0"); |
#else |
asm volatile ("vor 0,0,0"); |
asm volatile ("lvlx 0,0,0"); |
#endif |
return 0; |
} |
} $options |
} |
}] |
} |
|
# Return 1 if the target supports executing 64-bit instructions, 0 |
# otherwise. Cache the result. |
|
proc check_effective_target_powerpc64 { } { |
global powerpc64_available_saved |
global tool |
|
if [info exists powerpc64_available_saved] { |
verbose "check_effective_target_powerpc64 returning saved $powerpc64_available_saved" 2 |
} else { |
set powerpc64_available_saved 0 |
|
# Some simulators are known to not support powerpc64 instructions. |
if { [istarget powerpc-*-eabi*] || [istarget powerpc-ibm-aix*] } { |
verbose "check_effective_target_powerpc64 returning 0" 2 |
return $powerpc64_available_saved |
} |
|
# Set up, compile, and execute a test program containing a 64-bit |
# instruction. Include the current process ID in the file |
# names to prevent conflicts with invocations for multiple |
# testsuites. |
set src ppc[pid].c |
set exe ppc[pid].x |
|
set f [open $src "w"] |
puts $f "int main() {" |
puts $f "#ifdef __MACH__" |
puts $f " asm volatile (\"extsw r0,r0\");" |
puts $f "#else" |
puts $f " asm volatile (\"extsw 0,0\");" |
puts $f "#endif" |
puts $f " return 0; }" |
close $f |
|
set opts "additional_flags=-mcpu=G5" |
|
verbose "check_effective_target_powerpc64 compiling testfile $src" 2 |
set lines [${tool}_target_compile $src $exe executable "$opts"] |
file delete $src |
|
if [string match "" $lines] then { |
# No error message, compilation succeeded. |
set result [${tool}_load "./$exe" "" ""] |
set status [lindex $result 0] |
remote_file build delete $exe |
verbose "check_effective_target_powerpc64 testfile status is <$status>" 2 |
|
if { $status == "pass" } then { |
set powerpc64_available_saved 1 |
} |
} else { |
verbose "check_effective_target_powerpc64 testfile compilation failed" 2 |
} |
} |
|
return $powerpc64_available_saved |
} |
|
# GCC 3.4.0 for powerpc64-*-linux* included an ABI fix for passing |
# complex float arguments. This affects gfortran tests that call cabsf |
# in libm built by an earlier compiler. Return 1 if libm uses the same |
# argument passing as the compiler under test, 0 otherwise. |
# |
# When the target name changes, replace the cached result. |
|
proc check_effective_target_broken_cplxf_arg { } { |
return [check_cached_effective_target broken_cplxf_arg { |
# Skip the work for targets known not to be affected. |
if { ![istarget powerpc64-*-linux*] } { |
expr 0 |
} elseif { ![is-effective-target lp64] } { |
expr 0 |
} else { |
check_runtime_nocache broken_cplxf_arg { |
#include <complex.h> |
extern void abort (void); |
float fabsf (float); |
float cabsf (_Complex float); |
int main () |
{ |
_Complex float cf; |
float f; |
cf = 3 + 4.0fi; |
f = cabsf (cf); |
if (fabsf (f - 5.0) > 0.0001) |
abort (); |
return 0; |
} |
} "-lm" |
} |
}] |
} |
|
proc check_alpha_max_hw_available { } { |
return [check_runtime alpha_max_hw_available { |
int main() { return __builtin_alpha_amask(1<<8) != 0; } |
}] |
} |
|
# Returns true iff the FUNCTION is available on the target system. |
# (This is essentially a Tcl implementation of Autoconf's |
# AC_CHECK_FUNC.) |
|
proc check_function_available { function } { |
return [check_no_compiler_messages ${function}_available \ |
executable [subst { |
#ifdef __cplusplus |
extern "C" |
#endif |
char $function (); |
int main () { $function (); } |
}]] |
} |
|
# Returns true iff "fork" is available on the target system. |
|
proc check_fork_available {} { |
return [check_function_available "fork"] |
} |
|
# Returns true iff "mkfifo" is available on the target system. |
|
proc check_mkfifo_available {} { |
if {[istarget *-*-cygwin*]} { |
# Cygwin has mkfifo, but support is incomplete. |
return 0 |
} |
|
return [check_function_available "mkfifo"] |
} |
|
# Returns true iff "__cxa_atexit" is used on the target system. |
|
proc check_cxa_atexit_available { } { |
return [check_cached_effective_target cxa_atexit_available { |
if { [istarget "hppa*-*-hpux10*"] } { |
# HP-UX 10 doesn't have __cxa_atexit but subsequent test passes. |
expr 0 |
} elseif { [istarget "*-*-vxworks"] } { |
# vxworks doesn't have __cxa_atexit but subsequent test passes. |
expr 0 |
} else { |
check_runtime_nocache cxa_atexit_available { |
// C++ |
#include <stdlib.h> |
static unsigned int count; |
struct X |
{ |
X() { count = 1; } |
~X() |
{ |
if (count != 3) |
exit(1); |
count = 4; |
} |
}; |
void f() |
{ |
static X x; |
} |
struct Y |
{ |
Y() { f(); count = 2; } |
~Y() |
{ |
if (count != 2) |
exit(1); |
count = 3; |
} |
}; |
Y y; |
int main() { return 0; } |
} |
} |
}] |
} |
|
proc check_effective_target_objc2 { } { |
return [check_no_compiler_messages objc2 object { |
#ifdef __OBJC2__ |
int dummy[1]; |
#else |
#error |
#endif |
}] |
} |
|
proc check_effective_target_next_runtime { } { |
return [check_no_compiler_messages objc2 object { |
#ifdef __NEXT_RUNTIME__ |
int dummy[1]; |
#else |
#error |
#endif |
}] |
} |
|
# Return 1 if we're generating 32-bit code using default options, 0 |
# otherwise. |
|
proc check_effective_target_ilp32 { } { |
return [check_no_compiler_messages ilp32 object { |
int dummy[sizeof (int) == 4 |
&& sizeof (void *) == 4 |
&& sizeof (long) == 4 ? 1 : -1]; |
}] |
} |
|
# Return 1 if we're generating 32-bit or larger integers using default |
# options, 0 otherwise. |
|
proc check_effective_target_int32plus { } { |
return [check_no_compiler_messages int32plus object { |
int dummy[sizeof (int) >= 4 ? 1 : -1]; |
}] |
} |
|
# Return 1 if we're generating 32-bit or larger pointers using default |
# options, 0 otherwise. |
|
proc check_effective_target_ptr32plus { } { |
return [check_no_compiler_messages ptr32plus object { |
int dummy[sizeof (void *) >= 4 ? 1 : -1]; |
}] |
} |
|
# Return 1 if we support 32-bit or larger array and structure sizes |
# using default options, 0 otherwise. |
|
proc check_effective_target_size32plus { } { |
return [check_no_compiler_messages size32plus object { |
char dummy[65537]; |
}] |
} |
|
# Returns 1 if we're generating 16-bit or smaller integers with the |
# default options, 0 otherwise. |
|
proc check_effective_target_int16 { } { |
return [check_no_compiler_messages int16 object { |
int dummy[sizeof (int) < 4 ? 1 : -1]; |
}] |
} |
|
# Return 1 if we're generating 64-bit code using default options, 0 |
# otherwise. |
|
proc check_effective_target_lp64 { } { |
return [check_no_compiler_messages lp64 object { |
int dummy[sizeof (int) == 4 |
&& sizeof (void *) == 8 |
&& sizeof (long) == 8 ? 1 : -1]; |
}] |
} |
|
# Return 1 if we're generating 64-bit code using default llp64 options, |
# 0 otherwise. |
|
proc check_effective_target_llp64 { } { |
return [check_no_compiler_messages llp64 object { |
int dummy[sizeof (int) == 4 |
&& sizeof (void *) == 8 |
&& sizeof (long long) == 8 |
&& sizeof (long) == 4 ? 1 : -1]; |
}] |
} |
|
# Return 1 if the target supports long double larger than double, |
# 0 otherwise. |
|
proc check_effective_target_large_long_double { } { |
return [check_no_compiler_messages large_long_double object { |
int dummy[sizeof(long double) > sizeof(double) ? 1 : -1]; |
}] |
} |
|
# Return 1 if the target supports double larger than float, |
# 0 otherwise. |
|
proc check_effective_target_large_double { } { |
return [check_no_compiler_messages large_double object { |
int dummy[sizeof(double) > sizeof(float) ? 1 : -1]; |
}] |
} |
|
# Return 1 if the target supports double of 64 bits, |
# 0 otherwise. |
|
proc check_effective_target_double64 { } { |
return [check_no_compiler_messages double64 object { |
int dummy[sizeof(double) == 8 ? 1 : -1]; |
}] |
} |
|
# Return 1 if the target supports double of at least 64 bits, |
# 0 otherwise. |
|
proc check_effective_target_double64plus { } { |
return [check_no_compiler_messages double64plus object { |
int dummy[sizeof(double) >= 8 ? 1 : -1]; |
}] |
} |
|
# Return 1 if the target supports compiling fixed-point, |
# 0 otherwise. |
|
proc check_effective_target_fixed_point { } { |
return [check_no_compiler_messages fixed_point object { |
_Sat _Fract x; _Sat _Accum y; |
}] |
} |
|
# Return 1 if the target supports compiling decimal floating point, |
# 0 otherwise. |
|
proc check_effective_target_dfp_nocache { } { |
verbose "check_effective_target_dfp_nocache: compiling source" 2 |
set ret [check_no_compiler_messages_nocache dfp object { |
float x __attribute__((mode(DD))); |
}] |
verbose "check_effective_target_dfp_nocache: returning $ret" 2 |
return $ret |
} |
|
proc check_effective_target_dfprt_nocache { } { |
return [check_runtime_nocache dfprt { |
typedef float d64 __attribute__((mode(DD))); |
d64 x = 1.2df, y = 2.3dd, z; |
int main () { z = x + y; return 0; } |
}] |
} |
|
# Return 1 if the target supports compiling Decimal Floating Point, |
# 0 otherwise. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_dfp { } { |
return [check_cached_effective_target dfp { |
check_effective_target_dfp_nocache |
}] |
} |
|
# Return 1 if the target supports linking and executing Decimal Floating |
# Point, 0 otherwise. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_dfprt { } { |
return [check_cached_effective_target dfprt { |
check_effective_target_dfprt_nocache |
}] |
} |
|
# Return 1 if the target supports compiling and assembling UCN, 0 otherwise. |
|
proc check_effective_target_ucn_nocache { } { |
# -std=c99 is only valid for C |
if [check_effective_target_c] { |
set ucnopts "-std=c99" |
} |
append ucnopts " -fextended-identifiers" |
verbose "check_effective_target_ucn_nocache: compiling source" 2 |
set ret [check_no_compiler_messages_nocache ucn object { |
int \u00C0; |
} $ucnopts] |
verbose "check_effective_target_ucn_nocache: returning $ret" 2 |
return $ret |
} |
|
# Return 1 if the target supports compiling and assembling UCN, 0 otherwise. |
# |
# This won't change for different subtargets, so cache the result. |
|
proc check_effective_target_ucn { } { |
return [check_cached_effective_target ucn { |
check_effective_target_ucn_nocache |
}] |
} |
|
# Return 1 if the target needs a command line argument to enable a SIMD |
# instruction set. |
|
proc check_effective_target_vect_cmdline_needed { } { |
global et_vect_cmdline_needed_saved |
global et_vect_cmdline_needed_target_name |
|
if { ![info exists et_vect_cmdline_needed_target_name] } { |
set et_vect_cmdline_needed_target_name "" |
} |
|
# If the target has changed since we set the cached value, clear it. |
set current_target [current_target_name] |
if { $current_target != $et_vect_cmdline_needed_target_name } { |
verbose "check_effective_target_vect_cmdline_needed: `$et_vect_cmdline_needed_target_name' `$current_target'" 2 |
set et_vect_cmdline_needed_target_name $current_target |
if { [info exists et_vect_cmdline_needed_saved] } { |
verbose "check_effective_target_vect_cmdline_needed: removing cached result" 2 |
unset et_vect_cmdline_needed_saved |
} |
} |
|
if [info exists et_vect_cmdline_needed_saved] { |
verbose "check_effective_target_vect_cmdline_needed: using cached result" 2 |
} else { |
set et_vect_cmdline_needed_saved 1 |
if { [istarget alpha*-*-*] |
|| [istarget ia64-*-*] |
|| (([istarget x86_64-*-*] || [istarget i?86-*-*]) |
&& [check_effective_target_lp64]) |
|| ([istarget powerpc*-*-*] |
&& ([check_effective_target_powerpc_spe] |
|| [check_effective_target_powerpc_altivec])) |
|| [istarget spu-*-*] |
|| ([istarget arm*-*-*] && [check_effective_target_arm_neon]) } { |
set et_vect_cmdline_needed_saved 0 |
} |
} |
|
verbose "check_effective_target_vect_cmdline_needed: returning $et_vect_cmdline_needed_saved" 2 |
return $et_vect_cmdline_needed_saved |
} |
|
# Return 1 if the target supports hardware vectors of int, 0 otherwise. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_vect_int { } { |
global et_vect_int_saved |
|
if [info exists et_vect_int_saved] { |
verbose "check_effective_target_vect_int: using cached result" 2 |
} else { |
set et_vect_int_saved 0 |
if { [istarget i?86-*-*] |
|| ([istarget powerpc*-*-*] |
&& ![istarget powerpc-*-linux*paired*]) |
|| [istarget spu-*-*] |
|| [istarget x86_64-*-*] |
|| [istarget sparc*-*-*] |
|| [istarget alpha*-*-*] |
|| [istarget ia64-*-*] |
|| [check_effective_target_arm32] } { |
set et_vect_int_saved 1 |
} |
} |
|
verbose "check_effective_target_vect_int: returning $et_vect_int_saved" 2 |
return $et_vect_int_saved |
} |
|
# Return 1 if the target supports signed int->float conversion |
# |
|
proc check_effective_target_vect_intfloat_cvt { } { |
global et_vect_intfloat_cvt_saved |
|
if [info exists et_vect_intfloat_cvt_saved] { |
verbose "check_effective_target_vect_intfloat_cvt: using cached result" 2 |
} else { |
set et_vect_intfloat_cvt_saved 0 |
if { [istarget i?86-*-*] |
|| ([istarget powerpc*-*-*] |
&& ![istarget powerpc-*-linux*paired*]) |
|| [istarget x86_64-*-*] } { |
set et_vect_intfloat_cvt_saved 1 |
} |
} |
|
verbose "check_effective_target_vect_intfloat_cvt: returning $et_vect_intfloat_cvt_saved" 2 |
return $et_vect_intfloat_cvt_saved |
} |
|
|
# Return 1 if the target supports unsigned int->float conversion |
# |
|
proc check_effective_target_vect_uintfloat_cvt { } { |
global et_vect_uintfloat_cvt_saved |
|
if [info exists et_vect_uintfloat_cvt_saved] { |
verbose "check_effective_target_vect_uintfloat_cvt: using cached result" 2 |
} else { |
set et_vect_uintfloat_cvt_saved 0 |
if { [istarget i?86-*-*] |
|| ([istarget powerpc*-*-*] |
&& ![istarget powerpc-*-linux*paired*]) |
|| [istarget x86_64-*-*] } { |
set et_vect_uintfloat_cvt_saved 1 |
} |
} |
|
verbose "check_effective_target_vect_uintfloat_cvt: returning $et_vect_uintfloat_cvt_saved" 2 |
return $et_vect_uintfloat_cvt_saved |
} |
|
|
# Return 1 if the target supports signed float->int conversion |
# |
|
proc check_effective_target_vect_floatint_cvt { } { |
global et_vect_floatint_cvt_saved |
|
if [info exists et_vect_floatint_cvt_saved] { |
verbose "check_effective_target_vect_floatint_cvt: using cached result" 2 |
} else { |
set et_vect_floatint_cvt_saved 0 |
if { [istarget i?86-*-*] |
|| ([istarget powerpc*-*-*] |
&& ![istarget powerpc-*-linux*paired*]) |
|| [istarget x86_64-*-*] } { |
set et_vect_floatint_cvt_saved 1 |
} |
} |
|
verbose "check_effective_target_vect_floatint_cvt: returning $et_vect_floatint_cvt_saved" 2 |
return $et_vect_floatint_cvt_saved |
} |
|
# Return 1 if the target supports unsigned float->int conversion |
# |
|
proc check_effective_target_vect_floatuint_cvt { } { |
global et_vect_floatuint_cvt_saved |
|
if [info exists et_vect_floatuint_cvt_saved] { |
verbose "check_effective_target_vect_floatuint_cvt: using cached result" 2 |
} else { |
set et_vect_floatuint_cvt_saved 0 |
if { ([istarget powerpc*-*-*] |
&& ![istarget powerpc-*-linux*paired*]) } { |
set et_vect_floatuint_cvt_saved 1 |
} |
} |
|
verbose "check_effective_target_vect_floatuint_cvt: returning $et_vect_floatuint_cvt_saved" 2 |
return $et_vect_floatuint_cvt_saved |
} |
|
# Return 1 is this is an arm target using 32-bit instructions |
proc check_effective_target_arm32 { } { |
return [check_no_compiler_messages arm32 assembly { |
#if !defined(__arm__) || (defined(__thumb__) && !defined(__thumb2__)) |
#error FOO |
#endif |
}] |
} |
|
# Return 1 if this is an ARM target supporting -mfpu=vfp |
# -mfloat-abi=softfp. Some multilibs may be incompatible with these |
# options. |
|
proc check_effective_target_arm_vfp_ok { } { |
if { [check_effective_target_arm32] } { |
return [check_no_compiler_messages arm_vfp_ok object { |
int dummy; |
} "-mfpu=vfp -mfloat-abi=softfp"] |
} else { |
return 0 |
} |
} |
|
# Return 1 if this is an ARM target supporting -mfpu=vfp |
# -mfloat-abi=hard. Some multilibs may be incompatible with these |
# options. |
|
proc check_effective_target_arm_hard_vfp_ok { } { |
if { [check_effective_target_arm32] } { |
return [check_no_compiler_messages arm_hard_vfp_ok executable { |
int main() { return 0;} |
} "-mfpu=vfp -mfloat-abi=hard"] |
} else { |
return 0 |
} |
} |
|
# Return 1 if this is an ARM target supporting -mfpu=neon |
# -mfloat-abi=softfp. Some multilibs may be incompatible with these |
# options. |
|
proc check_effective_target_arm_neon_ok { } { |
if { [check_effective_target_arm32] } { |
return [check_no_compiler_messages arm_neon_ok object { |
#include "arm_neon.h" |
int dummy; |
} "-mfpu=neon -mfloat-abi=softfp"] |
} else { |
return 0 |
} |
} |
|
# Return 1 is this is an ARM target where -mthumb causes Thumb-1 to be |
# used. |
|
proc check_effective_target_arm_thumb1_ok { } { |
return [check_no_compiler_messages arm_thumb1_ok assembly { |
#if !defined(__arm__) || !defined(__thumb__) || defined(__thumb2__) |
#error FOO |
#endif |
} "-mthumb"] |
} |
|
# Return 1 is this is an ARM target where -mthumb causes Thumb-2 to be |
# used. |
|
proc check_effective_target_arm_thumb2_ok { } { |
return [check_no_compiler_messages arm_thumb2_ok assembly { |
#if !defined(__thumb2__) |
#error FOO |
#endif |
} "-mthumb"] |
} |
|
# Return 1 if the target supports executing NEON instructions, 0 |
# otherwise. Cache the result. |
|
proc check_effective_target_arm_neon_hw { } { |
return [check_runtime arm_neon_hw_available { |
int |
main (void) |
{ |
long long a = 0, b = 1; |
asm ("vorr %P0, %P1, %P2" |
: "=w" (a) |
: "0" (a), "w" (b)); |
return (a != 1); |
} |
} "-mfpu=neon -mfloat-abi=softfp"] |
} |
|
# Return 1 if this is a ARM target with NEON enabled. |
|
proc check_effective_target_arm_neon { } { |
if { [check_effective_target_arm32] } { |
return [check_no_compiler_messages arm_neon object { |
#ifndef __ARM_NEON__ |
#error not NEON |
#else |
int dummy; |
#endif |
}] |
} else { |
return 0 |
} |
} |
|
# Return 1 if this a Loongson-2E or -2F target using an ABI that supports |
# the Loongson vector modes. |
|
proc check_effective_target_mips_loongson { } { |
return [check_no_compiler_messages loongson assembly { |
#if !defined(__mips_loongson_vector_rev) |
#error FOO |
#endif |
}] |
} |
|
# Return 1 if this is an ARM target that adheres to the ABI for the ARM |
# Architecture. |
|
proc check_effective_target_arm_eabi { } { |
return [check_no_compiler_messages arm_eabi object { |
#ifndef __ARM_EABI__ |
#error not EABI |
#else |
int dummy; |
#endif |
}] |
} |
|
# Return 1 if this is an ARM target supporting -mcpu=iwmmxt. |
# Some multilibs may be incompatible with this option. |
|
proc check_effective_target_arm_iwmmxt_ok { } { |
if { [check_effective_target_arm32] } { |
return [check_no_compiler_messages arm_iwmmxt_ok object { |
int dummy; |
} "-mcpu=iwmmxt"] |
} else { |
return 0 |
} |
} |
|
# Return 1 if this is a PowerPC target with floating-point registers. |
|
proc check_effective_target_powerpc_fprs { } { |
if { [istarget powerpc*-*-*] |
|| [istarget rs6000-*-*] } { |
return [check_no_compiler_messages powerpc_fprs object { |
#ifdef __NO_FPRS__ |
#error no FPRs |
#else |
int dummy; |
#endif |
}] |
} else { |
return 0 |
} |
} |
|
# Return 1 if this is a PowerPC target with hardware double-precision |
# floating point. |
|
proc check_effective_target_powerpc_hard_double { } { |
if { [istarget powerpc*-*-*] |
|| [istarget rs6000-*-*] } { |
return [check_no_compiler_messages powerpc_hard_double object { |
#ifdef _SOFT_DOUBLE |
#error soft double |
#else |
int dummy; |
#endif |
}] |
} else { |
return 0 |
} |
} |
|
# Return 1 if this is a PowerPC target supporting -maltivec. |
|
proc check_effective_target_powerpc_altivec_ok { } { |
if { ([istarget powerpc*-*-*] |
&& ![istarget powerpc-*-linux*paired*]) |
|| [istarget rs6000-*-*] } { |
# AltiVec is not supported on AIX before 5.3. |
if { [istarget powerpc*-*-aix4*] |
|| [istarget powerpc*-*-aix5.1*] |
|| [istarget powerpc*-*-aix5.2*] } { |
return 0 |
} |
return [check_no_compiler_messages powerpc_altivec_ok object { |
int dummy; |
} "-maltivec"] |
} else { |
return 0 |
} |
} |
|
# Return 1 if this is a PowerPC target supporting -mvsx |
|
proc check_effective_target_powerpc_vsx_ok { } { |
if { ([istarget powerpc*-*-*] |
&& ![istarget powerpc-*-linux*paired*]) |
|| [istarget rs6000-*-*] } { |
# AltiVec is not supported on AIX before 5.3. |
if { [istarget powerpc*-*-aix4*] |
|| [istarget powerpc*-*-aix5.1*] |
|| [istarget powerpc*-*-aix5.2*] } { |
return 0 |
} |
return [check_no_compiler_messages powerpc_vsx_ok object { |
int main (void) { |
#ifdef __MACH__ |
asm volatile ("xxlor vs0,vs0,vs0"); |
#else |
asm volatile ("xxlor 0,0,0"); |
#endif |
return 0; |
} |
} "-mvsx"] |
} else { |
return 0 |
} |
} |
|
# Return 1 if this is a PowerPC target supporting -mcpu=cell. |
|
proc check_effective_target_powerpc_ppu_ok { } { |
if [check_effective_target_powerpc_altivec_ok] { |
return [check_no_compiler_messages cell_asm_available object { |
int main (void) { |
#ifdef __MACH__ |
asm volatile ("lvlx v0,v0,v0"); |
#else |
asm volatile ("lvlx 0,0,0"); |
#endif |
return 0; |
} |
}] |
} else { |
return 0 |
} |
} |
|
# Return 1 if this is a PowerPC target that supports SPU. |
|
proc check_effective_target_powerpc_spu { } { |
if [istarget powerpc*-*-linux*] { |
return [check_effective_target_powerpc_altivec_ok] |
} else { |
return 0 |
} |
} |
|
# Return 1 if this is a PowerPC SPE target. The check includes options |
# specified by dg-options for this test, so don't cache the result. |
|
proc check_effective_target_powerpc_spe_nocache { } { |
if { [istarget powerpc*-*-*] } { |
return [check_no_compiler_messages_nocache powerpc_spe object { |
#ifndef __SPE__ |
#error not SPE |
#else |
int dummy; |
#endif |
} [current_compiler_flags]] |
} else { |
return 0 |
} |
} |
|
# Return 1 if this is a PowerPC target with SPE enabled. |
|
proc check_effective_target_powerpc_spe { } { |
if { [istarget powerpc*-*-*] } { |
return [check_no_compiler_messages powerpc_spe object { |
#ifndef __SPE__ |
#error not SPE |
#else |
int dummy; |
#endif |
}] |
} else { |
return 0 |
} |
} |
|
# Return 1 if this is a PowerPC target with Altivec enabled. |
|
proc check_effective_target_powerpc_altivec { } { |
if { [istarget powerpc*-*-*] } { |
return [check_no_compiler_messages powerpc_altivec object { |
#ifndef __ALTIVEC__ |
#error not Altivec |
#else |
int dummy; |
#endif |
}] |
} else { |
return 0 |
} |
} |
|
# Return 1 if this is a PowerPC 405 target. The check includes options |
# specified by dg-options for this test, so don't cache the result. |
|
proc check_effective_target_powerpc_405_nocache { } { |
if { [istarget powerpc*-*-*] || [istarget rs6000-*-*] } { |
return [check_no_compiler_messages_nocache powerpc_405 object { |
#ifdef __PPC405__ |
int dummy; |
#else |
#error not a PPC405 |
#endif |
} [current_compiler_flags]] |
} else { |
return 0 |
} |
} |
|
# Return 1 if this is a SPU target with a toolchain that |
# supports automatic overlay generation. |
|
proc check_effective_target_spu_auto_overlay { } { |
if { [istarget spu*-*-elf*] } { |
return [check_no_compiler_messages spu_auto_overlay executable { |
int main (void) { } |
} "-Wl,--auto-overlay" ] |
} else { |
return 0 |
} |
} |
|
# The VxWorks SPARC simulator accepts only EM_SPARC executables and |
# chokes on EM_SPARC32PLUS or EM_SPARCV9 executables. Return 1 if the |
# test environment appears to run executables on such a simulator. |
|
proc check_effective_target_ultrasparc_hw { } { |
return [check_runtime ultrasparc_hw { |
int main() { return 0; } |
} "-mcpu=ultrasparc"] |
} |
|
# Return 1 if the target supports hardware vector shift operation. |
|
proc check_effective_target_vect_shift { } { |
global et_vect_shift_saved |
|
if [info exists et_vect_shift_saved] { |
verbose "check_effective_target_vect_shift: using cached result" 2 |
} else { |
set et_vect_shift_saved 0 |
if { ([istarget powerpc*-*-*] |
&& ![istarget powerpc-*-linux*paired*]) |
|| [istarget ia64-*-*] |
|| [istarget i?86-*-*] |
|| [istarget x86_64-*-*] |
|| [check_effective_target_arm32] } { |
set et_vect_shift_saved 1 |
} |
} |
|
verbose "check_effective_target_vect_shift: returning $et_vect_shift_saved" 2 |
return $et_vect_shift_saved |
} |
|
# Return 1 if the target supports hardware vectors of long, 0 otherwise. |
# |
# This can change for different subtargets so do not cache the result. |
|
proc check_effective_target_vect_long { } { |
if { [istarget i?86-*-*] |
|| (([istarget powerpc*-*-*] |
&& ![istarget powerpc-*-linux*paired*]) |
&& [check_effective_target_ilp32]) |
|| [istarget x86_64-*-*] |
|| [check_effective_target_arm32] |
|| ([istarget sparc*-*-*] && [check_effective_target_ilp32]) } { |
set answer 1 |
} else { |
set answer 0 |
} |
|
verbose "check_effective_target_vect_long: returning $answer" 2 |
return $answer |
} |
|
# Return 1 if the target supports hardware vectors of float, 0 otherwise. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_vect_float { } { |
global et_vect_float_saved |
|
if [info exists et_vect_float_saved] { |
verbose "check_effective_target_vect_float: using cached result" 2 |
} else { |
set et_vect_float_saved 0 |
if { [istarget i?86-*-*] |
|| [istarget powerpc*-*-*] |
|| [istarget spu-*-*] |
|| [istarget mipsisa64*-*-*] |
|| [istarget x86_64-*-*] |
|| [istarget ia64-*-*] |
|| [check_effective_target_arm32] } { |
set et_vect_float_saved 1 |
} |
} |
|
verbose "check_effective_target_vect_float: returning $et_vect_float_saved" 2 |
return $et_vect_float_saved |
} |
|
# Return 1 if the target supports hardware vectors of double, 0 otherwise. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_vect_double { } { |
global et_vect_double_saved |
|
if [info exists et_vect_double_saved] { |
verbose "check_effective_target_vect_double: using cached result" 2 |
} else { |
set et_vect_double_saved 0 |
if { [istarget i?86-*-*] |
|| [istarget x86_64-*-*] |
|| [istarget spu-*-*] } { |
set et_vect_double_saved 1 |
} |
} |
|
verbose "check_effective_target_vect_double: returning $et_vect_double_saved" 2 |
return $et_vect_double_saved |
} |
|
# Return 1 if the target supports hardware vectors of long long, 0 otherwise. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_vect_long_long { } { |
global et_vect_long_long_saved |
|
if [info exists et_vect_long_long_saved] { |
verbose "check_effective_target_vect_long_long: using cached result" 2 |
} else { |
set et_vect_long_long_saved 0 |
if { [istarget i?86-*-*] |
|| [istarget x86_64-*-*] } { |
set et_vect_long_long_saved 1 |
} |
} |
|
verbose "check_effective_target_vect_long_long: returning $et_vect_long_long_saved" 2 |
return $et_vect_long_long_saved |
} |
|
|
# Return 1 if the target plus current options does not support a vector |
# max instruction on "int", 0 otherwise. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_vect_no_int_max { } { |
global et_vect_no_int_max_saved |
|
if [info exists et_vect_no_int_max_saved] { |
verbose "check_effective_target_vect_no_int_max: using cached result" 2 |
} else { |
set et_vect_no_int_max_saved 0 |
if { [istarget sparc*-*-*] |
|| [istarget spu-*-*] |
|| [istarget alpha*-*-*] } { |
set et_vect_no_int_max_saved 1 |
} |
} |
verbose "check_effective_target_vect_no_int_max: returning $et_vect_no_int_max_saved" 2 |
return $et_vect_no_int_max_saved |
} |
|
# Return 1 if the target plus current options does not support a vector |
# add instruction on "int", 0 otherwise. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_vect_no_int_add { } { |
global et_vect_no_int_add_saved |
|
if [info exists et_vect_no_int_add_saved] { |
verbose "check_effective_target_vect_no_int_add: using cached result" 2 |
} else { |
set et_vect_no_int_add_saved 0 |
# Alpha only supports vector add on V8QI and V4HI. |
if { [istarget alpha*-*-*] } { |
set et_vect_no_int_add_saved 1 |
} |
} |
verbose "check_effective_target_vect_no_int_add: returning $et_vect_no_int_add_saved" 2 |
return $et_vect_no_int_add_saved |
} |
|
# Return 1 if the target plus current options does not support vector |
# bitwise instructions, 0 otherwise. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_vect_no_bitwise { } { |
global et_vect_no_bitwise_saved |
|
if [info exists et_vect_no_bitwise_saved] { |
verbose "check_effective_target_vect_no_bitwise: using cached result" 2 |
} else { |
set et_vect_no_bitwise_saved 0 |
} |
verbose "check_effective_target_vect_no_bitwise: returning $et_vect_no_bitwise_saved" 2 |
return $et_vect_no_bitwise_saved |
} |
|
# Return 1 if the target plus current options supports vector permutation, |
# 0 otherwise. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_vect_perm { } { |
global et_vect_perm |
|
if [info exists et_vect_perm_saved] { |
verbose "check_effective_target_vect_perm: using cached result" 2 |
} else { |
set et_vect_perm_saved 0 |
if { [istarget powerpc*-*-*] |
|| [istarget spu-*-*] } { |
set et_vect_perm_saved 1 |
} |
} |
verbose "check_effective_target_vect_perm: returning $et_vect_perm_saved" 2 |
return $et_vect_perm_saved |
} |
|
|
# Return 1 if the target plus current options supports a vector |
# widening summation of *short* args into *int* result, 0 otherwise. |
# A target can also support this widening summation if it can support |
# promotion (unpacking) from shorts to ints. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_vect_widen_sum_hi_to_si { } { |
global et_vect_widen_sum_hi_to_si |
|
if [info exists et_vect_widen_sum_hi_to_si_saved] { |
verbose "check_effective_target_vect_widen_sum_hi_to_si: using cached result" 2 |
} else { |
set et_vect_widen_sum_hi_to_si_saved [check_effective_target_vect_unpack] |
if { [istarget powerpc*-*-*] |
|| [istarget ia64-*-*] } { |
set et_vect_widen_sum_hi_to_si_saved 1 |
} |
} |
verbose "check_effective_target_vect_widen_sum_hi_to_si: returning $et_vect_widen_sum_hi_to_si_saved" 2 |
return $et_vect_widen_sum_hi_to_si_saved |
} |
|
# Return 1 if the target plus current options supports a vector |
# widening summation of *char* args into *short* result, 0 otherwise. |
# A target can also support this widening summation if it can support |
# promotion (unpacking) from chars to shorts. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_vect_widen_sum_qi_to_hi { } { |
global et_vect_widen_sum_qi_to_hi |
|
if [info exists et_vect_widen_sum_qi_to_hi_saved] { |
verbose "check_effective_target_vect_widen_sum_qi_to_hi: using cached result" 2 |
} else { |
set et_vect_widen_sum_qi_to_hi_saved 0 |
if { [check_effective_target_vect_unpack] |
|| [istarget ia64-*-*] } { |
set et_vect_widen_sum_qi_to_hi_saved 1 |
} |
} |
verbose "check_effective_target_vect_widen_sum_qi_to_hi: returning $et_vect_widen_sum_qi_to_hi_saved" 2 |
return $et_vect_widen_sum_qi_to_hi_saved |
} |
|
# Return 1 if the target plus current options supports a vector |
# widening summation of *char* args into *int* result, 0 otherwise. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_vect_widen_sum_qi_to_si { } { |
global et_vect_widen_sum_qi_to_si |
|
if [info exists et_vect_widen_sum_qi_to_si_saved] { |
verbose "check_effective_target_vect_widen_sum_qi_to_si: using cached result" 2 |
} else { |
set et_vect_widen_sum_qi_to_si_saved 0 |
if { [istarget powerpc*-*-*] } { |
set et_vect_widen_sum_qi_to_si_saved 1 |
} |
} |
verbose "check_effective_target_vect_widen_sum_qi_to_si: returning $et_vect_widen_sum_qi_to_si_saved" 2 |
return $et_vect_widen_sum_qi_to_si_saved |
} |
|
# Return 1 if the target plus current options supports a vector |
# widening multiplication of *char* args into *short* result, 0 otherwise. |
# A target can also support this widening multplication if it can support |
# promotion (unpacking) from chars to shorts, and vect_short_mult (non-widening |
# multiplication of shorts). |
# |
# This won't change for different subtargets so cache the result. |
|
|
proc check_effective_target_vect_widen_mult_qi_to_hi { } { |
global et_vect_widen_mult_qi_to_hi |
|
if [info exists et_vect_widen_mult_qi_to_hi_saved] { |
verbose "check_effective_target_vect_widen_mult_qi_to_hi: using cached result" 2 |
} else { |
if { [check_effective_target_vect_unpack] |
&& [check_effective_target_vect_short_mult] } { |
set et_vect_widen_mult_qi_to_hi_saved 1 |
} else { |
set et_vect_widen_mult_qi_to_hi_saved 0 |
} |
if { [istarget powerpc*-*-*] } { |
set et_vect_widen_mult_qi_to_hi_saved 1 |
} |
} |
verbose "check_effective_target_vect_widen_mult_qi_to_hi: returning $et_vect_widen_mult_qi_to_hi_saved" 2 |
return $et_vect_widen_mult_qi_to_hi_saved |
} |
|
# Return 1 if the target plus current options supports a vector |
# widening multiplication of *short* args into *int* result, 0 otherwise. |
# A target can also support this widening multplication if it can support |
# promotion (unpacking) from shorts to ints, and vect_int_mult (non-widening |
# multiplication of ints). |
# |
# This won't change for different subtargets so cache the result. |
|
|
proc check_effective_target_vect_widen_mult_hi_to_si { } { |
global et_vect_widen_mult_hi_to_si |
|
if [info exists et_vect_widen_mult_hi_to_si_saved] { |
verbose "check_effective_target_vect_widen_mult_hi_to_si: using cached result" 2 |
} else { |
if { [check_effective_target_vect_unpack] |
&& [check_effective_target_vect_int_mult] } { |
set et_vect_widen_mult_hi_to_si_saved 1 |
} else { |
set et_vect_widen_mult_hi_to_si_saved 0 |
} |
if { [istarget powerpc*-*-*] |
|| [istarget spu-*-*] |
|| [istarget i?86-*-*] |
|| [istarget x86_64-*-*] } { |
set et_vect_widen_mult_hi_to_si_saved 1 |
} |
} |
verbose "check_effective_target_vect_widen_mult_hi_to_si: returning $et_vect_widen_mult_hi_to_si_saved" 2 |
return $et_vect_widen_mult_hi_to_si_saved |
} |
|
# Return 1 if the target plus current options supports a vector |
# dot-product of signed chars, 0 otherwise. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_vect_sdot_qi { } { |
global et_vect_sdot_qi |
|
if [info exists et_vect_sdot_qi_saved] { |
verbose "check_effective_target_vect_sdot_qi: using cached result" 2 |
} else { |
set et_vect_sdot_qi_saved 0 |
} |
verbose "check_effective_target_vect_sdot_qi: returning $et_vect_sdot_qi_saved" 2 |
return $et_vect_sdot_qi_saved |
} |
|
# Return 1 if the target plus current options supports a vector |
# dot-product of unsigned chars, 0 otherwise. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_vect_udot_qi { } { |
global et_vect_udot_qi |
|
if [info exists et_vect_udot_qi_saved] { |
verbose "check_effective_target_vect_udot_qi: using cached result" 2 |
} else { |
set et_vect_udot_qi_saved 0 |
if { [istarget powerpc*-*-*] } { |
set et_vect_udot_qi_saved 1 |
} |
} |
verbose "check_effective_target_vect_udot_qi: returning $et_vect_udot_qi_saved" 2 |
return $et_vect_udot_qi_saved |
} |
|
# Return 1 if the target plus current options supports a vector |
# dot-product of signed shorts, 0 otherwise. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_vect_sdot_hi { } { |
global et_vect_sdot_hi |
|
if [info exists et_vect_sdot_hi_saved] { |
verbose "check_effective_target_vect_sdot_hi: using cached result" 2 |
} else { |
set et_vect_sdot_hi_saved 0 |
if { ([istarget powerpc*-*-*] && ![istarget powerpc-*-linux*paired*]) |
|| [istarget i?86-*-*] |
|| [istarget x86_64-*-*] } { |
set et_vect_sdot_hi_saved 1 |
} |
} |
verbose "check_effective_target_vect_sdot_hi: returning $et_vect_sdot_hi_saved" 2 |
return $et_vect_sdot_hi_saved |
} |
|
# Return 1 if the target plus current options supports a vector |
# dot-product of unsigned shorts, 0 otherwise. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_vect_udot_hi { } { |
global et_vect_udot_hi |
|
if [info exists et_vect_udot_hi_saved] { |
verbose "check_effective_target_vect_udot_hi: using cached result" 2 |
} else { |
set et_vect_udot_hi_saved 0 |
if { ([istarget powerpc*-*-*] && ![istarget powerpc-*-linux*paired*]) } { |
set et_vect_udot_hi_saved 1 |
} |
} |
verbose "check_effective_target_vect_udot_hi: returning $et_vect_udot_hi_saved" 2 |
return $et_vect_udot_hi_saved |
} |
|
|
# Return 1 if the target plus current options supports a vector |
# demotion (packing) of shorts (to chars) and ints (to shorts) |
# using modulo arithmetic, 0 otherwise. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_vect_pack_trunc { } { |
global et_vect_pack_trunc |
|
if [info exists et_vect_pack_trunc_saved] { |
verbose "check_effective_target_vect_pack_trunc: using cached result" 2 |
} else { |
set et_vect_pack_trunc_saved 0 |
if { ([istarget powerpc*-*-*] && ![istarget powerpc-*-linux*paired*]) |
|| [istarget i?86-*-*] |
|| [istarget x86_64-*-*] |
|| [istarget spu-*-*] } { |
set et_vect_pack_trunc_saved 1 |
} |
} |
verbose "check_effective_target_vect_pack_trunc: returning $et_vect_pack_trunc_saved" 2 |
return $et_vect_pack_trunc_saved |
} |
|
# Return 1 if the target plus current options supports a vector |
# promotion (unpacking) of chars (to shorts) and shorts (to ints), 0 otherwise. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_vect_unpack { } { |
global et_vect_unpack |
|
if [info exists et_vect_unpack_saved] { |
verbose "check_effective_target_vect_unpack: using cached result" 2 |
} else { |
set et_vect_unpack_saved 0 |
if { ([istarget powerpc*-*-*] && ![istarget powerpc-*paired*]) |
|| [istarget i?86-*-*] |
|| [istarget x86_64-*-*] |
|| [istarget spu-*-*] } { |
set et_vect_unpack_saved 1 |
} |
} |
verbose "check_effective_target_vect_unpack: returning $et_vect_unpack_saved" 2 |
return $et_vect_unpack_saved |
} |
|
# Return 1 if the target plus current options does not guarantee |
# that its STACK_BOUNDARY is >= the reguired vector alignment. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_unaligned_stack { } { |
global et_unaligned_stack_saved |
|
if [info exists et_unaligned_stack_saved] { |
verbose "check_effective_target_unaligned_stack: using cached result" 2 |
} else { |
set et_unaligned_stack_saved 0 |
} |
verbose "check_effective_target_unaligned_stack: returning $et_unaligned_stack_saved" 2 |
return $et_unaligned_stack_saved |
} |
|
# Return 1 if the target plus current options does not support a vector |
# alignment mechanism, 0 otherwise. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_vect_no_align { } { |
global et_vect_no_align_saved |
|
if [info exists et_vect_no_align_saved] { |
verbose "check_effective_target_vect_no_align: using cached result" 2 |
} else { |
set et_vect_no_align_saved 0 |
if { [istarget mipsisa64*-*-*] |
|| [istarget sparc*-*-*] |
|| [istarget ia64-*-*] |
|| [check_effective_target_arm32] } { |
set et_vect_no_align_saved 1 |
} |
} |
verbose "check_effective_target_vect_no_align: returning $et_vect_no_align_saved" 2 |
return $et_vect_no_align_saved |
} |
|
# Return 1 if the target supports a vector misalign access, 0 otherwise. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_vect_hw_misalign { } { |
global et_vect_hw_misalign_saved |
|
if [info exists et_vect_hw_misalign_saved] { |
verbose "check_effective_target_vect_hw_misalign: using cached result" 2 |
} else { |
set et_vect_hw_misalign_saved 0 |
if { ([istarget x86_64-*-*] |
|| [istarget i?86-*-*]) } { |
set et_vect_hw_misalign_saved 1 |
} |
} |
verbose "check_effective_target_vect_hw_misalign: returning $et_vect_hw_misalign_saved" 2 |
return $et_vect_hw_misalign_saved |
} |
|
|
# Return 1 if arrays are aligned to the vector alignment |
# boundary, 0 otherwise. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_vect_aligned_arrays { } { |
global et_vect_aligned_arrays |
|
if [info exists et_vect_aligned_arrays_saved] { |
verbose "check_effective_target_vect_aligned_arrays: using cached result" 2 |
} else { |
set et_vect_aligned_arrays_saved 0 |
if { (([istarget x86_64-*-*] |
|| [istarget i?86-*-*]) && [is-effective-target lp64]) |
|| [istarget spu-*-*] } { |
set et_vect_aligned_arrays_saved 1 |
} |
} |
verbose "check_effective_target_vect_aligned_arrays: returning $et_vect_aligned_arrays_saved" 2 |
return $et_vect_aligned_arrays_saved |
} |
|
# Return 1 if types of size 32 bit or less are naturally aligned |
# (aligned to their type-size), 0 otherwise. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_natural_alignment_32 { } { |
global et_natural_alignment_32 |
|
if [info exists et_natural_alignment_32_saved] { |
verbose "check_effective_target_natural_alignment_32: using cached result" 2 |
} else { |
# FIXME: 32bit powerpc: guaranteed only if MASK_ALIGN_NATURAL/POWER. |
set et_natural_alignment_32_saved 1 |
if { ([istarget *-*-darwin*] && [is-effective-target lp64]) } { |
set et_natural_alignment_32_saved 0 |
} |
} |
verbose "check_effective_target_natural_alignment_32: returning $et_natural_alignment_32_saved" 2 |
return $et_natural_alignment_32_saved |
} |
|
# Return 1 if types of size 64 bit or less are naturally aligned (aligned to their |
# type-size), 0 otherwise. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_natural_alignment_64 { } { |
global et_natural_alignment_64 |
|
if [info exists et_natural_alignment_64_saved] { |
verbose "check_effective_target_natural_alignment_64: using cached result" 2 |
} else { |
set et_natural_alignment_64_saved 0 |
if { ([is-effective-target lp64] && ![istarget *-*-darwin*]) |
|| [istarget spu-*-*] } { |
set et_natural_alignment_64_saved 1 |
} |
} |
verbose "check_effective_target_natural_alignment_64: returning $et_natural_alignment_64_saved" 2 |
return $et_natural_alignment_64_saved |
} |
|
# Return 1 if vector alignment (for types of size 32 bit or less) is reachable, 0 otherwise. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_vector_alignment_reachable { } { |
global et_vector_alignment_reachable |
|
if [info exists et_vector_alignment_reachable_saved] { |
verbose "check_effective_target_vector_alignment_reachable: using cached result" 2 |
} else { |
if { [check_effective_target_vect_aligned_arrays] |
|| [check_effective_target_natural_alignment_32] } { |
set et_vector_alignment_reachable_saved 1 |
} else { |
set et_vector_alignment_reachable_saved 0 |
} |
} |
verbose "check_effective_target_vector_alignment_reachable: returning $et_vector_alignment_reachable_saved" 2 |
return $et_vector_alignment_reachable_saved |
} |
|
# Return 1 if vector alignment for 64 bit is reachable, 0 otherwise. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_vector_alignment_reachable_for_64bit { } { |
global et_vector_alignment_reachable_for_64bit |
|
if [info exists et_vector_alignment_reachable_for_64bit_saved] { |
verbose "check_effective_target_vector_alignment_reachable_for_64bit: using cached result" 2 |
} else { |
if { [check_effective_target_vect_aligned_arrays] |
|| [check_effective_target_natural_alignment_64] } { |
set et_vector_alignment_reachable_for_64bit_saved 1 |
} else { |
set et_vector_alignment_reachable_for_64bit_saved 0 |
} |
} |
verbose "check_effective_target_vector_alignment_reachable_for_64bit: returning $et_vector_alignment_reachable_for_64bit_saved" 2 |
return $et_vector_alignment_reachable_for_64bit_saved |
} |
|
# Return 1 if the target supports vector conditional operations, 0 otherwise. |
|
proc check_effective_target_vect_condition { } { |
global et_vect_cond_saved |
|
if [info exists et_vect_cond_saved] { |
verbose "check_effective_target_vect_cond: using cached result" 2 |
} else { |
set et_vect_cond_saved 0 |
if { [istarget powerpc*-*-*] |
|| [istarget ia64-*-*] |
|| [istarget i?86-*-*] |
|| [istarget spu-*-*] |
|| [istarget x86_64-*-*] } { |
set et_vect_cond_saved 1 |
} |
} |
|
verbose "check_effective_target_vect_cond: returning $et_vect_cond_saved" 2 |
return $et_vect_cond_saved |
} |
|
# Return 1 if the target supports vector char multiplication, 0 otherwise. |
|
proc check_effective_target_vect_char_mult { } { |
global et_vect_char_mult_saved |
|
if [info exists et_vect_char_mult_saved] { |
verbose "check_effective_target_vect_char_mult: using cached result" 2 |
} else { |
set et_vect_char_mult_saved 0 |
if { [istarget ia64-*-*] |
|| [istarget i?86-*-*] |
|| [istarget x86_64-*-*] } { |
set et_vect_char_mult_saved 1 |
} |
} |
|
verbose "check_effective_target_vect_char_mult: returning $et_vect_char_mult_saved" 2 |
return $et_vect_char_mult_saved |
} |
|
# Return 1 if the target supports vector short multiplication, 0 otherwise. |
|
proc check_effective_target_vect_short_mult { } { |
global et_vect_short_mult_saved |
|
if [info exists et_vect_short_mult_saved] { |
verbose "check_effective_target_vect_short_mult: using cached result" 2 |
} else { |
set et_vect_short_mult_saved 0 |
if { [istarget ia64-*-*] |
|| [istarget spu-*-*] |
|| [istarget i?86-*-*] |
|| [istarget x86_64-*-*] |
|| [istarget powerpc*-*-*] |
|| [check_effective_target_arm32] } { |
set et_vect_short_mult_saved 1 |
} |
} |
|
verbose "check_effective_target_vect_short_mult: returning $et_vect_short_mult_saved" 2 |
return $et_vect_short_mult_saved |
} |
|
# Return 1 if the target supports vector int multiplication, 0 otherwise. |
|
proc check_effective_target_vect_int_mult { } { |
global et_vect_int_mult_saved |
|
if [info exists et_vect_int_mult_saved] { |
verbose "check_effective_target_vect_int_mult: using cached result" 2 |
} else { |
set et_vect_int_mult_saved 0 |
if { ([istarget powerpc*-*-*] && ![istarget powerpc-*-linux*paired*]) |
|| [istarget spu-*-*] |
|| [istarget i?86-*-*] |
|| [istarget x86_64-*-*] |
|| [check_effective_target_arm32] } { |
set et_vect_int_mult_saved 1 |
} |
} |
|
verbose "check_effective_target_vect_int_mult: returning $et_vect_int_mult_saved" 2 |
return $et_vect_int_mult_saved |
} |
|
# Return 1 if the target supports vector even/odd elements extraction, 0 otherwise. |
|
proc check_effective_target_vect_extract_even_odd { } { |
global et_vect_extract_even_odd_saved |
|
if [info exists et_vect_extract_even_odd_saved] { |
verbose "check_effective_target_vect_extract_even_odd: using cached result" 2 |
} else { |
set et_vect_extract_even_odd_saved 0 |
if { [istarget powerpc*-*-*] |
|| [istarget i?86-*-*] |
|| [istarget x86_64-*-*] |
|| [istarget spu-*-*] } { |
set et_vect_extract_even_odd_saved 1 |
} |
} |
|
verbose "check_effective_target_vect_extract_even_odd: returning $et_vect_extract_even_odd_saved" 2 |
return $et_vect_extract_even_odd_saved |
} |
|
# Return 1 if the target supports vector even/odd elements extraction of |
# vectors with SImode elements or larger, 0 otherwise. |
|
proc check_effective_target_vect_extract_even_odd_wide { } { |
global et_vect_extract_even_odd_wide_saved |
|
if [info exists et_vect_extract_even_odd_wide_saved] { |
verbose "check_effective_target_vect_extract_even_odd_wide: using cached result" 2 |
} else { |
set et_vect_extract_even_odd_wide_saved 0 |
if { [istarget powerpc*-*-*] |
|| [istarget i?86-*-*] |
|| [istarget x86_64-*-*] |
|| [istarget spu-*-*] } { |
set et_vect_extract_even_odd_wide_saved 1 |
} |
} |
|
verbose "check_effective_target_vect_extract_even_wide_odd: returning $et_vect_extract_even_odd_wide_saved" 2 |
return $et_vect_extract_even_odd_wide_saved |
} |
|
# Return 1 if the target supports vector interleaving, 0 otherwise. |
|
proc check_effective_target_vect_interleave { } { |
global et_vect_interleave_saved |
|
if [info exists et_vect_interleave_saved] { |
verbose "check_effective_target_vect_interleave: using cached result" 2 |
} else { |
set et_vect_interleave_saved 0 |
if { [istarget powerpc*-*-*] |
|| [istarget i?86-*-*] |
|| [istarget x86_64-*-*] |
|| [istarget spu-*-*] } { |
set et_vect_interleave_saved 1 |
} |
} |
|
verbose "check_effective_target_vect_interleave: returning $et_vect_interleave_saved" 2 |
return $et_vect_interleave_saved |
} |
|
# Return 1 if the target supports vector interleaving and extract even/odd, 0 otherwise. |
proc check_effective_target_vect_strided { } { |
global et_vect_strided_saved |
|
if [info exists et_vect_strided_saved] { |
verbose "check_effective_target_vect_strided: using cached result" 2 |
} else { |
set et_vect_strided_saved 0 |
if { [check_effective_target_vect_interleave] |
&& [check_effective_target_vect_extract_even_odd] } { |
set et_vect_strided_saved 1 |
} |
} |
|
verbose "check_effective_target_vect_strided: returning $et_vect_strided_saved" 2 |
return $et_vect_strided_saved |
} |
|
# Return 1 if the target supports vector interleaving and extract even/odd |
# for wide element types, 0 otherwise. |
proc check_effective_target_vect_strided_wide { } { |
global et_vect_strided_wide_saved |
|
if [info exists et_vect_strided_wide_saved] { |
verbose "check_effective_target_vect_strided_wide: using cached result" 2 |
} else { |
set et_vect_strided_wide_saved 0 |
if { [check_effective_target_vect_interleave] |
&& [check_effective_target_vect_extract_even_odd_wide] } { |
set et_vect_strided_wide_saved 1 |
} |
} |
|
verbose "check_effective_target_vect_strided_wide: returning $et_vect_strided_wide_saved" 2 |
return $et_vect_strided_wide_saved |
} |
|
# Return 1 if the target supports section-anchors |
|
proc check_effective_target_section_anchors { } { |
global et_section_anchors_saved |
|
if [info exists et_section_anchors_saved] { |
verbose "check_effective_target_section_anchors: using cached result" 2 |
} else { |
set et_section_anchors_saved 0 |
if { [istarget powerpc*-*-*] |
|| [istarget arm*-*-*] } { |
set et_section_anchors_saved 1 |
} |
} |
|
verbose "check_effective_target_section_anchors: returning $et_section_anchors_saved" 2 |
return $et_section_anchors_saved |
} |
|
# Return 1 if the target supports atomic operations on "int" and "long". |
|
proc check_effective_target_sync_int_long { } { |
global et_sync_int_long_saved |
|
if [info exists et_sync_int_long_saved] { |
verbose "check_effective_target_sync_int_long: using cached result" 2 |
} else { |
set et_sync_int_long_saved 0 |
# This is intentionally powerpc but not rs6000, rs6000 doesn't have the |
# load-reserved/store-conditional instructions. |
if { [istarget ia64-*-*] |
|| [istarget i?86-*-*] |
|| [istarget x86_64-*-*] |
|| [istarget alpha*-*-*] |
|| [istarget bfin*-*linux*] |
|| [istarget s390*-*-*] |
|| [istarget powerpc*-*-*] |
|| [istarget sparc64-*-*] |
|| [istarget sparcv9-*-*] |
|| [istarget mips*-*-*] } { |
set et_sync_int_long_saved 1 |
} |
} |
|
verbose "check_effective_target_sync_int_long: returning $et_sync_int_long_saved" 2 |
return $et_sync_int_long_saved |
} |
|
# Return 1 if the target supports atomic operations on "char" and "short". |
|
proc check_effective_target_sync_char_short { } { |
global et_sync_char_short_saved |
|
if [info exists et_sync_char_short_saved] { |
verbose "check_effective_target_sync_char_short: using cached result" 2 |
} else { |
set et_sync_char_short_saved 0 |
# This is intentionally powerpc but not rs6000, rs6000 doesn't have the |
# load-reserved/store-conditional instructions. |
if { [istarget ia64-*-*] |
|| [istarget i?86-*-*] |
|| [istarget x86_64-*-*] |
|| [istarget alpha*-*-*] |
|| [istarget s390*-*-*] |
|| [istarget powerpc*-*-*] |
|| [istarget sparc64-*-*] |
|| [istarget sparcv9-*-*] |
|| [istarget mips*-*-*] } { |
set et_sync_char_short_saved 1 |
} |
} |
|
verbose "check_effective_target_sync_char_short: returning $et_sync_char_short_saved" 2 |
return $et_sync_char_short_saved |
} |
|
# Return 1 if the target uses a ColdFire FPU. |
|
proc check_effective_target_coldfire_fpu { } { |
return [check_no_compiler_messages coldfire_fpu assembly { |
#ifndef __mcffpu__ |
#error FOO |
#endif |
}] |
} |
|
# Return true if this is a uClibc target. |
|
proc check_effective_target_uclibc {} { |
return [check_no_compiler_messages uclibc object { |
#include <features.h> |
#if !defined (__UCLIBC__) |
#error FOO |
#endif |
}] |
} |
|
# Return true if this is a uclibc target and if the uclibc feature |
# described by __$feature__ is not present. |
|
proc check_missing_uclibc_feature {feature} { |
return [check_no_compiler_messages $feature object " |
#include <features.h> |
#if !defined (__UCLIBC) || defined (__${feature}__) |
#error FOO |
#endif |
"] |
} |
|
# Return true if this is a Newlib target. |
|
proc check_effective_target_newlib {} { |
return [check_no_compiler_messages newlib object { |
#include <newlib.h> |
}] |
} |
|
# Return 1 if |
# (a) an error of a few ULP is expected in string to floating-point |
# conversion functions; and |
# (b) overflow is not always detected correctly by those functions. |
|
proc check_effective_target_lax_strtofp {} { |
# By default, assume that all uClibc targets suffer from this. |
return [check_effective_target_uclibc] |
} |
|
# Return 1 if this is a target for which wcsftime is a dummy |
# function that always returns 0. |
|
proc check_effective_target_dummy_wcsftime {} { |
# By default, assume that all uClibc targets suffer from this. |
return [check_effective_target_uclibc] |
} |
|
# Return 1 if constructors with initialization priority arguments are |
# supposed on this target. |
|
proc check_effective_target_init_priority {} { |
return [check_no_compiler_messages init_priority assembly " |
void f() __attribute__((constructor (1000))); |
void f() \{\} |
"] |
} |
|
# Return 1 if the target matches the effective target 'arg', 0 otherwise. |
# This can be used with any check_* proc that takes no argument and |
# returns only 1 or 0. It could be used with check_* procs that take |
# arguments with keywords that pass particular arguments. |
|
proc is-effective-target { arg } { |
set selected 0 |
if { [info procs check_effective_target_${arg}] != [list] } { |
set selected [check_effective_target_${arg}] |
} else { |
switch $arg { |
"vmx_hw" { set selected [check_vmx_hw_available] } |
"named_sections" { set selected [check_named_sections_available] } |
"gc_sections" { set selected [check_gc_sections_available] } |
"cxa_atexit" { set selected [check_cxa_atexit_available] } |
default { error "unknown effective target keyword `$arg'" } |
} |
} |
verbose "is-effective-target: $arg $selected" 2 |
return $selected |
} |
|
# Return 1 if the argument is an effective-target keyword, 0 otherwise. |
|
proc is-effective-target-keyword { arg } { |
if { [info procs check_effective_target_${arg}] != [list] } { |
return 1 |
} else { |
# These have different names for their check_* procs. |
switch $arg { |
"vmx_hw" { return 1 } |
"named_sections" { return 1 } |
"gc_sections" { return 1 } |
"cxa_atexit" { return 1 } |
default { return 0 } |
} |
} |
} |
|
# Return 1 if target default to short enums |
|
proc check_effective_target_short_enums { } { |
return [check_no_compiler_messages short_enums assembly { |
enum foo { bar }; |
int s[sizeof (enum foo) == 1 ? 1 : -1]; |
}] |
} |
|
# Return 1 if target supports merging string constants at link time. |
|
proc check_effective_target_string_merging { } { |
return [check_no_messages_and_pattern string_merging \ |
"rodata\\.str" assembly { |
const char *var = "String"; |
} {-O2}] |
} |
|
# Return 1 if target has the basic signed and unsigned types in |
# <stdint.h>, 0 otherwise. This will be obsolete when GCC ensures a |
# working <stdint.h> for all targets. |
|
proc check_effective_target_stdint_types { } { |
return [check_no_compiler_messages stdint_types assembly { |
#include <stdint.h> |
int8_t a; int16_t b; int32_t c; int64_t d; |
uint8_t e; uint16_t f; uint32_t g; uint64_t h; |
}] |
} |
|
# Return 1 if target has the basic signed and unsigned types in |
# <inttypes.h>, 0 otherwise. This is for tests that GCC's notions of |
# these types agree with those in the header, as some systems have |
# only <inttypes.h>. |
|
proc check_effective_target_inttypes_types { } { |
return [check_no_compiler_messages inttypes_types assembly { |
#include <inttypes.h> |
int8_t a; int16_t b; int32_t c; int64_t d; |
uint8_t e; uint16_t f; uint32_t g; uint64_t h; |
}] |
} |
|
# Return 1 if programs are intended to be run on a simulator |
# (i.e. slowly) rather than hardware (i.e. fast). |
|
proc check_effective_target_simulator { } { |
|
# All "src/sim" simulators set this one. |
if [board_info target exists is_simulator] { |
return [board_info target is_simulator] |
} |
|
# The "sid" simulators don't set that one, but at least they set |
# this one. |
if [board_info target exists slow_simulator] { |
return [board_info target slow_simulator] |
} |
|
return 0 |
} |
|
# Return 1 if the target is a VxWorks kernel. |
|
proc check_effective_target_vxworks_kernel { } { |
return [check_no_compiler_messages vxworks_kernel assembly { |
#if !defined __vxworks || defined __RTP__ |
#error NO |
#endif |
}] |
} |
|
# Return 1 if the target is a VxWorks RTP. |
|
proc check_effective_target_vxworks_rtp { } { |
return [check_no_compiler_messages vxworks_rtp assembly { |
#if !defined __vxworks || !defined __RTP__ |
#error NO |
#endif |
}] |
} |
|
# Return 1 if the target is expected to provide wide character support. |
|
proc check_effective_target_wchar { } { |
if {[check_missing_uclibc_feature UCLIBC_HAS_WCHAR]} { |
return 0 |
} |
return [check_no_compiler_messages wchar assembly { |
#include <wchar.h> |
}] |
} |
|
# Return 1 if the target has <pthread.h>. |
|
proc check_effective_target_pthread_h { } { |
return [check_no_compiler_messages pthread_h assembly { |
#include <pthread.h> |
}] |
} |
|
# Return 1 if the target can truncate a file from a file-descriptor, |
# as used by libgfortran/io/unix.c:fd_truncate; i.e. ftruncate or |
# chsize. We test for a trivially functional truncation; no stubs. |
# As libgfortran uses _FILE_OFFSET_BITS 64, we do too; it'll cause a |
# different function to be used. |
|
proc check_effective_target_fd_truncate { } { |
set prog { |
#define _FILE_OFFSET_BITS 64 |
#include <unistd.h> |
#include <stdio.h> |
#include <stdlib.h> |
int main () |
{ |
FILE *f = fopen ("tst.tmp", "wb"); |
int fd; |
const char t[] = "test writing more than ten characters"; |
char s[11]; |
fd = fileno (f); |
write (fd, t, sizeof (t) - 1); |
lseek (fd, 0, 0); |
if (ftruncate (fd, 10) != 0) |
exit (1); |
close (fd); |
f = fopen ("tst.tmp", "rb"); |
if (fread (s, 1, sizeof (s), f) != 10 || strncmp (s, t, 10) != 0) |
exit (1); |
exit (0); |
} |
} |
|
if { [check_runtime ftruncate $prog] } { |
return 1; |
} |
|
regsub "ftruncate" $prog "chsize" prog |
return [check_runtime chsize $prog] |
} |
|
# Add to FLAGS all the target-specific flags needed to access the c99 runtime. |
|
proc add_options_for_c99_runtime { flags } { |
if { [istarget *-*-solaris2*] } { |
return "$flags -std=c99" |
} |
if { [istarget powerpc-*-darwin*] } { |
return "$flags -mmacosx-version-min=10.3" |
} |
return $flags |
} |
|
# Add to FLAGS all the target-specific flags needed to enable |
# full IEEE compliance mode. |
|
proc add_options_for_ieee { flags } { |
if { [istarget "alpha*-*-*"] |
|| [istarget "sh*-*-*"] } { |
return "$flags -mieee" |
} |
return $flags |
} |
|
# Add to FLAGS the flags needed to enable functions to bind locally |
# when using pic/PIC passes in the testsuite. |
|
proc add_options_for_bind_pic_locally { flags } { |
if {[check_no_compiler_messages using_pic2 assembly { |
#if __PIC__ != 2 |
#error FOO |
#endif |
}]} { |
return "$flags -fPIE" |
} |
if {[check_no_compiler_messages using_pic1 assembly { |
#if __PIC__ != 1 |
#error FOO |
#endif |
}]} { |
return "$flags -fpie" |
} |
|
return $flags |
} |
|
# Return 1 if the target provides a full C99 runtime. |
|
proc check_effective_target_c99_runtime { } { |
return [check_cached_effective_target c99_runtime { |
global srcdir |
|
set file [open "$srcdir/gcc.dg/builtins-config.h"] |
set contents [read $file] |
close $file |
append contents { |
#ifndef HAVE_C99_RUNTIME |
#error FOO |
#endif |
} |
check_no_compiler_messages_nocache c99_runtime assembly \ |
$contents [add_options_for_c99_runtime ""] |
}] |
} |
|
# Return 1 if target wchar_t is at least 4 bytes. |
|
proc check_effective_target_4byte_wchar_t { } { |
return [check_no_compiler_messages 4byte_wchar_t object { |
int dummy[sizeof (__WCHAR_TYPE__) >= 4 ? 1 : -1]; |
}] |
} |
|
# Return 1 if the target supports automatic stack alignment. |
|
proc check_effective_target_automatic_stack_alignment { } { |
if { [istarget i?86*-*-*] |
|| [istarget x86_64-*-*] } then { |
return 1 |
} else { |
return 0 |
} |
} |
|
# Return 1 if avx instructions can be compiled. |
|
proc check_effective_target_avx { } { |
return [check_no_compiler_messages avx object { |
void _mm256_zeroall (void) |
{ |
__builtin_ia32_vzeroall (); |
} |
} "-O2 -mavx" ] |
} |
|
# Return 1 if sse instructions can be compiled. |
proc check_effective_target_sse { } { |
return [check_no_compiler_messages sse object { |
int main () |
{ |
__builtin_ia32_stmxcsr (); |
return 0; |
} |
} "-O2 -msse" ] |
} |
|
# Return 1 if sse2 instructions can be compiled. |
proc check_effective_target_sse2 { } { |
return [check_no_compiler_messages sse2 object { |
typedef long long __m128i __attribute__ ((__vector_size__ (16))); |
|
__m128i _mm_srli_si128 (__m128i __A, int __N) |
{ |
return (__m128i)__builtin_ia32_psrldqi128 (__A, 8); |
} |
} "-O2 -msse2" ] |
} |
|
# Return 1 if C wchar_t type is compatible with char16_t. |
|
proc check_effective_target_wchar_t_char16_t_compatible { } { |
return [check_no_compiler_messages wchar_t_char16_t object { |
__WCHAR_TYPE__ wc; |
__CHAR16_TYPE__ *p16 = &wc; |
char t[(((__CHAR16_TYPE__) -1) < 0 == ((__WCHAR_TYPE__) -1) < 0) ? 1 : -1]; |
}] |
} |
|
# Return 1 if C wchar_t type is compatible with char32_t. |
|
proc check_effective_target_wchar_t_char32_t_compatible { } { |
return [check_no_compiler_messages wchar_t_char32_t object { |
__WCHAR_TYPE__ wc; |
__CHAR32_TYPE__ *p32 = &wc; |
char t[(((__CHAR32_TYPE__) -1) < 0 == ((__WCHAR_TYPE__) -1) < 0) ? 1 : -1]; |
}] |
} |
|
# Return 1 if pow10 function exists. |
|
proc check_effective_target_pow10 { } { |
return [check_runtime pow10 { |
#include <math.h> |
int main () { |
double x; |
x = pow10 (1); |
return 0; |
} |
} "-lm" ] |
} |
|
# Return 1 if current options generate DFP instructions, 0 otherwise. |
|
proc check_effective_target_hard_dfp {} { |
return [check_no_messages_and_pattern hard_dfp "!adddd3" assembly { |
typedef float d64 __attribute__((mode(DD))); |
d64 x, y, z; |
void foo (void) { z = x + y; } |
}] |
} |
|
# Return 1 if string.h and wchar.h headers provide C++ requires overloads |
# for strchr etc. functions. |
|
proc check_effective_target_correct_iso_cpp_string_wchar_protos { } { |
return [check_no_compiler_messages correct_iso_cpp_string_wchar_protos assembly { |
#include <string.h> |
#include <wchar.h> |
#if !defined(__cplusplus) \ |
|| !defined(__CORRECT_ISO_CPP_STRING_H_PROTO) \ |
|| !defined(__CORRECT_ISO_CPP_WCHAR_H_PROTO) |
ISO C++ correct string.h and wchar.h protos not supported. |
#else |
int i; |
#endif |
}] |
} |
|
# Return 1 if GNU as is used. |
|
proc check_effective_target_gas { } { |
global use_gas_saved |
global tool |
|
if {![info exists use_gas_saved]} { |
# Check if the as used by gcc is GNU as. |
set gcc_as [lindex [${tool}_target_compile "-print-prog-name=as" "" "none" ""] 0] |
# Provide /dev/null as input, otherwise gas times out reading from |
# stdin. |
set status [remote_exec host "$gcc_as" "-v /dev/null"] |
set as_output [lindex $status 1] |
if { [ string first "GNU" $as_output ] >= 0 } { |
set use_gas_saved 1 |
} else { |
set use_gas_saved 0 |
} |
} |
return $use_gas_saved |
} |
|
# Return 1 if the compiler has been configure with link-time optimization |
# (LTO) support. |
|
proc check_effective_target_lto { } { |
global ENABLE_LTO |
return [info exists ENABLE_LTO] |
} |
|
# Return 1 if the language for the compiler under test is C. |
|
proc check_effective_target_c { } { |
global tool |
if [string match $tool "gcc"] { |
return 1 |
} |
return 0 |
} |
|
# Return 1 if the language for the compiler under test is C++. |
|
proc check_effective_target_c++ { } { |
global tool |
if [string match $tool "g++"] { |
return 1 |
} |
return 0 |
} |