summaryrefslogtreecommitdiff
path: root/tests/channelThief.ur
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2013-12-27 12:10:03 -0500
committerGravatar Adam Chlipala <adam@chlipala.net>2013-12-27 12:10:03 -0500
commitee16149ddef734c9945ff0339300fd926ca91b1a (patch)
tree85f0265a4778128dee390ef80d943cc6c5b0669f /tests/channelThief.ur
parent8ebc8340ebc13704014d5b2a3bbcd453786162c8 (diff)
Raise exception when recv()ing from someone else's channel; improve setting of client ID in RPCs
Diffstat (limited to 'tests/channelThief.ur')
-rw-r--r--tests/channelThief.ur32
1 files changed, 32 insertions, 0 deletions
diff --git a/tests/channelThief.ur b/tests/channelThief.ur
new file mode 100644
index 00000000..1893979a
--- /dev/null
+++ b/tests/channelThief.ur
@@ -0,0 +1,32 @@
+table t : { Ch : channel string }
+
+fun go () =
+ let
+ fun overwrite () =
+ dml (DELETE FROM t WHERE TRUE);
+ ch <- channel;
+ dml (INSERT INTO t (Ch) VALUES ({[ch]}));
+ return ch
+
+ fun retrieve () =
+ oneRowE1 (SELECT (t.Ch) FROM t)
+
+ fun transmit () =
+ ch <- retrieve ();
+ send ch "Test"
+
+ fun listenOn ch =
+ s <- recv ch;
+ alert s
+ in
+ ch <- overwrite ();
+ return <xml><body onload={listenOn ch}>
+ <button value="overwrite" onclick={fn _ => ch <- rpc (overwrite ()); listenOn ch}/>
+ <button value="retrieve" onclick={fn _ => ch <- rpc (retrieve ()); listenOn ch}/>
+ <button value="transmit" onclick={fn _ => rpc (transmit ())}/>
+ </body></xml>
+ end
+
+fun main () = return <xml><body>
+ <form><submit action={go}/></form>
+</body></xml>