(require-library cells simple-tests datatype typed-lists) (import list-functor set-functor simple-tests datatype) ;;;;;; test untyped modules (define-test (immutable-lists?) (check (import cells immutable-lists) (define nil (ilist-null)) (ilist? nil) (ilist-null? nil) (not (null? nil)) (define nls (ilist-cons 1 nil)) (ilist? nls) nls (define nlst (ilist 0 1 (cell 2) 3 4)) (ilist? nlst) (not (list? nlst)) nlst (= (ilist-apply + 1 2 (ilist 3 4 5)) 15) (ilist-equal? (ilist-repeat 5 0) (ilist 0 0 0 0 0)) (ilist-equal? (ilist-iterate 5 add1 0) (ilist 0 1 2 3 4)) (ilist-equal? (ilist-iterate-while (lambda (x) (< x 5)) add1 0) (ilist 0 1 2 3 4)) (ilist-equal? (ilist-iterate-until (lambda (x) (= x 5)) add1 0) (ilist 0 1 2 3 4)) (ilist-equal? (ilist-zip (ilist 1 2 3 4 5) (ilist 10 20 30)) (ilist 1 10 2 20 3 30 4 5)) (ilist-equal? (ilist-interpose 10 (ilist 1 2 3 4 5)) (ilist 1 10 2 10 3 10 4 10 5)) (ilist-equal? (ilist-drop 3 nlst) (ilist 3 4)) (ilist-equal? (ilist-drop-while odd? (ilist 1 3 2 4 5)) (ilist 2 4 5)) (ilist-equal? (ilist-take-while odd? (ilist 1 3 2 4 5)) (ilist 1 3)) (receive (head tail) (ilist-split-with even? (ilist 1 3 2 4 5)) (and (ilist-equal? head (ilist 1 3)) (ilist-equal? tail (ilist 2 4 5)))) (ilist-equal? (ilist-take 2 nlst) (ilist 0 1)) (define nrest (ilist-rest nlst)) nrest (ilist? (ilist-null)) (ilist-null? (ilist-null)) (not (ilist-null? nls)) (not (ilist? '(1 2))) (ilist-null? (ilist-rest nls)) (= (ilist-first nlst) 0) (ilist? (ilist-reverse nlst)) (ilist-reverse nlst) (equal? (ilist->list nlst) (list 0 1 (cell 2) 3 4)) (equal? (ilist-item 2 nlst) (cell 2)) (cell-set! (ilist-item 2 nlst) 20) (equal? (ilist-item 2 nlst) (cell 20)) (= (cell-ref (ilist-item 2 nlst)) 20) (= (ilist-length nlst) 5) (ilist-equal? (ilist-from-upto 2 4 nlst) (ilist (cell 20) 3)) (ilist-equal? (ilist-append (ilist 0 1 2 3) (ilist 4 5 6)) (ilist 0 1 2 3 4 5 6)) (ilist-equal? (ilist-append (ilist 0) (ilist 1) (ilist 2) (ilist 3 4) (ilist 5 6 7) (ilist 8)) (ilist 0 1 2 3 4 5 6 7 8)) (ilist-equal? (ilist-map add1 (ilist 0 1 2 3)) (ilist 1 2 3 4)) (ilist-equal? (ilist-map + (ilist 1 2 3) (ilist 10 20 30 40)) (ilist 11 22 33)) (ilist-equal? (ilist-mappend ilist (ilist 10 20 30) (ilist 1 2 3 4 5)) (ilist 10 1 20 2 30 3)) (ilist-equal? (ilist-fold-right ilist-cons (ilist-null) (ilist 0 1 2 3 4)) (ilist 0 1 2 3 4)) (ilist-equal? (ilist-fold-right ilist-cons (ilist 0 1 2) (ilist 3 4)) (ilist 3 4 0 1 2)) (= (ilist-fold-right * 1 (ilist 1 2 3 4 5)) 120) (= (ilist-fold-left * 1 (ilist 1 2 3 4 5)) 120) (= (ilist-fold-left + 0 (ilist 1 2 3) (ilist 10 20 30)) 66) (equal? (ilist-fold-left cons '(100) (ilist 1 2 3 4)) '(((((100) . 1) . 2) . 3) . 4)) (equal? (call-with-values (lambda () (ilist-reverse (ilist 1 2 3) (ilist 10 20 30))) list) (list (ilist 3 2 1) (ilist 30 20 10))) (ilist-equal? (ilist-remove 0 (ilist 1 0 2 0 3 0 4)) (ilist 1 2 3 4)) (ilist-equal? (ilist-merge < (ilist 2 4 5 7 8) (ilist 1 3 6 9 10)) (ilist 1 2 3 4 5 6 7 8 9 10)) (not (condition-case (ilist-merge < (ilist-null) (ilist 1 3 2)) ((exn) #f))) (ilist-equal? (ilist-merge-sort <= (ilist 2 0 1 4 3)) (ilist 0 1 2 3 4)) (ilist-equal? (ilist-insertion-sort < (ilist 2 0 1 4 3)) (ilist 0 1 2 3 4)) (not (ilist-sorted? <= (ilist 2 0 1 4 3))) (ilist-sorted? <= (ilist 0 1 2 3 4)) (ilist-equal? (ilist-insert-sorted <= 2 (ilist 0 1 2 3 4)) (ilist 0 1 2 2 3 4)) (ilist-equal? (ilist-insert-sorted <= 5 (ilist 0 1 2 3 4)) (ilist 0 1 2 3 4 5)) (ilist-every? odd? (ilist 1 3 5)) (ilist-every? odd? (ilist)) (= (ilist-some odd? (ilist 2 3 5)) 3) (not (ilist-some odd? (ilist 2 4 6))) (ilist-not-every? odd? (ilist 1 2 3)) (ilist-not-any? odd? (ilist 2 4 6)) (ilist-in? (ilist 2 3) (ilist 1 2 3)) (not (ilist-in? (ilist 1 2 3) (ilist 2 3))) (not (ilist-in? (ilist 1 2 3) (ilist 2 1 3))) (ilist-in? (ilist) (ilist 2 3)) )) (define-test (sets?) (check (import sets immutable-lists) (set= (ilist->set (ilist 1 2 1 3 2 3)) (set 3 2 1)) (set? (set 1 2 3)) (set? (set 1 2 2 3)) (set= (set 2 1 3) (set 1 2 2 3)) (set-in? 2 (set 1 1 2 3)) (set<= (set 2 1 2) (set 4 1 2 3 4)) (set= (set-add 0 (set 1 2 3)) (set 0 1 2 3)) (set= (set-add 2 (set 1 2 3)) (set 1 2 3)) (= (set-cardinality (set 2 1 2 3 2)) 3) (set= (set-remove 2 (set 2 1 2 3 2)) (set 1 3)) (set= (set 0 1 1 0 2 3 2) (set 2 3 0 1)) (set= (set-difference (set 0 2 1 3) (set 1 1)) (set 0 2 3)) (set= (set-union (set 1 2) (set 2 3) (set 3 4)) (set 1 2 3 4)) (set= (set-intersection (set 1 2 3 4) (set 2 3 5) (set 3 4)) (set 3)) (set= (set-filter odd? (set 2 1 3 3 1 1)) (set 3 1)) )) ;;;;;; test functors (define-test (any-lists?) (check ;; argument module (module any (item? equ?) (import scheme) (define (item? x) #t) (define (equ? x y) (equal? x y)) ) ;; apply functor (module any-lists = (list-functor any)) ;; import (import (prefix any-lists any-) cells) (define als (any-ilist-repeat 3 (cell #f))) (any-ilist? als) (not (list? als)) (= (any-ilist-length als) 3) (equal? (any-ilist->list (any-ilist-map cell-ref als)) (make-list 3)) (define alst (any-ilist (lambda (x) #f) 'a "x" (cell 3) #\z)) (procedure? (any-ilist-first alst)) (any-ilist-equal? (any-ilist-memp cell? alst) (any-ilist (cell 3) #\z)) (any-ilist-equal? (any-ilist-member #\z alst) (any-ilist-cons #\z (any-ilist-null))) )) (define-test (string-lists?) (check (module strings (equ? item?) (import scheme) (define equ? string=?) (define item? string?)) (module string-lists = (list-functor strings)) (import (prefix string-lists str-)) (str-ilist-equal? (str-ilist-append (str-ilist "a" "b") (str-ilist "c")) (str-ilist "a" "b" "c")) )) (define-test (symbol-lists?) (check (module symbols (equ? item?) (import scheme) (define equ? eq?) (define item? symbol?)) (module symbol-lists = (list-functor symbols)) (import (prefix symbol-lists sym-)) (sym-ilist-equal? (sym-ilist-append (sym-ilist 'a 'b) (sym-ilist 'c)) (sym-ilist 'a 'b 'c)) (equal? (sym-ilist-bind (x y z) (sym-ilist 'a 'b 'c) (list x y z)) '(a b c)) (sym-ilist-equal? (sym-ilist-bind (x . y) (sym-ilist 'a 'b 'c) y) (sym-ilist 'b 'c)) (xpr:val (sym-ilist-bind (x . y) (sym-ilist 'a 'b) (list x y))) (sym-ilist-null? (sym-ilist-bind x (sym-ilist-null) x)) (sym-ilist-bind () (sym-ilist-null) #t) )) (define-test (list-lists?) (check (module lists (equ? item?) (import scheme (only data-structures list-of?) (only chicken condition-case)) (define equ? equal?) (define item? (list-of? symbol?))) (module list-lists = (list-functor lists)) (import (prefix list-lists lst-)) (not (condition-case (lst-ilist-cons '(1) (lst-ilist-null)) ((exn) #f))) (lst-ilist-equal? (lst-ilist-append (lst-ilist '(a) '(b)) (lst-ilist '(c))) (lst-ilist '(a) '(b) '(c))) )) (define-test (pair-lists?) (check (module pairs (item? equ?) (import scheme) (define (item? x) (and (pair? x) (number? (car x)) (string? (cdr x)))) (define equ? equal?)) (module pair-lists = (list-functor pairs)) (import (prefix pair-lists nsp-)) (define nspl (nsp-ilist (cons 1 "one") (cons 2 "two") (cons 3 "three"))) (equal? (nsp-ilist-assoc 2 nspl) '(2 . "two")) (not (nsp-ilist-assp zero? nspl)) )) (define-test (num-sets?) (check ;; argument module (module nums (item? equ?) (import scheme) (define item? number?) (define equ? =) ) ;; apply functors (module num-lists = (list-functor nums)) (module num-sets = (set-functor nums num-lists)) ;; import (import (prefix num-lists num-) (prefix num-sets num-)) (num-set= (num-ilist->set (num-ilist 1 2 1 3 2 3)) (num-set 3 2 1)) (num-set? (num-set 1 2 3)) (num-set? (num-set 1 2 2 3)) (num-set= (num-set 2 1 3) (num-set 1 2 2 3)) (num-set-in? 2 (num-set 1 1 2 3)) (num-set<= (num-set 2 1 2) (num-set 4 1 2 3 4)) (num-set= (num-set-add 0 (num-set 1 2 3)) (num-set 0 1 2 3)) (num-set= (num-set-add 2 (num-set 1 2 3)) (num-set 1 2 3)) (= (num-set-cardinality (num-set 2 1 2 3 2)) 3) (num-set= (num-set-remove 2 (num-set 2 1 2 3 2)) (num-set 1 3)) (num-set= (num-set 0 1 1 0 2 3 2) (num-set 2 3 0 1)) (num-set= (num-set-difference (num-set 0 2 1 3) (num-set 1 1)) (num-set 0 2 3)) (num-set= (num-set-union (num-set 1 2) (num-set 2 3) (num-set 3 4)) (num-set 1 2 3 4)) (num-set= (num-set-intersection (num-set 1 2 3 4) (num-set 2 3 5) (num-set 3 4)) (num-set 3)) (num-set= (num-set-filter odd? (num-set 2 1 3 3 1 1)) (num-set 3 1)) )) (compound-test (TYPED-LISTS-AND-SETS) (immutable-lists?) (sets?) (any-lists?) (string-lists?) (symbol-lists?) (list-lists?) (pair-lists?) (num-sets?) )