new tests

scsh/test/pattern-matching-test.scm

@@ -532,12 +532,13 @@
 ;;         (arguments are: (:value :value :value))
 ;;
 ;;
-;(add-test! 'regexp->sre-test 'pattern-matching 
+(add-test! 'regexp->sre-test 'pattern-matching 
-;  (lambda ()
+  (lambda ()
-;    (equal? '(? "Pete" (+ "Sz") "ilagyi")
+    (let ((re (re-seq (list (re-string "Pete ")
-;	    (regexp->sre (re-repeat 0 1 (re-seq  (re-string "Pete ")
+			    (re-repeat 1 #f (re-string "Sz"))
-;						 (re-repeat 1 #f (re-string "Sz"))
+			    (re-string "ilagyi")))))
-;						 (re-string "ilagyi")))))))
+      (equal? '(? "Pete " (+ "Sz") "ilagyi")
+	      (regexp->sre (re-repeat 0 1 re))))))
 
 (add-test! 'char-classes+algebra-test 'pattern-matching
   (lambda ()
@@ -595,3 +596,121 @@
 		    (string-match (rx (* alphanumeric)) "xxxabcdexxx"))
 	 (eq-match? (string-match (rx (: "xxx" (: "abcde" "x" "xx"))) "xxxabcdexxx")
 		    (string-match (rx (* (| (/ "ae") "x"))) "xxxabcdexxx")))))
+
+(add-test! 'regexp-adt-re-seq-test 'pattern-matching
+  (lambda ()
+    (and (re-seq? (make-re-seq '("foo" "bar")))
+	 (re-seq? (re-seq '("foo" "bar")))
+	 (equal? '("foo" "bar")
+		 (re-seq:elts (make-re-seq '("foo" "bar"))))
+	 (= 2
+	    (re-seq:tsm (rx (: (submatch "foo")
+			       (submatch "bar"))))))))
+
+(add-test! 'regexp-adt-re-choice-test 'pattern-matching
+  (lambda ()
+    (and (re-choice? (make-re-choice '("foo" "bar")))
+	 (re-choice? (re-choice '("foo" "bar")))
+	 (equal? '("foo" "bar")
+		 (re-choice:elts (make-re-choice '("foo" "bar"))))
+	 (= 2
+	    (re-choice:tsm (rx (| (submatch "foo")
+			       (submatch "bar"))))))))
+
+(add-test! 'regexp-adt-re-repeat-test 'pattern-matching
+  (lambda ()
+    (and (re-repeat? (make-re-repeat 1 5 '("foo" "bar")))
+	 (= 1
+	    (re-repeat:from (make-re-repeat 1 5 '("foo" "bar"))))
+	 (= 5
+	    (re-repeat:to (make-re-repeat 1 5 '("foo" "bar"))))
+	 (= 2
+	    (re-repeat:tsm (rx (** 1 5 (submatch "foo")
+				   (submatch "bar"))))))))
+
+(add-test! 'regexp-adt-re-submatch-test 'pattern-matching
+  (lambda ()
+    (and (re-submatch? (make-re-submatch (rx "foo")))
+	 (= 1
+	    (re-submatch:pre-dsm (make-re-submatch (rx "foo") 1 0)))
+	 (= 0
+	    (re-submatch:post-dsm (make-re-submatch (rx "foo") 1 0)))
+	 (= 3
+	    (re-submatch:tsm (rx (submatch (submatch "foo")
+					   (submatch "bar"))))))))
+
+(add-test! 'regexp-adt-re-string-test 'pattern-matching
+  (lambda ()
+    (and (re-string? (make-re-string "abc"))
+	 (re-string? (re-string "abc"))
+	 (equal? "abc"
+		 (re-string:chars (rx "abc"))))))
+
+(add-test! 'regexp-adt-re-char-set-test 'pattern-matching
+  (lambda ()
+    (and (re-char-set? (make-re-char-set (list->char-set (list #\a #\b #\c))))
+	 (re-char-set? (re-char-set (list->char-set (list #\a #\b #\c))))
+	 (equal? '(#\a #\b #\c)
+		 (char-set->list (re-char-set:cset 
+				  (make-re-char-set (list->char-set (list #\a #\b #\c)))))))))
+
+(add-test! 'regexp-adt-re-dsm-test 'pattern-matching
+  (lambda ()
+    (and (re-dsm? (make-re-dsm (rx "foo") 1 0))
+;XXX	 (re-dsm? (re-dsm (rx "foo") 1 0))
+	 (re-string? (re-dsm:body (make-re-dsm (rx "foo") 1 0)))
+	 (= 1
+	    (re-dsm:pre-dsm (make-re-dsm (rx "foo") 1 0)))
+	 (= 0
+	    (re-dsm:post-dsm (make-re-dsm (rx "foo") 1 0)))
+	 (= 1
+	    (re-dsm:tsm (make-re-dsm (rx "foo") 1 0))))))
+
+(add-test! 'regexp-adt-re-const-test 'pattern-matching
+  (lambda ()
+    (and (regexp? re-bos)
+	 (regexp? re-eos)
+	 (regexp? re-bol)
+	 (regexp? re-eol)
+	 (re-bos? re-bos)
+	 (re-eos? re-eos)
+	 (re-bol? re-bol)
+	 (re-eol? re-eol))))
+
+(add-test! 'regexp-adt-re-const-2-test 'pattern-matching
+  (lambda ()
+    (and (regexp? re-trivial)
+	 (re-trivial? re-trivial)
+	 (regexp? re-empty)
+	 (re-empty? re-empty)
+	 (regexp? re-any)
+	 (re-any? re-any)
+	 (regexp? re-nonl)
+	 (= 3
+	    (re-tsm (rx (submatch (submatch "foo")
+					   (submatch "bar")))))
+;; XXX clean-up-cres
+	 (matches-same-signs? re-any (rx any))
+	 (matches-same-signs? re-nonl (rx (~ #\newline)))
+	 (matches-same-signs? re-empty (rx (|)))
+;; XXX error - but why?
+;;	 (matches-same-signs? re-trivial (rx ""))
+	 )))
+
+;(add-test! 'if-sre-form-test 'pattern-matching
+;  (lambda ()
+;    (let* ((sr '(: "a" "b")))
+;	   (rgxp (rx sr)))
+;      (and (regexp? (if-sre-form sr
+;				 (rx se)
+;				 sr))
+;	   (regexp? (if-sre-form rgxp
+;				 (rx rgxp)
+;				 rgxp))))))
+
+;(add-test! 'sre-form?-test 'pattern-matching
+;  (lambda ()
+;    (let* ((sr '(: "a" "b"))
+;	   (rgxp (rx sr)))
+;      (and (not (sre-form? rgxp))
+;	   (sre-form sr)))))