summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib/js/urweb.js5
-rw-r--r--lib/ur/basis.urs1
-rw-r--r--src/c/urweb.c5
-rw-r--r--tests/utf8.py79
-rw-r--r--tests/utf8.ur217
5 files changed, 292 insertions, 15 deletions
diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index 00637172..2d39bc69 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -2122,9 +2122,7 @@ function isBlank(c) {
}
function isSpace(c) {
var cp = ord(c);
- if (cp == 10)
- return true;
- if (cp == 13)
+ if (cp >= 10 && cp <= 13)
return true;
if (cp == 133)
return true;
@@ -2790,6 +2788,7 @@ function isPrint(c) {
function toLower(c) {
var cp = ord(c);
+
if (cp == 304)
return chr(105);
else if (cp >= 7312 && cp <= 7354)
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index c9d6556b..c893e65d 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -80,6 +80,7 @@ val ord : char -> int
val chr : int -> char
val iscodepoint : int -> bool
+val issingle : char -> bool
(** String operations *)
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 96e30cec..78946872 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -4496,6 +4496,11 @@ uw_Basis_bool uw_Basis_iscodepoint (uw_context ctx, uw_Basis_int n) {
return !!(n <= 0x10FFFF);
}
+uw_Basis_bool uw_Basis_issingle (uw_context ctx, uw_Basis_char c) {
+ (void)ctx;
+ return !!(c < 128);
+}
+
uw_Basis_char uw_Basis_chr(uw_context ctx, uw_Basis_int n) {
(void)ctx;
uw_Basis_char ch = (uw_Basis_char)n;
diff --git a/tests/utf8.py b/tests/utf8.py
index 440bc82a..ac8df5c3 100644
--- a/tests/utf8.py
+++ b/tests/utf8.py
@@ -2,51 +2,51 @@ import unittest
import base
class Suite(base.Base):
- def test_1(self):
+ def test_99(self):
"""Test case: substring (1)"""
self.start('Utf8/substrings')
- def test_2(self):
+ def test_98(self):
"""Test case: strlen (2)"""
self.start('Utf8/strlens')
- def test_3(self):
+ def test_97(self):
"""Test case: strlenGe (3)"""
self.start('Utf8/strlenGens')
- def test_4(self):
+ def test_96(self):
"""Test case: strcat (4)"""
self.start('Utf8/strcats')
- def test_5(self):
+ def test_95(self):
"""Test case: strsub (5)"""
self.start('Utf8/strsubs')
- def test_6(self):
+ def test_94(self):
"""Test case: strsuffix (6)"""
self.start('Utf8/strsuffixs')
- def test_7(self):
+ def test_93(self):
"""Test case: strchr (7)"""
self.start('Utf8/strchrs')
- def test_8(self):
+ def test_92(self):
"""Test case: strindex (8)"""
self.start('Utf8/strindexs')
- def test_9(self):
+ def test_91(self):
"""Test case: strindex (9)"""
self.start('Utf8/strsindexs')
- def test_10(self):
+ def test_90(self):
"""Test case: strcspn (10)"""
self.start('Utf8/strcspns')
- def test_11(self):
+ def test_89(self):
"""Test case: str1 (11)"""
self.start('Utf8/str1s')
- def test_12(self):
+ def test_88(self):
"""Test case: isalnum (12)"""
self.start('Utf8/isalnums')
@@ -105,3 +105,58 @@ class Suite(base.Base):
def test_26 (self):
"""Test case: test_db (26) """
self.start('Utf8/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_1 (self):
+ """Test case: ftTolower """
+ self.full_test("ftTolower")
+
+ def test_2 (self):
+ """Test case: ftToupper """
+ self.full_test("ftToupper")
+
+ def test_3 (self):
+ """Test case: ftIsalpha """
+ self.full_test("ftIsalpha")
+
+ def test_4 (self):
+ """Test case: ftIsdigit """
+ self.full_test("ftIsdigit")
+
+ def test_5 (self):
+ """Test case: ftIsalnum """
+ self.full_test("ftIsalnum")
+
+ def test_6 (self):
+ """Test case: ftIsspace """
+ self.full_test("ftIsspace")
+
+ def test_7 (self):
+ """Test case: ftIsblank """
+ self.full_test("ftIsblank")
+
+ def test_8 (self):
+ """Test case: ftIsprint """
+ self.full_test("ftIsprint")
+
+ def test_9 (self):
+ """Test case: ftIsxdigit """
+ self.full_test("ftIsxdigit")
+
+ def test_10 (self):
+ """Test case: ftIsupper """
+ self.full_test("ftIsupper")
+
+ def test_11 (self):
+ """Test case: ftIslower """
+ self.full_test("ftIslower")
diff --git a/tests/utf8.ur b/tests/utf8.ur
index c7aefd79..777bb141 100644
--- a/tests/utf8.ur
+++ b/tests/utf8.ur
@@ -1,4 +1,13 @@
+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 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>
@@ -31,6 +40,38 @@ fun test_fn_cside [a ::: Type] (_ : eq a) (_ : show a) (f : unit -> a) (expected
</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 highencode () : transaction page =
return <xml>
<body>
@@ -553,6 +594,182 @@ fun test_db () : transaction page =
</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>
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-01 20:12:16 +0000