rx bug fix related to ranges that include 255

svn: r4381

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)

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")

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"))

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
 

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;