366 lines
9.0 KiB
Plaintext
366 lines
9.0 KiB
Plaintext
#
|
|
# 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't 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
|
|
}
|