#
# select.test
#
# Tests for the select command.
#---------------------------------------------------------------------------
# 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: select.test,v 1.1 2001/10/24 23:31:49 hobbs Exp $
#------------------------------------------------------------------------------
#

if {[cequal [info procs Test] {}]} {
    source [file join [file dirname [info script]] testlib.tcl]
}

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

catch {select} msg
# FIX: Should have an infox check.
if {"$msg" == "select is not available on this version of Unix"} {
    echo "**** $msg"
    echo "**** tests skipped"
    return
}

#
# Note: The behavior of what is returned for write-ready is not consistent,
# some systems (BSD 4.4) don't return a pipe file handle that has been 
# written to but not read from.  This is the reason for the lsearch checks
# below.
#

pipe pipe1ReadFh pipe1WriteFh
fcntl $pipe1WriteFh nobuf 1

pipe pipe2ReadFh pipe2WriteFh
fcntl $pipe2WriteFh nobuf 1

set pipeReadList   [list $pipe1ReadFh  $pipe2ReadFh]
set pipeWriteList  [list $pipe1WriteFh $pipe2WriteFh]

Test select-1.1 {select tests} {
    select $pipeReadList $pipeWriteList {} 0.5
} 0 [list {} $pipeWriteList {}]

Test select-1.2 {select tests} {
    puts $pipe1WriteFh "Written to pipe 1"
    set ret [select $pipeReadList $pipeWriteList {} 0.5]
    list [lindex $ret 0] \
        [expr [lsearch [lindex $ret 1] $pipe2WriteFh] >= 0] \
        [lindex $ret 2] \
        [gets $pipe1ReadFh]
} 0 [list $pipe1ReadFh 1 {} "Written to pipe 1"]

Test select-1.3 {select tests} {
    puts $pipe2WriteFh "Written to pipe 2"
    set ret [select $pipeReadList $pipeWriteList {} 0.5]
    list [lindex $ret 0] \
        [expr [lsearch [lindex $ret 1] $pipe1WriteFh] >= 0] \
        [lindex $ret 2] \
        [gets $pipe2ReadFh]
} 0 [list $pipe2ReadFh 1 {} "Written to pipe 2"]

Test select-1.4 {select tests} {
    puts $pipe1WriteFh "Written to pipe 1"
    puts $pipe2WriteFh "Written to pipe 2"
    set ret [select $pipeReadList {} {} 0.5]
    list $ret [gets $pipe1ReadFh] [gets $pipe2ReadFh]
} 0 [list [list $pipeReadList {} {}] "Written to pipe 1" \
          "Written to pipe 2"]

Test select-1.5 {select tests} {
    select $pipeReadList $pipeWriteList {} 0
} 0 [list {} $pipeWriteList {}]

Test select-1.6 {select tests} {
    puts $pipe1WriteFh "Written to pipe 1"
    set ret [select $pipeReadList $pipeWriteList]
    list [lindex $ret 0] \
        [expr [lsearch [lindex $ret 1] $pipe2WriteFh] >= 0] \
        [lindex $ret 2] \
        [gets $pipe1ReadFh]
} 0 [list $pipe1ReadFh 1 {} "Written to pipe 1"]

Test select-1.7 {select tests} {
    puts $pipe1WriteFh "Written to pipe 1"
    set ret [select $pipeReadList $pipeWriteList {} 0]
    list [lindex $ret 0] \
        [expr [lsearch [lindex $ret 1] $pipe2WriteFh] >= 0] \
        [lindex $ret 2] \
        [gets $pipe1ReadFh]
} 0 [list $pipe1ReadFh 1 {} "Written to pipe 1"]

Test select-1.8 {select tests} {
    puts $pipe1WriteFh "Written to pipe 1 #1"
    puts $pipe1WriteFh "Written to pipe 1 #2"
    set ret1 [select $pipeReadList {} {} 0]
    set data1 [gets $pipe1ReadFh]
    set ret2 [select $pipeReadList {} {} 0]
    set data2 [gets $pipe1ReadFh]
    list $ret1 $data1 $ret2 $data2
} 0 [list [list $pipe1ReadFh {} {}] "Written to pipe 1 #1" \
          [list $pipe1ReadFh {} {}] "Written to pipe 1 #2"]


Test select-2.1 {select tests} {
    select foo $pipeWriteList {} 0
} 1 {can not find channel named "foo"}

Test select-2.2 {select tests} {
     select $pipeReadList $pipeWriteList {} X
} 1 {expected floating-point number but got "X"}


# cleanup
::tcltest::cleanupTests
return