#!/usr/bin/tclsh8.4
#
# testing.tcl -- Test Framework for ParentheTcl (p7tcl)
#
# Copyright (c) 2004-2006 Henry Strickland
#
# Permission is hereby granted, free of charge, to any person obtaining a
# copy of this software and associated documentation files (the "Software"),
# to deal in the Software without restriction, including without limitation
# the rights to use, copy, modify, merge, publish, distribute, sublicense,
# and/or sell copies of the Software, and to permit persons to whom the
# Software is furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included
# in all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
# OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
# ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
# OTHER DEALINGS IN THE SOFTWARE.
#
#         (* http://www.opensource.org/licenses/mit-license.php *)
#
#  Usage:
#      source testing.tcl
#
#  This file will load a ".so" file with a name based on our $argv0 value,
#  and if [lindex $argv 0] is "-g", it adds "_g.so".
#  (See code at the very end of this file.)

if [info exists Successes] {
	error "testing.tcl already loaded"
}
set Successes 0

proc Humanize s {
	# change non-ASCII chars to "?" and trim to 999 chars
	regsub {[^ -~]} $s "?" s
	set s [string range $s 0 999]
	if {[string length $s]>=999} { append s "..." }
	set s
}


proc AssertTrue {expression} {
    set e [catch [list uplevel 1 [list expr $expression]] result]

    if $e {
	error "TEST THREW ERROR $e: Condition `[Humanize $expression]' Expected true Threw `[Humanize $result]'"
    }

    if { ! $result } {
	error "TEST FAILED: Condition `[Humanize $expression]' Expected true Result `[Humanize $result]'"
    }
    incr ::Successes
    return
}

proc AssertFalse {expression} {
    set e [catch [list uplevel 1 [list expr $expression]] result]

    if $e {
	error "TEST THREW ERROR $e: Condition `[Humanize $expression]' Expected false Threw `[Humanize $result]'"
    }

    if { $result } {
	error "TEST FAILED: Condition `[Humanize $expression]' Expected false Result `[Humanize $result]'"
    }
    incr ::Successes
    return
}

proc AssertEq {expected command} {
    set e [catch [list uplevel 1 $command] result]

    if $e {
	error "TEST THREW ERROR $e: Command `[Humanize $command]' Expected `[Humanize $expected]' Threw `[Humanize $result]'"
    }

    if { $expected ne $result } {
	error "TEST FAILED: Command `[Humanize $command]' Expected `[Humanize $expected]' Result `[Humanize $result]'"
    }
    incr ::Successes
    return
}

proc AssertNe {expected command} {
    set e [catch [list uplevel 1 $command] result]

    if $e {
	error "TEST THREW ERROR $e: Command `[Humanize $command]' Expected `[Humanize $expected]' Threw `[Humanize $result]'"
    }

    if { $expected eq $result } {
	error "TEST FAILED: Command `[Humanize $command]' Result `[Humanize $result]'"
    }
    incr ::Successes
    return
}

proc AssertMatch {expectedPattern command} {
    set e [catch [list uplevel 1 $command] result]

    if $e {
	error "TEST THREW ERROR $e: Command `[Humanize $command]' ExpectedPattern `[Humanize $expectedPattern]' Threw `[Humanize $result]'"
    }

    if { ! [string match $expectedPattern $result] } {
	error "TEST FAILED: Command `[Humanize $command]' ExpectedPattern `[Humanize $expectedPattern]' Result `[Humanize $result]'"
    }
    incr ::Successes
    return
}

proc AssertError {expected command} {
    set e [catch [list uplevel 1 $command] result]

    if { $e != 1 } { 
	error "TEST DID NOT THROW EXPECTED ERROR: Command `[Humanize $command]' Expected `[Humanize $expected]' Status $e Result `[Humanize $result]'" 
    }

    if { ! [string match $expected $result] } {
	error "ERROR THROWN DID NOT MATCH EXPECTED ERROR: Command `[Humanize $command]' Expected `[Humanize $expected]' Result `[Humanize $result]'"
    }
    incr ::Successes
    return
}

proc Okay {} {
	puts "        OKAY: $::Successes tests succeeded"
	return
}

# Now load the .so being tested.
# Deduce its name from $argv0.
# If there is an initial argument -g, use the debug version.

if { [lindex $argv 0] eq "-g" } {
	# debug version
	set DEBUG 1
	set EXTENSION _g.so
	set argv [lrange $argv 1 end]
} else {
	# normal version
	set DEBUG 0
	set EXTENSION   .so
}

load ./[file rootname $argv0]$EXTENSION