path: root/gcc/testsuite/lib/chill.exp

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