#
# lgets.test
#
# Tests for the lgets 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: lgets.test,v 1.1.1.1 1999/06/28 20:35:26 damon Exp $
#------------------------------------------------------------------------------
#

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

Test lgets-1.1 {lgets command} {
    lgets
} 1 {wrong # args: lgets fileId ?varName?}

Test lgets-1.2 {lgets command} {
    lgets a b c
} 1 {wrong # args: lgets fileId ?varName?}

Test lgets-1.3 {lgets command} {
    lgets a
} 1 {can not find channel named "a"}

set f [open test2.tmp w]
Test lgets-1.4 {lgets command} {
    lgets $f
} 1 "channel \"$f\" wasn't opened for reading"
catch {close $f}

set test2data \
        [replicate abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 100]
set f [open test2.tmp w]
puts $f $test2data
close $f

Test lgets-1.5 {lgets command with long line} {
    set f [open test2.tmp]
    set x [lgets $f]
    close $f
    set x
} 0 $test2data

Test lgets-1.6 {lgets command with long line} {
    set f [open test2.tmp]
    set x [lgets $f y]
    close $f
    list $x $y
} 0 [list [clength $test2data] $test2data]

Test lgets-1.7 {lgets command with EOF in list element} {
    set f [open test2.tmp w]
    puts $f "Test1  \{Test2 " nonewline
    close $f
    set f [open test2.tmp]
    lgets $f
} 1 {EOF encountered before newline while reading list from channel}

catch {close $f}

Test lgets-1.8 {lgets command with EOF in list} {
    set f [open test2.tmp w]
    puts $f "Test1\nTest2" nonewline
    close $f
    set f [open test2.tmp]
    set x {}
    set y {}
    lappend x [lgets $f y] $y
    set y {}
    lappend x [catch {lgets $f y} r] $r $y
    close $f
    set x
} 0 {5 Test1 1 {EOF encountered before newline while reading list from channel} Test2}

Test lgets-2.1 {lgets command} {
    catch {unset data}
    set data(0) [list aaa b cccc]
    set data(1) [list aaaa \" ccc]
    set data(2) [list aaaaa \" cc]
    set data(3) [list aaaaa \"\" \} \{ \n c]
    set data(4) [list bcad \n defg \n nypq]
    set data(5) [list {BCAD  {AAA
BBB
CCC}
defg
nypq}]
    set data(6) [list [replicate ABD 200]  "\n" [replicate XYZ 100]]
    set data(7) [list [replicate ABD 255]  "\n" [replicate XYZ 100]]
    set data(8) [list [replicate ABD 256]  "\n" [replicate XYZ 100]]
    set data(9) [list [replicate "AAA\n \{B \"BB" 100]]

    set fh [open test1.tmp w]
    foreach idx [lsort -integer [array names data]] {
        puts $fh $data($idx)
    }
    close $fh
    set fh [open test1.tmp]
    concat {}
} 0 {}

Test lgets-2.2 {lgets command} {
    lgets $fh
} 0 $data(0)

Test lgets-2.3 {lgets command} {
    lgets $fh retvar
    set retvar
} 0 $data(1)

Test lgets-2.4 {lgets command} {
    lgets $fh
} 0 $data(2)

Test lgets-2.5 {lgets command} {
    lgets $fh retvar
    set retvar
} 0 $data(3)

Test lgets-2.6 {lgets command} {
    lgets $fh
} 0 $data(4)

Test lgets-2.7 {lgets command} {
    lgets $fh retvar
    set retvar
} 0 $data(5)

Test lgets-2.8 {lgets command} {
    lgets $fh retvar
    set retvar
} 0 $data(6)

Test lgets-2.9 {lgets command} {
    lgets $fh retvar
    set retvar
} 0 $data(7)

Test lgets-2.10 {lgets command} {
    lgets $fh retvar
    set retvar
} 0 $data(8)

Test lgets-2.11 {lgets command} {
    lgets $fh retvar
    set retvar
} 0 $data(9)

catch {close $fh}
unset data

# Make sure odd lists work.
set data [list ERR_REQUEST_PROCESSOR_FAILURE " {sc ...\""]

Test lgets-3.1 {lgets command} {
    set fh [open test1.tmp w+]
    puts $fh $data
    seek $fh 0
    lgets $fh
} 0 $data

catch {close $fh}

# Easy test to make sure basic non-blocked channel works, even though we
# don't actually test the no-data case.

# FIX: Doesn't work right on Win32.
if [cequal $tcl_platform(platform) windows] {
    echo "    * lgets tests not completely ported to Win32, some tests skipped"
    TestRemove test1.tmp test2.tmp
    return
}

pipe rpipe wpipe
fconfigure $rpipe -blocking 0

Test lgets-4.1 {lgets on non-blocked channel} {
    puts $wpipe $data
    flush $wpipe
    lgets $rpipe
} 1 {channel is non-blocking; not currently supported by the lgets command} {tempNotPc}

Test lgets-4.2 {lgets on non-blocked channel} {
    puts $wpipe $data
    flush $wpipe
    catch {unset x}
    list [lgets $rpipe x] $x
} 1 {channel is non-blocking; not currently supported by the lgets command}        {tempNotPc}

catch {close $rpipe}
catch {close $wpipe}
unset data


#
# Binary data 
#

Test lgets-5.1 {lgets with binary data} {
    catch {unset data}
    set data(0) [list aaa b cc\0cc]
    set data(1) [list aaaa \" \0\0  ccc]
    set data(2) [list aaaaa \" cc]
    set data(3) [list aaaaa \"\" \} [replicate \0\1\0 5] \{ \n c]
    set data(4) [list bcad \n defg \n nypq]
    set data(5) [list BCAD  "AAA
\0
BBB
CCC" "
defg
\0\0\0" nypq]
    set data(6) [list [replicate ABD 200]  "\n" [replicate XYZ 100]]
    set data(7) [list [replicate ABD 255]  "\n" [replicate XYZ 100]]
    set data(8) [list [replicate ABD 256]  "\n" [replicate XYZ 100]]
    set data(9) [list [replicate "AAA\n \{B \"BB" 100]]

    set fh [open test1.tmp w]
    foreach idx [lsort -integer [array names data]] {
        puts $fh $data($idx)
    }
    close $fh
    set fh [open test1.tmp]
    concat {}
} 0 {}

Test lgets-5.2 {lgets with binary data} {
    lgets $fh
} 0 $data(0)

Test lgets-5.3 {lgets with binary data} {
    lgets $fh retvar
    set retvar
} 0 $data(1)

Test lgets-5.4 {lgets with binary data} {
    lgets $fh
} 0 $data(2)

Test lgets-5.5 {lgets with binary data} {
    lgets $fh retvar
    set retvar
} 0 $data(3)

Test lgets-5.6 {lgets with binary data} {
    lgets $fh
} 0 $data(4)

Test lgets-5.7 {lgets with binary data} {
    lgets $fh retvar
    set retvar
} 0 $data(5)

Test lgets-5.8 {lgets with binary data} {
    lgets $fh retvar
    set retvar
} 0 $data(6)

Test lgets-5.9 {lgets with binary data} {
    lgets $fh retvar
    set retvar
} 0 $data(7)

Test lgets-5.10 {lgets with binary data} {
    lgets $fh retvar
    set retvar
} 0 $data(8)

Test lgets-5.11 {lgets with binary data} {
    lgets $fh retvar
    set retvar
} 0 $data(9)

catch {close $fh}
unset data

Test lgets-6.0 {lgets corner cases} {
    set fh [open test2.tmp w+]
    puts $fh [list {\\server} {\home} {foo\}}]
    seek $fh 0
    lgets $fh inlist
    close $fh
    set inlist
} 0 [list {\\server} {\home} {foo\}}]


TestRemove test1.tmp test2.tmp



