mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 13:30:26 +02:00
Code Activity

(concatenate, concatenate!): New tests.

Browse source
This commit is contained in:
Kevin Ryde 2003-07-28 23:45:31 +00:00
parent 47f2726f4c
commit c6e9db20c1
1 changed files with 43 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

43
test-suite/tests/srfi-1.test
View file

@ -43,6 +43,49 @@
(set! lst (ref-delete elem lst proc)))))) (set! lst (ref-delete elem lst proc))))))
;;
;; concatenate and concatenate!
;;
(let ()
(define (common-tests concatenate-proc unmodified?)
(define (try lstlst want)
(let ((lstlst-copy (copy-tree lstlst))
(got (concatenate-proc lstlst)))
(if unmodified?
(if (not (equal? lstlst lstlst-copy))
(error "input lists modified")))
(equal? got want)))
(pass-if-exception "too few args" exception:wrong-num-args
(concatenate-proc))
(pass-if-exception "too many args" exception:wrong-num-args
(concatenate-proc '() '()))
(pass-if "no lists"
(try '() '()))
(pass-if (try '((1)) '(1)))
(pass-if (try '((1 2)) '(1 2)))
(pass-if (try '(() (1)) '(1)))
(pass-if (try '(() () (1)) '(1)))
(pass-if (try '((1) (2)) '(1 2)))
(pass-if (try '(() (1 2)) '(1 2)))
(pass-if (try '((1) 2) '(1 . 2)))
(pass-if (try '((1) (2) 3) '(1 2 . 3)))
(pass-if (try '((1) (2) (3 . 4)) '(1 2 3 . 4)))
)
(with-test-prefix "concatenate"
(common-tests concatenate #t))
(with-test-prefix "concatenate!"
(common-tests concatenate! #f)))
;; ;;
;; delete and delete! ;; delete and delete!
;; ;;