From e452bb052b6c1afbaaa72efb653ea31561333866 Mon Sep 17 00:00:00 2001
From: fab <fabrice.leal.ch@gmail.com>
Date: Tue, 11 Dec 2018 22:16:37 +0000
Subject: exhaustive testing brought to selenium. bug fix in isspace. useful
 function to test if char is <128

---
 lib/js/urweb.js  |   5 +-
 lib/ur/basis.urs |   1 +
 src/c/urweb.c    |   5 ++
 tests/utf8.py    |  79 +++++++++++++++++---
 tests/utf8.ur    | 217 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 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>
-- 
cgit v1.2.3