Fix R6RS 'fixnum-width'.

[bpt/guile.git] / test-suite / tests / chars.test

diff --git a/test-suite/tests/chars.test b/test-suite/tests/chars.test
index 72805d1..98854f7 100644 (file)
--- 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 -*-
+;;;; chars.test --- Characters.       -*- coding: utf-8; mode: scheme; -*-
 ;;;; Greg J. Badros <gjb@cs.washington.edu>
 ;;;;
-;;;;   Copyright (C) 2000, 2006, 2009 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2000, 2006, 2009, 2010 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
@@ -45,18 +45,18 @@
     (pass-if "char=? #\\A #\\A"
       (char=? #\A #\A))
 
-    (expect-fail "char=? #\\A #\\a"
-      (char=? #\A #\a))
+    (pass-if "char=? #\\A #\\a"
+      (not (char=? #\A #\a)))
 
-    (expect-fail "char=? #\\A #\\B"
-      (char=? #\A #\B))
+    (pass-if "char=? #\\A #\\B"
+      (not (char=? #\A #\B)))
 
-    (expect-fail "char=? #\\B #\\A"
-      (char=? #\A #\B))
+    (pass-if "char=? #\\B #\\A"
+      (not (char=? #\A #\B)))
 
     ;; char<?
-    (expect-fail "char<? #\\A #\\A"
-      (char<? #\A #\A))
+    (pass-if "char<? #\\A #\\A"
+      (not (char<? #\A #\A)))
 
     (pass-if "char<? #\\A #\\a"
       (char<? #\A #\a))
@@ -64,8 +64,8 @@
     (pass-if "char<? #\\A #\\B"
       (char<? #\A #\B))
 
-    (expect-fail "char<? #\\B #\\A"
-      (char<? #\B #\A))
+    (pass-if "char<? #\\B #\\A"
+      (not (char<? #\B #\A)))
 
     ;; char<=?
     (pass-if "char<=? #\\A #\\A"
@@ -77,18 +77,18 @@
     (pass-if "char<=? #\\A #\\B"
       (char<=? #\A #\B))
 
-    (expect-fail "char<=? #\\B #\\A"
-      (char<=? #\B #\A))
+    (pass-if "char<=? #\\B #\\A"
+      (not (char<=? #\B #\A)))
 
     ;; char>?
-    (expect-fail "char>? #\\A #\\A"
-      (char>? #\A #\A))
+    (pass-if "char>? #\\A #\\A"
+      (not (char>? #\A #\A)))
 
-    (expect-fail "char>? #\\A #\\a"
-      (char>? #\A #\a))
+    (pass-if "char>? #\\A #\\a"
+      (not (char>? #\A #\a)))
 
-    (expect-fail "char>? #\\A #\\B"
-      (char>? #\A #\B))
+    (pass-if "char>? #\\A #\\B"
+      (not (char>? #\A #\B)))
 
     (pass-if "char>? #\\B #\\A"
       (char>? #\B #\A))
@@ -97,11 +97,11 @@
     (pass-if "char>=? #\\A #\\A"
       (char>=? #\A #\A))
 
-    (expect-fail "char>=? #\\A #\\a"
-      (char>=? #\A #\a))
+    (pass-if "char>=? #\\A #\\a"
+      (not (char>=? #\A #\a)))
 
-    (expect-fail "char>=? #\\A #\\B"
-      (char>=? #\A #\B))
+    (pass-if "char>=? #\\A #\\B"
+      (not (char>=? #\A #\B)))
 
     (pass-if "char>=? #\\B #\\A"
       (char>=? #\B #\A))
@@ -113,24 +113,24 @@
     (pass-if "char-ci=? #\\A #\\a"
       (char-ci=? #\A #\a))
 
-    (expect-fail "char-ci=? #\\A #\\B"
-      (char-ci=? #\A #\B))
+    (pass-if "char-ci=? #\\A #\\B"
+      (not (char-ci=? #\A #\B)))
 
-    (expect-fail "char-ci=? #\\B #\\A"
-      (char-ci=? #\A #\B))
+    (pass-if "char-ci=? #\\B #\\A"
+      (not (char-ci=? #\A #\B)))
 
     ;; char-ci<?
-    (expect-fail "char-ci<? #\\A #\\A"
-      (char-ci<? #\A #\A))
+    (pass-if "char-ci<? #\\A #\\A"
+      (not (char-ci<? #\A #\A)))
 
-    (expect-fail "char-ci<? #\\A #\\a"
-      (char-ci<? #\A #\a))
+    (pass-if "char-ci<? #\\A #\\a"
+      (not (char-ci<? #\A #\a)))
 
     (pass-if "char-ci<? #\\A #\\B"
       (char-ci<? #\A #\B))
 
-    (expect-fail "char-ci<? #\\B #\\A"
-      (char-ci<? #\B #\A))
+    (pass-if "char-ci<? #\\B #\\A"
+      (not (char-ci<? #\B #\A)))
 
     ;; char-ci<=?
     (pass-if "char-ci<=? #\\A #\\A"
@@ -142,18 +142,18 @@
     (pass-if "char-ci<=? #\\A #\\B"
       (char-ci<=? #\A #\B))
 
-    (expect-fail "char-ci<=? #\\B #\\A"
-      (char-ci<=? #\B #\A))
+    (pass-if "char-ci<=? #\\B #\\A"
+      (not (char-ci<=? #\B #\A)))
 
     ;; char-ci>?
-    (expect-fail "char-ci>? #\\A #\\A"
-      (char-ci>? #\A #\A))
+    (pass-if "char-ci>? #\\A #\\A"
+      (not (char-ci>? #\A #\A)))
 
-    (expect-fail "char-ci>? #\\A #\\a"
-      (char-ci>? #\A #\a))
+    (pass-if "char-ci>? #\\A #\\a"
+      (not (char-ci>? #\A #\a)))
 
-    (expect-fail "char-ci>? #\\A #\\B"
-      (char-ci>? #\A #\B))
+    (pass-if "char-ci>? #\\A #\\B"
+      (not (char-ci>? #\A #\B)))
 
     (pass-if "char-ci>? #\\B #\\A"
       (char-ci>? #\B #\A))
@@ -165,8 +165,8 @@
     (pass-if "char-ci>=? #\\A #\\a"
       (char-ci>=? #\A #\a))
 
-    (expect-fail "char-ci>=? #\\A #\\B"
-      (char-ci>=? #\A #\B))
+    (pass-if "char-ci>=? #\\A #\\B"
+      (not (char-ci>=? #\A #\B)))
 
     (pass-if "char-ci>=? #\\B #\\A"
       (char-ci>=? #\B #\A)))
@@ -210,7 +210,12 @@
        (not (char-is-both? #\newline))
        (char-is-both? #\a)
        (char-is-both? #\Z)
-       (not (char-is-both? #\1)))))
+       (not (char-is-both? #\1))))
+
+    (pass-if "char-general-category"
+      (and (eq? (char-general-category #\a) 'Ll)
+          (eq? (char-general-category #\A) 'Lu)
+          (eq? (char-general-category #\762) 'Lt))))
 
   (with-test-prefix "integer"
 
@@ -253,6 +258,24 @@
 
   (with-test-prefix "charnames"
 
+    (pass-if "R5RS character names"
+      (and (eqv? #\space (integer->char #x20))
+           (eqv? #\newline (integer->char #x0A))))
+
+    (pass-if "R6RS character names"
+      (and (eqv? #\nul (integer->char #x00))
+           (eqv? #\alarm (integer->char #x07))
+           (eqv? #\backspace (integer->char #x08))
+           (eqv? #\tab (integer->char #x09))
+           (eqv? #\linefeed (integer->char #x0A))
+           (eqv? #\newline (integer->char #x0A))
+           (eqv? #\vtab (integer->char #x0B))
+           (eqv? #\page (integer->char #x0C))
+           (eqv? #\return (integer->char #x0D))
+           (eqv? #\esc (integer->char #x1B))
+           (eqv? #\space (integer->char #x20))
+           (eqv? #\delete (integer->char #x7F))))
+
     (pass-if "R5RS character names are case insensitive"
       (and (eqv? #\space #\ )
            (eqv? #\SPACE #\ )
@@ -288,5 +311,18 @@
     (pass-if "C0 control character names are preferred write format"
       (string=?
        (with-output-to-string (lambda () (write #\soh)))
-       "#\\soh"))))
-
+       "#\\soh"))
+
+    (pass-if "combining accent is pretty-printed"
+      (let ((accent (integer->char #x030f))) ; COMBINING DOUBLE GRAVE ACCENT
+        (string=?
+         (with-fluids ((%default-port-encoding "UTF-8"))
+           (with-output-to-string (lambda () (write accent))))
+         "#\\◌̏")))
+
+    (pass-if "combining X is pretty-printed"
+      (let ((x (integer->char #x0353))) ; COMBINING X BELOW
+        (string=?
+         (with-fluids ((%default-port-encoding "UTF-8"))
+           (with-output-to-string (lambda () (write x))))
+         "#\\◌͓")))))