[Guile-commits] GNU Guile branch, wip-r6rs-libraries, updated. release_1-9-8-82-gdbf667f

[Julian Graham]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=dbf667f9777c1ac37e904e8192895f1a2b51dbfc

The branch, wip-r6rs-libraries has been updated
       via  dbf667f9777c1ac37e904e8192895f1a2b51dbfc (commit)
      from  72196ef70f6550bae305e98a348d06ad887eff6e (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit dbf667f9777c1ac37e904e8192895f1a2b51dbfc
Author: Julian Graham <address@hidden>
Date:   Sun Mar 21 16:19:06 2010 -0400

    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

-----------------------------------------------------------------------

Summary of changes:
 module/Makefile.am                 |    1 +
 module/rnrs/6/unicode.scm          |  104 ++++++++++++++++++++++++++++++++++++
 test-suite/Makefile.am             |    1 +
 test-suite/tests/r6rs-unicode.test |   50 +++++++++++++++++
 4 files changed, 156 insertions(+), 0 deletions(-)
 create mode 100644 module/rnrs/6/unicode.scm
 create mode 100644 test-suite/tests/r6rs-unicode.test

diff --git a/module/Makefile.am b/module/Makefile.am
index e5510a4..2ef342d 100644
--- a/module/Makefile.am
+++ b/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                         \
diff --git a/module/rnrs/6/unicode.scm b/module/rnrs/6/unicode.scm
new file mode 100644
index 0000000..09140b6
--- /dev/null
+++ b/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)))
+)
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 5c2619d..0ea70b3 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -77,6 +77,7 @@ SCM_TESTS = tests/alist.test                  \
            tests/r6rs-records-inspection.test  \
            tests/r6rs-records-procedural.test  \
            tests/r6rs-records-syntactic.test   \
+           tests/r6rs-unicode.test             \
            tests/ramap.test                    \
            tests/reader.test                   \
            tests/receive.test                  \
diff --git a/test-suite/tests/r6rs-unicode.test 
b/test-suite/tests/r6rs-unicode.test
new file mode 100644
index 0000000..d8a69a1
--- /dev/null
+++ b/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))))


hooks/post-receive
-- 
GNU Guile