# time.test = Copyright (C) 2003 Pat Thoyts <patthoyts@users.sourceforge.net>
#
# Exercise the tcllib time package.
#
# $Id: time.test,v 1.5 2003/05/02 22:33:59 patthoyts Exp $

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

package forget time
catch {namespace delete time}
if {[catch {source [file join [file dirname [info script]] time.tcl]} msg]} {
    puts "skipped [file tail [info script]]: $msg"
    return
}

puts "- tcltest [package present tcltest]"
puts "- time    [package present time]"


# -------------------------------------------------------------------------

set testScript tstsrv.tmp

proc createServerProcess {} {
    file delete -force $::testScript
    set f [open $::testScript w+]
    puts $f {
        # This proc is called to handle client connections. We only need to
        # return the time in TIME epoch and then close the channel.
        proc ::srv {chan args} {
            if {[catch {
                set r [binary format I [expr {int([clock seconds] + 2208988800)}]]
                puts "connect on $chan from [fconfigure $chan -peername]"
                puts -nonewline $chan $r
                close $chan
            } msg]} {
                puts stderr "error: $msg"
            }
            set ::done 1
        }
        
        set s [socket -server ::srv 0]
        fconfigure $s -translation binary -buffering none -eofchar {}
        set port [lindex [fconfigure $s -sockname] 2]
        
        puts $port 
        flush stdout
        vwait ::done
        update
        exit
    }
    close $f

    # Now run the server script as a child process - return child's
    # stdout to the caller so they can read the port to use.
    if {[catch {
        set f [open |[list [::tcltest::interpreter] $::testScript] r]
    }]} {
        set f [open |[list [info nameofexecutable] $::testScript] r]
    }

    fconfigure $f -buffering line -blocking 1
    #after 500 {set _init 1} ; vwait _init
    return $f
}

# -------------------------------------------------------------------------

set token {}

test time-1.1 {time::gettime} {
    global token
    list [catch {
        set f [createServerProcess]
        gets $f port
        set token [::time::gettime -protocol tcp localhost $port]
        set r {}
    } msg] $msg    
} {0 {}}

test time-1.2 {time::status} {
    global token
    list [catch {time::status $token} m] $m
} {0 ok}

test time-1.3 {time::unixtime} {
    global token
    list [catch {
        set t [time::unixtime $token]
        expr {(0 <= $t) && ($t <= 2147483647)}
    } m] $m
} {0 1}

test time-1.4 {time::cget} {
    global token
    list [catch {
        time::cget -port
    } m] $m
} {0 37}

test time-1.5 {time::cleanup} {
    global token
    list [catch {
        time::cleanup $token
    } m] $m
} {0 {}}

# -------------------------------------------------------------------------
#file delete -force $::testScript
::tcltest::cleanupTests
return

#
# Local variables:
#   mode: tcl
#   indent-tabs-mode: nil
# End: