diff --git a/scsh/test/pattern-matching-test.scm b/scsh/test/pattern-matching-test.scm new file mode 100644 index 0000000..ef88777 --- /dev/null +++ b/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 \ No newline at end of file