diff options
Diffstat (limited to 'gcc/testsuite/lib/chill.exp')
| -rw-r--r-- | gcc/testsuite/lib/chill.exp | 366 |
1 files changed, 1 insertions, 365 deletions
diff --git a/gcc/testsuite/lib/chill.exp b/gcc/testsuite/lib/chill.exp index bd8c4f64f2b..716021146f5 100644 --- a/gcc/testsuite/lib/chill.exp +++ b/gcc/testsuite/lib/chill.exp @@ -1,365 +1 @@ -# -# Expect script for Chill Regression Tests -# Copyright (C) 1993, 1996, 1997 Free Software Foundation -# -# This file 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 2 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 this program; if not, write to the Free Software -# Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -# -# Written by Jeffrey Wheat (cassidy@cygnus.com) -# - -# -# chill support library procedures and testsuite specific instructions -# - -# -# default_chill_version -# extract and print the version number of the chill compiler -# exits if compiler does not exist -# -proc default_chill_version { } { - global GCC_UNDER_TEST - - # ignore any arguments after the command - set compiler [lindex $GCC_UNDER_TEST 0] - - # verify that the compiler exists - if {[which $compiler] != 0} then { - set tmp [ exec $compiler -v ] - regexp "version.*$" $tmp version - - if [info exists version] then { - clone_output "[which $compiler] $version\n" - } - } else { - warning "$compiler does not exist" - exit -1 - } -} - -# -# chill_compile -# compile the specified file -# -# returns values: -# return 0 on success -# return 1 on failure with $result containing compiler output -# exit with -1 if compiler doesn't exist -# -# verbosity output: -# 1 - indicate compile in progress -# 2 - indicate compile, target name -# 3 - indicate compile, target name, exec command, and result -# -proc chill_compile { src obj } { - global GCC_UNDER_TEST - global CFLAGS - - global errno - global result - global verbose - - global subdir - global tmpdir - - set errno 0 - set cflags $CFLAGS - set dumpfile [file rootname $obj].cmp ;# name of file to dump stderr in - - # verify that the compiler exists - if { [which $GCC_UNDER_TEST] == 0 } then { - warning "$GCC_UNDER_TEST does not exist" - exit -1 - } - - if { $verbose == 1 } then { - send_user "Compiling... " - } else { - verbose " - CMPL: Compiling [file tail $src]" 2 - } - - # if object type is a grt file, then only build a grant file - if [string match "*.grt" $obj] then { - set cflags [concat $cflags -fgrant-only] - } - - # build command line - set commandline "$GCC_UNDER_TEST $cflags -I$subdir -c $src" - - # write command line to logfile - send_log "\n### EXEC: $commandline\n" - - # tell us whats going on if verbose - verbose "### EXEC: $commandline" 3 - - # exec the compiler with the appropriate flags - set errno [catch "exec $commandline" result] - - # dump compiler's stderr output into $dumpfile - this is a gross hack - set dumpfile [open $dumpfile w+]; puts $dumpfile $result; close $dumpfile - - # log any compiler output unless its null - if ![string match "" $result] then { send_log "\n$result\n" } - unset cflags - return -} - -# -# chill_link -# link the specified files -# -# returns values: -# return 0 on success -# return 1 on failure with $result containing compiler output -# exit with -1 if compiler doesn't exist -# -# verbosity output: -# 1 - indicate linking in progress -# 2 - indicate linking, target name -# 3 - indicate linking, target name, exec command, and result -# -proc chill_link { target } { - global GCC_UNDER_TEST - global CFLAGS - - global errno - global result - global verbose - global tmptarget - - global crt0 - global libs - global objs - - set errno 0 - - # verify that the compiler exists - if { [which $GCC_UNDER_TEST] == 0 } then { - warning "$GCC_UNDER_TEST does not exist" - exit -1 - } - - if { $verbose == 1 } then { - send_user "Linking... " - } else { - verbose " - LINK: Linking [file tail $target]" 2 - } - - # verify that the object exists - if ![file exists $target.o] then { - set errno 1 - set result "file $target.o doesn'timeout exist" - return - } - - # build command line - set commandline "$GCC_UNDER_TEST $CFLAGS -o $target $target.o $objs $crt0 $libs" - - # write command line to logfile - send_log "\n### EXEC: $commandline\n" - - # tell us whats going on if we are verbose - verbose "### EXEC: $commandline" 3 - - # link the objects, sending any linker output to $result - set errno [catch "exec $commandline > $tmptarget.lnk" result] - - # log any linker output unless its null - if ![string match "" $result] then { send_log "\n$result\n" } - return -} - -# -# default_chill_start -# -proc default_chill_start { } { - global srcdir - global subdir - global tmpdir - global verbose - - if { $verbose > 1 } then { send_user "Configuring testsuite... " } - - # tmpdir is obtained from $objdir/site.exp. if not, set it to /tmp - if ![info exists tmpdir] then { set tmpdir /tmp } - - # save and convert $srcdir to an absolute pathname, stomp on the old value - # stomp on $subdir and set to the absolute path to the subdirectory - global osrcdir; set osrcdir $srcdir; set srcdir [cd $srcdir; pwd] - global osubdir; set osubdir $subdir; set subdir $srcdir/$subdir - - # cd the temporary directory, $tmpdir - cd $tmpdir; verbose "### PWD: [pwd]" 5 - - # copy init files to the tmpdir - foreach initfile [glob -nocomplain $subdir/*.init] { - set targfile $tmpdir/[file tail [file rootname $initfile]] - verbose "### EXEC: cp $initfile $targfile" 5 - if [catch "exec cp $initfile $targfile"] then { - send_user "\nConfigure failed.\n" - exit -1 - } - } - if { $verbose > 1 } then { send_user "Configuring finished.\n" } -} - -# -# default_chill_exit -# -# -proc default_chill_exit { } { - global srcdir - global objdir - global tmpdir - global osrcdir - global osubdir - - # reset directory variables - set srcdir $osrcdir; set subdir $osubdir - - # remove all generated targets and objects - verbose "### EXEC: rm -f $tmpdir/*" 3 - catch "exec rm -f $tmpdir/*" result - - # change back to the main object directory - cd $objdir - verbose "### SANITY: [pwd]" 5 -} - -# -# chill_diff -# compare two files line-by-line -# -# returns values: -# return 0 on success -# return 1 if different -# return -1 if output file doesn't exist -# -# verbosity output: -# 1 - indicate diffing in progress -# 2 - indicate diffing, target names -# 3 - indicate diffing, target names, and result -# -proc chill_diff { file_1 file_2 } { - global errno - global result - global target - global tmptarget - - global verbose - - set eof -1 - set errno 0 - set differences 0 - - if { $verbose == 1 } then { - send_user "Diffing... " - } else { - verbose " - DIFF: Diffing [file tail $file_1] [file tail $file_2]" 2 - } - - # write command line to logfile - send_log "### EXEC: diff $file_1 $file_2\n" - - # tell us whats going on if we are verbose - verbose "### EXEC: diff $file_1 $file_2" 3 - - # verify file exists and open it - if [file exists $file_1] then { - set file_a [open $file_1 r] - } else { - set errno -1; set result "$file_1 doesn't exist" - return - } - - # verify file exists and is not zero length, and then open it - if [file exists $file_2] then { - if [file size $file_2]!=0 then { - set file_b [open $file_2 r] - } else { - set errno -1; set result "$file_2 is zero bytes"; return - } - } else { - set errno -1; set result "$file_2 doesn't exist"; return - } - - # spoof the diff routine - lappend list_a $target - - while { [gets $file_a line] != $eof } { - if [regexp "^#.*$" $line] then { - continue - } else { - lappend list_a $line - } - } - close $file_a - - # spoof the diff routine - lappend list_b $target - - while { [gets $file_b line] != $eof } { - if [regexp "^#.*$" $line] then { - continue - } else { - # use [file tail $line] to strip off pathname - lappend list_b [file tail $line] - } - } - close $file_b - - for { set i 0 } { $i < [llength $list_a] } { incr i } { - set line_a [lindex $list_a $i] - set line_b [lindex $list_b $i] - - if [string compare $line_a $line_b] then { - set errno 1 - set count [expr $i+1] - set linenum [format %dc%d $count $count] - verbose "$linenum" 3 - verbose "< $line_a" 3 - verbose "---" 3 - verbose "> $line_b" 3 - - send_log "$file_1: < $count: $line_a\n" - send_log "$file_2: > $count: $line_b\n" - set result "differences found" - } - } - return -} - -# -# chill_fail -# a wrapper around the framework fail proc -# -proc chill_fail { target result } { - global verbose - - if { $verbose == 1 } then { send_user "\n" } - fail $target - verbose "--------------------------------------------------" 3 - verbose "### RESULT: $result" 3 -} - -# -# chill_pass -# a wrapper around the framework fail proc -# -proc chill_pass { target } { - global verbose - - if { $verbose == 1 } then { send_user "\n" } - pass $target -} + set result "file $target.o doesn't exist" |