Mercurial > urweb
annotate tests/roundTrip.ur @ 1962:16c219c74426
Fix a soundness bug in purity analysis (mono_reduce)
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Sun, 19 Jan 2014 13:51:26 -0500 |
| parents | 8a169fc0838b |
| children |
| rev | line source |
|---|---|
| adamc@728 | 1 table channels : { Client : client, Channel : channel (string * int * float) } |
| adamc@728 | 2 PRIMARY KEY Client |
| adamc@728 | 3 |
| adam@1348 | 4 table dearlyDeparted : { Client : option client, When : time } |
| adam@1348 | 5 |
| adam@1348 | 6 task clientLeaves = fn cli : client => |
| adam@1348 | 7 dml (INSERT INTO dearlyDeparted (Client, When) VALUES ({[Some cli]}, CURRENT_TIMESTAMP)); |
| adam@1348 | 8 debug "Our favorite client has LEFT!" |
| adam@1348 | 9 |
| adamc@728 | 10 fun writeBack v = |
| adamc@728 | 11 me <- self; |
| adamc@728 | 12 r <- oneRow (SELECT channels.Channel FROM channels WHERE channels.Client = {[me]}); |
| adamc@728 | 13 send r.Channels.Channel v |
| adamc@728 | 14 |
| adam@1348 | 15 fun main' () = |
| adamc@728 | 16 me <- self; |
| adamc@728 | 17 ch <- channel; |
| adamc@728 | 18 dml (INSERT INTO channels (Client, Channel) VALUES ({[me]}, {[ch]})); |
| adamc@728 | 19 |
| adamc@728 | 20 buf <- Buffer.create; |
| adamc@728 | 21 |
| adamc@728 | 22 let |
| adamc@728 | 23 fun receiverA () = |
| adamc@728 | 24 v <- recv ch; |
| adamc@728 | 25 Buffer.write buf ("A:(" ^ v.1 ^ ", " ^ show v.2 ^ ", " ^ show v.3 ^ ")"); |
| adamc@728 | 26 receiverA () |
| adamc@728 | 27 |
| adamc@728 | 28 fun receiverB () = |
| adamc@728 | 29 v <- recv ch; |
| adamc@728 | 30 Buffer.write buf ("B:(" ^ v.1 ^ ", " ^ show v.2 ^ ", " ^ show v.3 ^ ")"); |
| adamc@728 | 31 error <xml>Bail out!</xml>; |
| adamc@728 | 32 receiverB () |
| adamc@728 | 33 |
| adamc@728 | 34 fun sender s n f = |
| adamc@729 | 35 sleep 2000; |
| adam@1348 | 36 rpc (writeBack (s, n, f)); |
| adamc@728 | 37 sender (s ^ "!") (n + 1) (f + 1.23) |
| adamc@728 | 38 in |
| adamc@729 | 39 return <xml><body onload={onDisconnect (alert "Server booted me"); |
| adamc@729 | 40 onConnectFail (alert "Connection failed"); |
| adamc@729 | 41 onServerError (fn s => alert ("Server error: " ^ s)); |
| adamc@729 | 42 spawn (receiverA ()); spawn (receiverB ()); sender "" 0 0.0}> |
| adamc@728 | 43 <dyn signal={Buffer.render buf}/> |
| adamc@728 | 44 </body></xml> |
| adamc@728 | 45 end |
| adam@1348 | 46 |
| adam@1348 | 47 fun main () = return <xml><body><form><submit action={main'}/></form></body></xml> |