Tcl Source Code

Artifact 6ebaf818c11efae24ed0d9350725db9a4c854304:

Attachment "serialTest.tcl" to ticket [2413550fff] added by oehhar 2014-02-25 17:06:55.

---

proc commTest {comm loop} {
	set fp [open $comm r+]
	fconfigure $fp -blocking 0
	fconfigure $fp -buffering none
	flush $fp
	
	puts "RX and TX (pins 2 & 3) on the serial device should be bridged"
	
	set failCnt 0
	
	for {set i 0} {$i < $loop} {incr i} {
		set testStr "This is a test of the serial communications"
		puts -nonewline $fp $testStr
		after 300
		set compStr [read $fp]
		if {[string equal $testStr $compStr]} {
			puts "Test $i Passed"
		} else {
			puts "Test $i Failed"
			puts $compStr
			incr failCnt
		}
		update
	}
	close $fp
	puts "Ran $i times, had $failCnt test(s) fail"
	if {$failCnt > 0} {
		error "A test failure occurred"
	}
}

# Enter in the communications port without any 
proc runTests {comm} {
	puts "//./${comm} name hint test"
	commTest //./${comm} 1
	after 5000
	puts "\n\\\\.\\${comm} name hint test"
	commTest \\\\.\\${comm} 1
	after 5000
	puts "\n${comm} name hint test"
	commTest $comm 1
	after 5000
	puts "\nRun RxTx loop"
	commTest $comm 1000
	puts "\nRun Connect/Disconnect loop"
	for {set i 0} {$i < 25} {incr i} {
		puts "\nLoop $i starting..."
		commTest $comm 10
		after 5000
	}
	puts "Passed testing!"
}