Mercurial > urweb
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>