archie/tcl-dp/tests/serial.test

# serial.test
#
#	This file tests the serial protocol
#

if {[string compare test [info procs test]] == 1} then {source ../tests/defs}


test serial-1.1.1 {dp_connect command} {
    list [catch {
	dp_connect serial -bar
    } msg] $msg
} {1 {Unknown option "-bar", must be -device, -block, or -readonly}}

test serial-1.1.2 {dp_connect command} {
    list [catch {
	dp_connect serial -bar foo
    } msg] $msg
} {1 {Unknown option "-bar", must be -device, -block, or -readonly}}

#
# Test arg missing checks
#

test serial-1.2.1 {dp_connect command} {
    list [catch {
	dp_connect serial -device
    } msg] $msg
} {1 {Value for "-device" missing}}

test serial-1.2.2 {dp_connect command} {
    list [catch {
	dp_connect serial -block
    } msg] $msg
} {1 {Value for "-block" missing}}

#
# Test type checking of args
#

test serial-1.3.1 {dp_connect command} {
    list [catch {
	dp_connect serial -device foo
    } msg] $msg
} {1 {Unknown device "foo"}}

test serial-1.3.3 {dp_connect command} {
    list [catch {
	dp_connect serial -block foo
    } msg] $msg
} {1 {expected boolean value but got "foo"}}

set sock1 {}
test serial-1.3.4 {dp_connect command} {
    list [catch {
	set sock1 [dp_connect serial -device serial1 -readonly true];
    } msg1] $msg1 [catch {
	close $sock1
    } msg2] $msg2
} {0 serial0 0 {}}
set sock1 {}

test serial-1.3.5 {dp_connect command} {
    list [catch {
	set sock1 [dp_connect serial -device serial1];
    } msg1] $msg1

    # UNIX only -------------------------------------
    # Are your serial ports writable by root only???
    # Use the "-readonly true" flag if so or chmod them.
} {0 serial1}

if {$sock1 == ""} {
    catch {
    	set sock1 [dp_connect serial -device serial1 -readonly true]
    }
}

# At this point, sock1 is either the null string or a handle to a serial
# socket.  Only do remaining tests if we could create the socket.

if {$sock1 != ""} {

#
# fconfigure tests
#

set trans [fconfigure $sock1 -translation] 

test serial-1.4.1 {fconfigure serial} {
    list [catch {
	fconfigure $sock1
    } msg] $msg
} {0 [list -blocking 1 -buffering line -buffersize 4096 -eofchar {{} {}} -translation $trans -charsize 8 -stopbits 1 -baudrate 19200 -parity none -device serial1}] 

test serial-1.4.2 {fconfigure serial} {
    list [catch {
	fconfigure $sock1 -badopt
    } msg] $msg
} {1 {bad option "-badopt": must be -blocking, -buffering, -buffersize, -eofchar, -translation, or a channel type specific option}} 

test serial-1.4.3 {fconfigure serial} {
    list [catch {
	fconfigure $sock1 -blocking 0
    } msg] $msg
} {0 {}} 

test serial-1.4.4 {fconfigure serial} {
    list [catch {
	fconfigure $sock1 -blocking
    } msg] $msg
} {0 0}

test serial-1.4.5.1 {fconfigure serial} {
    list [catch {
	fconfigure $sock1 -charsize
    } msg] $msg
} {0 8}

test serial-1.4.5.2 {fconfigure serial} {
    list [catch {
	fconfigure $sock1 -charsize foo
    } msg] $msg
} {1 {expected integer but got "foo"}}

test serial-1.4.5.3 {fconfigure serial} {
    list [catch {
	fconfigure $sock1 -charsize 7
    } msg1] $msg1 [catch {
	fconfigure $sock1 -charsize
    } msg2] $msg2
} {0 {} 0 7}

test serial-1.4.6.1 {fconfigure serial} {
    list [catch {
	fconfigure $sock1 -stopbits 2
    } msg1] $msg1 [catch {
	fconfigure $sock1 -stopbits
    } msg2] $msg2
} {0 {} 0 2}

test serial-1.4.6.2 {fconfigure serial} {
    list [catch {
	fconfigure $sock1 -stopbits foo
    } msg1] $msg1
} {1 {expected integer but got "foo"}}

test serial-1.4.7.1 {fconfigure serial} {
    list [catch {
	fconfigure $sock1 -baudrate
    } msg1] $msg1
} {0 19200}

test serial-1.4.7.2 {fconfigure serial} {
    list [catch {
	fconfigure $sock1 -baudrate foo
    } msg1] $msg1
} {1 {expected integer but got "foo"}}

test serial-1.4.7.3 {fconfigure serial} {
    list [catch {
	fconfigure $sock1 -baudrate 34567
    } msg1] $msg1
} {1 {}}

test serial-1.4.7.4 {fconfigure serial} {
    list [catch {
	fconfigure $sock1 -baudrate 38400
    } msg1] $msg1 [catch {
	fconfigure $sock1 -baudrate
    } msg2] $msg2
} {0 {} 0 38400}

test serial-1.4.8.1 {fconfigure serial} {
    list [catch {
	fconfigure $sock1 -parity foo
    } msg1] $msg1
} {1 {Parity must be "even", "odd" or "none"}}

test serial-1.4.8.2 {fconfigure serial} {
    list [catch {
	fconfigure $sock1 -parity even
    } msg1] $msg1 [catch {
	fconfigure $sock1 -parity
    } msg2] $msg2
} {0 {} 0 even}

test serial-1.4.9 {fconfigure serial} {
    list [catch {
	fconfigure $sock1
    } msg] $msg
} {0 [list -blocking 0 -buffering line -buffersize 4096 -eofchar {{} {}} -translation $trans -charsize 7 -stopbits 2 -baudrate 38400 -parity even -device serial1}] 

########################

#
# Shut 'em down
#
test serial-1.9.0 {close serial socket} {
    list [catch {
	close $sock1
    } msg] $msg
} {0 {}} 

test serial-1.9.1 {close serial socket} {
    list [catch {
	fconfigure $sock1
    } msg] $msg
} [list 1 "can not find channel named \"$sock1\""]


# The following close brace matches the line above:
#	if {$sock1 != ""} 
}