rx bug fix related to ranges that include 255

svn: r4381
This commit is contained in:
Matthew Flatt 2006-09-19 05:32:17 +00:00
parent 20b636c0c8
commit 2ddb89e85b
5 changed files with 60 additions and 5 deletions

View File

@ -14,7 +14,8 @@
(let ([n (string->number
(vector-ref (current-command-line-arguments) 0))])
(let* ([start-ch (make-channel)]
[end-ch (generate start-ch 500)])
[end-ch (parameterize ([current-thread-initial-stack-size 3])
(generate start-ch 500))])
(let loop ([n n][total 0])
(if (zero? n)
(printf "~a\n" total)

View File

@ -3,6 +3,7 @@
(load-relative "basic.ss")
(load-relative "unicode.ss")
(load-relative "rx.ss")
(load-relative "read.ss")
(load-relative "macro.ss")
(load-relative "syntax.ss")

View File

@ -91,7 +91,46 @@
(test-regexp-x '(#"abc" #"c") #"(a|b|c)+" #"abc")
(test-regexp-x '(#"abc" #"c" #"c") #"(a|(b|c))+" #"abc")
(test-regexp-x '(#"abc" #"c" #"b") #"((a|b)|c)+" #"abc")
(test-regexp-x '(#"bc" #"c") #"(b|c)+" #"abc")
;; Make sure we hit all types of ranges, with and without regstart:
;; EXACT1:
(test-regexp-x '(#"a") #"a" #"a")
(test-regexp-x #f #"a" #"b")
(test-regexp '(#"aaa") #"a*" #"aaa")
(test-regexp-x '(#"") #"a*" #"bbb")
(test-regexp-x '(#"a") #"q?a" #"a")
(test-regexp-x #f #"q?a" #"b")
;; RANGE:
(test-regexp-x '(#"a") #"[a-b]" #"a")
(test-regexp-x '(#"b") #"[a-b]" #"b")
(test-regexp-x #f #"[a-b]" #"c")
(test-regexp '(#"aba") #"[a-b]*" #"abac")
(test-regexp-x '(#"") #"[a-b]*" #"cbbb")
(test-regexp-x '(#"a") #"q?[a-b]" #"a")
(test-regexp-x '(#"b") #"q?[a-b]" #"b")
(test-regexp-x #f #"q?[a-b]" #"c")
;; NOTRANGE:
(test-regexp '(#"a") #"[^c-d]" #"a")
(test-regexp '(#"b") #"[^c-d]" #"b")
(test-regexp #f #"[^c-d]" #"c")
(test-regexp '(#"aba") #"[^c-d]*" #"abac")
(test-regexp '(#"") #"[^c-d]*" #"cbbb")
(test-regexp '(#"a") #"q?[^c-d]" #"a")
(test-regexp '(#"b") #"q?[^c-d]" #"b")
(test-regexp #f #"q?[^c-d]" #"c")
;; ANYOF:
(test-regexp '(#"a") #"[ad]" #"a")
(test-regexp '(#"d") #"[ad]" #"d")
(test-regexp #f #"[ad]" #"c")
(test-regexp '(#"ada") #"[ad]*" #"adac")
(test-regexp '(#"") #"[ad]*" #"cddd")
(test-regexp '(#"a") #"q?[ad]" #"a")
(test-regexp '(#"d") #"q?[ad]" #"d")
(test-regexp #f #"q?[ad]" #"c")
(test '(#"a") regexp-match #rx#"^[^\0]" #"aaa\0")
(test #f regexp-match #rx#"^[^\0]" #"\0aaa\0")
(test '(#"aaa") regexp-match #rx#"^[^\0]*" #"aaa\0")
(map (lambda (t)
(err/rt-test (byte-pregexp t))
@ -339,7 +378,7 @@
(#"^[^]cde]" #"cthing" #f)
(#"^[^]cde]" #"dthing" #f)
(#"^[^]cde]" #"ething" #f)
(#"^\\\201" #"\201" #f)
(#"^\\\201" #"\201" (#"\201"))
(#"^\377" #"\377" (#"\377"))
(#"^[0-9]+$" #"0" (#"0"))
(#"^[0-9]+$" #"1" (#"1"))

View File

@ -193,6 +193,16 @@
(test #f syntax-original? s)
(test #t syntax-original? se)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; paren-shape:
(let ([s (with-syntax ([a (quote-syntax [x y])])
#'[a 10])])
(test #f syntax-property #'(x) 'paren-shape)
(test #\[ syntax-property #'[x] 'paren-shape)
(test #\[ syntax-property s 'paren-shape)
(test #\[ syntax-property (syntax-case s () [(b _) #'b]) 'paren-shape))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Two-step macro chain

View File

@ -1684,7 +1684,11 @@ regranges(int parse_flags, int at_start)
if (parse_flags & PARSE_PCRE) {
if ((c >= '0') && (c <= '9'))
break;
if (((c >= 'a') && (c <= 'z'))
|| ((c >= 'A') && (c <= 'Z')))
regcharclass(regparsestr[regparse], new_map);
else
new_map[c] = 1;
} else
new_map[c] = 1;
regparse++;
@ -1801,7 +1805,7 @@ regranges(int parse_flags, int at_start)
return ret;
} else if ((on_ranges == 1)
|| (off_ranges == 1)) {
int rs = 0, re = 0, on;
int rs = 255, re = 255, on;
if (on_ranges == 1)
on = 1;