diff options
Diffstat (limited to 'tests')
115 files changed, 3035 insertions, 74 deletions
diff --git a/tests/DynChannel.py b/tests/DynChannel.py new file mode 100644 index 00000000..7af5ea78 --- /dev/null +++ b/tests/DynChannel.py @@ -0,0 +1,20 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('DynChannel/main') + + # initial state: only Register is visible + reg = self.xpath('button') + reg.click() + # and we get two another state: either Register or Send visible + send = self.xpath('span/button') + send.click() + alert = self.driver.switch_to.alert + self.assertEqual("Got something from the channel", alert.text) + alert.accept() + # we got the message back + span = self.xpath('span/span') + self.assertEqual("blabla", span.text) diff --git a/tests/Makefile b/tests/Makefile index 5313d12d..8df59518 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -2,3 +2,42 @@ all: test.o test.o: test.c gcc -c test.c -o test.o +### + +simple:: + ./driver.sh aborter2 + ./driver.sh aborter + ./driver.sh a_case_of_the_splits + ./driver.sh activeBlock + ./driver.sh activeFocus + ./driver.sh active + ./driver.sh agg + ./driver.sh ahead + ./driver.sh alert + ./driver.sh align + ./driver.sh appjs + ./driver.sh ascdesc + echo ./driver.sh attrMangle + ./driver.sh attrs_escape + echo ./driver.sh attrs + ./driver.sh autocomp + ./driver.sh babySpawn + ./driver.sh bindpat + ./driver.sh bodyClick + ./driver.sh bool + ./driver.sh both + ./driver.sh both2 + ./driver.sh button + ./driver.sh case + ./driver.sh caseMod + ./driver.sh ccheckbox + ./driver.sh cdataF + ./driver.sh cdataL + ./cffi.sh + ./driver.sh DynChannel + ./driver.sh jsonTest + ./driver.sh entities + ./driver.sh fact + ./driver.sh filter + ./driver.sh jsbspace + ./driver.sh utf8 diff --git a/tests/a_case_of_the_splits.py b/tests/a_case_of_the_splits.py new file mode 100644 index 00000000..9a78e2fb --- /dev/null +++ b/tests/a_case_of_the_splits.py @@ -0,0 +1,15 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('main') + reg = self.xpath('button') + # click a couple of times + reg.click() + reg.click() + # we should get HTML spliced into HTML as-is (properly escaped even!) + span = self.xpath('span') + txt = span.text + self.assertRegex(txt, ".*\\(0\\).* :: .*\\(1\\).* :: \\[\\]") diff --git a/tests/a_case_of_the_splits.ur b/tests/a_case_of_the_splits.ur new file mode 100644 index 00000000..2029729e --- /dev/null +++ b/tests/a_case_of_the_splits.ur @@ -0,0 +1,17 @@ +fun newCounter () : transaction xbody = + x <- source 0; + return <xml> + <dyn signal={n <- signal x; return <xml>{[n]}</xml>}/> + </xml> + +fun main () : transaction page = + ls <- source ([] : list xbody); + return <xml> + <body> + <button value="Add" onclick={fn _ => + l <- get ls; + c <- newCounter (); + set ls (c :: l)}/> + <dyn signal={l <- signal ls; return <xml>{[l]}</xml>}/> + </body> + </xml> diff --git a/tests/a_case_of_the_splits.urp b/tests/a_case_of_the_splits.urp new file mode 100644 index 00000000..b8238bf4 --- /dev/null +++ b/tests/a_case_of_the_splits.urp @@ -0,0 +1,4 @@ +rewrite all A_case_of_the_splits/* + +$/list +a_case_of_the_splits diff --git a/tests/aborter.py b/tests/aborter.py new file mode 100644 index 00000000..8379c656 --- /dev/null +++ b/tests/aborter.py @@ -0,0 +1,11 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('Aborter/main') + self.assertEqual("Fatal Error", self.driver.title) + txt = self.body_text() + self.assertEqual("Fatal error: :0:0-0:0: No way, Jose!", txt) + diff --git a/tests/aborter.urp b/tests/aborter.urp index fc1925ae..8c971440 100644 --- a/tests/aborter.urp +++ b/tests/aborter.urp @@ -1,4 +1,5 @@ database dbname=aborter sql aborter.sql +safeGet Aborter/main aborter diff --git a/tests/aborter2.py b/tests/aborter2.py new file mode 100644 index 00000000..c3f1e10e --- /dev/null +++ b/tests/aborter2.py @@ -0,0 +1,11 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('Aborter2/main') + self.assertEqual("", self.driver.title) + txt = self.body_text() + self.assertEqual("Result: 0", txt) + diff --git a/tests/active.py b/tests/active.py new file mode 100644 index 00000000..08846ac5 --- /dev/null +++ b/tests/active.py @@ -0,0 +1,14 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + b1 = self.xpath('span[1]/button') + b2 = self.xpath('span[2]/button') + for _ in range(3): + b1.click() + for _ in range(5): + b2.click() + self.assertEqual("3\n5", self.body_text()) diff --git a/tests/activeBlock.py b/tests/activeBlock.py new file mode 100644 index 00000000..d0e43fdb --- /dev/null +++ b/tests/activeBlock.py @@ -0,0 +1,20 @@ +import unittest +import base +import time + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + alert = self.driver.switch_to.alert + self.assertEqual("Error: May not 'sleep' in main thread of 'code' for <active>", alert.text) + alert.accept() + time.sleep(0.1) + alert = self.driver.switch_to.alert + self.assertEqual("Hi!", alert.text) + alert.accept() + button = self.xpath('span[1]/button') + button.click() + txt = self.body_text() + self.assertEqual("Hi! Click me! Success", txt) + diff --git a/tests/activeBlock.ur b/tests/activeBlock.ur index 5560edda..bced4af3 100644 --- a/tests/activeBlock.ur +++ b/tests/activeBlock.ur @@ -1,7 +1,7 @@ fun main () : transaction page = return <xml><body> <active code={s <- source ""; return <xml> <dyn signal={s <- signal s; return (txt s)}/> - <button onclick={fn _ => set s "Hi!"}/> + <button onclick={fn _ => set s "Hi!"}>Click me!</button> </xml>}/> <active code={sleep 1; return <xml>Hi!</xml>}/> diff --git a/tests/activeEmpty.py b/tests/activeEmpty.py new file mode 100644 index 00000000..8872833a --- /dev/null +++ b/tests/activeEmpty.py @@ -0,0 +1,12 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + alert = self.driver.switch_to.alert + self.assertEqual("Howdy, neighbor!", alert.text) + alert.accept() + txt = self.body_text() + self.assertEqual("This one ain't empty.", txt) diff --git a/tests/activeFocus.py b/tests/activeFocus.py new file mode 100644 index 00000000..47b9a921 --- /dev/null +++ b/tests/activeFocus.py @@ -0,0 +1,18 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + uw0 = self.xpath('input[2]') + active = self.driver.switch_to.active_element + self.assertEqual(uw0, active) + def test_2(self): + """Test case 2""" + self.start('dynamic') + btn = self.xpath('button') + btn.click() + uw1 = self.xpath('span/input[2]') + active = self.driver.switch_to.active_element + self.assertEqual(uw1, active) diff --git a/tests/activeFocus.ur b/tests/activeFocus.ur index 94d465e9..82d2c0c9 100644 --- a/tests/activeFocus.ur +++ b/tests/activeFocus.ur @@ -14,5 +14,5 @@ fun dynamic () : transaction page = <ctextbox/> <ctextbox id={i}/> <active code={giveFocus i; return <xml>Done</xml>}/> - </xml>}/> + </xml>}>Click</button> </body></xml> diff --git a/tests/agg.py b/tests/agg.py new file mode 100644 index 00000000..0b421d37 --- /dev/null +++ b/tests/agg.py @@ -0,0 +1,8 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('Agg/main') + self.assertEqual("0;1;2;\na, 50;", self.body_text()) diff --git a/tests/agg.ur b/tests/agg.ur index 19a8644b..2d8eed43 100644 --- a/tests/agg.ur +++ b/tests/agg.ur @@ -1,13 +1,23 @@ table t1 : {A : int, B : string, C : float} table t2 : {A : float, D : int, E : option string} -val q1 : sql_query [] _ _ = (SELECT COUNT( * ) FROM t1) -val q2 : sql_query [] _ _ = (SELECT AVG(t1.A) FROM t1) -val q3 : sql_query [] _ _ = (SELECT SUM(t1.C) FROM t1) -val q4 : sql_query [] _ _ = (SELECT MIN(t1.B), MAX(t1.A) FROM t1) -val q5 : sql_query [] _ _ = (SELECT SUM(t1.A) FROM t1 GROUP BY t1.B) +val q1 : sql_query [] [] _ _ = (SELECT COUNT( * ) FROM t1) +val q2 : sql_query [] [] _ _ = (SELECT AVG(t1.A) FROM t1) +val q3 : sql_query [] [] _ _ = (SELECT SUM(t1.C) FROM t1) +val q4 : sql_query [] [] _ _ = (SELECT MIN(t1.B), MAX(t1.A) FROM t1) +val q5 : sql_query [] [] _ _ = (SELECT SUM(t1.A) FROM t1 GROUP BY t1.B) val q6 = (SELECT COUNT(t2.E) FROM t2 GROUP BY t2.D) +task initialize = fn () => + dml (INSERT INTO t1 (A, B, C) VALUES (1, 'a', 1.0)); + dml (INSERT INTO t1 (A, B, C) VALUES (2, 'b', 2.0)); + dml (INSERT INTO t1 (A, B, C) VALUES (50, 'c', 99.0)); + dml (INSERT INTO t2 (A, D, E) VALUES (1.0, 1, NULL)); + dml (INSERT INTO t2 (A, D, E) VALUES (1.0, 2, {[Some "a"]})); + dml (INSERT INTO t2 (A, D, E) VALUES (1.0, 3, NULL)); + dml (INSERT INTO t2 (A, D, E) VALUES (1.0, 3, {[Some "b"]})); + dml (INSERT INTO t2 (A, D, E) VALUES (1.0, 3, {[Some "c"]})) + fun main () : transaction page = xml <- queryX q6 (fn r => <xml>{[r.1]};</xml>); xml2 <- queryX q4 (fn r => <xml>{[r.1]}, {[r.2]};</xml>); diff --git a/tests/ahead.py b/tests/ahead.py new file mode 100644 index 00000000..6e767948 --- /dev/null +++ b/tests/ahead.py @@ -0,0 +1,15 @@ +import unittest +import base +import time + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + alert = self.driver.switch_to.alert + self.assertEqual("Hi!", alert.text) + alert.accept() + time.sleep(0.1) + alert = self.driver.switch_to.alert + self.assertEqual("Bye!", alert.text) + alert.accept() diff --git a/tests/alert.py b/tests/alert.py new file mode 100644 index 00000000..4b783d50 --- /dev/null +++ b/tests/alert.py @@ -0,0 +1,11 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + el = self.xpath('a') + el.click() + alert = self.driver.switch_to.alert + self.assertEqual("You clicked it! That's some fancy shooting!", alert.text) diff --git a/tests/alert.ur b/tests/alert.ur index 3fe68d75..7a290921 100644 --- a/tests/alert.ur +++ b/tests/alert.ur @@ -1,3 +1,3 @@ fun main () : transaction page = return <xml><body> - <a onclick={alert "You clicked it! That's some fancy shooting!"}>Click Me!</a> + <a onclick={fn _ => alert "You clicked it! That's some fancy shooting!"}>Click Me!</a> </body></xml> diff --git a/tests/align.py b/tests/align.py new file mode 100644 index 00000000..525ab4e6 --- /dev/null +++ b/tests/align.py @@ -0,0 +1,11 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + el = self.xpath('p[@align="left"]') + self.assertEqual("Left", el.text) + el = self.xpath('p[@align="right"]') + self.assertEqual("Right", el.text) diff --git a/tests/appjs.py b/tests/appjs.py new file mode 100644 index 00000000..02ac2193 --- /dev/null +++ b/tests/appjs.py @@ -0,0 +1,11 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + el = self.xpath('button') + el.click() + alert = self.driver.switch_to.alert + self.assertEqual("3", alert.text) diff --git a/tests/appjs.ur b/tests/appjs.ur index 01e9f345..403b0b4e 100644 --- a/tests/appjs.ur +++ b/tests/appjs.ur @@ -1,5 +1,5 @@ fun id n = if n = 0 then 0 else 1 + id (n - 1) fun main () : transaction page = return <xml><body> - <button onclick={alert (show (id 3))}/> + <button onclick={fn _ => alert (show (id 3))}/> </body></xml> diff --git a/tests/ascdesc.py b/tests/ascdesc.py new file mode 100644 index 00000000..6b514f4e --- /dev/null +++ b/tests/ascdesc.py @@ -0,0 +1,11 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('Ascdesc/main') + el = self.xpath('p[1]') + self.assertEqual("1; 2; 3;", el.text) + el = self.xpath('p[2]') + self.assertEqual("3; 2; 1;", el.text) diff --git a/tests/ascdesc.ur b/tests/ascdesc.ur index 59dd0169..fadac27d 100644 --- a/tests/ascdesc.ur +++ b/tests/ascdesc.ur @@ -4,7 +4,15 @@ fun sortEm b = queryX1 (SELECT * FROM t ORDER BY t.A {if b then sql_asc else sql_desc}) (fn r => <xml>{[r.A]}; </xml>) -fun main () : transaction page = return <xml><body> - <a link={sortEm True}>Ascending</a><br/> - <a link={sortEm False}>Descending</a> +task initialize = fn () => + dml (INSERT INTO t (A) VALUES (1)); + dml (INSERT INTO t (A) VALUES (2)); + dml (INSERT INTO t (A) VALUES (3)) + +fun main () : transaction page = + p1 <- sortEm True; + p2 <- sortEm False; + return <xml><body> + <p>{p1}</p> + <p>{p2}</p> </body></xml> diff --git a/tests/ascdesc.urp b/tests/ascdesc.urp index 3e0b075d..a1c4124e 100644 --- a/tests/ascdesc.urp +++ b/tests/ascdesc.urp @@ -1,4 +1,3 @@ -database dbname=test -sql ascdesc.sql +database dbname=ascdesc ascdesc
\ No newline at end of file diff --git a/tests/attrMangle.py b/tests/attrMangle.py new file mode 100644 index 00000000..d3b24244 --- /dev/null +++ b/tests/attrMangle.py @@ -0,0 +1,11 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + el = self.xpath('goofy[@name eq "beppo" and @data-role eq "excellence"]') + el.click() + alert = self.driver.switch_to.alert + self.assertEqual("You clicked it! That's some fancy shooting!", alert.text) diff --git a/tests/attrs_escape.py b/tests/attrs_escape.py new file mode 100644 index 00000000..fc9f91b5 --- /dev/null +++ b/tests/attrs_escape.py @@ -0,0 +1,10 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + el = self.xpath('form/input') + val = el.get_attribute('value') + self.assertEqual("\"Well hey\"\nWow", val) diff --git a/tests/attrs_escape.ur b/tests/attrs_escape.ur index 12de101e..87d554fe 100644 --- a/tests/attrs_escape.ur +++ b/tests/attrs_escape.ur @@ -1,4 +1,6 @@ -val main = fn () => <html><body> - <font face="\"Well hey\" -Wow">Welcome</font> -</body></html> +fun main () : transaction page = return <xml><body> +<form> + <submit value="\"Well hey\" +Wow"/> +</form> +</body></xml> diff --git a/tests/autocomp.py b/tests/autocomp.py new file mode 100644 index 00000000..28c3b7d2 --- /dev/null +++ b/tests/autocomp.py @@ -0,0 +1,15 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + txt = self.xpath('div') + self.assertEqual('/', txt.text) + inp = self.xpath('/input') + inp.send_keys('hello there') + self.assertEqual('hello there /', txt.text) + btn = self.xpath('button') + btn.click() + self.assertEqual("hello there / hello there", txt.text) diff --git a/tests/autocomp.ur b/tests/autocomp.ur index d4e6a287..753318f7 100644 --- a/tests/autocomp.ur +++ b/tests/autocomp.ur @@ -2,10 +2,10 @@ fun main () : transaction page = a <- source ""; b <- source ""; return <xml><body> - <form> - <textbox{#A} source={a}/> - <button onclick={x <- get a; set b x}/> + <ctextbox source={a}/> + <button onclick={fn _ => x <- get a; set b x}>click me</button> + <div> <dyn signal={v <- signal a; return <xml>{[v]}</xml>}/> / <dyn signal={v <- signal b; return <xml>{[v]}</xml>}/> - </form> + </div> </body></xml> diff --git a/tests/babySpawn.py b/tests/babySpawn.py new file mode 100644 index 00000000..6693e969 --- /dev/null +++ b/tests/babySpawn.py @@ -0,0 +1,12 @@ +import unittest +import base +import time + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + btn = self.xpath('button') + btn.click() + alert = self.driver.switch_to.alert + self.assertEqual("Hi", alert.text) diff --git a/tests/badkind.ur b/tests/badkind.ur new file mode 100644 index 00000000..600f7a35 --- /dev/null +++ b/tests/badkind.ur @@ -0,0 +1 @@ +fun main () : transaction page = <xml>ahoy!</xml> diff --git a/tests/badkind.urp b/tests/badkind.urp new file mode 100644 index 00000000..934e4928 --- /dev/null +++ b/tests/badkind.urp @@ -0,0 +1,3 @@ +rewrite Badkind/main / + +badkind diff --git a/tests/base.py b/tests/base.py new file mode 100644 index 00000000..b9a026f2 --- /dev/null +++ b/tests/base.py @@ -0,0 +1,29 @@ +# use pip install selenium first +# ensure you have both chome driver & chrome installed + +import unittest +from selenium import webdriver +from selenium.common.exceptions import NoSuchElementException + +class Base(unittest.TestCase): + """Include test cases on a given url""" + + def start(self, path='main'): + self.driver.get('http://localhost:8080/' + path) + def xpath(self, path): + return self.driver.find_element_by_xpath('/html/body/'+path) + def body_text(self): + return self.driver.find_element_by_xpath('/html/body').text + + def setUp(self): + """Start web driver""" + chrome_options = webdriver.ChromeOptions() + chrome_options.add_argument('--no-sandbox') + chrome_options.add_argument('--headless') + chrome_options.add_argument('--disable-gpu') + self.driver = webdriver.Chrome(options=chrome_options) + self.driver.implicitly_wait(10) + + def tearDown(self): + """Stop web driver""" + self.driver.quit() diff --git a/tests/bindpat.py b/tests/bindpat.py new file mode 100644 index 00000000..6c33f52f --- /dev/null +++ b/tests/bindpat.py @@ -0,0 +1,9 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.driver.get('http://localhost:8080/main') + el = self.driver.find_element_by_xpath('/html/body') + self.assertEqual("1, 2, hi, 2.34, 8, 9", el.text) diff --git a/tests/bindpat.ur b/tests/bindpat.ur index bca4bd41..8fd6eb39 100644 --- a/tests/bindpat.ur +++ b/tests/bindpat.ur @@ -1,6 +1,9 @@ fun main () : transaction page = (a, b) <- return (1, 2); {C = c, ...} <- return {C = "hi", D = False}; - d <- return 2.34; - {1 = e, 2 = f} <- return (8, 9); + let + val d = 2.34 + val {1 = e, 2 = f} = (8, 9) + in return <xml>{[a]}, {[b]}, {[c]}, {[d]}, {[e]}, {[f]}</xml> + end
\ No newline at end of file diff --git a/tests/bodyClick.py b/tests/bodyClick.py new file mode 100644 index 00000000..0c10d632 --- /dev/null +++ b/tests/bodyClick.py @@ -0,0 +1,18 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('main') + bd = self.driver.find_element_by_xpath('/html/body') + + bd.click() + alert = self.driver.switch_to.alert + self.assertEqual("You clicked the body.", alert.text) + alert.accept() + + bd.send_keys('h') + alert = self.driver.switch_to.alert + self.assertEqual("Key", alert.text) + alert.accept() diff --git a/tests/bool.py b/tests/bool.py new file mode 100644 index 00000000..e5fedf19 --- /dev/null +++ b/tests/bool.py @@ -0,0 +1,17 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('main') + l = self.xpath('li[1]/a') + l.click() + self.assertEqual("Yes!", self.body_text()) + + def test_2(self): + """Test case 2""" + self.start('main') + l = self.xpath('li[2]/a') + l.click() + self.assertEqual("No!", self.body_text()) diff --git a/tests/bool.ur b/tests/bool.ur index b7e57dca..b8edbba6 100644 --- a/tests/bool.ur +++ b/tests/bool.ur @@ -1,8 +1,8 @@ -val page = fn b => <html><body> +val page = fn b => return <xml><body> {cdata (case b of False => "No!" | True => "Yes!")} -</body></html> +</body></xml> -val main : unit -> page = fn () => <html><body> +val main : unit -> transaction page = fn () => return <xml><body> <li><a link={page True}>True</a></li> <li><a link={page False}>False</a></li> -</body></html> +</body></xml> diff --git a/tests/both.py b/tests/both.py new file mode 100644 index 00000000..c3a8e8ee --- /dev/null +++ b/tests/both.py @@ -0,0 +1,12 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('Both/main') + t = self.xpath('form/input[@type=\'text\']') + t.send_keys('hello') + l = self.xpath('form/input[@type=\'submit\']') + l.click() + self.assertEqual("", self.body_text()) diff --git a/tests/both.ur b/tests/both.ur index d1c9f40e..b0f2a493 100644 --- a/tests/both.ur +++ b/tests/both.ur @@ -1,9 +1,10 @@ fun main () : transaction page = return <xml> <body> <form> - <textbox{#Text}/><submit action={submit}/> + <textbox{#Text}/> + <submit action={handler}/> </form> </body> </xml> -and submit r = return <xml/> +and handler r = return <xml/> diff --git a/tests/both.urs b/tests/both.urs new file mode 100644 index 00000000..6ac44e0b --- /dev/null +++ b/tests/both.urs @@ -0,0 +1 @@ +val main : unit -> transaction page diff --git a/tests/both2.py b/tests/both2.py new file mode 100644 index 00000000..b5b3c0fc --- /dev/null +++ b/tests/both2.py @@ -0,0 +1,12 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('Both2/main') + t = self.xpath('form/input[@type=\'text\']') + t.send_keys('hello') + l = self.xpath('form/input[@type=\'submit\']') + l.click() + self.assertEqual("", self.body_text()) diff --git a/tests/both2.ur b/tests/both2.ur index c3f25cc9..3190def8 100644 --- a/tests/both2.ur +++ b/tests/both2.ur @@ -1,14 +1,12 @@ fun main () : transaction page = let - fun submit r = return <xml/> + fun handler r = return <xml/> in return <xml> <body> <form> - <textbox{#Text}/><submit action={submit}/> + <textbox{#Text}/><submit action={handler}/> </form> </body> </xml> end - - diff --git a/tests/button.py b/tests/button.py new file mode 100644 index 00000000..14159fec --- /dev/null +++ b/tests/button.py @@ -0,0 +1,13 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('main') + b = self.xpath('button') + + b.click() + alert = self.driver.switch_to.alert + self.assertEqual("AHOY", alert.text) + alert.accept() diff --git a/tests/case.py b/tests/case.py new file mode 100644 index 00000000..611273e2 --- /dev/null +++ b/tests/case.py @@ -0,0 +1,15 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('main') + d = self.xpath('div') + txt = "zero is two: B\none is two: B\ntwo is two: A" + self.assertEqual(txt, d.text) + + b = self.xpath('button') + b.click() + alert = self.driver.switch_to.alert + self.assertEqual(txt, alert.text) diff --git a/tests/case.ur b/tests/case.ur index b131b27b..a6f4c700 100644 --- a/tests/case.ur +++ b/tests/case.ur @@ -11,6 +11,22 @@ datatype nat = O | S of nat val is_two = fn x : nat => case x of S (S O) => A | _ => B -val zero_is_two = is_two O -val one_is_two = is_two (S O) -val two_is_two = is_two (S (S O)) +val shw = fn x : t => + case x of A => "A" | B => "B" + +fun main (): transaction page = return <xml><body> + <div> + <p>zero is two: {[shw (is_two O)]}</p> + <p>one is two: {[shw (is_two (S O))]}</p> + <p>two is two: {[shw (is_two (S (S O)))]}</p> + </div> + + <button onclick={fn _ => let + val m = + "zero is two: " ^ shw (is_two O) ^ "\n" ^ + "one is two: " ^ shw (is_two (S O)) ^ "\n" ^ + "two is two: " ^ shw (is_two (S (S O))) + in + alert m + end}>click me</button> +</body></xml> diff --git a/tests/caseMod.py b/tests/caseMod.py new file mode 100644 index 00000000..16e49a5b --- /dev/null +++ b/tests/caseMod.py @@ -0,0 +1,25 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('main') + l1 = self.xpath('li[1]/a') + l1.click() + + self.assertEqual("C A\n\nAgain!", self.body_text()) + def test_2(self): + """Test case 2""" + self.start('main') + l1 = self.xpath('li[2]/a') + l1.click() + + self.assertEqual("C B\n\nAgain!", self.body_text()) + def test_3(self): + """Test case 3""" + self.start('main') + l1 = self.xpath('li[3]/a') + l1.click() + + self.assertEqual("D\n\nAgain!", self.body_text()) diff --git a/tests/caseMod.ur b/tests/caseMod.ur index 0a870160..15a7e07a 100644 --- a/tests/caseMod.ur +++ b/tests/caseMod.ur @@ -24,15 +24,15 @@ val toString = fn x => | C B => "C B" | D => "D" -val rec page = fn x => <html><body> +val rec page = fn x => return <xml><body> {cdata (toString x)}<br/> <br/> <a link={page x}>Again!</a> -</body></html> +</body></xml> -val main : unit -> page = fn () => <html><body> +val main : unit -> transaction page = fn () => return <xml><body> <li> <a link={page (C A)}>C A</a></li> <li> <a link={page (C B)}>C B</a></li> <li> <a link={page D}>D</a></li> -</body></html> +</body></xml> diff --git a/tests/ccheckbox.py b/tests/ccheckbox.py new file mode 100644 index 00000000..f2390368 --- /dev/null +++ b/tests/ccheckbox.py @@ -0,0 +1,15 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('main') + d = self.xpath('input') + p = self.xpath('span') + self.assertEqual("True 1", p.text) + d.click() + # the elements gets re-created from scratch + # so we must refresh our reference + p = self.xpath('span') + self.assertEqual("False 3", p.text) diff --git a/tests/ccheckbox.ur b/tests/ccheckbox.ur index 09a8ece9..d70c24a5 100644 --- a/tests/ccheckbox.ur +++ b/tests/ccheckbox.ur @@ -1,7 +1,7 @@ fun main () : transaction page = s <- source True; t <- source 1; - return <xml><body><ccheckbox source={s} onclick={set t 3}/> + return <xml><body><ccheckbox source={s} onclick={fn _ => set t 3}/> <dyn signal={s <- signal s; t <- signal t; return <xml>{[s]} {[t]}</xml>}/> diff --git a/tests/cdataF.py b/tests/cdataF.py new file mode 100644 index 00000000..8f43176f --- /dev/null +++ b/tests/cdataF.py @@ -0,0 +1,8 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('main') + self.assertEqual("<Hi.\nBye.", self.body_text()) diff --git a/tests/cdataF.ur b/tests/cdataF.ur index 3f8da45b..698dead7 100644 --- a/tests/cdataF.ur +++ b/tests/cdataF.ur @@ -1,8 +1,8 @@ -val snippet = fn s => <body> +val snippet = fn s => <xml> <h1>{cdata s}</h1> -</body> +</xml> -val main = fn () => <html><body> +val main : unit -> transaction page = fn () => return <xml><body> {snippet "<Hi."} {snippet "Bye."} -</body></html> +</body></xml> diff --git a/tests/cdataL.py b/tests/cdataL.py new file mode 100644 index 00000000..67ccd75e --- /dev/null +++ b/tests/cdataL.py @@ -0,0 +1,18 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('main') + l1 = self.xpath('li[1]/a') + l1.click() + + self.assertEqual("<Hi.", self.body_text()) + def test_2(self): + """Test case 2""" + self.start('main') + l1 = self.xpath('li[2]/a') + l1.click() + + self.assertEqual("Bye.", self.body_text()) diff --git a/tests/cdataL.ur b/tests/cdataL.ur index 3aa3bef6..42122b20 100644 --- a/tests/cdataL.ur +++ b/tests/cdataL.ur @@ -1,8 +1,8 @@ -val subpage = fn s => <html><body> +val subpage : string -> transaction page = fn s => return <xml><body> <h1>{cdata s}</h1> -</body></html> +</body></xml> -val main = fn () => <html><body> +val main : unit -> transaction page = fn () => return <xml><body> <li> <a link={subpage "<Hi."}>Door #1</a></li> <li> <a link={subpage "Bye."}>Door #2</a></li> -</body></html> +</body></xml> diff --git a/tests/cffi.py b/tests/cffi.py new file mode 100644 index 00000000..34b31b8c --- /dev/null +++ b/tests/cffi.py @@ -0,0 +1,37 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('Cffi/main') + l1 = self.xpath('form[1]/input') + l1.click() + + b1 = self.xpath('button[1]') + b1.click() # TODO: check server output somehow + + b2 = self.xpath('button[2]') + b2.click() + alert = self.driver.switch_to.alert + self.assertEqual("<<Hoho>>", alert.text) + alert.accept() + + b3 = self.xpath('button[3]') + b3.click() + alert = self.driver.switch_to.alert + self.assertEqual("Hi there!", alert.text) + def test_2(self): + """Test case 2""" + self.start('Cffi/main') + l1 = self.xpath('form[2]/input') + l1.click() + + self.assertEqual("All good.", self.body_text()) + def test_3(self): + """Test case 3""" + self.start('Cffi/main') + l1 = self.xpath('form[3]/input') + l1.click() + + self.assertRegex(self.body_text(), "^Fatal error: .*$") diff --git a/tests/cffi.sh b/tests/cffi.sh new file mode 100755 index 00000000..1267c3e3 --- /dev/null +++ b/tests/cffi.sh @@ -0,0 +1,6 @@ +#!/bin/bash + +CCOMP=gcc + +$CCOMP -pthread -Wimplicit -Werror -Wno-unused-value -I ..include/urweb -c "test.c" -o "test.o" -g +./driver.sh cffi diff --git a/tests/cffi.ur b/tests/cffi.ur index bcb9944c..89dc9906 100644 --- a/tests/cffi.ur +++ b/tests/cffi.ur @@ -3,9 +3,9 @@ fun printer () = Test.foo fun effect () = Test.print; return <xml><body> - <button value="Remote" onclick={printer ()}/> - <button value="Local" onclick={Test.bar "Hoho"}/> - <button value="Either" onclick={Test.print}/> + <button value="Remote" onclick={fn _ => rpc (printer ())}/> + <button value="Local" onclick={fn _ => Test.bar "Hoho"}/> + <button value="Either" onclick={fn _ => Test.print}/> </body></xml> fun xact () = diff --git a/tests/classAndDynClass.ur b/tests/classAndDynClass.ur new file mode 100644 index 00000000..ba01962d --- /dev/null +++ b/tests/classAndDynClass.ur @@ -0,0 +1,9 @@ +style style1 +style style2 + +fun main () : transaction page = return <xml><body> + <div class="style1" dynClass={return (CLASS "style2")}>Text</div> + <div dynClass={return (CLASS "style2")}>Text</div> + <div style="font-weight: bold" dynStyle={return (STYLE "font-variant: small-caps")}>Text</div> + <div dynStyle={return (STYLE "font-variant: small-caps")}>Text</div> +</body></xml> diff --git a/tests/clib.urp b/tests/clib.urp index de89d03a..9ac0f144 100644 --- a/tests/clib.urp +++ b/tests/clib.urp @@ -1,6 +1,6 @@ ffi test include test.h -script http://localhost/test/test.js +jsFile test.js link test.o effectful Test.print serverOnly Test.foo diff --git a/tests/cradio.py b/tests/cradio.py new file mode 100644 index 00000000..cc075593 --- /dev/null +++ b/tests/cradio.py @@ -0,0 +1,33 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start("Cradio/main") + txt = self.xpath('div[1]').text + self.assertEqual("Hello, I'm B. I'll be your waiter for this evening.", txt) + txt2 = self.xpath('div[2]').text + self.assertEqual('Value:', txt2) + el1 = self.xpath('label[1]/input') + el2 = self.xpath('label[2]/input') + self.assertEqual(False, el1.is_selected()) + self.assertEqual(True, el2.is_selected()) + el1.click() + alert = self.driver.switch_to.alert + self.assertEqual("Now it's A", alert.text) + alert.accept() + self.assertEqual(True, el1.is_selected()) + self.assertEqual(False, el2.is_selected()) + txt = self.xpath('div[1]').text + self.assertEqual("Hello, I'm A. I'll be your waiter for this evening.", txt) + txt2 = self.xpath('div[2]').text + self.assertEqual('Value:', txt2) + # now check that the second radio group works as well + el3 = self.xpath('label[4]/input') + el3.click() + alert = self.driver.switch_to.alert + alert.accept() + txt2 = self.xpath('div[2]').text + self.assertEqual('Value: Y', txt2) + self.assertEqual("Hello, I'm A. I'll be your waiter for this evening.", txt) diff --git a/tests/cradio.ur b/tests/cradio.ur new file mode 100644 index 00000000..48c04f1e --- /dev/null +++ b/tests/cradio.ur @@ -0,0 +1,26 @@ +fun main () = +s <- source (Some "B"); +r <- source None; +let + val onc = v <- get s; alert ("Now it's " ^ show v) + val onc_r = v <- get r; alert ("Changed to " ^ show v) +in + return <xml><body> + <h1>First group</h1> + + <label>Wilbur <cradio source={s} value="A" onchange={onc}/></label> + <label>Walbur <cradio source={s} value="B" onchange={onc}/></label> + + <div> + Hello, I'm <dyn signal={s <- signal s; return <xml>{[s]}</xml>}/>. I'll be your waiter for this evening. + </div> + + <h1>Second group</h1> + + <label>X <cradio source={r} value="X" onchange={onc_r}/></label> + <label>Y <cradio source={r} value="Y" onchange={onc_r}/></label> + <label>Z <cradio source={r} value="Z" onchange={onc_r}/></label> + + <div>Value: <dyn signal={r <- signal r; return <xml>{[r]}</xml>}/></div> + </body></xml> +end diff --git a/tests/alert.urp b/tests/cradio.urp index 3976e9b0..0681ab21 100644 --- a/tests/alert.urp +++ b/tests/cradio.urp @@ -1,3 +1,3 @@ debug -alert +cradio diff --git a/tests/cradio.urs b/tests/cradio.urs new file mode 100644 index 00000000..6ac44e0b --- /dev/null +++ b/tests/cradio.urs @@ -0,0 +1 @@ +val main : unit -> transaction page diff --git a/tests/dbupload.urp b/tests/dbupload.urp index dd8417d1..daa68e2c 100644 --- a/tests/dbupload.urp +++ b/tests/dbupload.urp @@ -2,5 +2,6 @@ database dbname=dbupload sql dbupload.sql allow mime * rewrite all Dbupload/* +filecache /tmp/files dbupload diff --git a/tests/dbuploadOpt.ur b/tests/dbuploadOpt.ur new file mode 100644 index 00000000..466b49f3 --- /dev/null +++ b/tests/dbuploadOpt.ur @@ -0,0 +1,27 @@ +table t : { Id : int, Blob : option blob, MimeType : string } +sequence s + +fun getImage id : transaction page = + r <- oneRow1 (SELECT t.Blob, t.MimeType + FROM t + WHERE t.Id = {[id]}); + case r.Blob of + None => error <xml>Oh no!</xml> + | Some blob => returnBlob blob (blessMime r.MimeType) + +fun main () : transaction page = + let + fun handle r = + id <- nextval s; + dml (INSERT INTO t (Id, Blob, MimeType) + VALUES ({[id]}, {[if fileMimeType r.File = "image/jpeg" then Some (fileData r.File) else None]}, {[fileMimeType r.File]})); + main () + in + x <- queryX1 (SELECT t.Id FROM t) + (fn r => <xml><img src={url (getImage r.Id)}/><br/></xml>); + return <xml><body> + <form><upload{#File}/> <submit action={handle}/></form> + <hr/> + {x} + </body></xml> + end diff --git a/tests/dbuploadOpt.urp b/tests/dbuploadOpt.urp new file mode 100644 index 00000000..816bcea1 --- /dev/null +++ b/tests/dbuploadOpt.urp @@ -0,0 +1,7 @@ +database dbname=dbuploadOpt +sql dbuploadOpt.sql +allow mime * +rewrite all DbuploadOpt/* +filecache /tmp/files + +dbuploadOpt diff --git a/tests/driver.sh b/tests/driver.sh new file mode 100755 index 00000000..d20809d0 --- /dev/null +++ b/tests/driver.sh @@ -0,0 +1,29 @@ +#!/bin/bash + +if [[ $# -eq 0 ]] ; then + echo 'Supply at least one argument' + exit 1 +fi + +TESTDB=/tmp/$1.db +TESTSQL=/tmp/$1.sql +TESTPID=/tmp/$1.pid +TESTSRV=./$1.exe + +rm -f $TESTDB $TESTSQL $TESTPID $TESTSRV +../bin/urweb -debug -boot -noEmacs -dbms sqlite -db $TESTDB -sql $TESTSQL "$1" || exit 1 + +if [ -e $TESTSQL ] +then + sqlite3 $TESTDB < $TESTSQL +fi + +$TESTSRV -q -a 127.0.0.1 & +echo $! >> $TESTPID +sleep 1 +if [[ $# -eq 1 ]] ; then + python3 -m unittest $1.py +else + python3 -m unittest $1.Suite.$2 +fi +kill `cat $TESTPID` diff --git a/tests/dupTag.ur b/tests/dupTag.ur new file mode 100644 index 00000000..cee35df1 --- /dev/null +++ b/tests/dupTag.ur @@ -0,0 +1,21 @@ +structure S = struct + fun one () = + let + fun save r = return <xml/> + in + return <xml><body><form><submit action={save}/></form></body></xml> + end + fun two () = + let + fun save r = return <xml/> + in + return <xml><body><form><submit action={save}/></form></body></xml> + end +end + +fun main () : transaction page = return <xml> + <body> + <a link={S.one()}>one</a> + <a link={S.two()}>two</a> + </body> + </xml> diff --git a/tests/emptyUpdate.ur b/tests/emptyUpdate.ur new file mode 100644 index 00000000..0402d78a --- /dev/null +++ b/tests/emptyUpdate.ur @@ -0,0 +1,6 @@ +table a : { B : int } + +fun main () : transaction page = + dml (update [[]] {} a (WHERE TRUE)); + return <xml></xml> + diff --git a/tests/emptyUpdate.urp b/tests/emptyUpdate.urp new file mode 100644 index 00000000..42cc98e2 --- /dev/null +++ b/tests/emptyUpdate.urp @@ -0,0 +1,4 @@ +database dbname=test +safeGet EmptyUpdate/main + +emptyUpdate diff --git a/tests/endpoints.py b/tests/endpoints.py new file mode 100755 index 00000000..8dc5abef --- /dev/null +++ b/tests/endpoints.py @@ -0,0 +1,30 @@ +#!/usr/bin/python3 + +import sys +import json +import time +import subprocess +import urllib.request +import urllib.parse +import os + +def main(): + prefix = 'http://localhost:8080/' + + with open('/tmp/endpoints.json') as json_data: + data = json.load(json_data) + endpoints = data['endpoints'] + for ep in endpoints: + path = ep['url'] + src = urllib.parse.urljoin(prefix, path) + if ep['method'] == 'GET': + contents = urllib.request.urlopen(src).read() + # it's okay that we can retrieve it, enough for us right now + else: + # TODO: add support for parameters? + post_fields = {'Nam': 'X', 'Msg': 'message', 'Sameday': 'on'} # Set POST fields here + request = urllib.request.Request(src, urllib.parse.urlencode(post_fields).encode()) + contents = urllib.request.urlopen(request).read().decode() + +if __name__ == '__main__': + main() diff --git a/tests/endpoints.sh b/tests/endpoints.sh new file mode 100755 index 00000000..1d3289a5 --- /dev/null +++ b/tests/endpoints.sh @@ -0,0 +1,15 @@ +#!/bin/bash + +TEST=endpoints +TESTPID=/tmp/$TEST.pid +TESTENDPOINTS=/tmp/$TEST.json +TESTSRV=./$TEST.exe + +rm -f $TESTENDPOINTS $TESTPID $TESTSRV +../bin/urweb -debug -boot -noEmacs -endpoints $TESTENDPOINTS "$TEST" || exit 1 + +$TESTSRV -q -a 127.0.0.1 & +echo $! >> $TESTPID +sleep 1 +python3 $TEST.py +kill `cat $TESTPID` diff --git a/tests/endpoints.ur b/tests/endpoints.ur new file mode 100644 index 00000000..ddb91faa --- /dev/null +++ b/tests/endpoints.ur @@ -0,0 +1,40 @@ +fun formbased (): transaction page = + return <xml> + <body> + <form> + <label>Your name: <textbox{#Nam}/></label> + <label>Your message: <textarea{#Msg}/></label> + <label>Delivered on the same day <checkbox{#Sameday}/></label> + <submit value="Send" action={formbased_handler}/> + </form> + </body> + </xml> + +and formbased_handler (r : {Nam : string, Msg : string, Sameday : bool}) : transaction page = + return <xml> + <body> + <p>Oh hello {[r.Nam]}! Great to see you here again!</p> + <p>Your message was:</p> + <p>{[r.Msg]}</p> + <p>Sameday delivery was:</p> + <p>{[if r.Sameday then "set" else "unset"]}</p> + </body> + </xml> + +fun say_hi_to (s : string) : transaction page = +return <xml> + <body> + <p>It's {[s]} birthday!</p> + </body> +</xml> + +fun optimized_out (): transaction page = + return <xml>this one is optimized away since it's not referenced in the declarations</xml> + +fun main (): transaction page = + return <xml> + <body> + <p>hello</p> + <p>Say hi to <a link={say_hi_to "JC"}>JC</a></p> + </body> +</xml> diff --git a/tests/endpoints.urp b/tests/endpoints.urp new file mode 100644 index 00000000..faf855bd --- /dev/null +++ b/tests/endpoints.urp @@ -0,0 +1,4 @@ +rewrite url Endpoints/main index.html +rewrite url Endpoints/formbased greet.html + +endpoints diff --git a/tests/endpoints.urs b/tests/endpoints.urs new file mode 100644 index 00000000..fba42a2b --- /dev/null +++ b/tests/endpoints.urs @@ -0,0 +1,3 @@ +val main : unit -> transaction page +val say_hi_to : string -> transaction page +val formbased : unit -> transaction page diff --git a/tests/entities.py b/tests/entities.py new file mode 100644 index 00000000..d9087cbf --- /dev/null +++ b/tests/entities.py @@ -0,0 +1,14 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + p = self.xpath('p[1]') + self.assertEqual('Hello world! & so on, © me today (8 €)', p.text) + p = self.xpath('p[2]') + self.assertEqual('♠ ♣ ♥ ♦', p.text) + p = self.xpath('p[3]') + self.assertEqual('† DANGER †', p.text) + diff --git a/tests/entities.ur b/tests/entities.ur index 8b78edbc..1f45520d 100644 --- a/tests/entities.ur +++ b/tests/entities.ur @@ -1,5 +1,5 @@ fun main () : transaction page = return <xml><body> - Hello world! & so on, © me today (8 €)<br/> - ♠ ♣ ♥ ♦<br/> - † DANGER † + <p>Hello world! & so on, © me today (8 €)</p> + <p>♠ ♣ ♥ ♦</p> + <p>† DANGER †</p> </body></xml> diff --git a/tests/fact.py b/tests/fact.py new file mode 100644 index 00000000..3dcd6f71 --- /dev/null +++ b/tests/fact.py @@ -0,0 +1,10 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + b = self.driver.find_element_by_xpath('/html/body') + self.assertEqual('3628800, 3628800', b.text) + diff --git a/tests/fake_types b/tests/fake_types new file mode 100644 index 00000000..405e9d1d --- /dev/null +++ b/tests/fake_types @@ -0,0 +1,2 @@ +horrible_idea/blorpapalooza txt +whoa/yowza html diff --git a/tests/filter.py b/tests/filter.py new file mode 100644 index 00000000..f68f8f88 --- /dev/null +++ b/tests/filter.py @@ -0,0 +1,9 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('Filter/main') + tx = self.body_text() + self.assertEqual("4, 4; 44, 4.4;", tx) diff --git a/tests/filter.ur b/tests/filter.ur index efd326c3..2691a939 100644 --- a/tests/filter.ur +++ b/tests/filter.ur @@ -1,9 +1,16 @@ -fun filter [fs ::: {Type}] [ks] (t : sql_table fs ks) (p : sql_exp [T = fs] [] [] bool) - : sql_query [T = fs] [] = +fun filter [fs ::: {Type}] [ks] (t : sql_table fs ks) (p : sql_exp [T = fs] [] [] bool) = (SELECT * FROM t WHERE {p}) table t : { A : int, B : float } -fun main () = - queryX (filter t (WHERE t.A > 3)) - (fn r => <xml>{[r.T.A]}, {[r.T.B]}</xml>) +task initialize = fn () => + dml (INSERT INTO t (A, B) VALUES (1, 2.0)); + dml (INSERT INTO t (A, B) VALUES (2, 1.0)); + dml (INSERT INTO t (A, B) VALUES (3, 3.0)); + dml (INSERT INTO t (A, B) VALUES (4, 4.0)); + dml (INSERT INTO t (A, B) VALUES (44, 4.4)) + +fun main () : transaction page = + r <- queryX (filter t (WHERE t.A > 3)) + (fn r => <xml>{[r.T.A]}, {[r.T.B]}; </xml>); + return <xml><body>{r}</body></xml> diff --git a/tests/filter.urp b/tests/filter.urp index 102a1871..ddf1a3df 100644 --- a/tests/filter.urp +++ b/tests/filter.urp @@ -1,4 +1,5 @@ debug database dbname=filter +sql filter.sql filter diff --git a/tests/foreign_text.ur b/tests/foreign_text.ur new file mode 100644 index 00000000..8f404349 --- /dev/null +++ b/tests/foreign_text.ur @@ -0,0 +1,4 @@ +table t : { A : string } PRIMARY KEY A +table u : { A : string } CONSTRAINT A FOREIGN KEY A REFERENCES t(A) + +val main : transaction page = return <xml></xml> diff --git a/tests/foreign_text.urp b/tests/foreign_text.urp new file mode 100644 index 00000000..f0777eb6 --- /dev/null +++ b/tests/foreign_text.urp @@ -0,0 +1,5 @@ +dbms mysql +database dbname=foreign_text +sql foreign_text.sql + +foreign_text diff --git a/tests/html5_cforms.ur b/tests/html5_cforms.ur index be07d07e..317a0638 100644 --- a/tests/html5_cforms.ur +++ b/tests/html5_cforms.ur @@ -9,8 +9,8 @@ fun main () : transaction page = d <- source ""; e <- source ""; f <- source ""; - g <- source 1.0; - h <- source 1.0; + g <- source (Some 1.0); + h <- source (Some 1.0); i <- source "#CCCCCC"; j <- source "2014/11/16"; k <- source "2014/11/16 12:30:45"; diff --git a/tests/jsbspace.py b/tests/jsbspace.py new file mode 100644 index 00000000..b29d44b9 --- /dev/null +++ b/tests/jsbspace.py @@ -0,0 +1,11 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + el = self.xpath('button') + el.click() + alert = self.driver.switch_to.alert + self.assertEqual('Some \btext', alert.text) diff --git a/tests/jsbspace.ur b/tests/jsbspace.ur new file mode 100644 index 00000000..bf4b824f --- /dev/null +++ b/tests/jsbspace.ur @@ -0,0 +1,12 @@ +fun main () : transaction page = +let + fun onclick (): transaction unit = + (* this function runs on the client *) + alert "Some \btext" +in +return <xml> + <body> + <button onclick={fn _ => onclick()}>Click me!</button> + </body> +</xml> +end
\ No newline at end of file diff --git a/tests/jsonTest.py b/tests/jsonTest.py new file mode 100644 index 00000000..d9147511 --- /dev/null +++ b/tests/jsonTest.py @@ -0,0 +1,16 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + + pre = self.xpath('pre[1]') + self.assertEqual('line 1\nline 2', pre.text) + + pre = self.xpath('pre[2]') + self.assertEqual('1 :: 2 :: 3 :: []', pre.text) + + pre = self.xpath('pre[3]') + self.assertEqual('["hi","bye\\"","hehe"]', pre.text) diff --git a/tests/jsonTest.ur b/tests/jsonTest.ur index 97898de8..bce269bd 100644 --- a/tests/jsonTest.ur +++ b/tests/jsonTest.ur @@ -1,6 +1,7 @@ open Json fun main () : transaction page = return <xml><body> - {[fromJson "[1, 2, 3]" : list int]}<br/> - {[toJson ("hi" :: "bye\"" :: "hehe" :: [])]} + <pre>{[ fromJson "\"\\\\line \/ 1\\nline 2\"" : string ]}</pre><br/> + <pre>{[fromJson "[1, 2, 3]" : list int]}</pre><br/> + <pre>{[toJson ("hi" :: "bye\"" :: "hehe" :: [])]}</pre> </body></xml> diff --git a/tests/listGroupBy.ur b/tests/listGroupBy.ur new file mode 100644 index 00000000..c2419ce1 --- /dev/null +++ b/tests/listGroupBy.ur @@ -0,0 +1,13 @@ +fun lister () = List.tabulateM (fn _ => n <- rand; return (n % 100)) 8 + +fun main () : transaction page = + inp <- source []; + return <xml><body> + <button value="Compute" onclick={fn _ => + ls <- rpc (lister ()); + set inp ls}/> + + <dyn signal={inp <- signal inp; return (txt inp)}/> + -> + <dyn signal={inp <- signal inp; return (txt (List.groupBy (fn n m => n % 2 = m % 2) inp))}/> + </body></xml> diff --git a/tests/listGroupBy.urp b/tests/listGroupBy.urp new file mode 100644 index 00000000..1a63a89d --- /dev/null +++ b/tests/listGroupBy.urp @@ -0,0 +1,4 @@ +rewrite all ListGroupBy/* + +$/list +listGroupBy
\ No newline at end of file diff --git a/tests/mimeTypesDirective.ur b/tests/mimeTypesDirective.ur new file mode 100644 index 00000000..e69de29b --- /dev/null +++ b/tests/mimeTypesDirective.ur diff --git a/tests/mimeTypesDirective.urp b/tests/mimeTypesDirective.urp new file mode 100644 index 00000000..43f06a00 --- /dev/null +++ b/tests/mimeTypesDirective.urp @@ -0,0 +1,6 @@ +mimeTypes fake_types +file /hello.txt hello.txt +file /hello.html hello.html +file /hello2.txt hello.txt gadzooks/yippie + +mimeTypesDirective diff --git a/tests/mouseEvent.ur b/tests/mouseEvent.ur index 2192e0b0..32a67806 100644 --- a/tests/mouseEvent.ur +++ b/tests/mouseEvent.ur @@ -8,6 +8,8 @@ fun main () : transaction page = return <xml><body> ^ "\nScreenY = " ^ show ev.ScreenY ^ "\nClientX = " ^ show ev.ClientX ^ "\nClientY = " ^ show ev.ClientY + ^ "\nOffsetX = " ^ show ev.OffsetX + ^ "\nOffsetY = " ^ show ev.OffsetY ^ "\nCtrlKey = " ^ show ev.CtrlKey ^ "\nShiftKey = " ^ show ev.ShiftKey ^ "\nAltKey = " ^ show ev.AltKey diff --git a/tests/pairUnify.ur b/tests/pairUnify.ur new file mode 100644 index 00000000..1c9f9759 --- /dev/null +++ b/tests/pairUnify.ur @@ -0,0 +1,6 @@ +datatype a = A +datatype b = B + +val x : a * b = (A, B) + +val y : b = x diff --git a/tests/prefixClash.ur b/tests/prefixClash.ur new file mode 100644 index 00000000..a2325077 --- /dev/null +++ b/tests/prefixClash.ur @@ -0,0 +1,3 @@ +val index = return <xml></xml> +val other = return <xml></xml> +val ather = return <xml></xml> diff --git a/tests/prefixClash.urp b/tests/prefixClash.urp new file mode 100644 index 00000000..cf4545d0 --- /dev/null +++ b/tests/prefixClash.urp @@ -0,0 +1,4 @@ +rewrite url PrefixClash/index foo +rewrite url PrefixClash/* foo/ [-] + +prefixClash diff --git a/tests/prefixClash.urs b/tests/prefixClash.urs new file mode 100644 index 00000000..e5e58c0a --- /dev/null +++ b/tests/prefixClash.urs @@ -0,0 +1,3 @@ +val index : transaction page +val other : transaction page +val ather : transaction page diff --git a/tests/rpc_unit.ur b/tests/rpc_unit.ur new file mode 100644 index 00000000..befd6045 --- /dev/null +++ b/tests/rpc_unit.ur @@ -0,0 +1,8 @@ +val callme = return ((), (), "A", (), ()) + +val main : transaction page = return <xml><body> + <button value="CLICK ME" + onclick={fn _ => + (_, _, s, _, _) <- rpc callme; + alert s}/> +</body></xml> diff --git a/tests/serializingXml.ur b/tests/serializingXml.ur new file mode 100644 index 00000000..34eb3436 --- /dev/null +++ b/tests/serializingXml.ur @@ -0,0 +1,14 @@ +fun alerts n = + if n <= 0 then + return () + else + (alert ("Alert #" ^ show n); + alerts (n - 1)) + +cookie uhoh : serialized xbody + +fun main () : transaction page = + setCookie uhoh {Value = serialize <xml><active code={alerts 3; return <xml>Yay!</xml>}/></xml>, + Expires = None, + Secure = False}; + return <xml></xml> diff --git a/tests/slashform.ur b/tests/slashform.ur new file mode 100644 index 00000000..63591886 --- /dev/null +++ b/tests/slashform.ur @@ -0,0 +1,9 @@ +fun handler f = return <xml>{[f.F1]} {[f.F2]} {[f.F3]}</xml> + +val main = return <xml><body><form> + <textbox{#F1}/> + <textarea{#F2}/> + <checkbox{#F3}/> + <upload{#File}/> + <submit action={handler}/> +</form></body></xml> diff --git a/tests/slashform.urs b/tests/slashform.urs new file mode 100644 index 00000000..61778b87 --- /dev/null +++ b/tests/slashform.urs @@ -0,0 +1 @@ +val main : transaction page diff --git a/tests/task_cookie.ur b/tests/task_cookie.ur new file mode 100644 index 00000000..39f49b0a --- /dev/null +++ b/tests/task_cookie.ur @@ -0,0 +1,9 @@ +cookie myCookie: {Value: string} + +fun main (): transaction page = return <xml></xml> + +task initialize = fn () => + c <- getCookie myCookie; + case c of + None => debug "No cookie" + | Some {Value = v} => debug ("Cookie value: " ^ v) diff --git a/tests/test.c b/tests/test.c index ef8558d7..24071aa6 100644 --- a/tests/test.c +++ b/tests/test.c @@ -1,6 +1,6 @@ #include <stdio.h> -#include "../include/urweb.h" +#include "urweb/urweb.h" typedef uw_Basis_string uw_Test_t; @@ -27,16 +27,16 @@ uw_Basis_unit uw_Test_foo(uw_context ctx) { } static void commit(void *data) { - printf("Commit: %s\n", data); + printf("Commit: %s\n", (char*)data); } static void rollback(void *data) { - printf("Rollback: %s\n", data); + printf("Rollback: %s\n", (char*)data); } -static void free(void *data) { - printf("Free: %s\n", data); +static void ffree(void *data, int will_retry) { + printf("Free: %s, %d\n", (char*)data, will_retry); } uw_Basis_unit uw_Test_transactional(uw_context ctx) { - uw_register_transactional(ctx, "Beppo", commit, rollback, free); + uw_register_transactional(ctx, "Beppo", commit, rollback, ffree); return uw_unit_v; } diff --git a/tests/test.h b/tests/test.h index c0dec379..43a7746e 100644 --- a/tests/test.h +++ b/tests/test.h @@ -1,4 +1,4 @@ -#include "../include/urweb.h" +#include "urweb/urweb.h" typedef uw_Basis_string uw_Test_t; diff --git a/tests/tooEager.ur b/tests/tooEager.ur new file mode 100644 index 00000000..c84a6d6c --- /dev/null +++ b/tests/tooEager.ur @@ -0,0 +1,18 @@ +fun test (i: list int) : transaction unit = + a <- return (Some "abc"); + c <- (case a of + None => return "1" + | Some b => + debug "not happening :("; + return "2" + ); + (case i of + [] => return () + | first :: _ => debug c) + +fun main (): transaction page = + return <xml> + <body> + <button onclick={fn _ => rpc (test [])}>click</button> + </body> + </xml> diff --git a/tests/trgm.ur b/tests/trgm.ur new file mode 100644 index 00000000..45783366 --- /dev/null +++ b/tests/trgm.ur @@ -0,0 +1,25 @@ +table turtles : { Nam : string } + +fun add name = + dml (INSERT INTO turtles(Nam) + VALUES ({[name]})) + +fun closest name = + List.mapQuery (SELECT * + FROM turtles + ORDER BY similarity(turtles.Nam, {[name]}) DESC + LIMIT 5) + (fn r => r.Turtles.Nam) + +val main = + name <- source ""; + results <- source []; + return <xml><body> + Name: <ctextbox source={name}/><br/> + <button value="Add" onclick={fn _ => n <- get name; rpc (add n)}/><br/> + <button value="Search" onclick={fn _ => n <- get name; ls <- rpc (closest n); set results ls}/><br/> + <dyn signal={rs <- signal results; + return <xml><ol> + {List.mapX (fn n => <xml><li>{[n]}</li></xml>) rs} + </ol></xml>}/> + </body></xml> diff --git a/tests/trgm.urp b/tests/trgm.urp new file mode 100644 index 00000000..326151e7 --- /dev/null +++ b/tests/trgm.urp @@ -0,0 +1,6 @@ +database dbname=trgm +sql trgm.sql +rewrite all Trgm/* + +$/list +trgm diff --git a/tests/trgm.urs b/tests/trgm.urs new file mode 100644 index 00000000..61778b87 --- /dev/null +++ b/tests/trgm.urs @@ -0,0 +1 @@ +val main : transaction page diff --git a/tests/unurlify2.ur b/tests/unurlify2.ur new file mode 100644 index 00000000..2e82928d --- /dev/null +++ b/tests/unurlify2.ur @@ -0,0 +1,16 @@ +datatype bugged = Nothing | Something of int +datatype myDt = One | Two +type myRecord = {Bugged: bugged + , MyDt : myDt} + +fun rpcTarget (t: myRecord) = return () + +val good = {Bugged = Something 4, MyDt = One} +val bad = {Bugged = Nothing, MyDt = One} + +fun main () : transaction page = return <xml> + <body> + <button onclick={fn _ => rpc (rpcTarget good)}>rpc with good</button> + <button onclick={fn _ => rpc (rpcTarget bad)}>rpc with bad</button> + </body> +</xml> diff --git a/tests/utf8.py b/tests/utf8.py new file mode 100644 index 00000000..6036fa12 --- /dev/null +++ b/tests/utf8.py @@ -0,0 +1,174 @@ +import unittest +import base + +class Suite(base.Base): + + def no_falses(self, name): + self.start('Utf8/' + name) + + elems = self.driver.find_elements_by_xpath('//pre') + + self.assertNotEqual(0, len(elems)) + for e in elems: + self.assertEqual("True", e.text) + + def test_1(self): + """Test case: substring (1)""" + self.no_falses('substrings') + + def test_2(self): + """Test case: strlen (2)""" + self.no_falses('strlens') + + def test_3(self): + """Test case: strlenGe (3)""" + self.no_falses('strlenGens') + + def test_4(self): + """Test case: strcat (4)""" + self.no_falses('strcats') + + def test_5(self): + """Test case: strsub (5)""" + self.no_falses('strsubs') + + def test_6(self): + """Test case: strsuffix (6)""" + self.no_falses('strsuffixs') + + def test_7(self): + """Test case: strchr (7)""" + self.no_falses('strchrs') + + def test_8(self): + """Test case: strindex (8)""" + self.no_falses('strindexs') + + def test_9(self): + """Test case: strindex (9)""" + self.no_falses('strsindexs') + + def test_10(self): + """Test case: strcspn (10)""" + self.no_falses('strcspns') + + def test_11(self): + """Test case: str1 (11)""" + self.no_falses('str1s') + + def test_12(self): + """Test case: isalnum (12)""" + self.no_falses('isalnums') + + def test_13(self): + """Test case: isalpha (13)""" + self.no_falses('isalphas') + + def test_14(self): + """Test case: isblank (14)""" + self.no_falses('isblanks') + + def test_15(self): + """Test case: iscntrl (15)""" + self.no_falses('iscntrls') + + def test_16(self): + """Test case: isdigit (16)""" + self.no_falses('isdigits') + + def test_17(self): + """Test case: isgraph (17)""" + self.no_falses('isgraphs') + + def test_18(self): + """Test case: islower (18)""" + self.no_falses('islowers') + + def test_19(self): + """Test case: isprint (19)""" + self.no_falses('isprints') + + def test_20(self): + """Test case: ispunct (20)""" + self.no_falses('ispuncts') + + def test_21(self): + """Test case: isspace (21)""" + self.no_falses('isspaces') + + def test_22(self): + """Test case: isupper (22)""" + self.no_falses('isuppers') + + def test_23(self): + """Test case: isxdigit (23)""" + self.no_falses('isxdigits') + + def test_24(self): + """Test case: toupper (24)""" + self.no_falses('touppers') + + def test_25(self): + """Test case: ord (25)""" + self.no_falses('ord_and_chrs') + + def test_26 (self): + """Test case: test_db (26) """ + self.no_falses('test_db') + + def full_test (self, name): + + gap = 1000 + i = 0 + while (i + gap < 130000): + self.start('Utf8/' + name + '/' + str(i) + '/' + str(i + gap)) + errors = self.body_text() + self.assertEqual("", errors, errors) + i = i + gap + + + def test_89 (self): + """Test case: ftTolower """ + self.full_test("ftTolower") + + def test_90 (self): + """Test case: ftToupper """ + self.full_test("ftToupper") + + def test_91 (self): + """Test case: ftIsalpha """ + self.full_test("ftIsalpha") + + def test_92 (self): + """Test case: ftIsdigit """ + self.full_test("ftIsdigit") + + def test_93 (self): + """Test case: ftIsalnum """ + self.full_test("ftIsalnum") + + def test_94 (self): + """Test case: ftIsspace """ + self.full_test("ftIsspace") + + def test_95 (self): + """Test case: ftIsblank """ + self.full_test("ftIsblank") + + def test_96 (self): + """Test case: ftIsprint """ + self.full_test("ftIsprint") + + def test_97 (self): + """Test case: ftIsxdigit """ + self.full_test("ftIsxdigit") + + def test_98 (self): + """Test case: ftIsupper """ + self.full_test("ftIsupper") + + def test_99 (self): + """Test case: ftIslower """ + self.full_test("ftIslower") + ''' + ''' diff --git a/tests/utf8.ur b/tests/utf8.ur new file mode 100644 index 00000000..2150fde6 --- /dev/null +++ b/tests/utf8.ur @@ -0,0 +1,1704 @@ + +fun from_m_upto_n f m n = + if m < n then + <xml> + { f m } + { from_m_upto_n f (m + 1) n } + </xml> + else + <xml></xml> + +fun from_m_upto_n2 (f : int -> transaction xbody) (m : int) (n : int) : transaction xbody = + if m < n then + h <- f m; + t <- from_m_upto_n2 f (m + 1) n; + return <xml> + { h } + { t } + </xml> + else + return <xml></xml> + +fun test_fn_both_sides [a ::: Type] (_ : eq a) (_ : show a) (f : unit -> a) (expected : a) (testname : string) : xbody = +<xml> + <p>Server side test: {[testname]}</p> + <pre>{[show (f () = expected)]}</pre> + <active code={return <xml><p>Client side test: {[testname]}</p><pre>{[show (f () = expected)]}</pre></xml>}> +</active> + </xml> + +fun test_fn_both_sides2 [a ::: Type] (_ : eq a) (_ : show a) (f : unit -> a) (serverexp : a) (expected : a) (testname : string) : xbody = +<xml> + <p>Test: {[testname]}</p> + <active code={ + let + val stest = (serverexp = expected) + in + return <xml> + <p>Server side test: {[testname]}</p> + <pre>{[show stest]}</pre> + {if stest then + <xml></xml> + else + <xml> + <p>S: {[serverexp]}</p> + <p>E: {[expected]}</p> + </xml>} + </xml> + end}> +</active> + <active code={return <xml><p>Client side test: {[testname]}</p><pre>{[show (f () = expected)]}</pre></xml>}> +</active> +</xml> + +fun test_fn_sside [a ::: Type] (_ : eq a) (_ : show a) (f : unit -> a) (expected : a) (testname : string) : xbody = + <xml> + <p>Server side test: {[testname]}</p> + <pre>{[show (f () = expected)]}</pre> + </xml> + + fun test_fn_cside [a ::: Type] (_ : eq a) (_ : show a) (f : unit -> a) (expected : a) (testname : string) : xbody = + let + val r = f () + val v = r = expected + in + <xml> + <active code={return <xml><p>Client side test: {[testname]}</p><pre>{[show v]}</pre> + {if v then + <xml></xml> + else + <xml>Expected '{[show expected]}', is '{[show r]}'</xml>} + </xml>}> +</active> + </xml> + end + +fun test_fn_cside_int (f : unit -> int) (expected : int) (testname : string) : xbody = + <xml> + <active code={let + val computed = f () + in + if computed = expected then + return <xml><p>{[testname]}</p><pre>True</pre></xml> + else + return <xml><p>{[testname]}</p><pre>False</pre></xml> + end}> +</active> + </xml> + +fun test_fn_cside_ch (f : unit -> char) (expected : char) (testname : string) : xbody = + <xml> + <active code={let + val computed = f () + val msgErr = "Expected (S) " ^ (show expected) ^ " [" ^ (show (ord expected)) ^ "] but is (C) " ^ + (show computed) ^ "[" ^ (show (ord computed)) ^ "]." + in + if computed = expected then + return <xml></xml> + else + return <xml><p>ERROR {[testname]}: {[msgErr]}</p></xml> + end}> + </active> + </xml> + +fun test_fn_cside_b (f : unit -> bool) (expected : bool) (testname : string) : xbody = + <xml> + <active code={let + val computed = f () + val msgErr = "Expected (S) " ^ (show expected) ^ " but is (C) " ^ + (show computed) ^ "." + in + if computed = expected then + return <xml></xml> + else + return <xml><p>ERROR {[testname]}: {[msgErr]}</p></xml> + end}> + </active> + </xml> + +fun generateTests _ = + return { SL1 = (strlen "𝌆𝌇𝌈𝌉"), + SL2 = (strlen "𝌇𝌈𝌉"), + SL3 = (strlen "𝌈𝌉"), + SL4 = (strlen "𝌉"), + SS1 = (substring "𝌆𝌇𝌈𝌉" 1 3), + SS2 = (substring "𝌆𝌇𝌈𝌉" 2 2), + SS3 = (substring "𝌆𝌇𝌈𝌉" 3 1) , + SLSS1 = (strlen (substring "𝌆𝌇𝌈𝌉" 1 3)), + SLSS2 = (strlen (substring "𝌆𝌇𝌈𝌉" 2 2)), + SLSS3 = (strlen (substring "𝌆𝌇𝌈𝌉" 3 1)), + + SSB1 = (strsub "𝌆𝌇𝌈𝌉" 0), + SSB2 = (strsub "𝌆𝌇𝌈𝌉" 1), + SSB3 = (strsub "𝌆𝌇𝌈𝌉" 2), + SSB4 = (strsub "𝌆𝌇𝌈𝌉" 3), + + SSF1 = (strsuffix "𝌆𝌇𝌈𝌉" 0), + SSF2 = (strsuffix "𝌆𝌇𝌈𝌉" 1), + SSF3 = (strsuffix "𝌆𝌇𝌈𝌉" 2), + SSF4 = (strsuffix "𝌆𝌇𝌈𝌉" 3), + + SC1 = (strchr "𝌆𝌇𝌈𝌉" #"c"), + SC2 = (strchr "𝌆𝌇𝌈𝌉" (strsub "𝌆" 0)), + SC3 = (strchr "𝌆𝌇𝌈𝌉" (strsub "𝌇" 0)), + SC4 = (strchr "𝌆𝌇𝌈𝌉" (strsub "𝌈" 0)), + SC5 = (strchr "𝌆𝌇𝌈𝌉" (strsub "𝌉" 0)), + + SI1 = (strindex "𝌆𝌇𝌈𝌉" #"c"), + SI2 = (strindex "𝌆𝌇𝌈𝌉" (strsub "𝌆" 0)), + SI3 = (strindex "𝌆𝌇𝌈𝌉" (strsub "𝌇" 0)), + SI4 = (strindex "𝌆𝌇𝌈𝌉" (strsub "𝌈" 0)), + SI5 = (strindex "𝌆𝌇𝌈𝌉" (strsub "𝌉" 0)), + + SSI1 = (strsindex "𝌆𝌇𝌈𝌉" ""), + SSI2 = (strsindex "𝌆𝌇𝌈𝌉" "𝌆𝌇𝌈𝌉"), + SSI3 = (strsindex "𝌆𝌇𝌈𝌉" "𝌆𝌇𝌈c"), + SSI4 = (strsindex "𝌆𝌇𝌈𝌉" "𝌇𝌈𝌉"), + SSI5 = (strsindex "𝌆𝌇𝌈𝌉" "𝌇𝌈c"), + SSI6 = (strsindex "𝌆𝌇𝌈𝌉" "𝌈𝌉"), + SSI7 = (strsindex "𝌆𝌇𝌈𝌉" "𝌈c"), + SSI8 = (strsindex "𝌆𝌇𝌈𝌉" "𝌉"), + SSI9 = (strsindex "𝌆𝌇𝌈𝌉" "c"), + + SCSP1 = (strcspn "𝌆𝌇𝌈𝌉" ""), + SCSP2 = (strcspn "𝌆𝌇𝌈𝌉" "𝌆𝌇𝌈𝌉"), + SCSP3 = (strcspn "𝌆𝌇𝌈𝌉" "𝌆"), + SCSP4 = (strcspn "𝌆𝌇𝌈𝌉" "𝌇𝌈𝌉"), + SCSP5 = (strcspn "𝌆𝌇𝌈𝌉" "𝌈𝌉"), + SCSP6 = (strcspn "𝌆𝌇𝌈𝌉" "𝌉"), + + OSS1 = (ord (strsub "𝌆𝌇𝌈𝌉" 0)), + OSS2 = (ord (strsub "𝌆𝌇𝌈𝌉" 1)), + OSS3 = (ord (strsub "𝌆𝌇𝌈𝌉" 2)), + OSS4 = (ord (strsub "𝌆𝌇𝌈𝌉" 3)), + + SSS1 = (show (strsub "𝌆𝌇𝌈𝌉" 0)), + SSS2 = (show (strsub "𝌆𝌇𝌈𝌉" 1)), + SSS3 = (show (strsub "𝌆𝌇𝌈𝌉" 2)), + SSS4 = (show (strsub "𝌆𝌇𝌈𝌉" 3)) + } + +fun highencode () : transaction page = + t <- source None; + return <xml> + <body onload={tests <- rpc (generateTests ()); set t (Some tests); return ()}> + + <dyn signal={tests' <- signal t; + case tests' of + None => return <xml></xml> + | Some tests => return <xml> + + {test_fn_cside (fn _ => strlen "𝌆𝌇𝌈𝌉") tests.SL1 "high encode - strlen 1"} + {test_fn_cside (fn _ => strlen "𝌇𝌈𝌉") tests.SL2 "high encode - strlen 2"} + {test_fn_cside (fn _ => strlen "𝌈𝌉") tests.SL3 "high encode - strlen 3"} + {test_fn_cside (fn _ => strlen "𝌉") tests.SL4 "high encode - strlen 4"} + + {test_fn_cside (fn _ => substring "𝌆𝌇𝌈𝌉" 1 3) tests.SS1 "high encode - substring 1"} + {test_fn_cside (fn _ => substring "𝌆𝌇𝌈𝌉" 2 2) tests.SS2 "high encode - substring 2"} + {test_fn_cside (fn _ => substring "𝌆𝌇𝌈𝌉" 3 1) tests.SS3 "high encode - substring 3"} + + {test_fn_cside (fn _ => strlen (substring "𝌆𝌇𝌈𝌉" 1 3)) tests.SLSS1 "high encode - strlen of substring 1"} + {test_fn_cside (fn _ => strlen (substring "𝌆𝌇𝌈𝌉" 2 2)) tests.SLSS2 "high encode - strlen of substring 2"} + {test_fn_cside (fn _ => strlen (substring "𝌆𝌇𝌈𝌉" 3 1)) tests.SLSS3 "high encode - strlen of substring 3"} + + {test_fn_cside (fn _ => strsub "𝌆𝌇𝌈𝌉" 0) tests.SSB1 "high encode - strsub 1"} + {test_fn_cside (fn _ => strsub "𝌆𝌇𝌈𝌉" 1) tests.SSB2 "high encode - strsub 2"} + {test_fn_cside (fn _ => strsub "𝌆𝌇𝌈𝌉" 2) tests.SSB3 "high encode - strsub 3"} + {test_fn_cside (fn _ => strsub "𝌆𝌇𝌈𝌉" 3) tests.SSB4 "high encode - strsub 4"} + + {test_fn_cside (fn _ => strsuffix "𝌆𝌇𝌈𝌉" 0) tests.SSF1 "high encode - strsuffix 1"} + {test_fn_cside (fn _ => strsuffix "𝌆𝌇𝌈𝌉" 1) tests.SSF2 "high encode - strsuffix 2"} + {test_fn_cside (fn _ => strsuffix "𝌆𝌇𝌈𝌉" 2) tests.SSF3 "high encode - strsuffix 3"} + {test_fn_cside (fn _ => strsuffix "𝌆𝌇𝌈𝌉" 3) tests.SSF4 "high encode - strsuffix 4"} + + {test_fn_cside (fn _ => strchr "𝌆𝌇𝌈𝌉" #"c") tests.SC1 "high encode - strchr 1"} + {test_fn_cside (fn _ => strchr "𝌆𝌇𝌈𝌉" (strsub "𝌆" 0)) tests.SC2 "high encode - strchr 2"} + {test_fn_cside (fn _ => strchr "𝌆𝌇𝌈𝌉" (strsub "𝌇" 0)) tests.SC3 "high encode - strchr 3"} + {test_fn_cside (fn _ => strchr "𝌆𝌇𝌈𝌉" (strsub "𝌈" 0)) tests.SC4 "high encode - strchr 4"} + {test_fn_cside (fn _ => strchr "𝌆𝌇𝌈𝌉" (strsub "𝌉" 0)) tests.SC5 "high encode - strchr 5"} + + {test_fn_cside (fn _ => strindex "𝌆𝌇𝌈𝌉" #"c") tests.SI1 "high encode - strindex 1"} + {test_fn_cside (fn _ => strindex "𝌆𝌇𝌈𝌉" (strsub "𝌆" 0)) tests.SI2 "high encode - strindex 2"} + {test_fn_cside (fn _ => strindex "𝌆𝌇𝌈𝌉" (strsub "𝌇" 0)) tests.SI3 "high encode - strindex 3"} + {test_fn_cside (fn _ => strindex "𝌆𝌇𝌈𝌉" (strsub "𝌈" 0)) tests.SI4 "high encode - strindex 4"} + {test_fn_cside (fn _ => strindex "𝌆𝌇𝌈𝌉" (strsub "𝌉" 0)) tests.SI5 "high encode - strindex 5"} + + {test_fn_cside (fn _ => strsindex "𝌆𝌇𝌈𝌉" "") tests.SSI1 "high encode - strsindex 1"} + {test_fn_cside (fn _ => strsindex "𝌆𝌇𝌈𝌉" "𝌆𝌇𝌈𝌉") tests.SSI2 "high encode - strsindex 2"} + {test_fn_cside (fn _ => strsindex "𝌆𝌇𝌈𝌉" "𝌆𝌇𝌈c") tests.SSI3 "high encode - strsindex 3"} + {test_fn_cside (fn _ => strsindex "𝌆𝌇𝌈𝌉" "𝌇𝌈𝌉") tests.SSI4 "high encode - strsindex 4"} + {test_fn_cside (fn _ => strsindex "𝌆𝌇𝌈𝌉" "𝌇𝌈c") tests.SSI5 "high encode - strsindex 5"} + {test_fn_cside (fn _ => strsindex "𝌆𝌇𝌈𝌉" "𝌈𝌉") tests.SSI6 "high encode - strsindex 6"} + {test_fn_cside (fn _ => strsindex "𝌆𝌇𝌈𝌉" "𝌈c") tests.SSI7 "high encode - strsindex 7"} + {test_fn_cside (fn _ => strsindex "𝌆𝌇𝌈𝌉" "𝌉") tests.SSI8 "high encode - strsindex 8"} + {test_fn_cside (fn _ => strsindex "𝌆𝌇𝌈𝌉" "c") tests.SSI9 "high encode - strsindex 9"} + + {test_fn_cside (fn _ => strcspn "𝌆𝌇𝌈𝌉" "") tests.SCSP1 "high encode - strcspn 1"} + {test_fn_cside (fn _ => strcspn "𝌆𝌇𝌈𝌉" "𝌆𝌇𝌈𝌉") tests.SCSP2 "high encode - strcspn 2"} + {test_fn_cside (fn _ => strcspn "𝌆𝌇𝌈𝌉" "𝌆") tests.SCSP3 "high encode - strcspn 3"} + {test_fn_cside (fn _ => strcspn "𝌆𝌇𝌈𝌉" "𝌇𝌈𝌉") tests.SCSP4 "high encode - strcspn 4"} + {test_fn_cside (fn _ => strcspn "𝌆𝌇𝌈𝌉" "𝌈𝌉") tests.SCSP5 "high encode - strcspn 5"} + {test_fn_cside (fn _ => strcspn "𝌆𝌇𝌈𝌉" "𝌉") tests.SCSP6 "high encode - strcspn 6"} + + {test_fn_cside (fn _ => ord (strsub "𝌆𝌇𝌈𝌉" 0)) tests.OSS1 "high encode - ord 1"} + {test_fn_cside (fn _ => ord (strsub "𝌆𝌇𝌈𝌉" 1)) tests.OSS2 "high encode - ord 2"} + {test_fn_cside (fn _ => ord (strsub "𝌆𝌇𝌈𝌉" 2)) tests.OSS3 "high encode - ord 3"} + {test_fn_cside (fn _ => ord (strsub "𝌆𝌇𝌈𝌉" 3)) tests.OSS4 "high encode - ord 4"} + + {test_fn_cside (fn _ => show (strsub "𝌆𝌇𝌈𝌉" 0)) tests.SSS1 "high encode - show 1"} + {test_fn_cside (fn _ => show (strsub "𝌆𝌇𝌈𝌉" 1)) tests.SSS2 "high encode - show 2"} + {test_fn_cside (fn _ => show (strsub "𝌆𝌇𝌈𝌉" 2)) tests.SSS3 "high encode - show 3"} + {test_fn_cside (fn _ => show (strsub "𝌆𝌇𝌈𝌉" 3)) tests.SSS4 "high encode - show 4"} + + </xml> } /> + + </body> + </xml> + +(* substrings *) +fun substring1 _ = substring "abc" 0 3 +fun substring2 _ = substring "abc" 1 2 +fun substring3 _ = substring "abc" 2 1 +fun substring4 _ = substring "ábó" 0 3 +fun substring5 _ = substring "ábó" 1 2 +fun substring6 _ = substring "ábó" 2 1 +fun substring7 _ = substring "ábó" 0 2 +fun substring8 _ = substring "ábó" 0 1 +fun substring9 _ = substring "" 0 0 + +fun substringsserver _ = + return { + T1 = substring1 (), + T2 = substring2 (), + T3 = substring3 (), + T4 = substring4 (), + T5 = substring5 (), + T6 = substring6 (), + T7 = substring7 (), + T8 = substring8 (), + T9 = substring9 () + } + +fun substrings () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (substringsserver ()); + set t (Some r); + return () }> + + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => + return <xml> + {test_fn_both_sides2 substring1 t'.T1 "abc" "substrings 1"} + {test_fn_both_sides2 substring2 t'.T2 "bc" "substrings 2"} + {test_fn_both_sides2 substring3 t'.T3 "c" "substrings 3"} + {test_fn_both_sides2 substring4 t'.T4 "ábó" "substrings 4"} + {test_fn_both_sides2 substring5 t'.T5 "bó" "substrings 5"} + {test_fn_both_sides2 substring6 t'.T6 "ó" "substrings 6"} + {test_fn_both_sides2 substring7 t'.T7 "áb" "substrings 7"} + {test_fn_both_sides2 substring8 t'.T8 "á" "substrings 8"} + {test_fn_both_sides2 substring9 t'.T9 "" "substrings 9"} + </xml> + } /> + </body> + </xml> + +(* strlen *) +fun strlen1 _ = strlen "abc" +fun strlen2 _ = strlen "çbc" +fun strlen3 _ = strlen "çãc" +fun strlen4 _ = strlen "çãó" +fun strlen5 _ = strlen "ç" +fun strlen6 _ = strlen "c" +fun strlen7 _ = strlen "" +fun strlen8 _ = strlen "が" +fun strlen9 _ = strlen "漢" +fun strlen10 _ = strlen "カ" +fun strlen11 _ = strlen "وظيفية" +fun strlen12 _ = strlen "函數" +fun strlen13 _ = strlen "Функциональное" + +fun strlensserver _ = + return { + T1 = strlen1 (), + T2 = strlen2 (), + T3 = strlen3 (), + T4 = strlen4 (), + T5 = strlen5 (), + T6 = strlen6 (), + T7 = strlen7 (), + T8 = strlen8 (), + T9 = strlen9 (), + T10 = strlen10 (), + T11 = strlen11 (), + T12 = strlen12 (), + T13 = strlen13 () + } + +fun strlens () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (strlensserver()); + set t (Some r); + return ()}> + + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => + return <xml> + {test_fn_both_sides2 strlen1 t'.T1 3 "strlen 1"} + {test_fn_both_sides2 strlen2 t'.T2 3 "strlen 2"} + {test_fn_both_sides2 strlen3 t'.T3 3 "strlen 3"} + {test_fn_both_sides2 strlen4 t'.T4 3 "strlen 4"} + {test_fn_both_sides2 strlen5 t'.T5 1 "strlen 5"} + {test_fn_both_sides2 strlen6 t'.T6 1 "strlen 6"} + {test_fn_both_sides2 strlen7 t'.T7 0 "strlen 7"} + {test_fn_both_sides2 strlen8 t'.T8 1 "strlen 8"} + {test_fn_both_sides2 strlen9 t'.T9 1 "strlen 9"} + {test_fn_both_sides2 strlen10 t'.T10 1 "strlen 10"} + {test_fn_both_sides2 strlen11 t'.T11 6 "strlen 11"} + {test_fn_both_sides2 strlen12 t'.T12 2 "strlen 12"} + {test_fn_both_sides2 strlen13 t'.T13 14 "strlen 13"} + </xml>} /> + + </body> + </xml> + +(* strlenGe *) +fun strlenGe1 _ = strlenGe "" 1 +fun strlenGe2 _ = strlenGe "" 0 +fun strlenGe3 _ = strlenGe "aba" 4 +fun strlenGe4 _ = strlenGe "aba" 3 +fun strlenGe5 _ = strlenGe "aba" 2 +fun strlenGe6 _ = strlenGe "àçá" 4 +fun strlenGe7 _ = strlenGe "àçá" 3 +fun strlenGe8 _ = strlenGe "àçá" 2 + +fun strleGesserver _ = return { + T1 = strlenGe1 (), + T2 = strlenGe2 (), + T3 = strlenGe3 (), + T4 = strlenGe4 (), + T5 = strlenGe5 (), + T6 = strlenGe6 (), + T7 = strlenGe7 (), + T8 = strlenGe8 () + } + +fun strlenGens () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (strleGesserver()); + set t (Some r); + return ()}> + + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => + return <xml> + {test_fn_both_sides2 strlenGe1 t'.T1 False "strlenGe 1"} + {test_fn_both_sides2 strlenGe2 t'.T2 True "strlenGe 2"} + {test_fn_both_sides2 strlenGe3 t'.T3 False "strlenGe 3"} + {test_fn_both_sides2 strlenGe4 t'.T4 True "strlenGe 4"} + {test_fn_both_sides2 strlenGe5 t'.T5 True "strlenGe 5"} + {test_fn_both_sides2 strlenGe6 t'.T6 False "strlenGe 6"} + {test_fn_both_sides2 strlenGe7 t'.T7 True "strlenGe 7"} + {test_fn_both_sides2 strlenGe8 t'.T8 True "strlenGe 8"} + </xml>} /> + </body> + </xml> + +type clen = { S : string, L : int } + +val clen_eq : eq clen = mkEq (fn a b => + a.S = b.S && a.L = b.L) + +val clen_show : show clen = mkShow (fn a => + "{S = " ^ a.S ^ ", L = " ^ (show a.L) ^ "}") +(* strcat *) + +fun teststrcat a b = let val c = strcat a b in {S = c, L = strlen c} end +fun teststrcat1 _ = teststrcat "" "" +fun teststrcat2 _ = teststrcat "aa" "bb" +fun teststrcat3 _ = teststrcat "" "bb" +fun teststrcat4 _ = teststrcat "aa" "" +fun teststrcat5 _ = teststrcat "àà" "áá" +fun teststrcat6 _ = teststrcat "" "áá" +fun teststrcat7 _ = teststrcat "àà" "" +fun teststrcat8 _ = teststrcat "函數" "ãã" +fun teststrcat9 _ = teststrcat "ç" "ã" +fun teststrcat10 _ = teststrcat (show (strsub "ç" 0)) (show (strsub "ã" 0)) +fun teststrcat11 _ = teststrcat (show (chr 231)) (show (chr 227)) + +fun strcatsserver () = + return { + T1 = teststrcat1 (), + T2 = teststrcat2 (), + T3 = teststrcat3 (), + T4 = teststrcat4 (), + T5 = teststrcat5 (), + T6 = teststrcat6 (), + T7 = teststrcat7 (), + T8 = teststrcat8 (), + T9 = teststrcat9 (), + T10 = teststrcat10 (), + T11 = teststrcat11 () + } + +fun strcats () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (strcatsserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 teststrcat1 t'.T1 {S="",L=0} "strcat 1" } + {test_fn_both_sides2 teststrcat2 t'.T2 {S="aabb",L=4} "strcat 2" } + {test_fn_both_sides2 teststrcat3 t'.T3 {S="bb",L=2} "strcat 3" } + {test_fn_both_sides2 teststrcat4 t'.T4 {S="aa",L=2} "strcat 4" } + {test_fn_both_sides2 teststrcat5 t'.T5 {S="ààáá",L=4} "strcat 5" } + {test_fn_both_sides2 teststrcat6 t'.T6 {S="áá",L=2} "strcat 6" } + {test_fn_both_sides2 teststrcat7 t'.T7 {S="àà",L=2} "strcat 7" } + {test_fn_both_sides2 teststrcat8 t'.T8 {S="函數ãã",L=4} "strcat 8" } + {test_fn_both_sides2 teststrcat9 t'.T9 {S="çã",L=2} "strcat 9" } + {test_fn_both_sides2 teststrcat10 t'.T10 {S="çã",L=2} "strcat 10" } + {test_fn_both_sides2 teststrcat11 t'.T11 {S="çã",L=2} "strcat 11" } + </xml>} /> + </body> + </xml> + +(* strsubs *) + +fun strsub1 _ = strsub "abàç" 0 +fun strsub2 _ = strsub "abàç" 1 +fun strsub3 _ = strsub "àb" 0 +fun strsub4 _ = strsub "abàç" 2 +fun strsub5 _ = strsub "abàç" 3 + +fun strsubsserver _ = return { + T1 = strsub1 (), + T2 = strsub2 (), + T3 = strsub3 (), + T4 = strsub4 (), + T5 = strsub5 () + } + +fun strsubs () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (strsubsserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 strsub1 t'.T1 #"a" "strsub 1"} + {test_fn_both_sides2 strsub2 t'.T2 #"b" "strsub 2"} + {test_fn_both_sides2 strsub3 t'.T3 (strsub "à" 0) "strsub 3"} + {test_fn_both_sides2 strsub4 t'.T4 (strsub "à" 0) "strsub 4"} + {test_fn_both_sides2 strsub5 t'.T5 (strsub "ç" 0) "strsub 5"} + </xml> + } /> + + </body> + </xml> + +(* strsuffixs *) +fun strsuffix1 _ = strsuffix "abàç" 0 +fun strsuffix2 _ = strsuffix "abàç" 1 +fun strsuffix3 _ = strsuffix "abàç" 2 +fun strsuffix4 _ = strsuffix "abàç" 3 + +fun strsuffixsserver _ = + return { + T1 = strsuffix1 (), + T2 = strsuffix2 (), + T3 = strsuffix3 (), + T4 = strsuffix4 () + } + +fun strsuffixs () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (strsuffixsserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 strsuffix1 t'.T1 "abàç" "strsuffix 1"} + {test_fn_both_sides2 strsuffix2 t'.T2 "bàç" "strsuffix 2"} + {test_fn_both_sides2 strsuffix3 t'.T3 "àç" "strsuffix 3"} + {test_fn_both_sides2 strsuffix4 t'.T4 "ç" "strsuffix 4"} + </xml> + } /> + + </body> + </xml> + +(* strchrs *) + +fun strchr1 _ = strchr "abàç" #"c" +fun strchr2 _ = strchr "abàç" #"a" +fun strchr3 _ = strchr "abàç" #"b" +fun strchr4 _ = strchr "abàç" (strsub "à" 0) +fun strchr5 _ = strchr "abàç" (strsub "ç" 0) + +fun strchrssserver _ = + return { + T1 = strchr1 (), + T2 = strchr2 (), + T3 = strchr3 (), + T4 = strchr4 (), + T5 = strchr5 () + } + +fun strchrs () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (strchrssserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 strchr1 t'.T1 None "strchr 1"} + {test_fn_both_sides2 strchr2 t'.T2 (Some "abàç") "strchr 2"} + {test_fn_both_sides2 strchr3 t'.T3 (Some "bàç") "strchr 3"} + {test_fn_both_sides2 strchr4 t'.T4 (Some "àç") "strchr 4"} + {test_fn_both_sides2 strchr5 t'.T5 (Some "ç") "strchr 5"} + </xml> + } /> + + </body> + </xml> + +(* strindexs *) +fun strindex1 _ = strindex "abàç" #"c" +fun strindex2 _ = strindex "abàç" #"a" +fun strindex3 _ = strindex "abàç" #"b" +fun strindex4 _ = strindex "abàç" (strsub "à" 0) +fun strindex5 _ = strindex "abàç" (strsub "ç" 0) + +fun strindexsserver _ = + return { + T1 = strindex1 (), + T2 = strindex2 (), + T3 = strindex3 (), + T4 = strindex4 (), + T5 = strindex5 () + } + +fun strindexs () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (strindexsserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 strindex1 t'.T1 None "strindex 1"} + {test_fn_both_sides2 strindex2 t'.T2 (Some 0) "strindex 2"} + {test_fn_both_sides2 strindex3 t'.T3 (Some 1) "strindex 3"} + {test_fn_both_sides2 strindex4 t'.T4 (Some 2) "strindex 4"} + {test_fn_both_sides2 strindex5 t'.T5 (Some 3) "strindex 5"} + </xml> + } /> + + </body> + </xml> + +(*strsindexs*) +fun strsindex1 _ = strsindex "abàç" "" +fun strsindex2 _ = strsindex "abàç" "abàç" +fun strsindex3 _ = strsindex "abàç" "abàc" +fun strsindex4 _ = strsindex "abàç" "bàç" +fun strsindex5 _ = strsindex "abàç" "bàc" +fun strsindex6 _ = strsindex "abàç" "àç" +fun strsindex7 _ = strsindex "abàç" "àc" +fun strsindex8 _ = strsindex "abàç" "ç" +fun strsindex9 _ = strsindex "abàç" "c" + +fun strsindexsserver _ = + return { + T1 = strsindex1 (), + T2 = strsindex2 (), + T3 = strsindex3 (), + T4 = strsindex4 (), + T5 = strsindex5 (), + T6 = strsindex6 (), + T7 = strsindex7 (), + T8 = strsindex8 (), + T9 = strsindex9 () + } + +fun strsindexs () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (strsindexsserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 strsindex1 t'.T1 (Some 0) "strsindex 1"} + {test_fn_both_sides2 strsindex2 t'.T2 (Some 0) "strsindex 2"} + {test_fn_both_sides2 strsindex3 t'.T3 None "strsindex 3"} + {test_fn_both_sides2 strsindex4 t'.T4 (Some 1) "strsindex 4"} + {test_fn_both_sides2 strsindex5 t'.T5 None "strsindex 5"} + {test_fn_both_sides2 strsindex6 t'.T6 (Some 2) "strsindex 6"} + {test_fn_both_sides2 strsindex7 t'.T7 None "strsindex 7"} + {test_fn_both_sides2 strsindex8 t'.T8 (Some 3) "strsindex 8"} + {test_fn_both_sides2 strsindex9 t'.T9 None "strsindex 9"} + </xml> + } /> + + </body> + </xml> + +(*strcspns*) +fun strcspn1 _ = strcspn "abàç" "" +fun strcspn2 _ = strcspn "abàç" "abàç" +fun strcspn3 _ = strcspn "abàç" "a" +fun strcspn4 _ = strcspn "abàç" "bà" +fun strcspn5 _ = strcspn "abàç" "àç" +fun strcspn6 _ = strcspn "abàç" "ç" + +fun strcspnsserver _ = + return { + T1 = strcspn1 (), + T2 = strcspn2 (), + T3 = strcspn3 (), + T4 = strcspn4 (), + T5 = strcspn5 (), + T6 = strcspn6 () + } + +fun strcspns () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (strcspnsserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 strcspn1 t'.T1 4 "strcspn 1"} + {test_fn_both_sides2 strcspn2 t'.T2 0 "strcspn 2"} + {test_fn_both_sides2 strcspn3 t'.T3 0 "strcspn 3"} + {test_fn_both_sides2 strcspn4 t'.T4 1 "strcspn 4"} + {test_fn_both_sides2 strcspn5 t'.T5 2 "strcspn 5"} + {test_fn_both_sides2 strcspn6 t'.T6 3 "strcspn 6"} + </xml> + } /> + + </body> + </xml> + +(* str1 *) +fun str11 _ = str1 #"a" +fun str12 _ = str1 (strsub "à" 0) +fun str13 _ = str1 (strsub "aá" 1) + +fun str1server _ = + return { + T1 = str11 (), + T2 = str12 (), + T3 = str13 () + } + +fun str1s () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (str1server ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 str11 t'.T1 "a" "str1 1"} + {test_fn_both_sides2 str12 t'.T2 "à" "str1 2"} + {test_fn_both_sides2 str13 t'.T3 "á" "str1 3"} + </xml> + } /> + + </body> + </xml> + +(* isalnum *) + +fun isalnum1 _ = isalnum #"a" +fun isalnum2 _ = isalnum #"a" +fun isalnum3 _ = isalnum (strsub "à" 0) +fun isalnum4 _ = isalnum #"A" +fun isalnum5 _ = isalnum (strsub "À" 0) +fun isalnum6 _ = isalnum #"1" +fun isalnum7 _ = not (isalnum #"!") +fun isalnum8 _ = not (isalnum #"#") +fun isalnum9 _ = not (isalnum #" ") + +fun isalnumsserver _ = return { + T1 = isalnum1 (), + T2 = isalnum2 (), + T3 = isalnum3 (), + T4 = isalnum4 (), + T5 = isalnum5 (), + T6 = isalnum6 (), + T7 = isalnum7 (), + T8 = isalnum8 (), + T9 = isalnum9 () + } + +fun isalnums () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (isalnumsserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 isalnum1 t'.T1 True "isalnum 1"} + {test_fn_both_sides2 isalnum2 t'.T2 True "isalnum 2"} + {test_fn_both_sides2 isalnum3 t'.T3 True "isalnum 3"} + {test_fn_both_sides2 isalnum4 t'.T4 True "isalnum 4"} + {test_fn_both_sides2 isalnum5 t'.T5 True "isalnum 5"} + {test_fn_both_sides2 isalnum6 t'.T6 True "isalnum 6"} + {test_fn_both_sides2 isalnum7 t'.T7 True "isalnum 7"} + {test_fn_both_sides2 isalnum8 t'.T8 True "isalnum 8"} + {test_fn_both_sides2 isalnum9 t'.T9 True "isalnum 9"} + </xml> + } /> + + </body> + </xml> + +(* isalpha *) +fun isalpha1 _ = isalpha #"a" +fun isalpha2 _ = isalpha (strsub "à" 0) +fun isalpha3 _ = isalpha #"A" +fun isalpha4 _ = isalpha (strsub "À" 0) +fun isalpha5 _ = not (isalpha #"1") +fun isalpha6 _ = not (isalpha #"!") +fun isalpha7 _ = not (isalpha #"#") +fun isalpha8 _ = not (isalpha #" ") + +fun isalphasserver () = + return { + T1 = isalpha1 (), + T2 = isalpha2 (), + T3 = isalpha3 (), + T4 = isalpha4 (), + T5 = isalpha5 (), + T6 = isalpha6 (), + T7 = isalpha7 (), + T8 = isalpha8 () + } + +fun isalphas () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (isalphasserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 isalpha1 t'.T1 True "isalpha 1"} + {test_fn_both_sides2 isalpha2 t'.T2 True "isalpha 2"} + {test_fn_both_sides2 isalpha3 t'.T3 True "isalpha 3"} + {test_fn_both_sides2 isalpha4 t'.T4 True "isalpha 4"} + {test_fn_both_sides2 isalpha5 t'.T5 True "isalpha 5"} + {test_fn_both_sides2 isalpha6 t'.T6 True "isalpha 6"} + {test_fn_both_sides2 isalpha7 t'.T7 True "isalpha 7"} + {test_fn_both_sides2 isalpha8 t'.T8 True "isalpha 8"} + </xml> + } /> + + </body> +</xml> + +(* isblanks *) +fun isblank1 _ = not (isblank #"a") +fun isblank2 _ = not (isblank (strsub "à" 0)) +fun isblank3 _ = not (isblank #"A") +fun isblank4 _ = not (isblank (strsub "À" 0)) +fun isblank5 _ = not (isblank #"1") +fun isblank6 _ = not (isblank #"!") +fun isblank7 _ = not (isblank #"#") +fun isblank8 _ = isblank #" " +fun isblank9 _ = isblank #"\t" +fun isblank10 _ = not (isblank #"\n") + +fun isblanksserver _ = + return { + T1 = isblank1 (), + T2 = isblank2 (), + T3 = isblank3 (), + T4 = isblank4 (), + T5 = isblank5 (), + T6 = isblank6 (), + T7 = isblank7 (), + T8 = isblank8 (), + T9 = isblank9 (), + T10 = isblank10 () + } + +fun isblanks () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (isblanksserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 isblank1 t'.T1 True "isblank 1"} + {test_fn_both_sides2 isblank2 t'.T2 True "isblank 2"} + {test_fn_both_sides2 isblank3 t'.T3 True "isblank 3"} + {test_fn_both_sides2 isblank4 t'.T4 True "isblank 4"} + {test_fn_both_sides2 isblank5 t'.T5 True "isblank 5"} + {test_fn_both_sides2 isblank6 t'.T6 True "isblank 6"} + {test_fn_both_sides2 isblank7 t'.T7 True "isblank 7"} + {test_fn_both_sides2 isblank8 t'.T8 True "isblank 8"} + {test_fn_both_sides2 isblank9 t'.T9 True "isblank 9"} + {test_fn_both_sides2 isblank10 t'.T10 True "isblank 10"} + </xml> + } /> + + </body> + </xml> + +(* iscntrls *) +fun iscntrl1 _ = not (iscntrl #"a") +fun iscntrl2 _ = not (iscntrl (strsub "à" 0)) +fun iscntrl3 _ = not (iscntrl #"A") +fun iscntrl4 _ = not (iscntrl (strsub "À" 0)) +fun iscntrl5 _ = not (iscntrl #"1") +fun iscntrl6 _ = not (iscntrl #"!") +fun iscntrl7 _ = not (iscntrl #"#") +fun iscntrl8 _ = not (iscntrl #" ") +fun iscntrl9 _ = iscntrl #"\t" +fun iscntrl10 _ = iscntrl #"\n" + +fun iscntrls () : transaction page = + return <xml> + <body> + {test_fn_sside iscntrl1 True "iscntrl 1"} + {test_fn_sside iscntrl2 True "iscntrl 2"} + {test_fn_sside iscntrl3 True "iscntrl 3"} + {test_fn_sside iscntrl4 True "iscntrl 4"} + {test_fn_sside iscntrl5 True "iscntrl 5"} + {test_fn_sside iscntrl6 True "iscntrl 6"} + {test_fn_sside iscntrl7 True "iscntrl 7"} + {test_fn_sside iscntrl8 True "iscntrl 8"} + {test_fn_sside iscntrl9 True "iscntrl 9"} + {test_fn_sside iscntrl10 True "iscntrl 10"} + </body> + </xml> + +(* isdigits *) +fun isdigit1 _ = not (isdigit #"a") +fun isdigit2 _ = not (isdigit (strsub "à" 0)) +fun isdigit3 _ = not (isdigit #"A") +fun isdigit4 _ = not (isdigit (strsub "À" 0)) +fun isdigit5 _ = isdigit #"1" +fun isdigit6 _ = not (isdigit #"!") +fun isdigit7 _ = not (isdigit #"#") +fun isdigit8 _ = not (isdigit #" ") +fun isdigit9 _ = not (isdigit #"\t") +fun isdigit10 _ = not (isdigit #"\n") + +fun isdigitsserver _ = + return { + T1 = isdigit1 (), + T2 = isdigit2 (), + T3 = isdigit3 (), + T4 = isdigit4 (), + T5 = isdigit5 (), + T6 = isdigit6 (), + T7 = isdigit7 (), + T8 = isdigit8 (), + T9 = isdigit9 (), + T10 = isdigit10 () + } + +fun isdigits () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (isdigitsserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 isdigit1 t'.T1 True "isdigit 1"} + {test_fn_both_sides2 isdigit2 t'.T2 True "isdigit 2"} + {test_fn_both_sides2 isdigit3 t'.T3 True "isdigit 3"} + {test_fn_both_sides2 isdigit4 t'.T4 True "isdigit 4"} + {test_fn_both_sides2 isdigit5 t'.T5 True "isdigit 5"} + {test_fn_both_sides2 isdigit6 t'.T6 True "isdigit 6"} + {test_fn_both_sides2 isdigit7 t'.T7 True "isdigit 7"} + {test_fn_both_sides2 isdigit8 t'.T8 True "isdigit 8"} + {test_fn_both_sides2 isdigit9 t'.T9 True "isdigit 9"} + {test_fn_both_sides2 isdigit10 t'.T10 True "isdigit 10"} + </xml> + } /> + + + </body> + </xml> + +fun isgraphs () : transaction page = + return <xml> + <body> + {test_fn_sside (fn _ => isgraph #"a") True "isgraph 1"} + {test_fn_sside (fn _ => isgraph (strsub "à" 0)) True "isgraph 2"} + {test_fn_sside (fn _ => isgraph #"A") True "isgraph 3"} + {test_fn_sside (fn _ => isgraph (strsub "À" 0)) True "isgraph 4"} + {test_fn_sside (fn _ => isgraph #"1") True "isgraph 5"} + {test_fn_sside (fn _ => isgraph #"!") True "isgraph 6"} + {test_fn_sside (fn _ => isgraph #"#") True "isgraph 7"} + {test_fn_sside (fn _ => not (isgraph #" ")) True "isgraph 8"} + {test_fn_sside (fn _ => not (isgraph #"\t")) True "isgraph 9"} + {test_fn_sside (fn _ => not (isdigit #"\n")) True "isgraph 10"} + </body> + </xml> + +(* islowers *) +fun islower1 _ = islower #"a" +fun islower2 _ = islower (strsub "à" 0) +fun islower3 _ = not (islower #"A") +fun islower4 _ = not (islower (strsub "À" 0)) +fun islower5 _ = not (islower #"1") +fun islower6 _ = not (islower #"!") +fun islower7 _ = not (islower #"#") +fun islower8 _ = not (islower #" ") +fun islower9 _ = not (islower #"\t") +fun islower10 _ = not (islower #"\n") + +fun islowersserver _ = + return { + T1 = islower1 (), + T2 = islower2 (), + T3 = islower3 (), + T4 = islower4 (), + T5 = islower5 (), + T6 = islower6 (), + T7 = islower7 (), + T8 = islower8 (), + T9 = islower9 (), + T10 = islower10 () + } + +fun islowers () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (islowersserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 islower1 t'.T1 True "islower 1"} + {test_fn_both_sides2 islower2 t'.T2 True "islower 2"} + {test_fn_both_sides2 islower3 t'.T3 True "islower 3"} + {test_fn_both_sides2 islower4 t'.T4 True "islower 4"} + {test_fn_both_sides2 islower5 t'.T5 True "islower 5"} + {test_fn_both_sides2 islower6 t'.T6 True "islower 6"} + {test_fn_both_sides2 islower7 t'.T7 True "islower 7"} + {test_fn_both_sides2 islower8 t'.T8 True "islower 8"} + {test_fn_both_sides2 islower9 t'.T9 True "islower 9"} + {test_fn_both_sides2 islower10 t'.T10 True "islower 10"} + </xml> + } /> + </body> + </xml> + +(* isprint *) +fun isprint1 _ = isprint #"a" +fun isprint2 _ = isprint (strsub "à" 0) +fun isprint3 _ = isprint #"A" +fun isprint4 _ = isprint (strsub "À" 0) +fun isprint5 _ = isprint #"1" +fun isprint6 _ = isprint #"!" +fun isprint7 _ = isprint #"#" +fun isprint8 _ = isprint #" " +fun isprint9 _ = not (isprint #"\t") +fun isprint10 _ = not (isprint #"\n") + +fun isprintsserver _ = return { + T1 = isprint1 (), + T2 = isprint2 (), + T3 = isprint3 (), + T4 = isprint4 (), + T5 = isprint5 (), + T6 = isprint6 (), + T7 = isprint7 (), + T8 = isprint8 (), + T9 = isprint9 (), + T10 = isprint10 () + } + +fun isprints () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (isprintsserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 isprint1 t'.T1 True "isprint 1"} + {test_fn_both_sides2 isprint2 t'.T2 True "isprint 2"} + {test_fn_both_sides2 isprint3 t'.T3 True "isprint 3"} + {test_fn_both_sides2 isprint4 t'.T4 True "isprint 4"} + {test_fn_both_sides2 isprint5 t'.T5 True "isprint 5"} + {test_fn_both_sides2 isprint6 t'.T6 True "isprint 6"} + {test_fn_both_sides2 isprint7 t'.T7 True "isprint 7"} + {test_fn_both_sides2 isprint8 t'.T8 True "isprint 8"} + {test_fn_both_sides2 isprint9 t'.T9 True "isprint 9"} + {test_fn_both_sides2 isprint10 t'.T10 True "isprint 10"} + </xml> + } /> + </body> + </xml> + +(* ispunct *) +fun ispunct1 _ = not (ispunct #"a") +fun ispunct2 _ = not (ispunct (strsub "à" 0)) +fun ispunct3 _ = not (ispunct #"A") +fun ispunct4 _ = not (ispunct (strsub "À" 0)) +fun ispunct5 _ = not (ispunct #"1") +fun ispunct6 _ = ispunct #"!" +fun ispunct7 _ = ispunct #"#" +fun ispunct8 _ = not (ispunct #" ") +fun ispunct9 _ = not (ispunct #"\t") +fun ispunct10 _ = not (ispunct #"\n") + +fun ispuncts () : transaction page = + return <xml> + <body> + {test_fn_sside ispunct1 True "ispunct 1"} + {test_fn_sside ispunct2 True "ispunct 2"} + {test_fn_sside ispunct3 True "ispunct 3"} + {test_fn_sside ispunct4 True "ispunct 4"} + {test_fn_sside ispunct5 True "ispunct 5"} + {test_fn_sside ispunct6 True "ispunct 6"} + {test_fn_sside ispunct7 True "ispunct 7"} + {test_fn_sside ispunct8 True "ispunct 8"} + {test_fn_sside ispunct9 True "ispunct 9"} + {test_fn_sside ispunct10 True "ispunct 10"} + </body> + </xml> + +(* isspace *) +fun isspace1 _ = not (isspace #"a") +fun isspace2 _ = not (isspace (strsub "à" 0)) +fun isspace3 _ = not (isspace #"A") +fun isspace4 _ = not (isspace (strsub "À" 0)) +fun isspace5 _ = not (isspace #"1") +fun isspace6 _ = not (isspace #"!") +fun isspace7 _ = not (isspace #"#") +fun isspace8 _ = isspace #" " +fun isspace9 _ = isspace #"\t" +fun isspace10 _ = isspace #"\n" + +fun isspacesserver _ = + return { + T1 = isspace1 (), + T2 = isspace2 (), + T3 = isspace3 (), + T4 = isspace4 (), + T5 = isspace5 (), + T6 = isspace6 (), + T7 = isspace7 (), + T8 = isspace8 (), + T9 = isspace9 (), + T10 = isspace10 () + } + +fun isspaces () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (isspacesserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 isspace1 t'.T1 True "isspace 1"} + {test_fn_both_sides2 isspace2 t'.T2 True "isspace 2"} + {test_fn_both_sides2 isspace3 t'.T3 True "isspace 3"} + {test_fn_both_sides2 isspace4 t'.T4 True "isspace 4"} + {test_fn_both_sides2 isspace5 t'.T5 True "isspace 5"} + {test_fn_both_sides2 isspace6 t'.T6 True "isspace 6"} + {test_fn_both_sides2 isspace7 t'.T7 True "isspace 7"} + {test_fn_both_sides2 isspace8 t'.T8 True "isspace 8"} + {test_fn_both_sides2 isspace9 t'.T9 True "isspace 9"} + {test_fn_both_sides2 isspace10 t'.T10 True "isspace 10"} + </xml> + } /> + + </body> + </xml> + +(* isupper *) +fun isupper1 _ = not (isupper #"a") +fun isupper2 _ = not (isupper (strsub "à" 0)) +fun isupper3 _ = isupper #"A" +fun isupper4 _ = isupper (strsub "À" 0) +fun isupper5 _ = not (isupper #"1") +fun isupper6 _ = not (isupper #"!") +fun isupper7 _ = not (isupper #"#") +fun isupper8 _ = not (isupper #" ") +fun isupper9 _ = not (isupper #"\t") +fun isupper10 _ = not (isupper #"\n") + +fun isuppersserver _ = + return { + T1 = isupper1 (), + T2 = isupper2 (), + T3 = isupper3 (), + T4 = isupper4 (), + T5 = isupper5 (), + T6 = isupper6 (), + T7 = isupper7 (), + T8 = isupper8 (), + T9 = isupper9 (), + T10 = isupper10 () + } + +fun isuppers () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (isuppersserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 isupper1 t'.T1 True "isupper 1"} + {test_fn_both_sides2 isupper2 t'.T2 True "isupper 2"} + {test_fn_both_sides2 isupper3 t'.T3 True "isupper 3"} + {test_fn_both_sides2 isupper4 t'.T4 True "isupper 4"} + {test_fn_both_sides2 isupper5 t'.T5 True "isupper 5"} + {test_fn_both_sides2 isupper6 t'.T6 True "isupper 6"} + {test_fn_both_sides2 isupper7 t'.T7 True "isupper 7"} + {test_fn_both_sides2 isupper8 t'.T8 True "isupper 8"} + {test_fn_both_sides2 isupper9 t'.T9 True "isupper 9"} + {test_fn_both_sides2 isupper10 t'.T10 True "isupper 10"} + </xml> + } /> + + </body> + </xml> + +(* isxdigit *) +fun isxdigit1 _ = isxdigit #"a" +fun isxdigit2 _ = not (isxdigit (strsub "à" 0)) +fun isxdigit3 _ = isxdigit #"A" +fun isxdigit4 _ = not (isxdigit (strsub "À" 0)) +fun isxdigit5 _ = isxdigit #"1" +fun isxdigit6 _ = not (isxdigit #"!") +fun isxdigit7 _ = not (isxdigit #"#") +fun isxdigit8 _ = not (isxdigit #" ") +fun isxdigit9 _ = not (isxdigit #"\t") +fun isxdigit10 _ = not (isxdigit #"\n") + +fun isxdigitsserver _ = + return { + T1 = isxdigit1 (), + T2 = isxdigit2 (), + T3 = isxdigit3 (), + T4 = isxdigit4 (), + T5 = isxdigit5 (), + T6 = isxdigit6 (), + T7 = isxdigit7 (), + T8 = isxdigit8 (), + T9 = isxdigit9 (), + T10 = isxdigit10 () + } + +fun isxdigits () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (isxdigitsserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 isxdigit1 t'.T1 True "isxdigit 1"} + {test_fn_both_sides2 isxdigit2 t'.T2 True "isxdigit 2"} + {test_fn_both_sides2 isxdigit3 t'.T3 True "isxdigit 3"} + {test_fn_both_sides2 isxdigit4 t'.T4 True "isxdigit 4"} + {test_fn_both_sides2 isxdigit5 t'.T5 True "isxdigit 5"} + {test_fn_both_sides2 isxdigit6 t'.T6 True "isxdigit 6"} + {test_fn_both_sides2 isxdigit7 t'.T7 True "isxdigit 7"} + {test_fn_both_sides2 isxdigit8 t'.T8 True "isxdigit 8"} + {test_fn_both_sides2 isxdigit9 t'.T9 True "isxdigit 9"} + {test_fn_both_sides2 isxdigit10 t'.T10 True "isxdigit 10"} + </xml> + } /> + + </body> + </xml> + +(* tolower *) + +fun tolower1 _ = tolower #"A" +fun tolower2 _ = tolower #"a" +fun tolower3 _ = tolower (strsub "á" 0) +fun tolower4 _ = tolower (strsub "Á" 0) +fun tolower5 _ = tolower #"1" +fun tolower6 _ = tolower (strsub "ß" 0) + +fun tolowersserver _ = + return { + T1 = tolower1 (), + T2 = tolower2 (), + T3 = tolower3 (), + T4 = tolower4 (), + T5 = tolower5 (), + T6 = tolower6 () + } + +fun tolowers () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (tolowersserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 tolower1 t'.T1 #"a" "tolower 1"} + {test_fn_both_sides2 tolower2 t'.T2 #"a" "tolower 2"} + {test_fn_both_sides2 tolower3 t'.T3 (strsub "á" 0) "tolower 3"} + {test_fn_both_sides2 tolower4 t'.T4 (strsub "á" 0) "tolower 4"} + {test_fn_both_sides2 tolower5 t'.T5 #"1" "tolower 5"} + {test_fn_both_sides2 tolower6 t'.T6 (strsub "ß" 0) "tolower 6"} + + </xml> + } /> + + </body> + </xml> + +(* toupper *) +fun toupper1 _ = toupper #"A" +fun toupper2 _ = toupper #"a" +fun toupper3 _ = toupper (strsub "á" 0) +fun toupper4 _ = toupper (strsub "Á" 0) +fun toupper5 _ = toupper #"1" +fun toupper6 _ = toupper (strsub "ß" 0) + +fun touppersserver _ = + return { + T1 = toupper1 (), + T2 = toupper2 (), + T3 = toupper3 (), + T4 = toupper4 (), + T5 = toupper5 (), + T6 = toupper6 () + } + +fun touppers () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (touppersserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 toupper1 t'.T1 #"A" "toupper 1"} + {test_fn_both_sides2 toupper2 t'.T2 #"A" "toupper 2"} + {test_fn_both_sides2 toupper3 t'.T3 (strsub "Á" 0) "toupper 3"} + {test_fn_both_sides2 toupper4 t'.T4 (strsub "Á" 0) "toupper 4"} + {test_fn_both_sides2 toupper5 t'.T5 #"1" "toupper 5"} + {test_fn_both_sides2 toupper6 t'.T6 (strsub "ß" 0) "toupper 6"} + + </xml> + } /> + + </body> + </xml> + +(* ord and chr*) +fun ordchr1 _ = chr (ord #"A") +fun ordchr2 _ = chr (ord #"a") +fun ordchr3 _ = chr (ord (strsub "á" 0)) +fun ordchr4 _ = chr (ord (strsub "Á" 0)) +fun ordchr5 _ = chr (ord #"1") +fun ordchr6 _ = chr (ord #"\n") +fun ordchr7 _ = chr (ord (strsub "が" 0)) +fun ordchr8 _ = chr (ord (strsub "漢" 0)) +fun ordchr9 _ = chr (ord (strsub "カ" 0)) + +fun ordchrsserver _ = return { + T1 = ordchr1 (), + T2 = ordchr2 (), + T3 = ordchr3 (), + T4 = ordchr4 (), + T5 = ordchr5 (), + T6 = ordchr6 (), + T7 = ordchr7 (), + T8 = ordchr8 (), + T9 = ordchr9 () + } + +fun ord_and_chrs () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (ordchrsserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + + {test_fn_both_sides2 ordchr1 t'.T1 #"A" "ord => chr 1"} + {test_fn_both_sides2 ordchr2 t'.T2 #"a" "ord => chr 2"} + {test_fn_both_sides2 ordchr3 t'.T3 (strsub "á" 0) "ord => chr 3"} + {test_fn_both_sides2 ordchr4 t'.T4 (strsub "Á" 0) "ord => chr 4"} + {test_fn_both_sides2 ordchr5 t'.T5 #"1" "ord => chr 5"} + {test_fn_both_sides2 ordchr6 t'.T6 #"\n" "ord => chr 6"} + {test_fn_both_sides2 ordchr7 t'.T7 (strsub "が" 0) "ord => chr 7"} + {test_fn_both_sides2 ordchr8 t'.T8 (strsub "漢" 0) "ord => chr 8"} + {test_fn_both_sides2 ordchr9 t'.T9 (strsub "カ" 0) "ord => chr 9"} + </xml> + } /> + </body> + </xml> + +(* ord *) +fun ord1 _ = ord #"a" +fun ord2 _ = ord (strsub "á" 0) +fun ord3 _ = ord #"5" +fun ord4 _ = ord (strsub "が" 0) +fun ord5 _ = ord (strsub "漢" 0) +fun ord6 _ = ord (strsub "カ" 0) + +fun ordsserver _ = + return { + T1 = ord1 (), + T2 = ord2 (), + T3 = ord3 (), + T4 = ord4 (), + T5 = ord5 (), + T6 = ord6 () + } + +fun test_ords () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (ordsserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_cside ord1 t'.T1 "test ord 1"} + {test_fn_cside ord2 t'.T2 "test ord 2"} + {test_fn_cside ord3 t'.T3 "test ord 3"} + {test_fn_cside ord4 t'.T4 "test ord 4"} + {test_fn_cside ord5 t'.T5 "test ord 5"} + {test_fn_cside ord6 t'.T6 "test ord 6"} + </xml> + } /> + </body> + </xml> + + + +and test_post () : transaction page = + let + fun test_post_cb r = + return <xml> + <body> + <pre> + {[r.T1]} + </pre> + <pre> + {[r.T2]} + </pre> + <pre> + {[r.T3]} + </pre> + <pre> + {[r.T4]} + </pre> + <pre> + {[r.T5]} + </pre> + <pre> + {[r.T6]} + </pre> + <pre> + {[r.T7]} + </pre> + </body> + </xml> + + in + t1 <- source ""; + t2 <- source "aco"; + t3 <- source "áçõ"; + t4 <- source "が"; + t5 <- source "𝌆𝌇𝌈𝌉"; + t6 <- source "Функциональное"; + t7 <- source "وظيفية"; + return <xml> + <body> + <form> + <textbox{#T1} source={t1} /> + <textbox{#T2} source={t2} /> + <textbox{#T3} source={t3} /> + <textbox{#T4} source={t4} /> + <textbox{#T5} source={t5} /> + <textbox{#T6} source={t6} /> + <textbox{#T7} source={t7} /> + <submit action={test_post_cb} value="submit" /> + </form> + </body> + </xml> + end + +table t : { Id : int, Text : string } + +fun test_db () : transaction page = + let + val s1 = "abc" + val s2 = "çãó" + val s3 = "が" + val s4 = "漢" + val s5 = "カ" + val s6 = "وظيفية" + + fun test_str_and_len n c expS expL = + test_fn_both_sides (fn _ => {S = c, L = strlen c}) {S=expS, L=expL} ("test_db " ^ (show n)) + + in + dml (INSERT INTO t (Id, Text) VALUES({[1]}, {[s1]})); + t1 <- oneRow (SELECT t.Text FROM t WHERE t.Id = 1); + + dml (INSERT INTO t (Id, Text) VALUES({[2]}, {[s2]})); + t2 <- oneRow (SELECT t.Text FROM t WHERE t.Id = 2); + + dml (INSERT INTO t (Id, Text) VALUES({[3]}, {[s3]})); + t3 <- oneRow (SELECT t.Text FROM t WHERE t.Id = 3); + + dml (INSERT INTO t (Id, Text) VALUES({[4]}, {[s4]})); + t4 <- oneRow (SELECT t.Text FROM t WHERE t.Id = 4); + + dml (INSERT INTO t (Id, Text) VALUES({[5]}, {[s5]})); + t5 <- oneRow (SELECT t.Text FROM t WHERE t.Id = 5); + + dml (INSERT INTO t (Id, Text) VALUES({[6]}, {[s6]})); + t6 <- oneRow (SELECT t.Text FROM t WHERE t.Id = 6); + + return <xml> + <body> + {test_str_and_len 1 t1.T.Text s1 (strlen s1)} + {test_str_and_len 2 t2.T.Text s2 (strlen s2)} + {test_str_and_len 3 t3.T.Text s3 (strlen s3)} + {test_str_and_len 4 t4.T.Text s4 (strlen s4)} + {test_str_and_len 5 t5.T.Text s5 (strlen s5)} + {test_str_and_len 6 t6.T.Text s6 (strlen s6)} + </body> + </xml> + end + +and ftTolower (minCh : int) (maxCh : int) : transaction page = + let + fun test_chr (n : int) : xbody = + if iscodepoint n then + test_fn_cside_ch (fn _ => tolower (chr n)) (tolower (chr n)) + ("test chr " ^ (show n) ^ " : " ^ (show (chr n))) + else + <xml></xml> + in + return <xml> + <body> + { from_m_upto_n (fn n => test_chr n) minCh maxCh } + </body> + </xml> + end + +and ftToupper (minCh : int) (maxCh : int) : transaction page = + let + fun test_chr (n : int) : xbody = + if iscodepoint n then + test_fn_cside_ch (fn _ => toupper (chr n)) (toupper (chr n)) + ("test chr " ^ (show n) ^ " : " ^ (show (chr n))) + else + <xml></xml> + in + return <xml> + <body> + { from_m_upto_n (fn n => test_chr n) minCh maxCh } + </body> + </xml> + end + +and ftIsalpha (minCh : int) (maxCh : int) : transaction page = + let + fun test_chr (n : int) : xbody = + if iscodepoint n then + test_fn_cside_b (fn _ => isalpha (chr n)) (isalpha (chr n)) + ("test chr " ^ (show n) ^ " : " ^ (show (chr n))) + else + <xml></xml> + in + return <xml> + <body> + { from_m_upto_n (fn n => test_chr n) minCh maxCh } + </body> + </xml> + end + +and ftIsdigit (minCh : int) (maxCh : int) : transaction page = + let + fun test_chr (n : int) : xbody = + if iscodepoint n then + test_fn_cside_b (fn _ => isdigit (chr n)) (isdigit (chr n)) + ("test chr " ^ (show n) ^ " : " ^ (show (chr n))) + else + <xml></xml> + in + return <xml> + <body> + { from_m_upto_n (fn n => test_chr n) minCh maxCh } + </body> + </xml> + end + +and ftIsalnum (minCh : int) (maxCh : int) : transaction page = + let + fun test_chr (n : int) : xbody = + if iscodepoint n then + test_fn_cside_b (fn _ => isalnum (chr n)) (isalnum (chr n)) + ("test chr " ^ (show n) ^ " : " ^ (show (chr n))) + else + <xml></xml> + in + return <xml> + <body> + { from_m_upto_n (fn n => test_chr n) minCh maxCh } + </body> + </xml> + end + +and ftIsspace (minCh : int) (maxCh : int) : transaction page = + let + fun test_chr (n : int) : xbody = + if iscodepoint n then + test_fn_cside_b (fn _ => isspace (chr n)) (isspace (chr n)) + ("test chr " ^ (show n) ^ " : " ^ (show (chr n))) + else + <xml></xml> + in + return <xml> + <body> + { from_m_upto_n (fn n => test_chr n) minCh maxCh } + </body> + </xml> + end + +and ftIsblank (minCh : int) (maxCh : int) : transaction page = + let + fun test_chr (n : int) : xbody = + if iscodepoint n then + test_fn_cside_b (fn _ => isblank (chr n)) (isblank (chr n)) + ("test chr " ^ (show n) ^ " : " ^ (show (chr n))) + else + <xml></xml> + in + return <xml> + <body> + { from_m_upto_n (fn n => test_chr n) minCh maxCh } + </body> + </xml> + end + +and ftIsprint (minCh : int) (maxCh : int) : transaction page = + let + fun test_chr (n : int) : xbody = + if iscodepoint n then + test_fn_cside_b (fn _ => isprint (chr n)) (isprint (chr n)) + ("test chr " ^ (show n) ^ " : " ^ (show (chr n))) + else + <xml></xml> + in + return <xml> + <body> + { from_m_upto_n (fn n => test_chr n) minCh maxCh } + </body> + </xml> + end + +and ftIsxdigit (minCh : int) (maxCh : int) : transaction page = + let + fun test_chr (n : int) : xbody = + if iscodepoint n then + test_fn_cside_b (fn _ => isxdigit (chr n)) (isxdigit (chr n)) + ("test chr " ^ (show n) ^ " : " ^ (show (chr n))) + else + <xml></xml> + in + return <xml> + <body> + { from_m_upto_n (fn n => test_chr n) minCh maxCh } + </body> + </xml> + end + +and ftIsupper (minCh : int) (maxCh : int) : transaction page = + let + fun test_chr (n : int) : xbody = + if iscodepoint n then + test_fn_cside_b (fn _ => isupper (chr n)) (isupper (chr n)) + ("test chr " ^ (show n) ^ " : " ^ (show (chr n))) + else + <xml></xml> + in + return <xml> + <body> + { from_m_upto_n (fn n => test_chr n) minCh maxCh } + </body> + </xml> + end + +and ftIslower (minCh : int) (maxCh : int) : transaction page = + let + fun test_chr (n : int) : xbody = + if iscodepoint n then + test_fn_cside_b (fn _ => islower (chr n)) (islower (chr n)) + ("test chr " ^ (show n) ^ " : " ^ (show (chr n))) + else + <xml></xml> + in + return <xml> + <body> + { from_m_upto_n (fn n => test_chr n) minCh maxCh } + </body> + </xml> + end + +fun index () : transaction page = + return <xml> + <body> + <a link={substrings ()}>substrings</a> + <a link={strlens ()}>strlens</a> + <a link={strlenGens ()}>strlenGens</a> + <a link={strcats ()}>strcats</a> + <a link={strsubs ()}>strsubs</a> + <a link={strsuffixs ()}>strsuffixs</a> + <a link={strchrs ()}>strchrs</a> + <a link={strindexs ()}>strindexs</a> + <a link={strsindexs ()}>strsindexs</a> + <a link={strcspns ()}>strcspns</a> + <a link={str1s ()}>str1s</a> + <a link={isalnums ()}>isalnums</a> + <a link={isalphas ()}>isalphas</a> + <a link={isblanks ()}>isblanks</a> + <a link={iscntrls ()}>iscntrls</a> + <a link={isdigits ()}>isdigits</a> + <a link={isgraphs ()}>isgraphs</a> + <a link={islowers ()}>islowers</a> + <a link={isprints ()}>isprints</a> + <a link={ispuncts ()}>ispuncts</a> + <a link={isspaces ()}>isspaces</a> + <a link={isuppers ()}>isuppers</a> + <a link={isxdigits ()}>isxdigits</a> + <a link={tolowers ()}>tolowers</a> + <a link={touppers ()}>touppers</a> + <a link={ord_and_chrs ()}>ord_and_chrs</a> + <a link={test_ords ()}>test ord</a> + <a link={highencode ()}>highencode</a> + <a link={test_db ()}>test_db</a> + <a link={test_post ()}>test_post</a> + </body> + </xml> diff --git a/tests/utf8.urp b/tests/utf8.urp new file mode 100644 index 00000000..74fcb1c2 --- /dev/null +++ b/tests/utf8.urp @@ -0,0 +1,7 @@ +database dbname=utf8 +sql utf8.sql +safeGet Utf8/test_db +serverOnly Utf8.generateTests + +$/option +utf8
\ No newline at end of file diff --git a/tests/wildsig.ur b/tests/wildsig.ur new file mode 100644 index 00000000..336772a7 --- /dev/null +++ b/tests/wildsig.ur @@ -0,0 +1,7 @@ +signature S = sig + val x : _ +end + +structure M : S = struct + val x = 7 +end |