#
# shell.test
#
# Tests for various TclX shell functions.
#---------------------------------------------------------------------------
# Copyright 1992-1999 Karl Lehenbauer and Mark Diekhans.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  Karl Lehenbauer and
# Mark Diekhans make no representations about the suitability of this
# software for any purpose.  It is provided "as is" without express or
# implied warranty.
#------------------------------------------------------------------------------
# $Id: shell.test,v 1.1.1.1 1999/06/28 20:35:28 damon Exp $
#------------------------------------------------------------------------------

if [cequal [info procs Test] {}] {source testlib.tcl}

if [cequal $tcl_platform(platform) windows] {
    echo "    * The shell tests have not been ported to Win32" 
    return
}

# Test tclx_errorHandler traping of errors.

Test shell-1.0 {TclX shell error handling} {
    exec $TCL_PROGRAM -c {
        proc tclx_errorHandler msg {
            echo "@@@Error handler got: $msg"
        }
        proc bad {} badcommand
        bad
        puts stderr "Should not make it here"
        exit 1
    }
} 0 {@@@Error handler got: invalid command name "badcommand"}
        
# Tested the deprecated functionallity where a variable contains the
# name of the error function.
Test shell-1.1 {deprected TclX shell error handling} {
    exec $TCL_PROGRAM -c {
        catch {rename tclx_errorHandler {}}
        proc err msg {
            echo "@@@Error handler got: $msg"
        }
        set tclx_errorHandler err
        proc bad {} badcommand
        bad
        puts stderr "Should not make it here"
        exit 1
    }
} 0 {@@@Error handler got: invalid command name "badcommand"}


# Test the eventloop command

#
# Program to handle read-ready events from stdin.  In deletes the event source
# when told to stop, which should make the process exit.
#
set prog {
    fconfigure stdout -buffering line
    fileevent stdin readable {
        if {[gets stdin line] < 0} {
            puts stderr "Shell event tests: unexpected EOF on stdin"
            exit 1
        }
        if [cequal $line "STOP NOW"] {
            puts "I AM STOPPING"
            fileevent stdin readable {}
        } else {
            puts "You said: $line"
        }
    }
    mainloop
}

Test shell-2.0 {TclX shell event handling} {
    set childPipe [open [list | $TCL_PROGRAM -c $prog] r+]
    fconfigure $childPipe -buffering line
    crange $childPipe 0 3
} 0 {file}


Test shell-2.1 {TclX shell event handling} {
    puts $childPipe "test shell-2.1"
    gets $childPipe
} 0 {You said: test shell-2.1}

Test shell-2.2 {TclX shell event handling} {
    puts $childPipe "test shell-2.2"
    gets $childPipe
} 0 {You said: test shell-2.2}

Test shell-2.3 {TclX shell event handling} {
    puts $childPipe "STOP NOW"
    gets $childPipe
} 0 {I AM STOPPING}

Test shell-2.4 {TclX shell event handling} {
    close $childPipe
} 0 {}


