~ chicken-core (chicken-5) d4f4019f8779b0cfa30513b3c0026831a66d688b

commit d4f4019f8779b0cfa30513b3c0026831a66d688b
Author:     Peter Bex <Peter.Bex@xs4all.nl>
AuthorDate: Fri Sep 24 22:46:35 2010 +0200
Commit:     Peter Bex <Peter.Bex@xs4all.nl>
CommitDate: Fri Sep 24 22:46:35 2010 +0200

    Apply upstream changeset f161a053a24e (Make case insensitivity work for enumerated charsets, and add case-insensitivity testcases for most charset types)

diff --git a/irregex-core.scm b/irregex-core.scm
index f09ab23c..ca4d327d 100644
--- a/irregex-core.scm
+++ b/irregex-core.scm
@@ -2458,7 +2458,10 @@
            ((pair? (car ls))
             (cond
              ((string? (caar ls))       ; Enumerated character set
-              (extend-state! (lp (cdr ls) n flags next) (string->cset (caar ls))))
+              (let ((set (if (flag-set? flags ~case-insensitive?)
+                             (cset-case-insensitive (string->cset (caar ls)))
+                             (string->cset (caar ls)))))
+               (extend-state! (lp (cdr ls) n flags next) set)))
              (else
               (case (caar ls)
                 ((seq :)
diff --git a/tests/test-irregex.scm b/tests/test-irregex.scm
index 8697a24f..d3c41b99 100644
--- a/tests/test-irregex.scm
+++ b/tests/test-irregex.scm
@@ -246,6 +246,30 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(test-group "Case sensitivity"
+  (test-assert
+   (not (irregex-match '(seq "abc") "ABC")))
+  (test-assert
+   (irregex-match (irregex '(seq "abc") 'case-insensitive) "ABC"))
+  (test-assert
+   (irregex-match '(w/nocase "abc") "ABC"))
+  (test-assert
+   (not (irregex-match '(w/nocase (w/case "abc")) "ABC")))
+  (test-assert
+   (irregex-match '(w/nocase (* ("abc"))) "ABC"))
+  (test-assert
+   (not (irregex-match '(w/nocase (w/case (* ("abc")))) "ABC")))
+  (test-assert
+   (irregex-match '(w/nocase (* (/ #\a #\c))) "ABC"))
+  (test-assert
+   (not (irregex-match '(w/nocase (w/case (/ #\a #\c))) "ABC")))
+  (test-assert
+   (not (irregex-match '(w/nocase (* (~ (/ #\a #\c)))) "abc")))
+  (test-assert
+   (not (irregex-match '(w/nocase (* (~ (/ #\a #\c)))) "ABC"))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (test-group "API"
   (test-assert (irregex? (irregex "a.*b")))
   (test-assert (irregex? (irregex '(: "a" (* any) "b"))))