summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-04-16 13:00:40 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-04-16 13:00:40 -0400
commitb6fef1cc8832978bd9673df1a968d06d42bc2eb0 (patch)
tree517b9c66d187dc97c0e7fbe181f43d9fefbef929 /tests
parent966f716a755bd954d817b43d1efaaeb6f939ad89 (diff)
Avoid thread death via message receive
Diffstat (limited to 'tests')
-rw-r--r--tests/buffer.ur25
-rw-r--r--tests/buffer.urs5
-rw-r--r--tests/roundTrip.ur36
-rw-r--r--tests/roundTrip.urp5
-rw-r--r--tests/roundTrip.urs1
-rw-r--r--tests/threads.ur18
-rw-r--r--tests/threads.urp3
-rw-r--r--tests/threads.urs1
8 files changed, 94 insertions, 0 deletions
diff --git a/tests/buffer.ur b/tests/buffer.ur
new file mode 100644
index 00000000..27e2b805
--- /dev/null
+++ b/tests/buffer.ur
@@ -0,0 +1,25 @@
+datatype lines = End | Line of string * source lines
+
+type t = { Head : source lines, Tail : source (source lines) }
+
+val create =
+ head <- source End;
+ tail <- source head;
+ return {Head = head, Tail = tail}
+
+fun renderL lines =
+ case lines of
+ End => <xml/>
+ | Line (line, linesS) => <xml>{[line]}<br/><dyn signal={renderS linesS}/></xml>
+
+and renderS linesS =
+ lines <- signal linesS;
+ return (renderL lines)
+
+fun render t = renderS t.Head
+
+fun write t s =
+ oldTail <- get t.Tail;
+ newTail <- source End;
+ set oldTail (Line (s, newTail));
+ set t.Tail newTail
diff --git a/tests/buffer.urs b/tests/buffer.urs
new file mode 100644
index 00000000..58312bbd
--- /dev/null
+++ b/tests/buffer.urs
@@ -0,0 +1,5 @@
+type t
+
+val create : transaction t
+val render : t -> signal xbody
+val write : t -> string -> transaction unit
diff --git a/tests/roundTrip.ur b/tests/roundTrip.ur
new file mode 100644
index 00000000..26a0113e
--- /dev/null
+++ b/tests/roundTrip.ur
@@ -0,0 +1,36 @@
+table channels : { Client : client, Channel : channel (string * int * float) }
+ PRIMARY KEY Client
+
+fun writeBack v =
+ me <- self;
+ r <- oneRow (SELECT channels.Channel FROM channels WHERE channels.Client = {[me]});
+ send r.Channels.Channel v
+
+fun main () =
+ me <- self;
+ ch <- channel;
+ dml (INSERT INTO channels (Client, Channel) VALUES ({[me]}, {[ch]}));
+
+ buf <- Buffer.create;
+
+ let
+ fun receiverA () =
+ v <- recv ch;
+ Buffer.write buf ("A:(" ^ v.1 ^ ", " ^ show v.2 ^ ", " ^ show v.3 ^ ")");
+ receiverA ()
+
+ fun receiverB () =
+ v <- recv ch;
+ Buffer.write buf ("B:(" ^ v.1 ^ ", " ^ show v.2 ^ ", " ^ show v.3 ^ ")");
+ error <xml>Bail out!</xml>;
+ receiverB ()
+
+ fun sender s n f =
+ sleep 9;
+ writeBack (s, n, f);
+ sender (s ^ "!") (n + 1) (f + 1.23)
+ in
+ return <xml><body onload={spawn (receiverA ()); spawn (receiverB ()); sender "" 0 0.0}>
+ <dyn signal={Buffer.render buf}/>
+ </body></xml>
+ end
diff --git a/tests/roundTrip.urp b/tests/roundTrip.urp
new file mode 100644
index 00000000..e8f27f2e
--- /dev/null
+++ b/tests/roundTrip.urp
@@ -0,0 +1,5 @@
+database dbname=roundtrip
+sql roundTrip.sql
+
+buffer
+roundTrip
diff --git a/tests/roundTrip.urs b/tests/roundTrip.urs
new file mode 100644
index 00000000..6ac44e0b
--- /dev/null
+++ b/tests/roundTrip.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/threads.ur b/tests/threads.ur
new file mode 100644
index 00000000..447b7a74
--- /dev/null
+++ b/tests/threads.ur
@@ -0,0 +1,18 @@
+fun main () =
+ buf <- Buffer.create;
+ let
+ fun loop1 () =
+ Buffer.write buf "A";
+ sleep 9;
+ loop1 ()
+
+ fun loop2 () =
+ Buffer.write buf "B";
+ sleep 9;
+ error <xml>Darn</xml>
+ loop2 ()
+ in
+ return <xml><body onload={spawn (loop1 ()); loop2 ()}>
+ <dyn signal={Buffer.render buf}/>
+ </body></xml>
+ end
diff --git a/tests/threads.urp b/tests/threads.urp
new file mode 100644
index 00000000..153e09a9
--- /dev/null
+++ b/tests/threads.urp
@@ -0,0 +1,3 @@
+
+buffer
+threads
diff --git a/tests/threads.urs b/tests/threads.urs
new file mode 100644
index 00000000..6ac44e0b
--- /dev/null
+++ b/tests/threads.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page