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 <julian.gra...@aya.yale.edu> 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
