gcc/testsuite/lib/chill.exp - gcc - Git at Google

 #
 # 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
 }
	#
	# 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
	}