summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorGravatar Ziv Scully <ziv@mit.edu>2014-09-13 19:16:07 -0400
committerGravatar Ziv Scully <ziv@mit.edu>2014-09-13 19:16:07 -0400
commita7bfe57a2a355c5362d33e993394aa0bac300360 (patch)
tree1f81b256828f90ff34656d7d8fe703ce13d22e48 /tests
parent6b6635f390cc072971dcc7b37af00bca21c48364 (diff)
parent5d2d4930568267b0e205ece3d4908cdc7ff715a1 (diff)
Merge.
Diffstat (limited to 'tests')
-rw-r--r--tests/DynChannel.ur29
-rw-r--r--tests/DynChannel.urp6
-rw-r--r--tests/button.ur4
-rw-r--r--tests/data_attr.ur6
-rwxr-xr-xtests/dbupload2.sh17
-rw-r--r--tests/dbupload2.ur29
-rw-r--r--tests/dbupload2.urp7
-rw-r--r--tests/dbupload2.urs1
-rw-r--r--tests/empty_record.ur3
-rw-r--r--tests/empty_record.urp2
-rw-r--r--tests/files.ur1
-rw-r--r--tests/files.urp6
-rw-r--r--tests/hello.txt1
-rw-r--r--tests/lessSafeFfi.ur7
-rw-r--r--tests/letwhere.ur7
-rw-r--r--tests/pb.ur7
-rw-r--r--tests/pb.urs1
-rw-r--r--tests/rpchan.ur18
-rw-r--r--tests/rpchan.urs1
-rw-r--r--tests/sqlurl.ur4
-rw-r--r--tests/sqlurl.urp6
-rw-r--r--tests/tags.ur26
-rw-r--r--tests/tags.urp6
-rw-r--r--tests/wackyunif.ur2
-rw-r--r--tests/wackyunif.urp2
-rw-r--r--tests/web.pngbin0 -> 9565 bytes
26 files changed, 194 insertions, 5 deletions
diff --git a/tests/DynChannel.ur b/tests/DynChannel.ur
new file mode 100644
index 00000000..d3688781
--- /dev/null
+++ b/tests/DynChannel.ur
@@ -0,0 +1,29 @@
+table channels : {Id : int, Channel:channel xbody}
+
+fun dosend (s:string) : transaction unit =
+ c <- oneRow1 (SELECT * FROM channels);
+ debug ("Sending " ^ s ^ " through the channel...");
+ send c.Channel <xml>{[s]}</xml>
+
+fun mkchannel {} : transaction xbody =
+ c <- channel;
+ s <- source <xml/>;
+ dml( DELETE FROM channels WHERE Id >= 0);
+ dml( INSERT INTO channels(Id, Channel) VALUES(0, {[c]}) );
+ return <xml>
+ <button value="Send" onclick={fn _ => rpc(dosend "blabla")}/>
+ <active code={spawn(x <- recv c; alert ("Got something from the channel"); set s x); return <xml/>}/>
+ <dyn signal={signal s}/>
+ </xml>
+
+fun main {} : transaction page =
+ s <- source <xml/>;
+ return <xml>
+ <head/>
+ <body>
+ <button value="Register" onclick={fn _ =>
+ x <- rpc(mkchannel {}); set s x
+ }/>
+ <dyn signal={signal s}/>
+ </body>
+ </xml>
diff --git a/tests/DynChannel.urp b/tests/DynChannel.urp
new file mode 100644
index 00000000..08d6d1a5
--- /dev/null
+++ b/tests/DynChannel.urp
@@ -0,0 +1,6 @@
+database dbname=DynChannel.db
+sql DynChannel.sql
+debug
+
+$/list
+DynChannel
diff --git a/tests/button.ur b/tests/button.ur
new file mode 100644
index 00000000..febcb0c9
--- /dev/null
+++ b/tests/button.ur
@@ -0,0 +1,4 @@
+fun main () : transaction page = return <xml><body>
+ <button onclick={fn _ => alert "AHOY"}><b>CLICK IT</b></button>
+</body></xml>
+
diff --git a/tests/data_attr.ur b/tests/data_attr.ur
index 80dda857..4462dc10 100644
--- a/tests/data_attr.ur
+++ b/tests/data_attr.ur
@@ -1,5 +1,5 @@
fun dynd r = return <xml><body>
- <div data={data_attr r.Attr r.Value}>How about that?</div>
+ <div data={data_attr data_kind r.Attr r.Value}>How about that?</div>
</body></xml>
fun main () : transaction page =
@@ -7,7 +7,7 @@ fun main () : transaction page =
a <- source "";
v <- source "";
return <xml><body>
- <div data-foo="hi" data-bar="bye" data-baz="why">Whoa there, cowboy!</div>
+ <div data-foo="hi" aria-something="wow" data-bar="bye" data-baz="why">Whoa there, cowboy!</div>
<hr/>
@@ -20,7 +20,7 @@ fun main () : transaction page =
<ctextbox source={a}/> = <ctextbox source={v}/>
<button onclick={fn _ =>
- a <- get a; v <- get v; set s <xml><div data={data_attr a v}>OHO!</div></xml>}/>
+ a <- get a; v <- get v; set s <xml><div data={data_attr data_kind a v}>OHO!</div></xml>}/>
<hr/>
<dyn signal={signal s}/>
</body></xml>
diff --git a/tests/dbupload2.sh b/tests/dbupload2.sh
new file mode 100755
index 00000000..cecf1960
--- /dev/null
+++ b/tests/dbupload2.sh
@@ -0,0 +1,17 @@
+#!/bin/sh
+
+set -e
+
+cd `dirname $0`
+
+urweb -dbms sqlite dbupload2
+
+rm -rf dbupload2.db || true
+sqlite3 dbupload2.db < dbupload2.sql
+
+./dbupload2.exe -p 8083 &
+sleep 1
+
+touch /tmp/empty
+curl --verbose -F"operation=upload" -F"filename=@/tmp/empty" http://localhost:8083/Blabla/bla
+
diff --git a/tests/dbupload2.ur b/tests/dbupload2.ur
new file mode 100644
index 00000000..428f2460
--- /dev/null
+++ b/tests/dbupload2.ur
@@ -0,0 +1,29 @@
+table t : { Id : int, Blob : blob, MimeType : string }
+sequence s
+
+fun getImage id : transaction page =
+ r <- oneRow1 (SELECT t.Blob, t.MimeType
+ FROM t
+ WHERE t.Id = {[id]});
+ returnBlob r.Blob (blessMime r.MimeType)
+
+fun handle (r : {File:file, Param:string}) =
+ id <- nextval s;
+ dml (INSERT INTO t (Id, Blob, MimeType)
+ VALUES ({[id]}, {[fileData r.File]}, {[fileMimeType r.File]}));
+ debug ("Text is " ^ r.Param);
+ main ()
+
+and main () : transaction page =
+ x <- queryX1 (SELECT t.Id FROM t)
+ (fn r => <xml><img src={url (getImage r.Id)}/>
+</xml>);
+ return <xml><body>
+ <form>
+ <upload{#File}/>
+ <textbox{#Param} value="text"/>
+ <submit action={handle}/>
+ </form>
+ <hr/>
+ {x}
+ </body></xml>
diff --git a/tests/dbupload2.urp b/tests/dbupload2.urp
new file mode 100644
index 00000000..bd550589
--- /dev/null
+++ b/tests/dbupload2.urp
@@ -0,0 +1,7 @@
+database dbname=dbupload2.db
+sql dbupload2.sql
+allow mime *
+rewrite all Dbupload2/*
+debug
+
+dbupload2
diff --git a/tests/dbupload2.urs b/tests/dbupload2.urs
new file mode 100644
index 00000000..80240dee
--- /dev/null
+++ b/tests/dbupload2.urs
@@ -0,0 +1 @@
+val main: {} -> transaction page
diff --git a/tests/empty_record.ur b/tests/empty_record.ur
new file mode 100644
index 00000000..45ab6fdb
--- /dev/null
+++ b/tests/empty_record.ur
@@ -0,0 +1,3 @@
+val concatX [ctx ::: {Unit}] [use ::: {Type}]
+ : list (xml ctx use []) -> xml ctx use []
+ = List.foldl join <xml/>
diff --git a/tests/empty_record.urp b/tests/empty_record.urp
new file mode 100644
index 00000000..c81175fc
--- /dev/null
+++ b/tests/empty_record.urp
@@ -0,0 +1,2 @@
+$/list
+empty_record
diff --git a/tests/files.ur b/tests/files.ur
new file mode 100644
index 00000000..94cf8eb1
--- /dev/null
+++ b/tests/files.ur
@@ -0,0 +1 @@
+fun main () : transaction page = return <xml>Main page</xml>
diff --git a/tests/files.urp b/tests/files.urp
new file mode 100644
index 00000000..100992e5
--- /dev/null
+++ b/tests/files.urp
@@ -0,0 +1,6 @@
+rewrite all Files/*
+file /hello_world.txt hello.txt
+file /img/web.png web.png
+file /files.urp files.urp
+
+files
diff --git a/tests/hello.txt b/tests/hello.txt
new file mode 100644
index 00000000..980a0d5f
--- /dev/null
+++ b/tests/hello.txt
@@ -0,0 +1 @@
+Hello World!
diff --git a/tests/lessSafeFfi.ur b/tests/lessSafeFfi.ur
index da79bfdc..6bf26ba9 100644
--- a/tests/lessSafeFfi.ur
+++ b/tests/lessSafeFfi.ur
@@ -1,15 +1,18 @@
ffi foo : int -> int
ffi bar serverOnly benignEffectful : int -> transaction unit
ffi baz : transaction int
+ffi adder : int -> int -> int
-ffi bup jsFunc "jsbup" : int -> transaction unit
+ffi bup jsFunc "alert" : string -> transaction unit
+ffi alert : string -> transaction unit
fun other () : transaction page =
(*bar 17;
q <- baz;*)
return <xml><body>
(*{[foo 42]}, {[q]}*)
- <button onclick={fn _ => bup 32}/>
+ <button value="bup" onclick={fn _ => bup "asdf"}/>
+ <button value="alert" onclick={fn _ => alert "qqqz"}/>
</body></xml>
fun main () = return <xml><body>
diff --git a/tests/letwhere.ur b/tests/letwhere.ur
new file mode 100644
index 00000000..8854f2aa
--- /dev/null
+++ b/tests/letwhere.ur
@@ -0,0 +1,7 @@
+fun main () : transaction page =
+ let
+ return <xml>Hi {[alice]} and {[bob]}!</xml>
+ where
+ val alice = "Alice"
+ val bob = "Bob"
+ end
diff --git a/tests/pb.ur b/tests/pb.ur
new file mode 100644
index 00000000..e6e5bd5c
--- /dev/null
+++ b/tests/pb.ur
@@ -0,0 +1,7 @@
+fun api_1 (pb:postBody) (nm:string) : transaction page =
+ return <xml>Processing the request</xml>
+
+fun api (pb:postBody) (v:int) (nm:string) : transaction page =
+ case v of
+ 1 => api_1 pb nm
+ | _ => error <xml>Version {[v]} is not supported</xml>
diff --git a/tests/pb.urs b/tests/pb.urs
new file mode 100644
index 00000000..9def0871
--- /dev/null
+++ b/tests/pb.urs
@@ -0,0 +1 @@
+val api : postBody -> int -> string -> transaction page
diff --git a/tests/rpchan.ur b/tests/rpchan.ur
new file mode 100644
index 00000000..08308d90
--- /dev/null
+++ b/tests/rpchan.ur
@@ -0,0 +1,18 @@
+fun remote () =
+ ch <- channel;
+ send ch "Hello World!";
+ return ch
+
+fun remoter () =
+ ch <- channel;
+ send ch "Hello World!";
+ return <xml><active code={spawn (s <- recv ch; alert s); return <xml/>}/></xml>
+
+fun main () =
+ x <- source <xml/>;
+ return <xml><body>
+ <button onclick={fn _ => ch <- rpc (remote ()); s <- recv ch; alert s}>TEST</button>
+ <button onclick={fn _ => y <- rpc (remoter ()); set x y}>TESTER</button>
+ <hr/>
+ <dyn signal={signal x}/>
+ </body></xml>
diff --git a/tests/rpchan.urs b/tests/rpchan.urs
new file mode 100644
index 00000000..6ac44e0b
--- /dev/null
+++ b/tests/rpchan.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/sqlurl.ur b/tests/sqlurl.ur
new file mode 100644
index 00000000..cdd51ca8
--- /dev/null
+++ b/tests/sqlurl.ur
@@ -0,0 +1,4 @@
+table t : { Url : url }
+
+task initialize = fn () =>
+ dml (INSERT INTO t (Url) VALUES ({[bless "http://www.google.com/"]}))
diff --git a/tests/sqlurl.urp b/tests/sqlurl.urp
new file mode 100644
index 00000000..bb5544df
--- /dev/null
+++ b/tests/sqlurl.urp
@@ -0,0 +1,6 @@
+database dbname=test
+sql sqlurl.sql
+rewrite url Sqlurl/*
+allow url http://www.google.com/
+
+sqlurl
diff --git a/tests/tags.ur b/tests/tags.ur
new file mode 100644
index 00000000..059e869a
--- /dev/null
+++ b/tests/tags.ur
@@ -0,0 +1,26 @@
+table images : { Id : int, Content : blob }
+table tags : { Id : int, Tag : string }
+
+datatype mode = Present | Absent
+type condition = { Tag : string, Mode : mode }
+
+type tag_query = sql_query [] [] [] [Id = int]
+
+fun addCondition (c : condition) (q : tag_query) : tag_query =
+ case c.Mode of
+ Present => (SELECT I.Id AS Id
+ FROM ({{q}}) AS I
+ JOIN tags ON tags.Id = I.Id AND tags.Tag = {[c.Tag]})
+ | Absent => (SELECT I.Id AS Id
+ FROM ({{q}}) AS I
+ LEFT JOIN tags ON tags.Id = I.Id AND tags.Tag = {[c.Tag]}
+ WHERE tags.Tag IS NULL)
+
+fun withConditions (cs : list condition) : tag_query =
+ List.foldl addCondition (SELECT images.Id AS Id FROM images) cs
+
+fun main (cs : list condition) : transaction page =
+ x <- queryX (withConditions cs) (fn r => <xml><li>{[r.Id]}</li></xml>);
+ return <xml><body>
+ {x}
+ </body></xml>
diff --git a/tests/tags.urp b/tests/tags.urp
new file mode 100644
index 00000000..b2f21c5a
--- /dev/null
+++ b/tests/tags.urp
@@ -0,0 +1,6 @@
+database dbname=test
+sql tags.sql
+rewrite url Tags/*
+
+$/list
+tags
diff --git a/tests/wackyunif.ur b/tests/wackyunif.ur
new file mode 100644
index 00000000..2a215e69
--- /dev/null
+++ b/tests/wackyunif.ur
@@ -0,0 +1,2 @@
+val concatX [ctx] [use] : _ -> _ ctx use _ =
+ List.foldl join <xml/>
diff --git a/tests/wackyunif.urp b/tests/wackyunif.urp
new file mode 100644
index 00000000..35791acf
--- /dev/null
+++ b/tests/wackyunif.urp
@@ -0,0 +1,2 @@
+$/list
+wackyunif
diff --git a/tests/web.png b/tests/web.png
new file mode 100644
index 00000000..17548060
--- /dev/null
+++ b/tests/web.png
Binary files differ
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-02 04:21:59 +0000