From 2ddb89e85bf16c39e9ee86bf9318afb4cc5cff6f Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 19 Sep 2006 05:32:17 +0000
Subject: [PATCH] rx bug fix related to ranges that include 255

svn: r4381
---
 .../benchmarks/shootout/cheapconcurrency.ss   |  3 +-
 collects/tests/mzscheme/mz.ss                 |  1 +
 collects/tests/mzscheme/rx.ss                 | 43 ++++++++++++++++++-
 collects/tests/mzscheme/stx.ss                | 10 +++++
 src/mzscheme/src/regexp.c                     |  8 +++-
 5 files changed, 60 insertions(+), 5 deletions(-)

diff --git a/collects/tests/mzscheme/benchmarks/shootout/cheapconcurrency.ss b/collects/tests/mzscheme/benchmarks/shootout/cheapconcurrency.ss
index ea035a9298..8bfc389cc7 100644
--- a/collects/tests/mzscheme/benchmarks/shootout/cheapconcurrency.ss
+++ b/collects/tests/mzscheme/benchmarks/shootout/cheapconcurrency.ss
@@ -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)
diff --git a/collects/tests/mzscheme/mz.ss b/collects/tests/mzscheme/mz.ss
index a85217e6a1..17ccaefced 100644
--- a/collects/tests/mzscheme/mz.ss
+++ b/collects/tests/mzscheme/mz.ss
@@ -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")
diff --git a/collects/tests/mzscheme/rx.ss b/collects/tests/mzscheme/rx.ss
index d651dc9d58..04ec908177 100644
--- a/collects/tests/mzscheme/rx.ss
+++ b/collects/tests/mzscheme/rx.ss
@@ -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"))
diff --git a/collects/tests/mzscheme/stx.ss b/collects/tests/mzscheme/stx.ss
index e08a4805ac..d746098d20 100644
--- a/collects/tests/mzscheme/stx.ss
+++ b/collects/tests/mzscheme/stx.ss
@@ -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
 
diff --git a/src/mzscheme/src/regexp.c b/src/mzscheme/src/regexp.c
index 9bc884fdae..333de81a49 100644
--- a/src/mzscheme/src/regexp.c
+++ b/src/mzscheme/src/regexp.c
@@ -1684,7 +1684,11 @@ regranges(int parse_flags, int at_start)
       if (parse_flags & PARSE_PCRE) {
 	if ((c >= '0') && (c <= '9'))
 	  break;
-	regcharclass(regparsestr[regparse], new_map);
+	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;