diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2009-04-16 13:00:40 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2009-04-16 13:00:40 -0400 |
| commit | e65c023309173aa291952143537f174888a8de86 (patch) | |
| tree | 517b9c66d187dc97c0e7fbe181f43d9fefbef929 /tests | |
| parent | d52fbe487bb29a4a60dcca1d36e9dadc64917517 (diff) | |
Avoid thread death via message receive
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/buffer.ur | 25 | ||||
| -rw-r--r-- | tests/buffer.urs | 5 | ||||
| -rw-r--r-- | tests/roundTrip.ur | 36 | ||||
| -rw-r--r-- | tests/roundTrip.urp | 5 | ||||
| -rw-r--r-- | tests/roundTrip.urs | 1 | ||||
| -rw-r--r-- | tests/threads.ur | 18 | ||||
| -rw-r--r-- | tests/threads.urp | 3 | ||||
| -rw-r--r-- | tests/threads.urs | 1 |
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 |