# time.test = Copyright (C) 2003 Pat Thoyts <patthoyts@users.sourceforge.net>
#
# Exercise the tcllib time package.
#
# -------------------------------------------------------------------------
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# -------------------------------------------------------------------------
# RCS: @(#) $Id: time.test,v 1.12 2006/10/09 21:41:41 andreas_kupries Exp $

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

source [file join \
	[file dirname [file dirname [file join [pwd] [info script]]]] \
	devtools testutilities.tcl]

testsNeedTcl     8.2
testsNeedTcltest 1.0

testing {
    useLocal time.tcl time
}

# -------------------------------------------------------------------------
# Constraints
#
tcltest::testConstraint remote 0; #  set true to use the remote tests.
tcltest::testConstraint udp \
        [llength [concat \
        [package provide udp] \
        [package provide ceptcl]]]

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

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} {
            fconfigure $chan -translation binary -buffering none -eofchar {}

            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 {}}


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

test time-2.0 {check for real: RFC 868} {remote} {
    set ::time::TestReady 0
    list [catch {
        set tok [time::gettime -protocol tcp -timeout 5000 ntp2a.mcc.ac.uk]
        time::wait $tok
        list [time::status $tok] [time::cleanup $tok]
    } err] $err
} {0 {ok {}}}

test time-2.1 {check for real: RFC 868} {remote udp} {
    set ::time::TestReady 0
    list [catch {
        set tok [time::gettime -protocol udp -timeout 5000 ntp2a.mcc.ac.uk]
        time::wait $tok
        list [time::status $tok] [time::cleanup $tok]
    } err] $err
} {0 {ok {}}}

test time-2.2 {check for real: RFC 2030} {remote udp} {
    set ::time::TestReady 0
    list [catch {
        set tok [time::getsntp -timeout 5000 ntp2a.mcc.ac.uk]
        time::wait $tok
        list [time::status $tok] [time::cleanup $tok]
    } err] $err
} {0 {ok {}}}

# -------------------------------------------------------------------------
file delete -force $::testScript
testsuiteCleanup
return

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