Implementation and test cases for the R6RS (rnrs unicode) library.

* module/Makefile.am: Add rnrs/6/unicode.scm to RNRS_SOURCES.
* module/rnrs/6/unicode.scm: New file.
* test-suite/Makefile.am: Add tests/r6rs-unicode.test to SCM_TESTS.
* test-suite/tests/r6rs-unicode.test

module/Makefile.am

@@ -263,6 +263,7 @@ RNRS_SOURCES =					\
   rnrs/6/hashtables.scm				\
   rnrs/6/lists.scm				\
   rnrs/6/syntax-case.scm			\
+  rnrs/6/unicode.scm				\
   rnrs/arithmetic/6/bitwise.scm			\
   rnrs/bytevector.scm				\
   rnrs/io/6/simple.scm				\

module/rnrs/6/unicode.scm

@@ -0,0 +1,104 @@
+;;; unicode.scm --- The R6RS Unicode library
+
+;;      Copyright (C) 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
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;; 
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;; 
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+
+(library (rnrs unicode (6))
+  (export char-upcase
+	  char-downcase
+	  char-titlecase
+	  char-foldcase
+	  
+	  char-ci=?
+	  char-ci<?
+	  char-ci>?
+	  char-ci<=?
+	  char-ci>=?
+	   
+	  char-alphabetic?
+	  char-numeric?
+	  char-whitespace?
+	  char-upper-case?
+	  char-lower-case?
+	  char-title-case?
+	  
+	  char-general-category
+	  
+	  string-upcase
+	  string-downcase
+	  string-titlecase
+	  string-foldcase
+	  
+	  string-ci=?
+	  string-ci<?
+	  string-ci>?
+	  string-ci<=?
+	  string-ci>=?
+	  
+	  string-normalize-nfd
+	  string-normalize-nfkd
+	  string-normalize-nfc
+	  string-normalize-nfkc)
+  (import (only (guile) char-upcase
+		        char-downcase
+			char-titlecase
+
+			char-ci=?
+			char-ci<?
+			char-ci>?
+			char-ci<=?
+			char-ci>=?
+
+			char-alphabetic?
+			char-numeric?
+			char-whitespace?
+			char-upper-case?
+			char-lower-case?
+
+			char-set-contains?
+			char-set:title-case
+
+			char-general-category
+
+			char-upcase
+			char-downcase
+			char-titlecase
+
+			string-upcase
+			string-downcase
+			string-titlecase
+	  
+			string-ci=?
+			string-ci<?
+			string-ci>?
+			string-ci<=?
+			string-ci>=?
+	  
+			string-normalize-nfd
+			string-normalize-nfkd
+			string-normalize-nfc
+			string-normalize-nfkc)
+	  (rnrs base (6)))
+
+  (define (char-foldcase char)
+    (if (or (eqv? char #\460) (eqv? char #\461))
+	char (char-downcase (char-upcase char))))
+
+  (define (char-title-case? char) (char-set-contains? char-set:title-case char))
+
+  (define (string-foldcase str) (string-downcase (string-upcase str)))
+)

test-suite/Makefile.am

@@ -83,6 +83,7 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/r6rs-records-inspection.test	\
 	    tests/r6rs-records-procedural.test	\
 	    tests/r6rs-records-syntactic.test	\
+	    tests/r6rs-unicode.test		\
 	    tests/rnrs-libraries.test		\
 	    tests/ramap.test			\
 	    tests/reader.test			\

test-suite/tests/r6rs-unicode.test

@@ -0,0 +1,50 @@
+;;; r6rs-unicode.test --- Test suite for R6RS (rnrs unicode)
+
+;;      Copyright (C) 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
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;; 
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;; 
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+
+(define-module (test-suite test-rnrs-unicode)
+  :use-module ((rnrs unicode) :version (6))
+  :use-module (test-suite lib))
+
+(with-test-prefix "char-foldcase"
+  (pass-if "basic case folding"
+    (and (eqv? (char-foldcase #\i) #\i)
+    	 (eqv? (char-foldcase #\337) #\337)
+	 (eqv? (char-foldcase #\1643) #\1703)
+	 (eqv? (char-foldcase #\1702) #\1703)))
+
+  (pass-if "Turkic characters"
+    (and (eqv? (char-foldcase #\460) #\460)
+    	 (eqv? (char-foldcase #\461) #\461))))
+
+(with-test-prefix "char-title-case?"
+  (pass-if "simple"
+    (and (not (char-title-case? #\I))
+	 (char-title-case? #\705))))
+
+(with-test-prefix "string-foldcase"
+  (pass-if "basic case folding"
+    (and (equal? (string-foldcase "Hi") "hi")
+	 (equal? (string-foldcase 
+		  (list->string '(#\1647 #\1621 #\1637 #\1643 #\1643)))
+		 (list->string '(#\1707 #\1661 #\1677 #\1703 #\1703)))))
+
+  (pass-if "case folding expands string"
+    (or (equal? (string-foldcase (list->string '(#\S #\t #\r #\a #\337 #\e)))
+		"strasse")
+	(throw 'unresolved))))