127 lines
4.2 KiB
Scheme
127 lines
4.2 KiB
Scheme
|
;;; 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
|