# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: io.test,v 1.10 1999/07/01 17:36:18 jenn Exp $
# RCS: @(#) $Id: io.test,v 1.11 1999/08/27 01:17:05 jenn Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import ::tcltest::*
}

if {"[info commands testchannel]" != "testchannel"} {
    puts "Skipping io tests. This application does not seem to have the"
    puts "testchannel command that is needed to run these tests."
    return
}

::tcltest::saveState

set ::tcltest::testConstraints(knownBugThreadedLinux) [expr \
	{($tcl_platform(os) != "Linux") \
	&& ([info commands testthread] != {})}]

set ::tcltest::testConstraints(knownBugThreadedSolaris) [expr \
	{($tcl_platform(os) != "SunOS") \
	&& ([info commands testthread] != {})}]

removeFile test1
removeFile pipe

catch {unset u}

# set up a long data file for some of the following tests

    close $f
    set f [open test1]
    fconfigure $f -encoding iso2022-jp
    set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 8 "there\u4e00ok" 11 "\u4e01more bytes" 4 "here"]
test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio} {
test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio knownBugThreadedSolaris knownBugThreadedLinux} {
    update
    set f [open "|[list $::tcltest::tcltest cat]" w+]
    fconfigure $f -buffering none
    puts -nonewline $f "foobar"
    fconfigure $f -blocking 0
    set x {}
    after 500 { lappend x timeout }

    flush $f
    vwait x
    vwait x
    lappend x [catch {close $f} msg] $msg
    set x
} "{} timeout {} timeout \u7266 {} eof 0 {}"

test io-13.1 {TranslateInputEOL: cr mode} {
test io-13.1 {TranslateInputEOL: cr mode} {knownBugThreadedLinux} {
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\rdef\r"
    close $f
    set f [open test1]
    fconfigure $f -translation cr
    set x [read $f]

    close $f
    set f [open test1]
    fconfigure $f -translation crlf
    set x [read $f]
    close $f
    set x
} "abcd\ndef\nfgh"
test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio} {
test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio knownBugThreadedSolaris knownBugThreadedLinux} {
    # (chanPtr->flags & INPUT_SAW_CR)
    # This test may fail on slower machines.

    set f [open "|[list $::tcltest::tcltest cat]" w+]
    fconfigure $f -blocking 0 -buffering none -translation {auto lf}

    fileevent $f read "ready $f"

    }
    lappend l [file size test1]
    close $f
    lappend l [file size test1]
    set l
} {0 60 72}
test io-27.6 {FlushChannel, async flushing, async close} \
	{stdio asyncPipeClose} {
	{stdio asyncPipeClose knownBugThreadedLinux} {
    removeFile pipe
    removeFile output
    set f [open pipe w]
    puts $f {
	set f [open output w]
	fconfigure $f -translation lf -buffering none -eofchar {}
	while {![eof stdin]} {

	    [catch {fileevent $f3 readable}]
} {0 {f script} 1 0 {f3 script} 0 {f script} 1 1 1 1 1}

# Execute these tests only if the "testfevent" command is present.

if {[info commands testfevent] == "testfevent"} {

test io-46.1 {Tcl event loop vs multiple interpreters} {
    test io-46.1 {Tcl event loop vs multiple interpreters} {knownBugThreadedLinux} {
    testfevent create
    testfevent cmd {
        set f [open foo r]
        set x "no event"
        fileevent $f readable {
            set x "f triggered: [gets $f]"
            fileevent $f readable {}

    lappend l [gets $f]
    lappend l [tell $f]
    lappend l [eof $f]
    close $f
    set l
} [list 7 a\rb\rc 7 {} 7 1]
    
test io-50.1 {testing handler deletion} {
test io-50.1 {testing handler deletion} {knownBugThreadedSolaris knownBugThreadedLinux} {
    removeFile test1
    set f [open test1 w]
    close $f
    set f [open test1 r]
    testchannelevent $f add readable [list delhandler $f]
    proc delhandler {f} {
	global z
	set z called
	testchannelevent $f delete 0
    }
    set z not_called
    update
    close $f
    set z
} called
test io-50.2 {testing handler deletion with multiple handlers} {
test io-50.2 {testing handler deletion with multiple handlers} {knownBugThreadedSolaris knownBugThreadedLinux} {
    removeFile test1
    set f [open test1 w]
    close $f
    set f [open test1 r]
    testchannelevent $f add readable [list delhandler $f 1]
    testchannelevent $f add readable [list delhandler $f 0]
    proc delhandler {f i} {
	global z
	lappend z "called delhandler $f $i"
	testchannelevent $f delete 0
    }
    set z ""
    update
    close $f
    string compare [string tolower $z] \
	[list [list called delhandler $f 0] [list called delhandler $f 1]]
} 0
test io-50.3 {testing handler deletion with multiple handlers} {
test io-50.3 {testing handler deletion with multiple handlers} {knownBugThreadedSolaris knownBugThreadedLinux} {
    removeFile test1
    set f [open test1 w]
    close $f
    set f [open test1 r]
    testchannelevent $f add readable [list notcalled $f 1]
    testchannelevent $f add readable [list delhandler $f 0]
    set z ""

    set z ""
    update
    close $f
    string compare [string tolower $z] \
	[list [list delhandler $f 0 called] \
	      [list delhandler $f 0 deleted myself]]
} 0
test io-50.4 {testing handler deletion vs reentrant calls} {
test io-50.4 {testing handler deletion vs reentrant calls} {knownBugThreadedSolaris knownBugThreadedLinux} {
    removeFile test1
    set f [open test1 w]
    close $f
    set f [open test1 r]
    testchannelevent $f add readable [list delrecursive $f]
    proc delrecursive {f} {
	global z u

    set u toplevel
    set z ""
    update
    close $f
    string compare [string tolower $z] \
	{{delrecursive calling recursive} {delrecursive deleting recursive}}
} 0
test io-50.5 {testing handler deletion vs reentrant calls} {
test io-50.5 {testing handler deletion vs reentrant calls} {knownBugThreadedSolaris knownBugThreadedLinux} {
    removeFile test1
    set f [open test1 w]
    close $f
    set f [open test1 r]
    testchannelevent $f add readable [list notcalled $f]
    testchannelevent $f add readable [list del $f]
    proc notcalled {f} {

    set u toplevel
    update
    close $f
    string compare [string tolower $z] \
	[list {del calling recursive} {del deleted notcalled} \
	      {del deleted myself} {del after update}]
} 0
test io-50.6 {testing handler deletion vs reentrant calls} {
test io-50.6 {testing handler deletion vs reentrant calls} {knownBugThreadedSolaris knownBugThreadedLinux} {
    removeFile test1
    set f [open test1 w]
    close $f
    set f [open test1 r]
    testchannelevent $f add readable [list second $f]
    testchannelevent $f add readable [list first $f]
    proc first {f} {