#!/usr/bin/tclsh
#
# Mx: testing script for awk-like test database
#
# Hanhua Feng - hanhua@cs.columbia.edu
#
# $Id: mxtest.tcl,v 1.10 2003/05/13 23:24:23 hanhua Exp $
#
# Usage:  ./mxtest.tcl <your-test-database>.tdb
#
# Database format:
#
# The test database file contains one or more entries of the following:
#
#    <expected-result> { <Mx-program> }
#
# Note that both <expected-result> and <Mx-program> can span multiple 
# lines.  Everything in the same line after the last } will be ignored.
# 
# <expected-result> contains one or more items separated by space/newline.
# Each item can have the following format:
#
#    !              switch stdin and stderr (default: matching stdin)
#    ...            there are more items can be ignored
#    /<regexp>/     use regular expression to match (use ^ and $ if needed!)
#    [<num>,<num>]  check whether the result is a number in the range
#    <other>        do exactly match.  number comparision for numbers.
#
# ; starts a line of comments
# ;; starts a line of comments that will be printed during testing
# ;;; starts a line of comments that will be immediately printed
#
# Example: the test for the following program will succeed:
#
#    ;;; My test script
#    ;; my test 1
#    1 2 [4,7] /^[0-9.]+$/  { return [1,2;5,3]; }
#    ;; my test 2
#    3                      { return 1+2; }

# set the source code directory here
set src ../src

# java should be in the path, otherwise add the full path
set javaexec java

# check operating system: windows or unix
if { [string first ":" $env(PWD)] >= 0 || ( [info exists env(OS)] \
           && [string first windows [string tolower $env(OS)]] >= 0 ) } {
    set osd ";"
} else {
    set osd ":"
}

proc count { line cnt } {
    set pos -1
    while { 1 } {
        incr pos
        set pos [string first "\{" $line $pos]
        if { $pos < 0 } break;
        incr cnt
    }

    set pos -1
    while { 1 } {
        incr pos
        set pos [string first "\}" $line $pos]
        if { $pos < 0 } break;
        incr cnt -1
    }

    return $cnt
}

proc remove_empty { l } {
    set rv {}

    foreach item $l {
        if { [string length $item] > 0 } {
            lappend rv $item
        }
    }

    return $rv
}

proc matchresult { pattern string error } {
    global linenum

    set pattern [remove_empty $pattern]
    set string [remove_empty $string]
    set error [remove_empty $error]

#    puts "Matching $pattern with $string..."

    foreach item $pattern {
        if { [string equal "!" $item ] } {
            set t $string
            set string $error
            set error $t
            continue
        }

        set data [lindex $string 0]
        set string [lrange $string 1 end]

        if { [string equal -length 1 "/" $item ] } {
            if { ![string equal [string index $item end] "/"] } {
                puts stderr "Error ($linenum): regexp must be ended by /"
                exit 1
            }

            if { ![regexp [string range $item 1 end-1] $data] } {
                puts "Test failed: expect $item, got $data"
                return -1
            }
        } elseif { [string equal -length 1 "\[" $item ] } {
            if { ![regexp "^\\\[(\[0-9.Ee+-\]+),(\[0-9.Ee+-\]+)\\\]$" \
                       $item dummy min max] } {
                puts stderr "Error($linenum): range format \[<num>,<num>\]."
                exit 1
            }

            if { ![string is double $data] || $data < $min || $data > $max } {
                puts "Test failed: expect $item, got $data"
                return -1;
            }
        } elseif { [string is double $data] } {
            if { $data != $item } {
                puts "Test failed: expect $item, got $data"
                return -1;
            }
        } elseif { [string equal "..." $item] } {
            set string {}
            set error {}
            break;
        } else {
            if { ![string equal $item $data] } {
                puts "Test failed: expect $item, got $data"
                return -1;
            }
        }

#        puts "Match succeeded: $item: $data"
    }

    if { [llength $string] > 0 } {
        puts "Test failed: additional data in output: $string"
        return -1;
    }

    if { [llength $error] > 0 } {
        puts "Test failed: additional data in error: $error"
        return -1;
    }

    return 0
}

if { [llength $argv] != 1 } {
    puts "Usage: $argv0 <test-script>.tdb"
    exit 0
}

set file [open [lindex $argv 0] r]

set env(CLASSPATH) $env(CLASSPATH)$osd$src$osd$src/matrix.jar

# puts $env(CLASSPATH)

set linenum 0

set testnum 1

for { set index 1 } { ![eof $file] } { incr index } {

    set expected ""
    set msg "\#$index"

    while { [gets $file line] >= 0 } {
        incr linenum
        set line [string trim $line]
        if { ![string equal -length 1 ";" $line] } {
            if { [string first "\{" $line] >= 0 } break
            append expected " " $line
        } elseif { [string equal -length 2 ";;" $line] } {
            if { [string equal -length 3 ";;;" $line] } {
                puts [string range $line 3 end]
            } else {
                set msg "\#$index:[string range $line 2 end]"
            }
        }
    }

    if { [string length $line] == 0 } {
        if { [string length [string trim $expected]] > 0 } {
            puts "Error line ($linenum): no action: $expected"
        }
        break;
    }

    set cnt [count $line 0]

    if { 0 == $cnt } {
        if { ![ regexp "^(\[^\{\]*)\{(.*)\} *$" $line dummy rexp cmd ] } {
            puts "Program Internal Error: handling line $linenum: $line"
            exit 1
        }
        append expected " " $rexp
        append cmd "\n"
    } else {
        if { ![regexp "^(\[^\{\]*)\{(.*)$" $line dummy rexp cmd ] } {
            puts "Program Internal Error: handling line $linenum: $line"
            exit 1
        }

        append expected " " $rexp
        append cmd "\n"

        set cnt [count $cmd 1]
        while { [gets $file line] >= 0 } {
            incr linenum
            set cnt [count $line $cnt]
            if { $cnt > 0 } {
                append cmd $line "\n"
            } else {
                set endpos [string last "\}" $line]
                incr endpos -1
                append cmd [string range $line 0 $endpos ] "\n"
                break
            }
        }
    }

    puts -nonewline $msg

    set result ""
    if { ![catch { set result [exec -- $javaexec MxMain -b << $cmd] } error] } {
        set error ""
    }
    

    if { [matchresult [split $expected] [split $result] [split $error]] < 0 } {
        puts " \[FAILED\]"
        puts "\[Program\]"
        puts $cmd
        puts "\[Result\]"
        puts $result
        if { [string length $error] > 0 } {
            puts "\[Error Message\]"
            puts $error
        }
        puts "\[Expecting\]"
        puts $expected

        exit 1
    } else {
        puts " \[PASSED\]"
    }

    incr testnum
}

puts "All passed!"
exit 0
