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

most changes are cosmetical 

there are few new tests
This commit is contained in:
chetz 2004-10-03 11:35:21 +00:00
parent da3caf4f5b
commit fc88c1907a
7 changed files with 565 additions and 519 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
scsh/test/awk-test.scm
View File

@ -124,8 +124,10 @@
((? "s") (set! read (cons '?s read)))
((+ "+") (set! read (cons '++ read)))))
(make-string-input-port str))
;; |z6 |z5 |z4 |z3 |z2 |z1 |
(equal? (list '++ '?s '*3 '?s '*3 'eine 'sre-zu '?s '*3 'eine 'sre-zu '?s '*3 'EINE '?s '*3 'sre-zu '?s '*3 'sre-zu)
;; |z6 |z5 |z4
(equal? (list '++ '?s '*3 '?s '*3 'eine 'sre-zu '?s '*3 'eine 'sre-zu
;; |z3 |z2 |z1 |
'?s '*3 'EINE '?s '*3 'sre-zu '?s '*3 'sre-zu)
read))))
;; --- when-test ---
@ -150,7 +152,8 @@
(set! read (cons 'third-clause read)))))
(make-string-input-port str))
(equal? read
(list 'third-clause 'third-clause 'third-clause 'third-clause 'second-clause 'first-clause)))))
(list 'third-clause 'third-clause 'third-clause
'third-clause 'second-clause 'first-clause)))))
;; --- expr-test-test ---
@ -171,7 +174,8 @@
(set! line (cons 'second-clause read)))
((> counter 5)
(set! read (cons 'third-clause read)))
((+ "3") ;; makes problems here, but was ok in sre-xpr-test ;;FIXXX it
((+ "3")
;; ^^^^^ makes problems here, but was ok in sre-expr-test ;;FIXXX it
(set! read (cons 'fourth-clause read)))))
(make-string-input-port str))
(equal? read
@ -258,7 +262,8 @@
(set! read (cons 'third-clause read)))))
(make-string-input-port str))
(equal? read
(list 'second-clause 'second-clause 'third-clause 'second-clause 'third-clause 'first-clause 'first-clause)))))
(list 'second-clause 'second-clause 'third-clause 'second-clause
'third-clause 'first-clause 'first-clause)))))
;; --- range-wo-begin-w-end-test ---
;; XX to do: only ok <test>s ... s.u.
@ -286,7 +291,8 @@
(set! read (cons 'third-clause read)))))
(make-string-input-port str))
(equal? read
(list 'second-clause 'second-clause 'third-clause 'second-clause 'third-clause 'first-clause 'first-clause)))))
(list 'second-clause 'second-clause 'third-clause 'second-clause
'third-clause 'first-clause 'first-clause)))))
;; --- range-w-begin-w-end-test ---
;; XX to do: only ok <test>s ... s.u.

20
scsh/test/bug-report-tests.scm Normal file
View File

@ -0,0 +1,20 @@
;;; Test for the bug reports from user- and hacker-archives
;;; 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)
(add-test! '2002-05-86-regexp-weirdness 'archive-users
(lambda ()
(let ((x (rx "{ OK=#t }")))
(and (not (regexp-search? x "foo"))
(regexp-search? x "...{ OK=#t }...")))))
(add-test! '2003-12-74-select-ports-with-zero-timeout 'archive-users
(lambda ()
(select-ports 0 (current-input-port))))

2
scsh/test/file-name-manipulation-test.scm
View File

@ -174,8 +174,6 @@
(equal? "/usr/shivers/../test"
(simplify-file-name "////usr/shivers/../test/")))))
;; XX todo:
(add-test! 'resolve-file-name 'file-name-manipulation
(lambda ()
(and (equal? (resolve-file-name "~")

40
scsh/test/pattern-matching-test.scm
View File

@ -43,7 +43,8 @@
(string-append (list->string (list (ascii->char i)))
(loop (+ i 1))))))
(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 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")
;; *** tests ***
@ -103,18 +104,31 @@
;XXX something is wrong with this
;(add-test! 're-vs-@re-submatch-test 'pattern-matching
; (lambda ()
; (let* ((f (lambda ()
; (rx (submatch "sub-f1")
; (submatch "sub-f2"))))
; (re (rx (submatch (* "foo"))
; (submatch (? "bar"))
; ,(f)
; (submatch "baz")))
; (match1 (string-match ,re "foofoobarsub-f1sub-f2baz"))
; (match2 (string-match ,@re "foofoobarsub-f1sub-f2baz")))
; (and (...)))))
(add-test! 're-vs-@re-submatch-test 'pattern-matching
(lambda ()
(let* ((f (lambda ()
(rx (submatch "sub-f1")
(submatch "sub-f2"))))
(re (rx (submatch (* "foo"))
(submatch (? "bar"))
,(f)
(submatch "baz")))
(re-@ (rx (submatch (* "foo"))
(submatch (? "bar"))
,@(f)
(submatch "baz")))
(match1 (string-match re "foofoobarsub-f1sub-f2baz"))
(match2 (string-match re-@ "foofoobarsub-f1sub-f2baz")))
(and match1
match2
(equal? "baz"
(match:substring match1 3))
(equal? "sub-f1"
(match:substring match2 3))
(equal? "sub-f2"
(match:substring match2 4))
(equal? "baz"
(match:substring match2 5))))))
(add-test! 'posix-string-test 'pattern-matching
(lambda ()

7
scsh/test/terminal-device-control-test.scm
View File

@ -266,3 +266,10 @@
ttyl/alt-delete-word
ttyl/no-kernel-status
ttyl/case-map)))))
(add-test! 'open-pty-test 'terminal-device-control
(lambda ()
(receive (pty-inport tty-name) (open-pty)
(and (tty? pty-inport)
(equal? tty-name (tty-file-name pty-inport))))))

5
scsh/test/time-procedure-calls.scm
View File

@ -38,9 +38,10 @@
(add-test! 'format-date 'time
(lambda ()
(string? (format-date "~a ~A ~b ~B ~c ~d ~H ~I ~j ~m ~M ~p ~S ~U ~w ~W ~x ~X ~y ~Y ~Z" (date)))))
(string? (format-date "~a ~A ~b ~B ~c ~d ~H ~I ~j ~m ~M ~p ~S ~U ~w ~W ~x ~X ~y ~Y ~Z"
(date)))))
;;; fill-in-date! seems to be not implemented yet.
;;; fill-in-date! is not implemented yet.
;(add-test! 'fill-in-date! 'time
; (lambda ()
; (date? (fill-in-date! (date)))))