diff options
Diffstat (limited to 'gcc/testsuite/lib/chill.exp')
| -rwxr-xr-x | gcc/testsuite/lib/chill.exp | 365 |
1 files changed, 365 insertions, 0 deletions
diff --git a/gcc/testsuite/lib/chill.exp b/gcc/testsuite/lib/chill.exp new file mode 100755 index 0000000..bd8c4f6 --- /dev/null +++ b/gcc/testsuite/lib/chill.exp @@ -0,0 +1,365 @@ +# +# 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 +} |