scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Log Message: 

first commit
This commit is contained in:
chetz 2004-08-09 08:46:09 +00:00
parent e42ed5864e
commit 9174add359
1 changed files with 127 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

127
scsh/test/pattern-matching-test.scm Normal file
View File

@ -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