#
# fcntl.test
#
# Tests for the fcntl 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: fcntl.test,v 1.2 2002/04/02 02:29:43 hobbs Exp $
#------------------------------------------------------------------------------
#

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

close [open FCNTL1.TMP w]
close [open FCNTL2.TMP w]
close [open FCNTL3.TMP w]

set testRWFH [open FCNTL1.TMP r+]
set testRFH [open FCNTL2.TMP r]
set testWFH [open FCNTL3.TMP w]

pipe testRPH testWPH

test fcntl-1.1 {fcntl tests} {
    fcntl $testRWFH RDONLY
} 0

test fcntl-1.2 {fcntl tests} {
    fcntl $testRWFH WRONLY
} 0

test fcntl-1.3 {fcntl tests} {
    fcntl $testRWFH RDWR
} 1

test fcntl-1.4 {fcntl tests} {
    fcntl $testRWFH READ
} 1

test fcntl-1.5 {fcntl tests} {
    fcntl $testRWFH WRITE
} 1


test fcntl-1.6 {fcntl tests} {
    fcntl $testRFH RDONLY
} 1

test fcntl-1.7 {fcntl tests} {
    fcntl $testRFH WRONLY
} 0

test fcntl-1.8 {fcntl tests} {
    fcntl $testRFH RDWR
} 0

test fcntl-1.9 {fcntl tests} {
    fcntl $testRFH READ
} 1

test fcntl-1.10 {fcntl tests} {
    fcntl $testRFH WRITE
} 0


test fcntl-1.11 {fcntl tests} {
    fcntl $testWFH RDONLY
} 0

test fcntl-1.12 {fcntl tests} {
    fcntl $testWFH WRONLY
} 1

test fcntl-1.13 {fcntl tests} {
    fcntl $testWFH RDWR
} 0

test fcntl-1.14 {fcntl tests} {
    fcntl $testWFH READ
} 0

test fcntl-1.15 {fcntl tests} {
    fcntl $testWFH WRITE
} 1


test fcntl-2.1 {fcntl tests} {
    fcntl $testRWFH CLOEXEC 1
    fcntl $testRWFH CLOEXEC
} 1

test fcntl-2.2 {fcntl tests} {
    fcntl $testRWFH CLOEXEC 0
    fcntl $testRWFH CLOEXEC
} 0 

test fcntl-2.3 {fcntl tests} {
    fcntl $testRPH NONBLOCK 1
    list [fcntl $testRPH NONBLOCK] [fconfigure $testRPH -blocking]
} {1 0}

test fcntl-2.4 {fcntl tests} unixOnly {
    fcntl $testRWFH append 1
    fcntl $testRWFH append
} 1

test fcntl-2.5 {fcntl tests} unixOnly {
    fcntl $testRWFH APPEND 0
    fcntl $testRWFH append
} 0

test fcntl-2.5.1 {fcntl tests} pcOnly {
    list [catch {fcntl $testRWFH APPEND 0} msg] $msg
} {1 {append mode is not available on MS Windows}}

test fcntl-3.1 {fcntl tests} {
    fcntl $testRPH NONBLOCK 0
    list [fcntl $testRPH nonBlock] [fconfigure $testRPH -blocking]
} {0 1}

test fcntl-3.2 {fcntl tests} {
    fcntl $testRWFH NOBUF 1
    list [fcntl $testRWFH NObuf] [fconfigure $testRWFH -buffering]
} {1 none}

close $testRWFH
close $testRFH
close $testWFH

# Reopen, can not have both nobuf and linebuf
set testRWFH [open FCNTL1.TMP w]  

test fcntl-4.1 {fcntl tests} {
    fcntl $testRWFH LINEBUF 1
    list [fcntl $testRWFH LINEBUF] [fconfigure $testRWFH -buffering]
} {1 line}

test fcntl-5.1 {fcntl tests} {
    list [catch {fcntl $testRWFH a b c} msg] $msg
} {1 {wrong # args: fcntl handle attribute ?value?}}

test fcntl-5.2 {fcntl tests} {
    list [catch {fcntl $testRWFH BAZ 1} msg] $msg
} {1 {unknown attribute name "BAZ", expected one of RDONLY, WRONLY, RDWR, READ, WRITE, APPEND, CLOEXEC, NONBLOCK, LINEBUF, NOBUF, or KEEPALIVE}}

test fcntl-5.3 {fcntl tests} {
    list [catch {fcntl $testRWFH APPEND FOO} msg] $msg
} {1 {expected boolean value but got "FOO"}}

close $testRWFH

test fcntl-5.4 {fcntl tests} {
    list [catch {fcntl $testRWFH RDONLY} msg] $msg
} [list 1 "can not find channel named \"$testRWFH\""]

close $testRPH
close $testWPH

#
# Tests for socket related controls.
#
set doSocketTests 0
# FIX: Should be an explict test for NT.
if {[cequal $tcl_platform(platform) unix] ||
    ![cequal $tcl_platform(os) "Windows 95"]} {
    if {[catch {close [socket [id host] echo]; set doSocketTests 1} msg]} {
        puts "*************************************************************"
        puts "Unable to connect to the \"echo\" server:"
        puts "$msg."
        puts "Some tests skipped."
        puts "*************************************************************"
    }
}
if $doSocketTests {
    set sockFH [socket [id host] echo]

    test fcntl-6.1 {fcntl socket tests} {
        fcntl $sockFH KEEPALIVE 1
        fcntl $sockFH KEEPALIVE
    } 1

    test fcntl-6.2 {fcntl socket tests} {
        fcntl $sockFH KEEPALIVE 0
        fcntl $sockFH KEEPALIVE
    } 0

    close $sockFH
}

TestRemove FCNTL1.TMP FCNTL2.TMP FCNTL3.TMP