TABLE OF CONTENTS


::pwtk::test

SYNOPSIS

proc ::pwtk::test {cmd {expectedResult ""} {expectedError ""}} {

PURPOSE

A command for testing scripts and commands, used by tests in tests/*test. It produces a nice and readable output.

ARGUMENTS

SOURCE

    variable catch_error

    set expectedResultPr [testProcessResult_ $expectedResult]
    set expectedErrorPr  [testProcessResult_ $expectedError]

    set result {}
    set resultErr {}
    set error  {}
    set pass N/A

    puts "
===============================================================Testing==
SCRIPT:
$cmd
"
    set tmp [file join [::fileutil::tempdir] error.[pid]]
    # delete the error file, if it exists
    file delete $tmp

    set catch_error 1
    try {
        if { $expectedError ne {} } {
            ::pwtk::redirect_stderr_to $tmp { set result [uplevel $cmd] }
        } else {
            set result [uplevel $cmd]
        }
    } on error err {
        if { [info commands ::tcl::orig_puts] ne {} } {
            # BEWARE: error occurred while evaluation script in
            # ::pwtk::redirect_stderr_to, revert "puts" to default Tcl puts
            # (see ::pwtk::redirect_stderr_to)
            rename ::puts {}
            rename ::tcl::orig_puts ::puts
        }
        if { $expectedError ne {} } {
            set resultErr [testProcessResult_ [readFile $tmp]]
        }
        ifnotempty err { set error "\n\nCODING_ERROR: $err" }        
    }
    set catch_error 0

    set result [testProcessResult_ $result]

    if { $expectedResult ne {} } {
        set pass [expr { $result == $expectedResultPr ? 1 : 0 } ]
    }
    if { $expectedError ne {} } {
        if { $resultErr eq {} && [file exists $tmp] } {
            # for checking stderr message
            set resultErr [testProcessResult_ [readFile $tmp]]
        }
        set passErr [expr { [filterQEerror_ $resultErr] == [filterQEerror_ $expectedErrorPr] ? 1 : 0 } ]
        if { ! $passErr } {
            set pass 0
        }
        if { $expectedResult eq {} } {
            set pass $passErr
        }
    }
    ifnotempty result {
        puts "RESULT:\n$result"
    }
    if { $pass != 1 && $expectedResult ne {} } {
        puts "EXPECTED RESULT:\n$expectedResultPr"
    }
    if { [file exists $tmp] && [file size $tmp] > 0} {
        puts "RESULTING STDERR:\n$resultErr"
    }
    if { $pass != 1 && $expectedError ne {} } {
        puts "EXPECTED ERROR:\n$expectedErrorPr"
    }
    puts "
PASSED: $pass$error
========================================================================
"
}