#! /bin/sh
exec ../src/sizzle -qs $0 $*
!#
;; test/srfi.scm -- tests from various SRFIs
;;
;; Copyright (C) 2000 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
;;
;; This is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; 
;; This software is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;; 
;; You should have received a copy of the GNU General Public License
;; along with this package; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.  

;; Load the test framework.
(load "test-suite.scm")

(use-modules (core list-lib))

;; Load all functions from SRFI-1 which are not primitive
;(primitive-load "../data/list-lib.scm")

(begin-section "SRFI-1")

(begin-sub-section "List constructors")

(pass-if (cons 'a '()) '(a) equal?)
(pass-if (cons '(a) '(b c d)) '((a) b c d) equal?)
(pass-if (cons "a" '(b c)) '("a" b c) equal?)
(pass-if (cons 'a 3) '(a . 3) equal?)
(pass-if (cons '(a b) 'c) '((a b) . c) equal?)

(pass-if (list 'a (+ 3 4) 'c) '(a 7 c) equal?)
(pass-if (list) '() eq?)

(pass-if (xcons '(b c) 'a) '(a b c) equal?)

(pass-if (cons* 1 2 3 4) '(1 2 3 . 4) equal?)
(pass-if (cons* 1) 1 =)

(pass-if (make-list 4) '(() () () ()) equal?)
(pass-if (make-list 4 'c) '(c c c c) equal?)

(pass-if (list-tabulate 4 values) '(0 1 2 3) equal?)

(pass-if (circular-list? (circular-list 1 2 3)) #t eq?)

(pass-if (iota 5) '(0 1 2 3 4) equal?)
(pass-if (iota 5 0 -1) '(0 -1 -2 -3 -4) equal?)

(begin-sub-section "List predicates")

(pass-if (proper-list? 1) #f eq?)
(pass-if (proper-list? '(1 2 3 4)) #t eq?)
(pass-if (proper-list? '(1 2 3 . 4)) #f eq?)
(pass-if (proper-list? (circular-list 1 2 3 4)) #f eq?)

(pass-if (circular-list? 1) #f eq?)
(pass-if (circular-list? '(1 2 3 4)) #f eq?)
(pass-if (circular-list? '(1 2 3 . 4)) #f eq?)
(pass-if (circular-list? (circular-list 1 2 3 4)) #t eq?)

(pass-if (dotted-list? 1) #t eq?)
(pass-if (dotted-list? '(1 2 3 4)) #f eq?)
(pass-if (dotted-list? '(1 2 3 . 4)) #t eq?)
(pass-if (dotted-list? (circular-list 1 2 3 4)) #f eq?)

(pass-if (pair? '(a . b)) #t eq?)
(pass-if (pair? '()) #f eq?)
(pass-if (pair? '#(a b)) #f eq?)
(pass-if (pair? 7) #f eq?)
(pass-if (pair? 'a) #f eq?)

(pass-if (null? '()) #t eq?)
(pass-if (null? '(1 2 3)) #f eq?)

(pass-if (null-list? '()) #t eq?)

(pass-if (not-pair? '()) #t eq?)

(pass-if (list= eq?) #t eq?)
(pass-if (list= eq? '(a)) #t eq?)
(pass-if (list= = '(1 2 3)) #t eq?)
(pass-if (list= = '(1 2 3) '(1 2 3)) #t eq?)

(begin-sub-section "List selectors")
(pass-if (car '(a b c)) 'a eq?)
(pass-if (car '((a) b c d)) '(a) equal?)
(pass-if (car '(1 . 2)) 1 =)
(pass-if (cdr '(1 . 2)) 2 =)

(pass-if (list-ref '(a b c d) 2) 'c eq?)

(pass-if (third '(a b c d e)) 'c eq?)

(pass-if (take '(a b c d e) 2) '(a b) equal?)
(pass-if (drop '(a b c d e) 2) '(c d e) equal?)
(pass-if (take '(1 2 3 . d) 2) '(1 2) equal?)
(pass-if (drop '(1 2 3 . d) 2) '(3 . d) equal?)
(pass-if (take '(1 2 3 . d) 3) '(1 2 3) equal?)
(pass-if (drop '(1 2 3 . d) 3) 'd equal?)

(pass-if (take-right '(a b c d e) 2) '(d e) equal?)
(pass-if (drop-right '(a b c d e) 2) '(a b c) equal?)

(pass-if (take-right '(1 2 3 . d) 2) '(2 3 . d) equal?)
(pass-if (drop-right '(1 2 3 . d) 2) '(1) equal?)
(pass-if (take-right '(1 2 3 . d) 0) 'd equal?)
(pass-if (drop-right '(1 2 3 . d) 0) '(1 2 3) equal?)

(pass-if (last '(a b c)) 'c eq?)
(pass-if (last-pair '(a b c)) '(c) equal?)

(begin-sub-section "length, append, reverse, zip & count")

(pass-if (append '(x) '(y)) '(x y) equal?)
(pass-if (append '(a) '(b c d)) '(a b c d) equal?)
(pass-if (append '(a (b)) '((c))) '(a (b) (c)) equal?)
(pass-if (append '(a b) '(c . d)) '(a b c . d) equal?)
(pass-if (append '() 'a) 'a eq?)
(pass-if (append '(x y)) '(x y) equal?)
(pass-if (append) '() eq?)

(pass-if (reverse '(a b c)) '(c b a) equal?)
(pass-if (reverse '(a (b c) d (e (f)))) '((e (f)) d (b c) a) equal?)

(pass-if (zip '(one two three) '(1 2 3)
	      '(odd even odd even odd even odd even))
	 '((one 1 odd) (two 2 even) (three 3 odd)) equal?)

(pass-if (zip '(3 1 4 1) (circular-list #f #t)) '((3 #f) (1 #t) (4 #f) (1 #t))
	 equal?)

(pass-if (call-with-values (lambda () (unzip2 '((1 one) (2 two) (3 three))))
	   (lambda (x y) (append x y)))
	 '(1 2 3 one two three) equal?)

(pass-if (count even? '(3 1 4 1 5 9 2 5 6)) 3 =)
(pass-if (count < '(1 2 4 8) '(2 4 6 8 10 12 14 16)) 3 =)
(pass-if (count < '(3 1 4 1) (circular-list 1 10)) 2 =)

(define lis '(1 2 3))
(pass-if (fold + 0 lis) 6 =)
(pass-if (fold cons '() lis) '(3 2 1) equal?)
(pass-if (fold cons '(2 3 4) '(1 0)) '(0 1 2 3 4) equal?)
(define lis '(1 2 bla 4 fasel))
(pass-if (fold (lambda (x count) (if (symbol? x) (+ count 1) count))
	       0
	       lis) 2 =)
(define lis '("bla" "foo" "foobar" "baz"))
(pass-if (fold (lambda (s max-len) (max max-len (string-length s)))
	       0
	       lis)
	 6 =)
(pass-if (fold cons* '() '(a b c) '(1 2 3 4 5)) '(c 3 b 2 a 1) equal?)

(pass-if (fold-right cons '() '(1 2 3)) '(1 2 3) equal?)
(pass-if (fold-right (lambda (x l) (if (even? x) (cons x l) l)) '() '(1 2 3 3)) '(2) equal?)
(pass-if (fold-right cons* '() '(a b c) '(1 2 3 4 5)) '(a 1 b 2 c 3) equal?)

(define lis '(1 2 3 4))
(pass-if (pair-fold (lambda (pair tail) (set-cdr! pair tail) pair) '() lis)
	 '(4 3 2 1) equal?)

(pass-if (pair-fold-right cons '() '(a b c)) '((a b c) (b c) (c)) equal?)

(pass-if (reduce max 0 '(-1 2 5 2 2 42)) 42 =)

(pass-if (reduce-right append '() '((1 2 3) (4 5 6))) '(1 2 3 4 5 6) equal?)

(pass-if (unfold (lambda (x) (> x 6))
		 (lambda (x) (* x x))
		 (lambda (x) (+ x 1))
		 1)
	 '(1 4 9 16 25 36) equal?)
                     
(pass-if (unfold null-list? car cdr '(1 2 3)) '(1 2 3) equal?)

(define l (with-input-from-string "1 (2 3)"
	    (lambda ()
	      (unfold eof-object? values (lambda (x) (read)) (read)))))
(pass-if l '(1 (2 3)) equal?)

(pass-if (unfold not-pair? car cdr '(1 2 3 . 4) values) '(1 2 3 . 4) equal?)

(pass-if (unfold null-list? car cdr '(1 2) (lambda (x) '(3 4)))
	 '(1 2 3 4) equal?)
	 
(test-summary)
