URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
Compare Revisions
- This comparison shows the changes necessary to convert path
/openrisc/trunk/gnu-old/gcc-4.2.2/gcc/testsuite/lib
- from Rev 154 to Rev 816
- ↔ Reverse comparison
Rev 154 → Rev 816
/copy-file.exp
0,0 → 1,33
# 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 { [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 |
} |
} |
} |
} |
/profopt.exp
0,0 → 1,418
# Copyright (C) 2001, 2004, 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/>. |
# |
# 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 |
|
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 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 "compat.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 |
} |
|
# Compile for profiling. |
|
set 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 "" |
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 "" |
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 |
} |
} |
} |
/gcc.exp
0,0 → 1,152
# Copyright (C) 1992, 1993, 1994, 1996, 1997, 1999, 2000, 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/>. |
|
# 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 |
|
# |
# 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 |
|
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 |
} |
|
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] |
} |
if [target_info exists gcc,timeout] { |
lappend options "timeout=[target_info gcc,timeout]" |
} |
lappend options "additional_flags=-fno-show-column" |
lappend options "compiler=$GCC_UNDER_TEST" |
set options [dg-additional-files-options $options $source] |
return [target_compile $source $dest $type $options] |
} |
/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 |
} |
/c-compat.exp
0,0 → 1,98
# Copyright (C) 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/>. |
|
# 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 |
set compat_have_dfp 1 |
# If there is an alternate compiler, does it support decimal float types? |
if { $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 |
} |
# Does the compiler under test support it? |
if { $compat_have_dfp == 1 } { |
set compat_have_dfp [check_effective_target_dfprt_nocache] |
verbose "compat_have_dfp for tst 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"] |
} |
} |
/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]" |
} |
} |
/gfortran-dg.exp
0,0 → 1,109
# Copyright (C) 2004, 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/>. |
|
load_lib gcc-dg.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 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_OPTIONS |
} 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} |
} |
} |
} |
/g++.exp
0,0 → 1,318
# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2002, 2003, |
# 2004, 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/>. |
|
# 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 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 " |
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 |
|
# 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 |
|
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" |
|
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" |
|
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 |
} |
} |
/obj-c++.exp
0,0 → 1,368
# Copyright (C) 2004, 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/>. |
|
# 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 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"] { |
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}"] { |
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}] |
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 |
|
lappend options "libs=-lobjc" |
set shlib_ext [get_shlib_extension] |
verbose "shared lib extension: $shlib_ext" |
|
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 (which usually |
# _is not_ the case on Mac OS X systems), 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 == ""} { |
verbose "see if we have -fgnu-runtime in options" |
if [regexp ".*-fgnu-runtime.*" "${options}" ] { |
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 == ""} { |
verbose "see if we have -fgnu-runtime in options" |
if [regexp ".*-fgnu-runtime.*" "${options}"] { |
set libobjc_dir \ |
[lookfor_file ${objcpath} libobjc/.libs/libobjc-gnu.${shlib_ext}] |
} |
} |
|
if { $libobjc_dir != "" } { |
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"; |
|
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 |
} |
} |
/wrapper.exp
0,0 → 1,42
# 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. |
|
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 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] |
} |
} |
} |
/gnat-dg.exp
0,0 → 1,45
# 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/>. |
|
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}] |
} |
/compat.exp
0,0 → 1,378
# Copyright (C) 2002, 2003, 2004, 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/>. |
|
# 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 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_INT: disable all tests using the complex integral types extension, |
# - VA: disable all tests using the variable number of arguments feature, |
# - 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 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 { |
remote_file build 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-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-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-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 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. |
regsub "_main.*" $src1 "" base |
regsub ".*/" $base "" base |
regsub "_main" $src1 "_x" src2 |
regsub "_main" $src1 "_y" src3 |
|
# 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 |
|
# 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 $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" |
set execname2 "${execbase}-${count}2" |
set execname3 "${execbase}-${count}3" |
set execname4 "${execbase}-${count}4" |
incr count |
|
remote_file build delete $execname1 |
remote_file build delete $execname2 |
remote_file build delete $execname3 |
remote_file build 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 "remote_file build delete $objfile" |
} |
} |
} |
} |
} |
/c-torture.exp
0,0 → 1,305
# Copyright (C) 1992-1998, 1999, 2000, 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 Rob Savoye. (rob@cygnus.com) |
|
load_lib file-format.exp |
|
# The default option list can be overridden by |
# TORTURE_OPTIONS="{ { list1 } ... { listN } }" |
|
if ![info exists TORTURE_OPTIONS] { |
# 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 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 } ] |
} |
|
|
# Split TORTURE_OPTIONS into two choices: one for testcases with loops and |
# one for testcases without loops. |
|
set torture_with_loops $TORTURE_OPTIONS |
set torture_without_loops "" |
foreach option $TORTURE_OPTIONS { |
if ![string match "*loop*" $option] { |
lappend torture_without_loops $option |
} |
} |
|
# |
# 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 |
remote_file build 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] |
} |
|
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 [gcc_target_compile "$sources" "${execname}" executable $options] |
|
if ![gcc_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" |
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 |
} |
} |
if { $skip == 0 } { |
set result [gcc_load "$execname" "" ""] |
set status [lindex $result 0] |
set output [lindex $result 1] |
} |
if { $oldstatus == "pass" } { |
remote_file build delete $oldexec |
} |
$status "$testcase execution, $option" |
set oldstatus $status |
} |
if [info exists status] { |
if { $status == "pass" } { |
remote_file build 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" |
} |
} |
/gcc-dg.exp
0,0 → 1,535
# Copyright (C) 1997, 1999, 2000, 2003, 2004, 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/>. |
|
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 prune.exp |
load_lib libgloss.exp |
load_lib target-libpath.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 |
|
if ![info exists TORTURE_OPTIONS] { |
# 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 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 } ] |
} |
|
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 |
} |
|
# Split TORTURE_OPTIONS into two choices: one for testcases with loops and |
# one for testcases without loops. |
|
set torture_with_loops $TORTURE_OPTIONS |
set torture_without_loops "" |
foreach option $TORTURE_OPTIONS { |
if ![string match "*loop*" $option] { |
lappend torture_without_loops $option |
} |
} |
|
# 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. An ICE always fails, |
# there's no way to XFAIL it. |
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" |
} |
|
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 |
|
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 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 $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} |
} |
} |
} |
|
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] } { |
foreach level {1 "" 3} { |
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] ] } { |
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 { |
remote_file build delete $output_file |
} |
} |
|
# 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" |
|
# Clean up dump files for additional source files. |
if [info exists additional_sources] { |
foreach srcfile $additional_sources { |
remove-build-file "[file tail $srcfile].$suffix" |
} |
} |
} |
|
# Remove files kept by --save-temps for the current test. |
# |
# Currently this is only .i files, but more can be added if there are |
# tests generating them. |
proc cleanup-saved-temps { } { |
global additional_sources |
|
# 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]].ii" |
remove-build-file "[file rootname [file tail $testcase]].i" |
|
# Clean up saved temp files for additional source files. |
if [info exists additional_sources] { |
foreach srcfile $additional_sources { |
remove-build-file "[file rootname [file tail $srcfile]].ii" |
remove-build-file "[file rootname [file tail $srcfile]].i" |
} |
} |
} |
|
# Remove files for specified Fortran modules. |
proc cleanup-modules { modlist } { |
foreach modname $modlist { |
remove-build-file [string tolower $modname].mod |
} |
} |
|
# 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 |
} |
error $errmsg $saved_info |
} |
set additional_files "" |
set additional_sources "" |
set additional_prunes "" |
set shouldfail 0 |
if [info exists compiler_conditional_xfail_data] { |
unset compiler_conditional_xfail_data |
} |
} |
} |
|
set additional_prunes "" |
/scanasm.exp
0,0 → 1,272
# Copyright (C) 2000, 2002, 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/>. |
|
# Various utilities for scanning assembler output, used by gcc-dg.exp and |
# g++-dg.exp. |
|
# Utility for scanning compiler result, invoked via dg-final. |
|
# 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" { } |
} |
} |
|
set fd [open $output_file r] |
set text [read $fd] |
close $fd |
|
set pattern [lindex $orig_args 0] |
set printable_pattern [string map {\t \\t \n \\n \r \\r \\ \\\\} $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 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 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 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 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 |
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 |
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 |
|
# 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 |
|
if { [llength [regexp -inline -all -- [lindex $args 0] $text]] == [lindex $args 1]} { |
pass "$testcase scan-assembler-times [lindex $args 0] [lindex $args 1]" |
} else { |
fail "$testcase scan-assembler-times [lindex $args 0] [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 output_file "[file rootname [file tail $testcase]].s" |
|
set fd [open "| $cxxfilt < $output_file" r] |
set text [read $fd] |
close $fd |
|
if [regexp -- [lindex $args 0] $text] { |
pass "$testcase scan-assembler-dem [lindex $args 0]" |
} else { |
fail "$testcase scan-assembler-dem [lindex $args 0]" |
} |
} |
|
# 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 output_file "[file rootname [file tail $testcase]].s" |
|
set fd [open "| $cxxfilt < $output_file" r] |
set text [read $fd] |
close $fd |
|
if ![regexp -- [lindex $args 0] $text] { |
pass "$testcase scan-assembler-dem-not [lindex $args 0]" |
} else { |
fail "$testcase scan-assembler-dem-not [lindex $args 0]" |
} |
} |
/treelang-dg.exp
0,0 → 1,36
# Copyright (C) 1997, 1999, 2000, 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 gcc-dg.exp |
|
# Define gcc callbacks for dg.exp. |
|
proc treelang-dg-test { prog do_what extra_tool_flags } { |
return [gcc-dg-test-1 treelang_target_compile $prog $do_what $extra_tool_flags] |
} |
|
proc treelang-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 treelang-dg-runtest { testcases default-extra-flags } { |
return [gcc-dg-runtest $testcases ${default-extra-flags}] |
} |
/gnat.exp
0,0 → 1,281
# 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/>. |
|
# 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 |
|
# |
# 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 |
|
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 [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 |
|
setenv ADA_INCLUDE_PATH "${rootme}/ada/rts" |
set ld_library_path ".:${gnat_libgcc_s_path}" |
lappend options "compiler=$GNAT_UNDER_TEST -q -f" |
lappend options "incdir=${rootme}/ada/rts" |
|
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 |
} |
|
# If this is an older version of DejaGnu (without find_gnatmake), provide one. |
# This can be deleted after next DejaGnu release. |
|
if { [info procs find_gnatmake] == "" } { |
proc 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] |
set CC "$file -I$root/ada/rts --GCC=$root/xgcc --GNATBIND=$root/gnatbind --GNATLINK=$root/gnatlink -cargs -B$root -largs --GCC=$root/xgcc -B$root -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 |
} |
} |
/prune.exp
0,0 → 1,58
# Copyright (C) 1997, 1999, 2000, 2002, 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/>. |
|
# 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 )?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)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 |
|
# 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 |
} |
} |
/gcov.exp
0,0 → 1,300
# 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 } { |
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 |
} |
} |
/treelang.exp
0,0 → 1,269
# Copyright (C) 1992, 1993, 1994, 1996, 1997, 2000, 2001, 2002, 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 was written by Rob Savoye (rob@cygnus.com) |
# Currently maintained by James A. Morrison (ja2morri@uwaterloo.ca) |
|
# Having this file here magically tells dejagnu that the treelang |
# directory is worthy of testing |
|
# This file is basically gcc.exp with gcc replaced with treelang. |
|
# This file is loaded by the tool init file (eg: unix.exp). It provides |
# default definitions for treelang_start, etc. and other supporting cast |
# members. |
|
# These globals are used by treelang_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 target-libpath.exp |
|
# |
# TREELANG_UNDER_TEST is the compiler under test. |
# |
|
# |
# default_treelang_version -- extract and print the version number of the compiler |
# |
|
proc default_treelang_version { } { |
global TREELANG_UNDER_TEST |
|
treelang_init |
|
# ignore any arguments after the command |
set compiler [lindex $TREELANG_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" |
} |
} |
|
# treelang_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 treelang_initialized 0 |
|
proc treelang_init { args } { |
global tmpdir |
global libdir |
global gluefile wrap_flags |
global treelang_initialized |
global TREELANG_UNDER_TEST |
global TOOL_EXECUTABLE |
global treelang_libgcc_s_path |
|
|
# 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 |
|
|
if { $treelang_initialized == 1 } { return; } |
|
if ![info exists TREELANG_UNDER_TEST] then { |
if [info exists TOOL_EXECUTABLE] { |
set TREELANG_UNDER_TEST $TOOL_EXECUTABLE |
} else { |
set TREELANG_UNDER_TEST [find_gcc] |
} |
} |
|
if ![info exists tmpdir] then { |
set tmpdir /tmp |
} |
|
treelang_maybe_build_wrapper "${tmpdir}/treelang-testglue.o" |
|
set treelang_libgcc_s_path \ |
[gcc-set-multilib-library-path $TREELANG_UNDER_TEST] |
} |
|
proc treelang_target_compile { source dest type options } { |
global rootme |
global tmpdir |
global gluefile wrap_flags |
global srcdir |
global TREELANG_UNDER_TEST |
global TOOL_OPTIONS |
global ld_library_path |
global treelang_libgcc_s_path |
|
set ld_library_path ".:${treelang_libgcc_s_path}" |
set_ld_library_path_env_vars |
|
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 libtreelang along with the compiler (which usually |
# _is not_ the case on Mac OS X systems), point the test harness |
# at it (and associated headers). |
|
return [target_compile $source $dest $type $options] |
} |
|
# |
# treelang_pass -- utility to record a testcase passed |
# |
|
proc treelang_pass { testcase cflags } { |
if { "$cflags" == "" } { |
pass "$testcase" |
} else { |
pass "$testcase, $cflags" |
} |
} |
|
# |
# treelang_fail -- utility to record a testcase failed |
# |
|
proc treelang_fail { testcase cflags } { |
if { "$cflags" == "" } { |
fail "$testcase" |
} else { |
fail "$testcase, $cflags" |
} |
} |
|
# |
# treelang_finish -- called at the end of every .exp script that calls treelang_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 treelang_init did |
# (that needs undoing). |
# |
|
proc treelang_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 treelang_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 treelang that aren't useful. |
|
proc prune_treelang_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 treelang 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 treelang 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 |
} |
|
/dg-pch.exp
0,0 → 1,77
# 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/>. |
|
load_lib copy-file.exp |
|
proc dg-pch { subdir test 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 delete "$bname$suffix.gch" } |
catch { file delete "$bname.s" } |
catch { file 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, $flags" 1 |
|
# For the header files, the default is to precompile. |
set dg-do-what-default precompile |
catch { file delete "$bname$suffix" } |
gcc_copy_files "[file rootname $test]${suffix}s" "$bname$suffix" |
dg-test -keep-output "./$bname$suffix" $flags "" |
|
# For the rest, the default is to compile to .s. |
set dg-do-what-default compile |
|
if { [ file exists "$bname$suffix.gch" ] } { |
# Ensure that the PCH file is used, not the original header. |
file delete "$bname$suffix" |
|
dg-test -keep-output $test $flags "-I." |
file delete "$bname$suffix.gch" |
if { [ file exists "$bname.s" ] } { |
file rename "$bname.s" "$bname.s-gch" |
gcc_copy_files "[file rootname $test]${suffix}s" "$bname$suffix" |
dg-test -keep-output $test $flags "-I." |
set tmp [ diff "$bname.s" "$bname.s-gch" ] |
if { $tmp == 0 } { |
untested "$nshort $flags assembly comparison" |
} elseif { $tmp == 1 } { |
pass "$nshort $flags assembly comparison" |
} else { |
fail "$nshort $flags assembly comparison" |
} |
file delete "$bname$suffix" |
file delete "$bname.s" |
file delete "$bname.s-gch" |
} else { |
untested "$nshort $flags assembly comparison" |
} |
|
} else { |
untested "$nshort $flags" |
untested "$nshort $flags assembly comparison" |
} |
} |
} |
/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] |
} |
/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]" |
} |
} |
/file-format.exp
0,0 → 1,91
# 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 |
|
catch { |
set output [exec $objdump_name --file-headers objfmtst.o ] |
} output |
|
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 |
} |
/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}] |
} |
/target-libpath.exp
0,0 → 1,257
# Copyright (C) 2004, 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/>. |
|
# 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 |
|
|
####################################### |
# 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_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 |
|
# Setting the ld library path causes trouble when testing cross-compilers. |
if { [is_remote target] } { |
return |
} |
|
if { $orig_environment_saved == 0 } { |
global env |
|
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_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 |
|
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 |
} |
|
/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] |
} |
/scandump.exp
0,0 → 1,217
# 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 dump output, used by gcc-dg.exp and |
# g++-dg.exp. |
# |
# This is largely borrowed from scanasm.exp. |
|
# 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 src [file tail [lindex $testcase 0]] |
set output_file "[glob $src.[lindex $args 2]]" |
|
set fd [open $output_file r] |
set text [read $fd] |
close $fd |
|
if [regexp -- [lindex $args 1] $text] { |
pass "$testcase scan-[lindex $args 0]-dump [lindex $args 1]" |
} else { |
fail "$testcase scan-[lindex $args 0]-dump [lindex $args 1]" |
} |
} |
|
# 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 src [file tail [lindex $testcase 0]] |
set output_file "[glob $src.[lindex $args 3]]" |
|
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 "$testcase scan-[lindex $args 0]-dump-times [lindex $args 1] [lindex $args 2]" |
} else { |
fail "$testcase scan-[lindex $args 0]-dump-times [lindex $args 1] [lindex $args 2]" |
} |
} |
|
# 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 src [file tail [lindex $testcase 0]] |
set output_file "[glob $src.[lindex $args 2]]" |
|
set fd [open $output_file r] |
set text [read $fd] |
close $fd |
|
if ![regexp -- [lindex $args 1] $text] { |
pass "$testcase scan-[lindex $args 0]-dump-not [lindex $args 1]" |
} else { |
fail "$testcase scan-[lindex $args 0]-dump-not [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 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 src [file tail [lindex $testcase 0]] |
set output_file "[glob $src.[lindex $args 2]]" |
|
set fd [open "| $cxxfilt < $output_file" r] |
set text [read $fd] |
close $fd |
|
if [regexp -- [lindex $args 1] $text] { |
pass "$testcase scan-[lindex $args 0]-dump-dem [lindex $args 1]" |
} else { |
fail "$testcase scan-[lindex $args 0]-dump-dem [lindex $args 1]" |
} |
} |
|
# 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 src [file tail [lindex $testcase 0]] |
set output_file "[glob $src.[lindex $args 2]]" |
|
set fd [open "| $cxxfilt < $output_file" r] |
set text [read $fd] |
close $fd |
|
if ![regexp -- [lindex $args 1] $text] { |
pass "$testcase scan-[lindex $args 0]-dump-dem-not [lindex $args 1]" |
} else { |
fail "$testcase scan-[lindex $args 0]-dump-dem-not [lindex $args 1]" |
} |
} |
/target-supports-dg.exp
0,0 → 1,411
# Copyright (C) 1997, 1999, 2000, 2003, 2004, 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/>. |
|
# 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 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. |
|
proc dg-require-effective-target { args } { |
set args [lreplace $args 0 0] |
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"] |
} |
} |
|
# Check the flags with which the test will be run against options in |
# a test directive that will skip or xfail that test. The DejaGnu proc |
# check_conditional_xfail will look at the options in compiler_flags, so |
# set that up for this test based on flags we know about. |
|
proc check_test_flags { args } { |
global compiler_flags |
upvar 2 dg-extra-tool-flags extra_tool_flags |
|
# Pull the args out of the enclosing list. |
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 $extra_tool_flags |
set dest [target_info name] |
if [board_info $dest exists multilib_flags] { |
append compiler_flags "[board_info $dest multilib_flags] " |
} |
|
set answer [check_conditional_xfail $args] |
|
# Any value in this variable originally was left over from an earlier test. |
set compiler_flags "" |
|
verbose "check_test_flags: $args $answer" 2 |
return $answer |
} |
|
# 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 |
# These variables are from DejaGnu's dg-test. |
upvar dg-extra-tool-flags extra_tool_flags |
upvar tool_flags tool_flags |
|
# 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 $extra_tool_flags |
append compiler_flags $tool_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 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 } { |
# 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 args [lreplace $args 0 0] |
|
set selector [list target [lindex $args 1]] |
if { [dg-process-target $selector] == "S" } { |
# These are defined in DejaGnu's dg-test, needed by check-flags. |
upvar dg-extra-tool-flags dg-extra-tool-flags |
upvar tool_flags tool_flags |
|
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 } { |
# 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 args [lreplace $args 0 0] |
set selector [list target [lindex $args 1]] |
if { [dg-process-target $selector] == "S" } { |
global compiler_conditional_xfail_data |
set compiler_conditional_xfail_data [lreplace $args 1 1 "*-*-*"] |
} |
} |
|
# 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. These variables |
# are defined in DejaGnu's dg-test, needed by check-flags. |
upvar dg-extra-tool-flags dg-extra-tool-flags |
upvar tool_flags tool_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] |
} |
} |
/gcc-defs.exp
0,0 → 1,258
# 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 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] |
|
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" |
} |
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 |
} |
/fortran-torture.exp
0,0 → 1,375
# 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/>. |
|
# 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. |
|
# The biggest change from g77 is that we always test all testcases with |
# loop options, because it is much harder to figure out whether a testcase |
# has loops if you have array syntax, like Fortran 95. In fact, the whole |
# point of F95 is arrays, so loops show up in most testcases anyway. |
|
|
# The default option list can be overridden by |
# TORTURE_OPTIONS="{ { list1 } ... { listN } }" |
|
if ![info exists TORTURE_OPTIONS] { |
set TORTURE_OPTIONS [list \ |
{ -O0 } { -O1 } { -O2 } \ |
{ -O2 -fomit-frame-pointer -finline-functions } \ |
{ -O2 -fomit-frame-pointer -finline-functions -funroll-loops } \ |
{ -O2 -fbounds-check } \ |
{ -O2 -fno-repack-arrays } \ |
{ -O3 -g } \ |
{ -Os }] |
} |
|
|
# |
# 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_OPTIONS |
|
# 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_OPTIONS |
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 existance 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 |
|
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 [list { "-O" } ] |
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" |
} |
} |
/objc.exp
0,0 → 1,319
# Copyright (C) 1992, 1993, 1994, 1996, 1997, 2000, 2001, 2002, 2004, 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/>. |
|
# 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 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 |
|
# 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 |
|
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 |
} |
|
objc_maybe_build_wrapper "${tmpdir}/objc-testglue.o" |
|
append 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 ld_library_path ".:${objc_libgcc_s_path}" |
lappend options "libs=-lobjc" |
set shlib_ext [get_shlib_extension] |
verbose "shared lib extension: $shlib_ext" |
|
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 (which usually |
# _is not_ the case on Mac OS X systems), 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 == ""} { |
verbose "see if we have -fgnu-runtime in options" |
if [regexp ".*-fgnu-runtime.*" "${options}"] { |
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 == ""} { |
verbose "see if we have -fgnu-runtime in options" |
if [regexp ".*-fgnu-runtime.*" "${options}"] { |
set libobjc_dir \ |
[lookfor_file ${objcpath} libobjc/.libs/libobjc-gnu.${shlib_ext}] |
} |
} |
if { $libobjc_dir != "" } { |
set objc_include_dir "${srcdir}/../../libobjc" |
lappend options "additional_flags=-I${objc_include_dir}" |
set libobjc_dir [file dirname ${libobjc_dir}] |
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" |
|
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 |
} |
|
/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]" |
} |
} |
/objc-torture.exp
0,0 → 1,324
# Copyright (C) 1992-1998, 1999, 2000, 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 Rob Savoye. (rob@cygnus.com) |
|
load_lib file-format.exp |
|
# The default option list can be overridden by |
# TORTURE_OPTIONS="{ { list1 } ... { listN } }" |
|
if ![info exists OBJC_RUNTIME_OPTIONS] { |
set OBJC_RUNTIME_OPTIONS "" |
foreach type {-fgnu-runtime -fnext-runtime} { |
global srcdir subdir |
|
set comp_output [objc_target_compile \ |
"$srcdir/$subdir/trivial.m" "trivial.exe" executable "additional_flags=$type"] |
|
# If we get any error, then we failed |
if ![string match "" $comp_output] then { |
continue; |
} |
lappend OBJC_RUNTIME_OPTIONS $type |
} |
} |
verbose -log "Using the following runtimes: $OBJC_RUNTIME_OPTIONS" |
|
|
if ![info exists TORTURE_OPTIONS] { |
# 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 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 " ] |
} |
|
|
# Split TORTURE_OPTIONS into two choices: one for testcases with loops and |
# one for testcases without loops. Add in the objc runtime options also. |
|
set torture_with_loops "" |
set torture_without_loops "" |
foreach objc_option $OBJC_RUNTIME_OPTIONS { |
foreach option $TORTURE_OPTIONS { |
|
if ![string match "*loop*" $option] { |
lappend torture_without_loops "$option $objc_option" |
} |
lappend torture_with_loops "$option $objc_option" |
} |
} |
|
|
# |
# 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 } { |
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" |
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 |
} |
} |
if { $skip == 0 } { |
set result [objc_load "$execname" "" ""] |
set status [lindex $result 0] |
set output [lindex $result 1] |
} |
if { $oldstatus == "pass" } { |
remote_file build delete $oldexec |
} |
$status "$testcase execution, $option" |
set oldstatus $status |
} |
if [info exists status] { |
if { $status == "pass" } { |
remote_file build 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 |
} |
|
# |
# 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" |
} |
} |
/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 |
} |
/gfortran.exp
0,0 → 1,200
# Copyright (C) 2003, 2004, 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/>. |
|
# 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 target-libpath.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"] { |
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 |
|
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" |
} |
|
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" |
|
set options [concat "$ALWAYS_GFORTRANFLAGS" $options] |
set options [dg-additional-files-options $options $source] |
return [target_compile $source $dest $type $options] |
} |
/target-supports.exp
0,0 → 1,1967
# Copyright (C) 1999, 2001, 2003, 2004, 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/>. |
|
# 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 some code and return the messages printed by the compiler, |
# and optionally the contents for assembly files. Either a string or |
# a list of two strings are returned, depending on WANT_OUTPUT. |
# |
# BASENAME is a basename to use for temporary files. |
# WANT_OUTPUT is a flag which is 0 to request returning just the |
# compiler messages, or 1 to return the messages and the contents |
# of the assembly file. TYPE should be "assembly" if WANT_OUTPUT |
# is set. |
# TYPE is the type of compilation to perform (see target_compile). |
# CONTENTS gives the contents of the input file. |
# The rest is optional: |
# OPTIONS: additional compiler options to use. |
proc get_compiler_messages {basename want_output type contents args} { |
global tool |
|
if { [llength $args] > 0 } { |
set options [list "additional_flags=[lindex $args 0]"] |
} else { |
set options "" |
} |
|
set src ${basename}[pid].c |
switch $type { |
assembly { set output ${basename}[pid].s } |
object { set output ${basename}[pid].o } |
} |
set f [open $src "w"] |
puts $f $contents |
close $f |
set lines [${tool}_target_compile $src $output $type "$options"] |
file delete $src |
|
if { $want_output } { |
if { $type != "assembly" } { |
error "WANT_OUTPUT can only be used with assembly output" |
} elseif { ![string match "" $lines] } { |
# An error occurred. |
set result [list $lines ""] |
} else { |
set text "" |
set chan [open "$output"] |
while {[gets $chan line] >= 0} { |
append text "$line\n" |
} |
close $chan |
set result [list $lines $text] |
} |
} else { |
set result $lines |
} |
|
remote_file build delete $output |
return $result |
} |
|
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 compiler and seeing if it prints any messages. Assume that the |
# property holds if the compiler doesn't print anything. The other |
# arguments are as for get_compiler_messages, starting with TYPE. |
proc check_no_compiler_messages {prop args} { |
global et_cache |
|
set target [current_target_name] |
if {![info exists et_cache($prop,target)] |
|| $et_cache($prop,target) != $target} { |
verbose "check_no_compiler_messages $prop: compiling source for $target" 2 |
set et_cache($prop,target) $target |
set et_cache($prop,value) \ |
[string match "" [eval get_compiler_messages $prop 0 $args]] |
} |
set value $et_cache($prop,value) |
verbose "check_no_compiler_messages $prop: returning $value for $target" 2 |
return $value |
} |
|
# Similar to check_no_compiler_messages, but also verify that the regular |
# expression PATTERN matches the compiler's output. |
proc check_no_messages_and_pattern {prop pattern args} { |
global et_cache |
|
set target [current_target_name] |
if {![info exists et_cache($prop,target)] |
|| $et_cache($prop,target) != $target} { |
verbose "check_no_messages_and_pattern $prop: compiling source for $target" 2 |
set et_cache($prop,target) $target |
set results [eval get_compiler_messages $prop 1 $args] |
set et_cache($prop,value) \ |
[expr [string match "" [lindex $results 0]] \ |
&& [regexp $pattern [lindex $results 1]]] |
} |
set value $et_cache($prop,value) |
verbose "check_no_messages_and_pattern $prop: returning $value for $target" 2 |
return $value |
} |
|
############################### |
# 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_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 |
} |
|
# 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 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 |
} |
|
# At present, there is no profiling support on NetWare. |
if { [istarget *-*-netware*] } { |
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 arm*-*-elf] |
|| [istarget arm*-*-symbianelf*] |
|| [istarget powerpc-*-eabi*] |
|| [istarget strongarm*-*-elf] |
|| [istarget xscale*-*-elf] |
|| [istarget cris-*-*] |
|| [istarget h8300-*-*] |
|| [istarget m32c-*-elf] |
|| [istarget m68k-*-elf] |
|| [istarget mips*-*-elf] |
|| [istarget xtensa-*-elf] |
|| [istarget *-*-windiss] } { |
set profiling_available_saved 0 |
} else { |
set profiling_available_saved 1 |
} |
} |
|
return $profiling_available_saved |
} |
|
# 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. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_tls {} { |
global et_tls_saved |
global tool |
|
if [info exists et_tls_saved] { |
verbose "check_effective_target_tls: using cached result" 2 |
} else { |
set et_tls_saved 1 |
|
set src tls[pid].c |
set asm tls[pid].S |
verbose "check_effective_target_tls: compiling testfile $src" 2 |
set f [open $src "w"] |
# Compile a small test program. |
puts $f "__thread int i;\n" |
close $f |
|
# Test for thread-local data supported by the platform. |
set comp_output \ |
[${tool}_target_compile $src $asm assembly ""] |
file delete $src |
if { [string match "*not supported*" $comp_output] } { |
set et_tls_saved 0 |
} |
remove-build-file $asm |
} |
verbose "check_effective_target_tls: returning $et_tls_saved" 2 |
return $et_tls_saved |
} |
|
# Return 1 if TLS executables can run correctly, 0 otherwise. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_tls_runtime {} { |
global et_tls_runtime_saved |
global tool |
|
if [info exists et_tls_runtime_saved] { |
verbose "check_effective_target_tls_runtime: using cached result" 2 |
} else { |
set et_tls_runtime_saved 0 |
|
set src tls_runtime[pid].c |
set exe tls_runtime[pid].x |
verbose "check_effective_target_tls_runtime: compiling testfile $src" 2 |
set f [open $src "w"] |
# Compile a small test program. |
puts $f "__thread int thr = 0;\n" |
puts $f "int main(void)\n {\n return thr;\n}" |
close $f |
|
set comp_output \ |
[${tool}_target_compile $src $exe executable ""] |
file delete $src |
|
if [string match "" $comp_output] then { |
# No error messages, everything is OK. |
|
set result [remote_load target "./$exe" "" ""] |
set status [lindex $result 0] |
remote_file build delete $exe |
|
verbose "check_effective_target_tls_runtime status is <$status>" 2 |
|
if { $status == "pass" } { |
set et_tls_runtime_saved 1 |
} |
|
verbose "check_effective_target_tls_runtime: returning $et_tls_runtime_saved" 2 |
} |
} |
|
return $et_tls_runtime_saved |
} |
|
# 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 -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 iconv is supported on the target. In particular IBM1047. |
|
proc check_iconv_available { test_what } { |
global tool |
global libiconv |
|
set result "" |
|
set src iconv[pid].c |
set exe iconv[pid].x |
verbose "check_iconv_available compiling testfile $src" 2 |
set f [open $src "w"] |
# Compile a small test program. |
puts $f "#include <iconv.h>\n" |
puts $f "int main (void)\n {\n iconv_t cd; \n" |
puts $f "cd = iconv_open (\"[lindex $test_what 1]\", \"UTF-8\");\n" |
puts $f "if (cd == (iconv_t) -1)\n return 1;\n" |
puts $f "return 0;\n}" |
close $f |
|
# If the tool configuration file has not set libiconv, try "-liconv" |
if { ![info exists libiconv] } { |
set libiconv "-liconv" |
} |
set lines [${tool}_target_compile $src $exe executable "libs=$libiconv" ] |
file delete $src |
|
if [string match "" $lines] then { |
# No error messages, everything is OK. |
|
set result [${tool}_load "./$exe" "" ""] |
set status [lindex $result 0] |
remote_file build delete $exe |
|
verbose "check_iconv_available status is <$status>" 2 |
|
if { $status == "pass" } then { |
return 1 |
} |
} |
|
return 0 |
} |
|
# 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 { } { |
global et_fortran_large_real_saved |
global et_fortran_large_real_target_name |
global tool |
|
if { ![info exists et_fortran_large_real_target_name] } { |
set et_fortran_large_real_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_fortran_large_real_target_name } { |
verbose "check_effective_target_fortran_large_real: `$et_fortran_large_real_target_name' `$current_target'" 2 |
set et_fortran_large_real_target_name $current_target |
if [info exists et_fortran_large_real_saved] { |
verbose "check_effective_target_fortran_large_real: removing cached result" 2 |
unset et_fortran_large_real_saved |
} |
} |
|
if [info exists et_fortran_large_real_saved] { |
verbose "check_effective_target_fortran_large_real returning saved $et_fortran_large_real_saved" 2 |
} else { |
set et_fortran_large_real_saved 0 |
|
# Set up, compile, and execute a test program using large real |
# kinds. Include the current process ID in the file names to |
# prevent conflicts with invocations for multiple testsuites. |
set src real[pid].f90 |
set exe real[pid].x |
|
set f [open $src "w"] |
puts $f "integer,parameter :: k = &" |
puts $f " selected_real_kind (precision (0.0_8) + 1)" |
puts $f "real(kind=k) :: x" |
puts $f "x = cos (x);" |
puts $f "end" |
close $f |
|
verbose "check_effective_target_fortran_large_real compiling testfile $src" 2 |
set lines [${tool}_target_compile $src $exe executable ""] |
file delete $src |
|
if [string match "" $lines] then { |
# No error message, compilation succeeded. |
set et_fortran_large_real_saved 1 |
} |
} |
|
return $et_fortran_large_real_saved |
} |
|
# 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 { } { |
global et_fortran_large_int_saved |
global et_fortran_large_int_target_name |
global tool |
|
if { ![info exists et_fortran_large_int_target_name] } { |
set et_fortran_large_int_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_fortran_large_int_target_name } { |
verbose "check_effective_target_fortran_large_int: `$et_fortran_large_int_target_name' `$current_target'" 2 |
set et_fortran_large_int_target_name $current_target |
if [info exists et_fortran_large_int_saved] { |
verbose "check_effective_target_fortran_large_int: removing cached result" 2 |
unset et_fortran_large_int_saved |
} |
} |
|
if [info exists et_fortran_large_int_saved] { |
verbose "check_effective_target_fortran_large_int returning saved $et_fortran_large_int_saved" 2 |
} else { |
set et_fortran_large_int_saved 0 |
|
# Set up, compile, and execute a test program using large integer |
# kinds. Include the current process ID in the file names to |
# prevent conflicts with invocations for multiple testsuites. |
set src int[pid].f90 |
set exe int[pid].x |
|
set f [open $src "w"] |
puts $f "integer,parameter :: k = &" |
puts $f " selected_int_kind (range (0_8) + 1)" |
puts $f "integer(kind=k) :: i" |
puts $f "end" |
close $f |
|
verbose "check_effective_target_fortran_large_int compiling testfile $src" 2 |
set lines [${tool}_target_compile $src $exe executable ""] |
file delete $src |
|
if [string match "" $lines] then { |
# No error message, compilation succeeded. |
set et_fortran_large_int_saved 1 |
} |
} |
|
return $et_fortran_large_int_saved |
} |
|
# 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 { } { |
global et_static_libgfortran |
global et_static_libgfortran_target_name |
global tool |
|
if { ![info exists et_static_libgfortran_target_name] } { |
set et_static_libgfortran_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_static_libgfortran_target_name } { |
verbose "check_effective_target_static_libgfortran: `$et_static_libgfortran_target_name' `$current_target'" 2 |
set et_static_libgfortran_target_name $current_target |
if [info exists et_static_libgfortran_saved] { |
verbose "check_effective_target_static_libgfortran: removing cached result" 2 |
unset et_static_libgfortran_saved |
} |
} |
|
if [info exists et_static_libgfortran_saved] { |
verbose "check_effective_target_static_libgfortran returning saved $et_static_libgfortran_saved" 2 |
} else { |
set et_static_libgfortran_saved 0 |
|
# Set up, compile, and execute a test program using static linking. |
# Include the current process ID in the file names to prevent |
# conflicts with invocations for multiple testsuites. |
set opts "additional_flags=-static" |
set src static[pid].f |
set exe static[pid].x |
|
set f [open $src "w"] |
puts $f " print *, 'test'" |
puts $f " end" |
close $f |
|
verbose "check_effective_target_static_libgfortran 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 et_static_libgfortran_saved 1 |
} |
} |
|
return $et_static_libgfortran_saved |
} |
|
# Return 1 if the target supports executing AltiVec instructions, 0 |
# otherwise. Cache the result. |
|
proc check_vmx_hw_available { } { |
global vmx_hw_available_saved |
global tool |
|
if [info exists vmx_hw_available_saved] { |
verbose "check_hw_available returning saved $vmx_hw_available_saved" 2 |
} else { |
set vmx_hw_available_saved 0 |
|
# Some simulators are known to not support VMX instructions. |
if { [istarget powerpc-*-eabi] || [istarget powerpc*-*-eabispe] } { |
verbose "check_hw_available returning 0" 2 |
return $vmx_hw_available_saved |
} |
|
# Set up, compile, and execute a test program containing VMX |
# instructions. Include the current process ID in the file |
# names to prevent conflicts with invocations for multiple |
# testsuites. |
set src vmx[pid].c |
set exe vmx[pid].x |
|
set f [open $src "w"] |
puts $f "int main() {" |
puts $f "#ifdef __MACH__" |
puts $f " asm volatile (\"vor v0,v0,v0\");" |
puts $f "#else" |
puts $f " asm volatile (\"vor 0,0,0\");" |
puts $f "#endif" |
puts $f " return 0; }" |
close $f |
|
# Most targets don't require special flags for this test case, but |
# Darwin does. |
if [istarget *-*-darwin*] { |
set opts "additional_flags=-maltivec" |
} else { |
set opts "" |
} |
|
verbose "check_vmx_hw_available 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_vmx_hw_available testfile status is <$status>" 2 |
|
if { $status == "pass" } then { |
set vmx_hw_available_saved 1 |
} |
} else { |
verbose "check_vmx_hw_availalble testfile compilation failed" 2 |
} |
} |
|
return $vmx_hw_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 { } { |
global et_broken_cplxf_arg_saved |
global et_broken_cplxf_arg_target_name |
global tool |
|
# Skip the work for targets known not to be affected. |
if { ![istarget powerpc64-*-linux*] } { |
return 0 |
} elseif { [is-effective-target ilp32] } { |
return 0 |
} |
|
if { ![info exists et_broken_cplxf_arg_target_name] } { |
set et_broken_cplxf_arg_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_broken_cplxf_arg_target_name } { |
verbose "check_effective_target_broken_cplxf_arg: `$et_broken_cplxf_arg_target_name'" 2 |
set et_broken_cplxf_arg_target_name $current_target |
if [info exists et_broken_cplxf_arg_saved] { |
verbose "check_effective_target_broken_cplxf_arg: removing cached result" 2 |
unset et_broken_cplxf_arg_saved |
} |
} |
|
if [info exists et_broken_cplxf_arg_saved] { |
verbose "check_effective_target_broken_cplxf_arg: using cached result" 2 |
} else { |
set et_broken_cplxf_arg_saved 0 |
# This is only known to affect one target. |
if { ![istarget powerpc64-*-linux*] || ![is-effective-target lp64] } { |
set et_broken_cplxf_arg_saved 0 |
verbose "check_effective_target_broken_cplxf_arg: caching 0" 2 |
return $et_broken_cplxf_arg_saved |
} |
|
# Set up, compile, and execute a C test program that calls cabsf. |
set src cabsf[pid].c |
set exe cabsf[pid].x |
|
set f [open $src "w"] |
puts $f "#include <complex.h>" |
puts $f "extern void abort (void);" |
puts $f "float fabsf (float);" |
puts $f "float cabsf (_Complex float);" |
puts $f "int main ()" |
puts $f "{" |
puts $f " _Complex float cf;" |
puts $f " float f;" |
puts $f " cf = 3 + 4.0fi;" |
puts $f " f = cabsf (cf);" |
puts $f " if (fabsf (f - 5.0) > 0.0001) abort ();" |
puts $f " return 0;" |
puts $f "}" |
close $f |
|
set lines [${tool}_target_compile $src $exe executable "-lm"] |
file delete $src |
|
if [string match "" $lines] { |
# No error message, compilation succeeded. |
set result [${tool}_load "./$exe" "" ""] |
set status [lindex $result 0] |
remote_file build delete $exe |
|
verbose "check_effective_target_broken_cplxf_arg: status is <$status>" 2 |
|
if { $status != "pass" } { |
set et_broken_cplxf_arg_saved 1 |
} |
} else { |
verbose "check_effective_target_broken_cplxf_arg: compilation failed" 2 |
} |
} |
return $et_broken_cplxf_arg_saved |
} |
|
proc check_alpha_max_hw_available { } { |
global alpha_max_hw_available_saved |
global tool |
|
if [info exists alpha_max_hw_available_saved] { |
verbose "check_alpha_max_hw_available returning saved $alpha_max_hw_available_saved" 2 |
} else { |
set alpha_max_hw_available_saved 0 |
|
# Set up, compile, and execute a test program probing bit 8 of the |
# architecture mask, which indicates presence of MAX instructions. |
set src max[pid].c |
set exe max[pid].x |
|
set f [open $src "w"] |
puts $f "int main() { return __builtin_alpha_amask(1<<8) != 0; }" |
close $f |
|
verbose "check_alpha_max_hw_available compiling testfile $src" 2 |
set lines [${tool}_target_compile $src $exe executable ""] |
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_alpha_max_hw_available testfile status is <$status>" 2 |
|
if { $status == "pass" } then { |
set alpha_max_hw_available_saved 1 |
} |
} else { |
verbose "check_alpha_max_hw_availalble testfile compilation failed" 2 |
} |
} |
|
return $alpha_max_hw_available_saved |
} |
|
# 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 } { |
set var "${function}_available_saved" |
global $var |
global tool |
|
if {![info exists $var]} { |
# Assume it exists. |
set $var 1 |
# Check to make sure. |
set src "function[pid].c" |
set exe "function[pid].exe" |
|
set f [open $src "w"] |
puts $f "#ifdef __cplusplus\nextern \"C\"\n#endif\n" |
puts $f "char $function ();\n" |
puts $f "int main () { $function (); }" |
close $f |
|
set lines [${tool}_target_compile $src $exe executable ""] |
file delete $src |
file delete $exe |
|
if {![string match "" $lines]} then { |
set $var 0 |
verbose -log "$function is not available" |
} else { |
verbose -log "$function is available" |
} |
} |
|
eval return \$$var |
} |
|
# 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 { } { |
global et_cxa_atexit |
global et_cxa_atexit_target_name |
global tool |
|
if { ![info exists et_cxa_atexit_target_name] } { |
set et_cxa_atexit_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_cxa_atexit_target_name } { |
verbose "check_cxa_atexit_available: `$et_cxa_atexit_target_name'" 2 |
set et_cxa_atexit_target_name $current_target |
if [info exists et_cxa_atexit] { |
verbose "check_cxa_atexit_available: removing cached result" 2 |
unset et_cxa_atexit |
} |
} |
|
if [info exists et_cxa_atexit] { |
verbose "check_cxa_atexit_available: using cached result" 2 |
} elseif { [istarget "hppa*-*-hpux10*"] } { |
# HP-UX 10 doesn't have __cxa_atexit but subsequent test passes. |
set et_cxa_atexit 0 |
} else { |
set et_cxa_atexit 0 |
|
# Set up, compile, and execute a C++ test program that depends |
# on correct ordering of static object destructors. This is |
# indicative of the presence and use of __cxa_atexit. |
set src cxaatexit[pid].cc |
set exe cxaatexit[pid].x |
|
set f [open $src "w"] |
puts $f "#include <stdlib.h>" |
puts $f "static unsigned int count;" |
puts $f "struct X" |
puts $f "{" |
puts $f " X() { count = 1; }" |
puts $f " ~X()" |
puts $f " {" |
puts $f " if (count != 3)" |
puts $f " exit(1);" |
puts $f " count = 4;" |
puts $f " }" |
puts $f "};" |
puts $f "void f()" |
puts $f "{" |
puts $f " static X x;" |
puts $f "}" |
puts $f "struct Y" |
puts $f "{" |
puts $f " Y() { f(); count = 2; }" |
puts $f " ~Y()" |
puts $f " {" |
puts $f " if (count != 2)" |
puts $f " exit(1);" |
puts $f " count = 3;" |
puts $f " }" |
puts $f "};" |
puts $f "Y y;" |
puts $f "int main()" |
puts $f "{ return 0; }" |
close $f |
|
set lines [${tool}_target_compile $src $exe executable ""] |
file delete $src |
|
if [string match "" $lines] { |
# No error message, compilation succeeded. |
set result [${tool}_load "./$exe" "" ""] |
set status [lindex $result 0] |
remote_file build delete $exe |
|
verbose "check_cxa_atexit_available: status is <$status>" 2 |
|
if { $status == "pass" } { |
set et_cxa_atexit 1 |
} |
} else { |
verbose "check_cxa_atexit_available: compilation failed" 2 |
} |
} |
return $et_cxa_atexit |
} |
|
|
# 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 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 [string match "" [get_compiler_messages dfp 0 object { |
_Decimal32 x; _Decimal64 y; _Decimal128 z; |
}]] |
verbose "check_effective_target_dfp_nocache: returning $ret" 2 |
return $ret |
} |
|
proc check_effective_target_dfprt_nocache { } { |
global tool |
|
set ret 0 |
|
verbose "check_effective_target_dfprt_nocache: compiling source" 2 |
# Set up, compile, and execute a test program containing decimal |
# float operations. |
set src dfprt[pid].c |
set exe dfprt[pid].x |
|
set f [open $src "w"] |
puts $f "_Decimal32 x = 1.2df; _Decimal64 y = 2.3dd; _Decimal128 z;" |
puts $f "int main () { z = x + y; return 0; }" |
close $f |
|
verbose "check_effective_target_dfprt_nocache: compiling testfile $src" 2 |
set lines [${tool}_target_compile $src $exe executable ""] |
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_dfprt_nocache: testfile status is <$status>" 2 |
if { $status == "pass" } then { |
set ret 1 |
} |
} |
return $ret |
verbose "check_effective_target_dfprt_nocache: returning $ret" 2 |
} |
|
# 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 { } { |
global et_dfp_saved |
|
if [info exists et_dfp_saved] { |
verbose "check_effective_target_dfp: using cached result" 2 |
} else { |
set et_dfp_saved [check_effective_target_dfp_nocache] |
} |
verbose "check_effective_target_dfp: returning $et_dfp_saved" 2 |
return $et_dfp_saved |
} |
|
# 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 { } { |
global et_dfprt_saved |
global tool |
|
if [info exists et_dfprt_saved] { |
verbose "check_effective_target_dfprt: using cached result" 2 |
} else { |
set et_dfprt_saved [check_effective_target_dfprt_nocache] |
} |
verbose "check_effective_target_dfprt: returning $et_dfprt_saved" 2 |
return $et_dfprt_saved |
} |
|
# 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 ia64-*-*] |
|| (([istarget x86_64-*-*] || [istarget i?86-*-*]) |
&& [check_effective_target_lp64]) |
|| ([istarget powerpc*-*-*] |
&& ([check_effective_target_powerpc_spe] |
|| [check_effective_target_powerpc_altivec]))} { |
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 x86_64-*-*] |
|| [istarget sparc*-*-*] |
|| [istarget alpha*-*-*] |
|| [istarget ia64-*-*] } { |
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 is this is an arm target using 32-bit instructions |
proc check_effective_target_arm32 { } { |
global et_arm32_saved |
global et_arm32_target_name |
global compiler_flags |
|
if { ![info exists et_arm32_target_name] } { |
set et_arm32_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_arm32_target_name } { |
verbose "check_effective_target_arm32: `$et_arm32_target_name' `$current_target'" 2 |
set et_arm32_target_name $current_target |
if { [info exists et_arm32_saved] } { |
verbose "check_effective_target_arm32: removing cached result" 2 |
unset et_arm32_saved |
} |
} |
|
if [info exists et_arm32_saved] { |
verbose "check-effective_target_arm32: using cached result" 2 |
} else { |
set et_arm32_saved 0 |
if { [istarget arm-*-*] |
|| [istarget strongarm*-*-*] |
|| [istarget xscale-*-*] } { |
if ![string match "*-mthumb *" $compiler_flags] { |
set et_arm32_saved 1 |
} |
} |
} |
verbose "check_effective_target_arm32: returning $et_arm32_saved" 2 |
return $et_arm32_saved |
} |
|
# 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 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 supporting -maltivec. |
|
proc check_effective_target_powerpc_altivec_ok { } { |
if { [istarget powerpc*-*-*] |
|| [istarget rs6000-*-*] } { |
# AltiVec is not supported on Aix. |
if { [istarget powerpc*-*-aix*] } { |
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 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 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 ia64-*-*] |
|| [istarget i?86-*-*] |
|| [istarget x86_64-*-*] } { |
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*-*-*] && [check_effective_target_ilp32]) |
|| [istarget x86_64-*-*] |
|| ([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 mipsisa64*-*-*] |
|| [istarget x86_64-*-*] |
|| [istarget ia64-*-*] } { |
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-*-*] } { |
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 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 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 a vector |
# widening summation of *short* args into *int* result, 0 otherwise. |
# |
# 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 0 |
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. |
# |
# 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 { [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 summation, 0 otherwise. |
# |
# This won't change for different subtargets so cache the result. |
|
proc check_effective_target_vect_widen_sum { } { |
global et_vect_widen_sum |
|
if [info exists et_vect_widen_sum_saved] { |
verbose "check_effective_target_vect_widen_sum: using cached result" 2 |
} else { |
set et_vect_widen_sum_saved 0 |
if { [istarget powerpc*-*-*] |
|| [istarget ia64-*-*] } { |
set et_vect_widen_sum_saved 1 |
} |
} |
verbose "check_effective_target_vect_widen_sum: returning $et_vect_widen_sum_saved" 2 |
return $et_vect_widen_sum_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 |
if { [istarget ia64-*-*] } { |
set et_vect_sdot_qi_saved 1 |
} |
} |
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*-*-*] |
|| [istarget ia64-*-*] } { |
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 i?86-*-*] |
|| [istarget x86_64-*-*] |
|| [istarget ia64-*-*] } { |
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*-*-*] } { |
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 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-*-*] } { |
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 arrays are naturally 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] } { |
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 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 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 i?86-*-*] |
|| [istarget x86_64-*-*] } { |
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 i?86-*-*] |
|| [istarget x86_64-*-*] } { |
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 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*-*-*] } { |
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 s390*-*-*] |
|| [istarget powerpc*-*-*] |
|| [istarget sparc64-*-*] |
|| [istarget sparcv9-*-*] } { |
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-*-*] } { |
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 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 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 |
} |