guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, master, updated. release_1-9-2-130-g18


From: Michael Gran
Subject: [Guile-commits] GNU Guile branch, master, updated. release_1-9-2-130-g1893df4
Date: Sat, 29 Aug 2009 07:04:17 +0000

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=1893df4145d045c51ec8748dac1e7f56c533f613

The branch, master has been updated
       via  1893df4145d045c51ec8748dac1e7f56c533f613 (commit)
       via  24d23822ee9d6a515aed8baaeff9d363fd7ec813 (commit)
       via  526ee76ac36921570708a746e73bba1cd7da2f62 (commit)
      from  6d736fdba2135de42e742924eac32e1c6bd9b79a (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 1893df4145d045c51ec8748dac1e7f56c533f613
Author: Michael Gran <address@hidden>
Date:   Fri Aug 28 23:48:36 2009 -0700

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

commit 24d23822ee9d6a515aed8baaeff9d363fd7ec813
Author: Michael Gran <address@hidden>
Date:   Fri Aug 28 23:47:42 2009 -0700

    Surrogate characters shouldn't be in charsets
    
    * libguile/srfi-14.c (charsets_complement): use surrogate #defines instead
      of hardcoded numbers
    
    * libguile/srfi-14.i.c (cs_full_ranges): remove surrogates from full
      charset
    
    * libguile/unidata_to_charset.pl (full): test for surrogates

commit 526ee76ac36921570708a746e73bba1cd7da2f62
Author: Michael Gran <address@hidden>
Date:   Fri Aug 28 23:44:41 2009 -0700

    Better range check for codepoints
    
    * libguile/chars.h (SCM_IS_UNICODE_CHAR): check for negative codepoints

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

Summary of changes:
 libguile/chars.h               |    8 +-
 libguile/srfi-14.c             |    5 +-
 libguile/srfi-14.i.c           |    5 +-
 libguile/unidata_to_charset.pl |   10 ++-
 test-suite/tests/chars.test    |  233 ++++++++++++++++++++++++++++++++++++++--
 5 files changed, 243 insertions(+), 18 deletions(-)

diff --git a/libguile/chars.h b/libguile/chars.h
index 85b1673..69ef8d0 100644
--- a/libguile/chars.h
+++ b/libguile/chars.h
@@ -48,9 +48,13 @@ typedef scm_t_int32 scm_t_wchar;
    : SCM_MAKE_ITAG8 ((scm_t_bits) (x), scm_tc8_char))
 
 #define SCM_CODEPOINT_MAX (0x10ffff)
+#define SCM_CODEPOINT_SURROGATE_START (0xd800)
+#define SCM_CODEPOINT_SURROGATE_END (0xdfff)
 #define SCM_IS_UNICODE_CHAR(c)                                          \
-  ((scm_t_wchar) (c) <= 0xd7ff                                          \
-   || ((scm_t_wchar) (c) >= 0xe000 && (scm_t_wchar) (c) <= SCM_CODEPOINT_MAX))
+  (((scm_t_wchar) (c) >= 0                                              \
+    && (scm_t_wchar) (c) < SCM_CODEPOINT_SURROGATE_START)               \
+   || ((scm_t_wchar) (c) > SCM_CODEPOINT_SURROGATE_END                  \
+       && (scm_t_wchar) (c) <= SCM_CODEPOINT_MAX))
 
 
 
diff --git a/libguile/srfi-14.c b/libguile/srfi-14.c
index 7ab65ac..50229ef 100644
--- a/libguile/srfi-14.c
+++ b/libguile/srfi-14.c
@@ -29,6 +29,7 @@
 #include "libguile.h"
 #include "libguile/srfi-14.h"
 #include "libguile/strings.h"
+#include "libguile/chars.h"
 
 /* Include the pre-computed standard charset data.  */
 #include "libguile/srfi-14.i.c"
@@ -386,8 +387,8 @@ charsets_complement (scm_t_char_set *p, scm_t_char_set *q)
       p->ranges = scm_gc_malloc (sizeof (scm_t_char_range) * 2,
                                  "character-set");
       p->ranges[0].lo = 0;
-      p->ranges[0].hi = 0xd7ff;
-      p->ranges[1].lo = 0xe000;
+      p->ranges[0].hi = SCM_CODEPOINT_SURROGATE_START - 1;
+      p->ranges[1].lo = SCM_CODEPOINT_SURROGATE_END + 1;
       p->ranges[1].hi = SCM_CODEPOINT_MAX;
       return;
     }
diff --git a/libguile/srfi-14.i.c b/libguile/srfi-14.i.c
index 5ef21f3..d92b4d7 100644
--- a/libguile/srfi-14.i.c
+++ b/libguile/srfi-14.i.c
@@ -2,7 +2,8 @@
 
 /* This file is #include'd by srfi-14.c.  */
 
-/* This file was generated from 
http://unicode.org/Public/UNIDATA/UnicodeData.txt
+/* This file was generated from
+   http://unicode.org/Public/UNIDATA/UnicodeData.txt
    with the unidata_to_charset.pl script.  */
 
 scm_t_char_range cs_lower_case_ranges[] = {
@@ -6925,7 +6926,7 @@ scm_t_char_range cs_full_ranges[] = {
   ,
   {0xac00, 0xd7a3}
   ,
-  {0xd800, 0xfa2d}
+  {0xe000, 0xfa2d}
   ,
   {0xfa30, 0xfa6a}
   ,
diff --git a/libguile/unidata_to_charset.pl b/libguile/unidata_to_charset.pl
index 6871e67..61c8d10 100755
--- a/libguile/unidata_to_charset.pl
+++ b/libguile/unidata_to_charset.pl
@@ -254,10 +254,14 @@ sub empty {
     return 0;
 }
 
-# Full -- All characters.  
+# Full -- All characters except for the surrogates
 sub full {
     my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
-    return 1;
+    if ($category =~ (/Cs/)) {
+        return 0;
+    } else {
+        return 1;
+    }
 }
 
 
@@ -362,7 +366,7 @@ sub compute {
 # Write a bit of a header
 print $out "/* srfi-14.i.c -- standard SRFI-14 character set data */\n\n";
 print $out "/* This file is #include'd by srfi-14.c.  */\n\n";
-print $out "/* This file was generated from\n"
+print $out "/* This file was generated from\n";
 print $out "   http://unicode.org/Public/UNIDATA/UnicodeData.txt\n";;
 print $out "   with the unidata_to_charset.pl script.  */\n\n";
 
diff --git a/test-suite/tests/chars.test b/test-suite/tests/chars.test
index b52b384..a8aaa58 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 <address@hidden>
 ;;;;
-;;;;   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))))


hooks/post-receive
-- 
GNU Guile




reply via email to

[Prev in Thread] Current Thread [Next in Thread]