From 5f1fd516cb5c0c70d8a33e439279efb5bca52bf7 Mon Sep 17 00:00:00 2001 From: Rolf-Thomas Happe Date: Tue, 16 Aug 2005 23:13:51 +0000 Subject: [PATCH] some tests --- scsh/sequences/AUTHORS | 2 +- scsh/sequences/NEWS | 3 + scsh/sequences/packages.scm | 7 ++ scsh/sequences/pkg-def.scm | 5 +- scsh/sequences/test.scm | 158 ++++++++++++++++++++++++++++++++++++ 5 files changed, 172 insertions(+), 3 deletions(-) create mode 100644 scsh/sequences/test.scm diff --git a/scsh/sequences/AUTHORS b/scsh/sequences/AUTHORS index ea94477..288277d 100644 --- a/scsh/sequences/AUTHORS +++ b/scsh/sequences/AUTHORS @@ -1 +1 @@ -Copyright (c) 2003 Rolf-Thomas Happe +Copyright (c) 2003, 2005 Rolf-Thomas Happe diff --git a/scsh/sequences/NEWS b/scsh/sequences/NEWS index 8818ae7..ce68196 100644 --- a/scsh/sequences/NEWS +++ b/scsh/sequences/NEWS @@ -1,2 +1,5 @@ +version 1.1 +* Some tests. + version 1.0 * New package system. diff --git a/scsh/sequences/packages.scm b/scsh/sequences/packages.scm index 9aa7a3a..f3a1ecc 100644 --- a/scsh/sequences/packages.scm +++ b/scsh/sequences/packages.scm @@ -184,3 +184,10 @@ (hide vector-fill! list->vector) ; vector-lib )) (files composeqs)) + + +(define-structure sequences-testbed (export ) + (open sequence-lib onebol scheme)) + +(define-structure vectors-testbed (export ) + (open vector-lib onebol scheme)) diff --git a/scsh/sequences/pkg-def.scm b/scsh/sequences/pkg-def.scm index fa328d7..ed65dc5 100644 --- a/scsh/sequences/pkg-def.scm +++ b/scsh/sequences/pkg-def.scm @@ -1,5 +1,5 @@ (define-package "sequences" - (1 0) + (1 1) ((install-lib-version (1 2 0))) (write-to-load-script `((config) @@ -14,4 +14,5 @@ (install-file "uniseqs.scm" 'scheme) (install-file "composeqs.scm" 'scheme) (install-file "specseqs.scm" 'scheme) - (install-file "vecnames.scm" 'scheme)) + (install-file "vecnames.scm" 'scheme) + (install-file "test.scm" 'scheme)) diff --git a/scsh/sequences/test.scm b/scsh/sequences/test.scm new file mode 100644 index 0000000..6ea7669 --- /dev/null +++ b/scsh/sequences/test.scm @@ -0,0 +1,158 @@ +;; poor man's testsuite for sequence-lib (fairly incomplete) +;; Run stuff ,in sequence-testbed + + +(define (true/1 x) #t) +(define (false/1 x) #f) + +(define (for-empty-seqs proc) + (for-each proc '(#() "" ()))) + +;; SEQUENCE-EVERY on various types of (empty) seqs +(for-empty-seqs (lambda (s) + (assert (sequence-every number? s)))) + +;; basic SEQUENCE-EVERY +(assert (sequence-every number? '(1 2 3))) +(deny (sequence-every number? '(1 six))) + +;; SEQUENCE-EVERY with start arg +(assert (sequence-every number? '#(x 4) 1)) +(deny (sequence-every number? '#(4 x 4) 1)) + +;; SEQUENCE-EVERY with start/end args +(assert (sequence-every number? '#(a b 0.1 d e) 2 2)) +(assert (sequence-every number? '#(a b 0.1 d e) 2 3)) +(deny (sequence-every number? '#(a b 0.1 d e) 2 4)) + +;; SEQUENCES-EVERY on various types of (empty) seqs +(for-empty-seqs (lambda (s) + (assert (sequences-every number? s)))) + +;; SEQUENCES-EVERY on one seq +(assert (sequences-every number? '#(1 2 3))) +(deny (sequence-every number? '(1 six))) + +;; SEQUENCES-EVERY on two seqs +(assert (sequences-every = '#() '())) +(assert (sequences-every char=? '(#\a #\b) "abc")) +(deny (sequences-every eqv? '(1 2) '#(1 six))) + +;; SEQUENCE-ANY on various types of (empty) lists +(for-empty-seqs (lambda (s) + (deny (sequence-any number? s)))) + +;; basic SEQUENCE-ANY +(assert (sequence-any number? '#(a 6 c))) +(deny (sequence-any number? '#(a b c))) + +;; SEQUENCE-ANY with start arg +(assert (sequence-any number? '#(x 4) 1)) +(deny (sequence-any number? '#(4 x) 1)) + +;; SEQUENCE-ANY with start/end args +(deny (sequence-any number? '(1 2 3) 2 2)) +(assert (sequence-any number? '#(a b 0.1 d e) 2 3)) +(deny (sequence-any number? '(x y))) + +;; SEQUENCES-ANY on various types of (empty) sequences +(for-empty-seqs (lambda (s) + (deny (sequences-any number? s)))) + +;; SEQUENCES-ANY on one seq +(assert (sequences-any number? '#(a 6 c))) +(deny (sequences-any number? '#(a b c))) + +;; SEQUENCES-ANY on two seqs +(deny (sequences-any = '#() '())) +(assert (sequences-any char=? '(#\a #\x) "abc")) +(deny (sequences-any eqv? '(2 1) '#(1 2))) + +(assert (equal? (sequence->list "afto" 2) + '(#\t #\o))) +(assert (equal? (sequence->list "afto" 2 2) + '())) + +(assert (equal? (sequence-copy/maker make-vector "aeiou zeta" 3) + '#(#\o #\u #\space #\z #\e #\t #\a))) + +(assert (string=? (sequence-copy "aeiou zeta" 3) + "ou zeta")) + +(let ((s (make-vector 6 'a))) + (sequence-copy! s 1 '(1 2 3) 1 3) + (assert (equal? s '#(a 2 3 a a a)))) +(let ((s (make-string 6 #\a))) + (sequence-copy! s 1 "gNOblok" 1 3) + (assert (equal? s "aNOaaa"))) + +;; SEQUENCE-COPY! from sequence into itself +(let ((s (vector 0 1 2 3 4 5 6))) + (sequence-copy! s 1 s 3 6) + (assert (equal? s '#(0 3 4 5 4 5 6)))) + +(let ((xs (list 0))) + (sequence-fill! xs '* 0 0) + (assert (equal? xs '(0)))) +(let ((xs (list 0 1 2 3))) + (sequence-fill! xs '* 2) + (equal? xs '(0 1 * *))) + +(assert (equal? (sequence-append) (vector))) +(assert (string=? (sequence-append "" '#(#\a #\b) "c" '()) + "abc")) + +(assert (string=? (sequence-map char-upcase "abcdefg" 3) + "DEFG")) +(assert (equal? (sequence-map/maker make-vector + - '(0 1 2 3 4 5) 2 4) + '#(-2 -3))) +(assert (equal? (sequences-map - '#(3 2 1 0) '(2 1 0)) + '#(1 1 1))) + +(assert (equal? (sequence-map-into! (vector 0 1 2 3 4 5 6) values + "abcdefghijk") + '#(#\a #\b #\c #\d #\e #\f #\g))) +(assert (equal? (sequence-map-into! (list 0 1 2 3 4 5 6) values + "abcdefghijk") + '(#\a #\b #\c #\d #\e #\f #\g))) +(assert (equal? (sequence-map-into! (list 0 1 2 3 4 5 6) values + "abcdefghijk" 1 6 2) + '(0 #\c #\d #\e #\f #\g 6))) +(let ((s (vector 0 1 2 3 4 5 6))) + (assert (equal? (sequence-map-into! s values s 1 4 3) + '#(0 3 4 5 4 5 6)))) + +(assert (equal? (sequences-map-into! (list 'a 'b 'c 'd) + + '#(0 1 2 3 4 5) '#(3 2 1 0)) + '(3 3 3 3))) +(assert (equal? (sequences-map-into! "" char-upcase "fno" "g") + "")) + +(assert (equal? (sequence-fold cons '() "abcde" 2 4) + '(#\d #\c))) +(assert (equal? (sequence-fold-right cons '() "abcde" 2 4) + '(#\c #\d))) +(assert (= (sequences-fold + 0 '(0 1 2 3) '#(1 2)) + 4)) +(assert (= (sequences-fold-right + 0 '(0 1 2 3) '#(1 2)) + 4)) + +(assert (sequence= char=? "abcdefg" '#(#\b #\c #\d #\e) 1 5)) +(assert (sequence= char=? "abcdefg" '#(#\b #\c #\d #\e f) 1 5 0 4)) +(assert (sequence= = '() "")) + +(assert (sequences= =)) +(assert (sequences= = '(1))) +(assert (sequences= = '(1 2 3) '#(1 2 3) '(1 2 3))) +(deny (sequences= = '(1) '#(1 2))) + +(assert (equal? (sequence-tabulate! (vector 1 2 3) 1 - 2) + '#(1 0 -1))) +(assert (equal? (sequence-tabulate! (vector 1 2 3) 1 - 0) + '#(1 2 3))) + +(assert (sequence-null? "")) +(assert (sequence-null? '())) +(assert (sequence-null? '#())) +(deny (sequence-null? " "))