diff options
author | Adam Chlipala <adam@chlipala.net> | 2013-12-27 12:10:03 -0500 |
---|---|---|
committer | Adam Chlipala <adam@chlipala.net> | 2013-12-27 12:10:03 -0500 |
commit | ee16149ddef734c9945ff0339300fd926ca91b1a (patch) | |
tree | 85f0265a4778128dee390ef80d943cc6c5b0669f /tests | |
parent | 8ebc8340ebc13704014d5b2a3bbcd453786162c8 (diff) |
Raise exception when recv()ing from someone else's channel; improve setting of client ID in RPCs
Diffstat (limited to 'tests')
-rw-r--r-- | tests/channelThief.ur | 32 | ||||
-rw-r--r-- | tests/channelThief.urp | 5 | ||||
-rw-r--r-- | tests/channelThief.urs | 1 |
3 files changed, 38 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> diff --git a/tests/channelThief.urp b/tests/channelThief.urp new file mode 100644 index 00000000..dee402d4 --- /dev/null +++ b/tests/channelThief.urp @@ -0,0 +1,5 @@ +database dbname=test +sql channelThief.sql +rewrite url ChannelThief/* + +channelThief diff --git a/tests/channelThief.urs b/tests/channelThief.urs new file mode 100644 index 00000000..6ac44e0b --- /dev/null +++ b/tests/channelThief.urs @@ -0,0 +1 @@ +val main : unit -> transaction page |