More tests for chars.test

* test-suite/tests/chars.test: more tests

1 files changed, 224 insertions, 9 deletions

diff --git a/test-suite/tests/chars.test b/test-suite/tests/chars.test
index b52b384c5..a8aaa58b0 100644
--- a/test-suite/tests/chars.test
+++ b/test-suite/tests/chars.test
@@ -1,7 +1,7 @@
 ;;;; chars.test --- test suite for Guile's char functions    -*- scheme -*-
 ;;;; Greg J. Badros <gjb@cs.washington.edu>
 ;;;;
-;;;; 	Copyright (C) 2000, 2006 Free Software Foundation, Inc.
+;;;; 	Copyright (C) 2000, 2006, 2009 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -31,13 +31,228 @@
     ;; evaluator-internal instruction codes and characters.
     (pass-if-exception "evaluating chars"
       exception:wrong-type-to-apply
-      (eval '(#\0) (interaction-environment)))))
+      (eval '(#\0) (interaction-environment))))
 
-(pass-if "char-is-both? works"
-	 (and
-	  (not (char-is-both? #\?))
-	  (not (char-is-both? #\newline))
-	  (char-is-both? #\a)
-	  (char-is-both? #\Z)
-	  (not (char-is-both? #\1))))
+  (with-test-prefix "comparisons"
 
+    ;; char=?
+    (pass-if "char=? #\\A #\\A"
+      (char=? #\A #\A))
+
+    (expect-fail "char=? #\\A #\\a"
+      (char=? #\A #\a))
+
+    (expect-fail "char=? #\\A #\\B"
+      (char=? #\A #\B))
+
+    (expect-fail "char=? #\\B #\\A"
+      (char=? #\A #\B))
+
+    ;; char<?
+    (expect-fail "char<? #\\A #\\A"
+      (char<? #\A #\A))
+
+    (pass-if "char<? #\\A #\\a"
+      (char<? #\A #\a))
+
+    (pass-if "char<? #\\A #\\B"
+      (char<? #\A #\B))
+
+    (expect-fail "char<? #\\B #\\A"
+      (char<? #\B #\A))
+
+    ;; char<=?
+    (pass-if "char<=? #\\A #\\A"
+      (char<=? #\A #\A))
+
+    (pass-if "char<=? #\\A #\\a"
+      (char<=? #\A #\a))
+
+    (pass-if "char<=? #\\A #\\B"
+      (char<=? #\A #\B))
+
+    (expect-fail "char<=? #\\B #\\A"
+      (char<=? #\B #\A))
+
+    ;; char>?
+    (expect-fail "char>? #\\A #\\A"
+      (char>? #\A #\A))
+
+    (expect-fail "char>? #\\A #\\a"
+      (char>? #\A #\a))
+
+    (expect-fail "char>? #\\A #\\B"
+      (char>? #\A #\B))
+
+    (pass-if "char>? #\\B #\\A"
+      (char>? #\B #\A))
+
+    ;; char>=?
+    (pass-if "char>=? #\\A #\\A"
+      (char>=? #\A #\A))
+
+    (expect-fail "char>=? #\\A #\\a"
+      (char>=? #\A #\a))
+
+    (expect-fail "char>=? #\\A #\\B"
+      (char>=? #\A #\B))
+
+    (pass-if "char>=? #\\B #\\A"
+      (char>=? #\B #\A))
+
+    ;; char-ci=?
+    (pass-if "char-ci=? #\\A #\\A"
+      (char-ci=? #\A #\A))
+
+    (pass-if "char-ci=? #\\A #\\a"
+      (char-ci=? #\A #\a))
+
+    (expect-fail "char-ci=? #\\A #\\B"
+      (char-ci=? #\A #\B))
+
+    (expect-fail "char-ci=? #\\B #\\A"
+      (char-ci=? #\A #\B))
+
+    ;; char-ci<?
+    (expect-fail "char-ci<? #\\A #\\A"
+      (char-ci<? #\A #\A))
+
+    (expect-fail "char-ci<? #\\A #\\a"
+      (char-ci<? #\A #\a))
+
+    (pass-if "char-ci<? #\\A #\\B"
+      (char-ci<? #\A #\B))
+
+    (expect-fail "char-ci<? #\\B #\\A"
+      (char-ci<? #\B #\A))
+
+    ;; char-ci<=?
+    (pass-if "char-ci<=? #\\A #\\A"
+      (char-ci<=? #\A #\A))
+
+    (pass-if "char-ci<=? #\\A #\\a"
+      (char-ci<=? #\A #\a))
+
+    (pass-if "char-ci<=? #\\A #\\B"
+      (char-ci<=? #\A #\B))
+
+    (expect-fail "char-ci<=? #\\B #\\A"
+      (char-ci<=? #\B #\A))
+
+    ;; char-ci>?
+    (expect-fail "char-ci>? #\\A #\\A"
+      (char-ci>? #\A #\A))
+
+    (expect-fail "char-ci>? #\\A #\\a"
+      (char-ci>? #\A #\a))
+
+    (expect-fail "char-ci>? #\\A #\\B"
+      (char-ci>? #\A #\B))
+
+    (pass-if "char-ci>? #\\B #\\A"
+      (char-ci>? #\B #\A))
+
+    ;; char-ci>=?
+    (pass-if "char-ci>=? #\\A #\\A"
+      (char-ci>=? #\A #\A))
+
+    (pass-if "char-ci>=? #\\A #\\a"
+      (char-ci>=? #\A #\a))
+
+    (expect-fail "char-ci>=? #\\A #\\B"
+      (char-ci>=? #\A #\B))
+
+    (pass-if "char-ci>=? #\\B #\\A"
+      (char-ci>=? #\B #\A)))
+
+  (with-test-prefix "categories"
+
+    (pass-if "char-alphabetic?"
+      (and (char-alphabetic? #\a)
+           (char-alphabetic? #\A)
+           (not (char-alphabetic? #\1))
+           (not (char-alphabetic? #\+))))
+
+    (pass-if "char-numeric?"
+      (and (not (char-numeric? #\a))
+           (not (char-numeric? #\A))
+           (char-numeric? #\1)
+           (not (char-numeric? #\+))))
+
+    (pass-if "char-whitespace?"
+      (and (not (char-whitespace? #\a))
+           (not (char-whitespace? #\A))
+           (not (char-whitespace? #\1))
+           (char-whitespace? #\space)
+           (not (char-whitespace? #\+))))
+
+    (pass-if "char-upper-case?"
+      (and (not (char-upper-case? #\a))
+           (char-upper-case? #\A)
+           (not (char-upper-case? #\1))
+           (not (char-upper-case? #\+))))
+
+    (pass-if "char-lower-case?"
+      (and (char-lower-case? #\a)
+           (not (char-lower-case? #\A))
+           (not (char-lower-case? #\1))
+           (not (char-lower-case? #\+))))
+
+    (pass-if "char-is-both? works"
+      (and
+       (not (char-is-both? #\?))
+       (not (char-is-both? #\newline))
+       (char-is-both? #\a)
+       (char-is-both? #\Z)
+       (not (char-is-both? #\1)))))
+
+  (with-test-prefix "integer"
+
+    (pass-if "char->integer"
+      (eqv? (char->integer #\A) 65))
+
+    (pass-if "integer->char"
+      (eqv? (integer->char 65) #\A))
+
+    (pass-if-exception "integer->char out of range, -1" exception:out-of-range
+      (integer->char -1))
+
+    (pass-if-exception "integer->char out of range, surrrogate" exception:out-of-range
+      (integer->char #xd800))
+
+    (pass-if-exception "integer->char out of range, 0x110000" exception:out-of-range
+      (integer->char #x110000)))
+
+  (with-test-prefix "case"
+
+    (pass-if "char-upcase"
+      (eqv? (char-upcase #\a) #\A))
+
+    (pass-if "char-downcase"
+      (eqv? (char-downcase #\A) #\a)))
+
+  (with-test-prefix "charnames"
+
+    (pass-if "R5RS character names are case insensitive"
+      (and (eqv? #\space #\ )
+           (eqv? #\SPACE #\ )
+           (eqv? #\Space #\ )
+           (eqv? #\newline (integer->char 10))
+           (eqv? #\NEWLINE (integer->char 10))
+           (eqv? #\Newline (integer->char 10))))
+
+    (pass-if "C0 control names are case insensitive"
+      (and (eqv? #\nul #\000)
+           (eqv? #\soh #\001)
+           (eqv? #\stx #\002)
+           (eqv? #\NUL #\000)
+           (eqv? #\SOH #\001)
+           (eqv? #\STX #\002)
+           (eqv? #\Nul #\000)
+           (eqv? #\Soh #\001)
+           (eqv? #\Stx #\002)))
+
+   (pass-if "alt charnames are case insensitive"
+     (eqv? #\null #\nul)
+     (eqv? #\NULL #\nul)
+     (eqv? #\Null #\nul))))