#!/bin/sh
# the next line restarts using wish \
exec wish4.1 "$0" "$@"

# This simple and elegant test engine was part of stooop-2.1,
# created by Jean-Luc Fontaine (jfontain@pluton.experdata.fr).
# I have since modified it for our needs.
# Modifications:
#   *	Use tputs instead of puts (this separates test-output from
#	debugging messages etc).  Note:  This leads to not failing
#	on error messages!  Also: each *.tst-script must now include
#	testutils.tcl
# /PF

set dir ./[file dirname [info script]]

lappend auto_path ./[file dirname [info script]]/..

# first gather valid files and sort them

set numbers [lsort [glob $dir/*.tst]]

if {[llength [info commands interp]]>0} {
    # for use as a puts emulation when running a slave interpreter
    proc appendWithNewLine {variableName string} {
        upvar $variableName variable
        append variable $string\n
    }
}

proc mkVec { data vName } {
	upvar 1 $vName v
	upvar 1 $data a
	set i 0
	foreach row [split $a "\n"] {
		set v($i) $row
		incr i
	}
}

# showDiffs: Just to find first error, no resync!
#
proc showDiffs { a b } {
	upvar 1 $a A
	upvar 1 $b B
	mkVec A vA
	mkVec B vB
	set iA 0
	set iB 0
	while { 1 } {
		if ![info exists vA($iA)] break
		if ![info exists vB($iB)] {
			set vB($iB) ""
		}
		if ![string compare $vA($iA) $vB($iB)] {
			puts "    OK: $vA($iA)"
		} else {
			puts "Wanted: $vA($iA)"
			puts "   Got: $vB($iB)"
		}
		incr iA; incr iB
	}
	while { 1 } {
		if ![info exists vB($iB)] break
		if ![info exists vA($iA)] {
			set vA($iA) ""
		}
		if ![string compare $vA($iA) $vB($iB)] {
			puts "    OK: $vA($iA)"
		} else {
			puts "Wanted: $vA($iA)"
			puts "   Got: $vB($iB)"
		}
		incr iA; incr iB
	}
}

foreach number [lsort $numbers] {
    puts -nonewline "test $number ... "
	flush stdout
    set testFile $number
    # store expected output
    set expect ""
    set file [open $testFile]
    while {[gets $file line]>=0} {
        if {[regexp {^## (.*)$} $line dummy line]} {
            append expect $line\n
        }
    }
    close $file

    if {[llength [info commands interp]]==0} {
        set output [eval exec -keepnewline \
		[concat $shell $testFile 2>@ stdout]]
    } else {
        # use as a slave interpreter if available,
	# for exec may not be available on some platforms
        set output {}
        set interpreter [interp create]
        # alias puts to be able to collect slave stdout data
        $interpreter alias tputs appendWithNewLine output
        $interpreter alias exit return
	$interpreter eval "set auto_path [list $auto_path]"
        if {[catch {$interpreter eval source $testFile} error]} {
            # error messages always appear first through
	    # exec because stderr is not buffered
            set output $error\n$output
        }
        interp delete $interpreter
    }

    if {[string compare $expect $output]==0} {
        puts passed
    } else {
	puts failed
	puts "--------"
	showDiffs expect output
	exit
        puts failed
	puts "--------"
        puts "### with output:"
        puts $output
        puts "### expected:"
        puts $expect
	puts "--------"
    }
}

exit
