Log Message:

first commit

scsh/test/pattern-matching-test.scm

@@ -0,0 +1,127 @@
+;;; Test for the function in section 6 of the scsh-manual "Pattern-matching strings with regular expressions"
+;;; Author: Christoph Hetz
+
+;; for  testing: (certainly the path will be an other on other systems...)
+
+;; ,open define-record-types handle
+;; ,config ,load C:/cygwin/home/mephisto/cvs-scsh/scsh/scsh/test/test-packages.scm
+;; ,load C:/cygwin/home/mephisto/cvs-scsh/scsh/scsh/test/test-base.scm
+;; load this file
+;; (test-all)
+
+;; *** basic help-functions ***
+
+(define eq-match?
+  (lambda (m1 m2)
+    (and (= (match:start m1)
+	    (match:start m2))
+	 (= (match:end m1)
+	    (match:end m2))
+	 (equal? (match:substring m1)
+		 (match:substring m2)))))
+
+;; *** tests ***
+
+(define test-string "Dieser Test-String wurde am 29.07.2004 um 5:23PM erstellt.\na aa aaa aaaa\nab aabb aaabbb\naba abba abbba\n1 12 123 1234\nyyyyyyyyyy\n")
+(define nul-string (list->string (list (ascii->char 0) (ascii->char 0))))
+(define newln-string "\n\n")
+
+(add-test! 'no-match-test 'pattern-matching
+	   (lambda ()
+	     (not (string-match (rx "xxx") test-string))))
+
+(add-test! 'simple-string-match 'pattern-matching
+	   (lambda ()
+	     (eq-match? (string-match (rx (- alpha ("aeiouAEIOU"))) test-string)
+			(string-match (rx (- (/"azAZ") ("aeiouAEIOU"))) test-string))))
+
+(add-test! 'simple-string-regexp 'pattern-matching
+	   (lambda ()
+	     (and (equal? "erstellt."
+			  (match:substring (string-match (rx "erstellt.") test-string)))
+		  (not (string-match (rx "Erstellt.") test-string)))))
+
+(add-test! 'simple-character-set 'pattern-matching
+	   (lambda ()
+	     (eq-match? (string-match (rx ("abcde")) test-string)
+			(string-match (rx ("edcba")) test-string))))
+
+(add-test! 'null-match-by-any 'pattern-matching
+	   (lambda ()
+	     (string-match (rx any) nul-string)))
+
+(add-test! 'newline-match-by-any 'pattern-matching
+	   (lambda ()
+	     (string-match (rx any) newln-string)))
+
+(add-test! 'sequences-test 'pattern-matching
+	   (lambda ()
+	     (equal? "1234"
+		     (match:substring (string-match (rx (: "1" any any "4")) test-string)))))
+
+(add-test! 'choices 'pattern-matching
+	   (lambda ()
+	     (let ((m1 (string-match (rx (| "erstellt." "xxx")) test-string))
+		   (m2 (string-match (rx (| "xxx" "erstellt.")) test-string)))
+	       (and m1
+		    m2
+		    (eq-match? m1 m2)))))
+
+
+(add-test! '*-test 'pattern-matching
+	   (lambda ()
+	     (and (equal? ""
+			  (match:substring (string-match (rx (* "y")) test-string)))
+		  (equal? "D"
+			  (match:substring (string-match (rx (* "D")) test-string))))))
+
+(add-test! '+-test 'pattern-matching
+	   (lambda ()
+	     (and (equal? "yyyyyyyyyy"
+			  (match:substring (string-match (rx (+ "y")) test-string)))
+		  (equal? "D"
+			  (match:substring (string-match (rx (+ "D")) test-string))))))
+
+(add-test! '?-test 'pattern-matching
+	   (lambda ()
+	     (and (equal? ""
+			  (match:substring (string-match (rx (? "y")) test-string)))
+		  (equal? "D"
+			  (match:substring (string-match (rx (? "D")) test-string))))))
+
+(add-test! '=-from-test 'pattern-matching
+	   (lambda ()
+	     (and (equal? "yyyyy"
+			  (match:substring (string-match (rx (= 5 "y")) test-string)))
+		  (not (string-match (rx (= 11 "y")) test-string)))))
+
+(add-test! '>=-from-test 'pattern-matching
+	   (lambda ()
+	     (and (equal? "yyyyyyyyyy"
+			  (match:substring (string-match (rx (>= 5 "y")) test-string)))
+		  (equal? "yyyyyyyyyy"
+			  (match:substring (string-match (rx (>= 10 "y")) test-string)))
+		  (not (string-match (rx (>= 11 "y")) test-string)))))
+
+(add-test! '**from-to-test 'pattern-matching
+	   (lambda ()
+	     (and (equal? "yyyyyyyyyy"
+			  (match:substring (string-match (rx (** 1 30 "y")) test-string)))
+		  (equal? "yyyyy"
+			  (match:substring (string-match (rx (** 1 5 "y")) test-string)))
+		  (not (string-match (rx (** 11 12 "y")) test-string))
+		  (not (string-match (rx (** 12 11 any)) test-string))
+		  (equal? "" 
+			  (match:substring (string-match (rx (** 0 0 any)) test-string))))))
+
+(add-test! 'single-characters-test 'pattern-matching
+	   (lambda ()
+	     (and (eq-match? (string-match (rx ("abcd")) test-string)
+			     (string-match (rx (| #\a #\b #\c #\d)) test-string))
+		  (eq-match? (string-match (rx ("xy")) test-string)
+			     (string-match (rx (| #\x #\y)) test-string)))))
+
+;(add-test! 'range-test 'pattern-matching
+;	   (lambda ()
+;	     (and (equal? "D"
+;			  (match-substring