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

(append-reverse, append-reverse!): New tests.

Browse source
This commit is contained in:
Kevin Ryde 2006-05-28 00:06:33 +00:00
parent 86cd2080d8
commit 86f7e7d676
1 changed files with 74 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -200,7 +200,80 @@
(pass-if "(1) (2) / 9 9" (pass-if "(1) (2) / 9 9"
(equal? '(1 2) (append-map noop '((1) (2)) '(9 9)))))) (equal? '(1 2) (append-map noop '((1) (2)) '(9 9))))))
;;
;; append-reverse
;;
(with-test-prefix "append-reverse"
;; return a list which is the cars and cdrs of LST
(define (list-contents lst)
(if (null? lst)
'()
(cons* (car lst) (cdr lst) (list-contents (cdr lst)))))
(define (valid-append-reverse revhead tail want)
(let ((revhead-contents (list-contents revhead))
(got (append-reverse revhead tail)))
(and (equal? got want)
;; revhead unchanged
(equal? revhead-contents (list-contents revhead)))))
(pass-if-exception "too few args (0)" exception:wrong-num-args
(append-reverse))
(pass-if-exception "too few args (1)" exception:wrong-num-args
(append-reverse '(x)))
(pass-if-exception "too many args (3)" exception:wrong-num-args
(append-reverse '() '() #f))
(pass-if (valid-append-reverse '() '() '()))
(pass-if (valid-append-reverse '() '(1 2 3) '(1 2 3)))
(pass-if (valid-append-reverse '(1) '() '(1)))
(pass-if (valid-append-reverse '(1) '(2) '(1 2)))
(pass-if (valid-append-reverse '(1) '(2 3) '(1 2 3)))
(pass-if (valid-append-reverse '(1 2) '() '(2 1)))
(pass-if (valid-append-reverse '(1 2) '(3) '(2 1 3)))
(pass-if (valid-append-reverse '(1 2) '(3 4) '(2 1 3 4)))
(pass-if (valid-append-reverse '(1 2 3) '() '(3 2 1)))
(pass-if (valid-append-reverse '(1 2 3) '(4) '(3 2 1 4)))
(pass-if (valid-append-reverse '(1 2 3) '(4 5) '(3 2 1 4 5))))
;;
;; append-reverse!
;;
(with-test-prefix "append-reverse!"
(pass-if-exception "too few args (0)" exception:wrong-num-args
(append-reverse!))
(pass-if-exception "too few args (1)" exception:wrong-num-args
(append-reverse! '(x)))
(pass-if-exception "too many args (3)" exception:wrong-num-args
(append-reverse! '() '() #f))
(pass-if (equal? '() (append-reverse! '() '())))
(pass-if (equal? '(1 2 3) (append-reverse! '() '(1 2 3))))
(pass-if (equal? '(1) (append-reverse! '(1) '())))
(pass-if (equal? '(1 2) (append-reverse! '(1) '(2))))
(pass-if (equal? '(1 2 3) (append-reverse! '(1) '(2 3))))
(pass-if (equal? '(2 1) (append-reverse! '(1 2) '())))
(pass-if (equal? '(2 1 3) (append-reverse! '(1 2) '(3))))
(pass-if (equal? '(2 1 3 4) (append-reverse! '(1 2) '(3 4))))
(pass-if (equal? '(3 2 1) (append-reverse! '(1 2 3) '())))
(pass-if (equal? '(3 2 1 4) (append-reverse! '(1 2 3) '(4))))
(pass-if (equal? '(3 2 1 4 5) (append-reverse! '(1 2 3) '(4 5)))))
;; ;;
;; assoc ;; assoc
;; ;;