[uim-commit] r369 - in trunk: scm test

[yamaken@freedesktop.org]

Author: yamaken
Date: 2005-01-27 17:43:05 -0800 (Thu, 27 Jan 2005)
New Revision: 369

Modified:
   trunk/scm/util.scm
   trunk/test/test-util.scm
Log:
* scm/util.scm
  - All changes are validated by test-util.scm
  - (char-printable?): Fix lacking non-ASCII character check
  - (string->letter): New procedure
* test/test-util.scm
  - (test char-control?, test char-upper-case?, test char-lower-case?,
    test char-alphabetic?, test char-numeric?, test char-printable?,
    test char-graphic?): Add non-ASCII character check
  - (test string->letter): New test


Modified: trunk/scm/util.scm
===================================================================
--- trunk/scm/util.scm	2005-01-27 23:54:56 UTC (rev 368)
+++ trunk/scm/util.scm	2005-01-28 01:43:05 UTC (rev 369)
@@ -62,7 +62,9 @@
 
 (define char-printable?
   (lambda (c)
-    (not (char-control? c))))
+    (and (integer? c)
+	 (<= c 127)
+	 (not (char-control? c)))))
 
 (define char-graphic?
   (lambda (c)
@@ -94,17 +96,22 @@
 (define usual-char? char-graphic?)
 (define to-lower-char char-downcase)
 
-;;
+(define string->letter
+  (lambda (str)
+    (let ((c (and (= (string-length str)
+		     1)
+		  (string->charcode str))))
+      (and (char-alphabetic? c)
+	   c))))
+
 (define string-list-concat
   (lambda (lst)
     (apply string-append (reverse lst))))
 
-;;
 (define string-find
   (lambda (lst str)
     (member str lst)))
 
-;;
 (define truncate-list
   (lambda (lst n)
     (if (or (< (length lst)

Modified: trunk/test/test-util.scm
===================================================================
--- trunk/test/test-util.scm	2005-01-27 23:54:56 UTC (rev 368)
+++ trunk/test/test-util.scm	2005-01-28 01:43:05 UTC (rev 369)
@@ -37,6 +37,10 @@
 
 (define-uim-test-case "testcase util character predicates"
   ("test char-control?"
+   (assert-false (uim-bool '(char-control? 'symbol)))
+   (assert-false (uim-bool '(char-control? "string")))
+   (assert-false (uim-bool '(char-control? '(0 1 2))))
+   (assert-false (uim-bool '(char-control? car)))
    (assert-true  (uim-bool '(char-control? 0)))    ; NUL
    (assert-true  (uim-bool '(char-control? 1)))    ; SOH
    (assert-true  (uim-bool '(char-control? 31)))   ; US
@@ -57,6 +61,10 @@
    (assert-false (uim-bool '(char-control? 126)))  ; ~
    (assert-true  (uim-bool '(char-control? 127)))) ; DEL
   ("test char-upper-case?"
+   (assert-false (uim-bool '(char-upper-case? 'symbol)))
+   (assert-false (uim-bool '(char-upper-case? "string")))
+   (assert-false (uim-bool '(char-upper-case? '(0 1 2))))
+   (assert-false (uim-bool '(char-upper-case? car)))
    (assert-false (uim-bool '(char-upper-case? 0)))    ; NUL
    (assert-false (uim-bool '(char-upper-case? 1)))    ; SOH
    (assert-false (uim-bool '(char-upper-case? 31)))   ; US
@@ -77,6 +85,10 @@
    (assert-false (uim-bool '(char-upper-case? 126)))  ; ~
    (assert-false (uim-bool '(char-upper-case? 127)))) ; DEL
   ("test char-lower-case?"
+   (assert-false (uim-bool '(char-lower-case? 'symbol)))
+   (assert-false (uim-bool '(char-lower-case? "string")))
+   (assert-false (uim-bool '(char-lower-case? '(0 1 2))))
+   (assert-false (uim-bool '(char-lower-case? car)))
    (assert-false (uim-bool '(char-lower-case? 0)))    ; NUL
    (assert-false (uim-bool '(char-lower-case? 1)))    ; SOH
    (assert-false (uim-bool '(char-lower-case? 31)))   ; US
@@ -97,6 +109,10 @@
    (assert-false (uim-bool '(char-lower-case? 126)))  ; ~
    (assert-false (uim-bool '(char-lower-case? 127)))) ; DEL
   ("test char-alphabetic?"
+   (assert-false (uim-bool '(char-alphabetic? 'symbol)))
+   (assert-false (uim-bool '(char-alphabetic? "string")))
+   (assert-false (uim-bool '(char-alphabetic? '(0 1 2))))
+   (assert-false (uim-bool '(char-alphabetic? car)))
    (assert-false (uim-bool '(char-alphabetic? 0)))    ; NUL
    (assert-false (uim-bool '(char-alphabetic? 1)))    ; SOH
    (assert-false (uim-bool '(char-alphabetic? 31)))   ; US
@@ -117,6 +133,10 @@
    (assert-false (uim-bool '(char-alphabetic? 126)))  ; ~
    (assert-false (uim-bool '(char-alphabetic? 127)))) ; DEL
   ("test char-numeric?"
+   (assert-false (uim-bool '(char-numeric? 'symbol)))
+   (assert-false (uim-bool '(char-numeric? "string")))
+   (assert-false (uim-bool '(char-numeric? '(0 1 2))))
+   (assert-false (uim-bool '(char-numeric? car)))
    (assert-false (uim-bool '(char-numeric? 0)))     ; NUL
    (assert-false (uim-bool '(char-numeric? 1)))     ; SOH
    (assert-false (uim-bool '(char-numeric? 31)))    ; US
@@ -137,6 +157,10 @@
    (assert-false (uim-bool '(char-numeric? 126)))   ; ~
    (assert-false (uim-bool '(char-numeric? 127)))) ; DEL
   ("test char-printable?"
+   (assert-false (uim-bool '(char-printable? 'symbol)))
+   (assert-false (uim-bool '(char-printable? "string")))
+   (assert-false (uim-bool '(char-printable? '(0 1 2))))
+   (assert-false (uim-bool '(char-printable? car)))
    (assert-false (uim-bool '(char-printable? 0)))    ; NUL
    (assert-false (uim-bool '(char-printable? 1)))    ; SOH
    (assert-false (uim-bool '(char-printable? 31)))   ; US
@@ -157,6 +181,10 @@
    (assert-true  (uim-bool '(char-printable? 126)))  ; ~
    (assert-false (uim-bool '(char-printable? 127)))) ; DEL
   ("test char-graphic?"
+   (assert-false (uim-bool '(char-graphic? 'symbol)))
+   (assert-false (uim-bool '(char-graphic? "string")))
+   (assert-false (uim-bool '(char-graphic? '(0 1 2))))
+   (assert-false (uim-bool '(char-graphic? car)))
    (assert-false (uim-bool '(char-graphic? 0)))    ; NUL
    (assert-false (uim-bool '(char-graphic? 1)))    ; SOH
    (assert-false (uim-bool '(char-graphic? 31)))   ; US
@@ -254,6 +282,30 @@
    (assert-equal 123 (uim '(char-upcase 123)))   ; {
    (assert-equal 126 (uim '(char-upcase 126)))   ; ~
    (assert-equal 127 (uim '(char-upcase 127))))  ; DEL
+  ("test string->letter"
+   (assert-false (uim-bool '(string->letter "")))    ; NUL
+   (assert-false (uim-bool '(string->letter "
")))  ; SOH
+   (assert-false (uim-bool '(string->letter "")))  ; US
+   (assert-false (uim-bool '(string->letter " ")))   ; SPACE
+   (assert-false (uim-bool '(string->letter "!")))   ; !
+   (assert-false (uim-bool '(string->letter "/")))   ; /
+   (assert-false (uim-bool '(string->letter "0")))   ; 0
+   (assert-false (uim-bool '(string->letter "9")))   ; 9
+   (assert-false (uim-bool '(string->letter ":")))   ; :
+   (assert-false (uim-bool '(string->letter "@")))   ; @
+   (assert-false (uim-bool '(string->letter "AA")))  ; AA
+   (assert-equal 65   (uim '(string->letter "A")))   ; A
+   (assert-equal 90   (uim '(string->letter "Z")))   ; Z
+   (assert-false (uim-bool '(string->letter "ZZ")))  ; ZZ
+   (assert-false (uim-bool '(string->letter "[")))   ; [
+   (assert-false (uim-bool '(string->letter "`")))   ; `
+   (assert-false (uim-bool '(string->letter "aa")))  ; aa
+   (assert-equal 97   (uim '(string->letter "a")))   ; a
+   (assert-equal 122  (uim '(string->letter "z")))   ; z
+   (assert-false (uim-bool '(string->letter "zz")))  ; zz
+   (assert-false (uim-bool '(string->letter "{")))   ; {
+   (assert-false (uim-bool '(string->letter "~")))   ; ~
+   (assert-false (uim-bool '(string->letter "")))) ; DEL
   ("test to-lower-char"
    (assert-true  (uim-bool '(eq? to-lower-char char-downcase)))))