From ebc5a54546d870dfddcf7192cbeab737e924bb25 Mon Sep 17 00:00:00 2001
From: Steve Bennett <steveb@workware.net.au>
Date: Sat, 23 Apr 2011 11:47:08 +1000
Subject: Clean out the tcltests directory

Some tests are already in tests/, move some others.
Move some examples to the examples directory

Signed-off-by: Steve Bennett <steveb@workware.net.au>
---
 examples/client-server.tcl | 83 ++++++++++++++++++++++++++++++++++++++++++++++
 examples/timedread.tcl     | 19 +++++++++++
 2 files changed, 102 insertions(+)
 create mode 100644 examples/client-server.tcl
 create mode 100644 examples/timedread.tcl

(limited to 'examples')

diff --git a/examples/client-server.tcl b/examples/client-server.tcl
new file mode 100644
index 0000000..4856e47
--- /dev/null
+++ b/examples/client-server.tcl
@@ -0,0 +1,83 @@
+proc bgerror {msg} {
+	puts "bgerror: $msg"
+	#exit 0
+}
+
+proc verbose {msg} {
+	puts $msg
+}
+
+if {[os.fork] == 0} {
+	verbose "child: waiting a bit"
+
+	# This will be our client
+
+	sleep .1
+
+	set f [socket stream localhost:9876]
+
+	set done 0
+
+	proc onread {f} {
+		if {[$f gets buf] > 0} {
+			verbose "child: read response '$buf'"
+		} else {
+			verbose "child: read got eof"
+			set ::done 1
+		}
+	}
+
+	proc onwrite {f} {
+		verbose "child: sending request"
+		$f puts -nonewline "GET / HTTP/1.0\r\n\r\n"
+		$f flush
+		$f writable {}
+	}
+
+	$f readable [list onread $f]
+	$f writable [list onwrite $f]
+
+	alarm 10
+	catch -signal {
+		verbose "child: in event loop"
+		vwait done
+		verbose "child: done event loop"
+	}
+	alarm 0
+	$f close
+	exit 0
+}
+
+verbose "parent: opening socket"
+set done 0
+
+# This will be our server
+set f [socket stream.server 0.0.0.0:9876]
+
+proc server_onread {f} {
+	verbose "parent: onread (server) got connection on $f"
+	set cfd [$f accept]
+	verbose "parent: onread accepted $cfd"
+
+	verbose "parent: read request '[string trim [$cfd gets]]'"
+
+	$cfd puts "Thanks for the request"
+	$cfd close
+
+	verbose "parent: sent response"
+
+	incr ::done
+}
+
+$f readable [list server_onread $f]
+
+alarm 10
+catch -signal {
+	vwait done
+}
+alarm 0
+$f close
+
+sleep .5
+
+return "ok"
diff --git a/examples/timedread.tcl b/examples/timedread.tcl
new file mode 100644
index 0000000..cb4c9aa
--- /dev/null
+++ b/examples/timedread.tcl
@@ -0,0 +1,19 @@
+# Tests that SIGALRM can interrupt read
+set f [open "/dev/urandom" r]
+
+set count 0
+set error NONE
+
+signal handle SIGALRM
+catch -signal {
+	alarm 0.5
+	while {1} {
+		incr count [string bytelength [read $f 100]]
+	}
+	alarm 0
+	signal default SIGALRM
+} error
+
+puts "Read $count bytes in 0.5 seconds: Got $error"
+
+$f close
-- 
cgit v1.1