diff tests/channelThief.ur @ 1942:a671e5258a2c

Raise exception when recv()ing from someone else's channel; improve setting of client ID in RPCs
author Adam Chlipala <adam@chlipala.net>
date Fri, 27 Dec 2013 12:10:03 -0500
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/channelThief.ur	Fri Dec 27 12:10:03 2013 -0500
@@ -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>