Fix some bugs in regsexp.

diff --git a/src/runtime/regsexp.scm b/src/runtime/regsexp.scm
index 7c8c941fb2de05ec2d07a15b3d3f1fc0692ff954..e6896e4f79a4df6c844fa290163050cfdd5c54da 100644 (file)
--- a/src/runtime/regsexp.scm
+++ b/src/runtime/regsexp.scm
@@ -57,25 +57,19 @@ USA.
 
 (define (%compile-char-set items)
   (scalar-values->alphabet
-   (map (lambda (item)
-         (cond ((or (unicode-scalar-value? item)
-                    (and (pair? item)
-                         (pair? (cdr item))
-                         (null? (cddr item))
-                         (unicode-scalar-value? (car item))
-                         (unicode-scalar-value? (cadr item))
-                         (< (car item) (cadr item))))
-                (list item))
-               ((unicode-char? item)
-                (list (char->integer item)))
-               ((alphabet? item)
-                (alphabet->scalar-values item))
-               ((string? item)
-                (map char->integer (string->list item)))
-               (else
-                (error:wrong-type-argument item "char-set item"
-                                           'COMPILE-REGSEXP))))
-       items)))
+   (append-map (lambda (item)
+                (cond ((well-formed-scalar-value-range? item)
+                       (list item))
+                      ((unicode-char? item)
+                       (list (char->integer item)))
+                      ((alphabet? item)
+                       (alphabet->scalar-values item))
+                      ((string? item)
+                       (map char->integer (string->list item)))
+                      (else
+                       (error:wrong-type-argument item "char-set item"
+                                                  'COMPILE-REGSEXP))))
+              items)))
 
 (define (%compile-group-key key)
   (if (not (or (fix:fixnum? key)

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 774e9664edf7ecb226a0eeea64f2f4a4e63916e0..02c2b7f1e576ecc3b17672440b744ada3146b6a7 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4973,6 +4973,7 @@ USA.
          error:not-utf32-string
          error:not-utf8-string
          error:not-well-formed-scalar-value-list
+         error:not-well-formed-scalar-value-range
          error:not-wide-string
          for-all-chars-in-string?
          for-any-char-in-string?
@@ -4990,6 +4991,7 @@ USA.
          guarantee-utf32-string
          guarantee-utf8-string
          guarantee-well-formed-scalar-value-list
+         guarantee-well-formed-scalar-value-range
          guarantee-wide-string
          guarantee-wide-string-index
          guarantee-wide-substring
@@ -5054,6 +5056,7 @@ USA.
          utf8-string-valid?
          utf8-string?
          well-formed-scalar-value-list?
+         well-formed-scalar-value-range?
          wide-string
          wide-string->string
          wide-string-index?

diff --git a/src/runtime/unicode.scm b/src/runtime/unicode.scm
index 6764160a2b167a1033d435be9c0dbde5bdbe4367..fffd5adc50039b3b48f83073f2a458b7fd22beb0 100644 (file)
--- a/src/runtime/unicode.scm
+++ b/src/runtime/unicode.scm
@@ -244,9 +244,9 @@ Not used at the moment.
                       (else #t))))))))
 
 (define (well-formed-scalar-value-list? items)
-  (list-of-type? items well-formed-item?))
+  (list-of-type? items well-formed-scalar-value-range?))
 
-(define (well-formed-item? item)
+(define (well-formed-scalar-value-range? item)
   (if (pair? item)
       (and (unicode-scalar-value? (car item))
           (unicode-scalar-value? (cdr item))
@@ -254,6 +254,7 @@ Not used at the moment.
       (unicode-scalar-value? item)))
 
 (define-guarantee well-formed-scalar-value-list "a Unicode scalar-value list")
+(define-guarantee well-formed-scalar-value-range "a Unicode scalar-value range")
 \f
 (define (scalar-values->alphabet items)
   (guarantee-well-formed-scalar-value-list items 'SCALAR-VALUES->ALPHABET)