;-*- Mode: Lisp -*- ;;;; Author: Paul Dietz ;;;; Created: Sat Apr 19 21:32:50 2003 ;;;; Contains: Tests of SUBLIS (in-package :cl-test) (deftest sublis.1 (check-sublis '((a b) g (d e 10 g h) 15 . g) '((e . e2) (g . 17))) ((a b) 17 (d e2 10 17 h) 15 . 17)) (deftest sublis.2 (check-sublis '(f6 10 (f4 (f3 (f1 a b) (f1 a p)) (f2 a b))) '(((f1 a b) . (f2 a b)) ((f2 a b) . (f1 a b))) :test #'equal) (f6 10 (f4 (f3 (f2 a b) (f1 a p)) (f1 a b)))) (deftest sublis.3 (check-sublis '(10 ((10 20 (a b c) 30)) (((10 20 30 40)))) '((30 . "foo"))) (10 ((10 20 (a b c) "foo")) (((10 20 "foo" 40))))) (deftest sublis.4 (check-sublis (sublis (copy-tree '((a . 2) (b . 4) (c . 1))) (copy-tree '(a b c d e (a b c a d b) f))) '((t . "yes")) :key #'(lambda (x) (and (typep x 'integer) (evenp x)))) ("yes" "yes" 1 d e ("yes" "yes" 1 "yes" d "yes") f)) (deftest sublis.5 (check-sublis '("fee" (("fee" "Fie" "foo")) fie ("fee" "fie")) `((,(copy-seq "fie") . #\f))) ("fee" (("fee" "Fie" "foo")) fie ("fee" "fie"))) (deftest sublis.6 (check-sublis '("fee" fie (("fee" "Fie" "foo") 1) ("fee" "fie")) `((,(copy-seq "fie") . #\f)) :test 'equal) ("fee" fie (("fee" "Fie" "foo") 1) ("fee" #\f))) (deftest sublis.7 (check-sublis '(("aa" a b) (z "bb" d) ((x . "aa"))) `((,(copy-seq "aa") . 1) (,(copy-seq "bb") . 2)) :test 'equal :key #'(lambda (x) (if (consp x) (car x) '*not-present*))) (1 (z . 2) ((x . "aa")))) ;; Check that a null key arg is ignored. (deftest sublis.8 (check-sublis '(1 2 a b) '((1 . 2) (a . b)) :key nil) (2 2 b b)) ;;; Order of argument evaluation (deftest sublis.order.1 (let ((i 0) w x y z) (values (sublis (progn (setf w (incf i)) '((a . z))) (progn (setf x (incf i)) (copy-tree '(a b c d))) :test (progn (setf y (incf i)) #'eql) :key (progn (setf z (incf i)) #'identity)) i w x y z)) (z b c d) 4 1 2 3 4) (deftest sublis.order.2 (let ((i 0) w x y z) (values (sublis (progn (setf w (incf i)) '((a . z))) (progn (setf x (incf i)) (copy-tree '(a b c d))) :key (progn (setf y (incf i)) #'identity) :test-not (progn (setf z (incf i)) (complement #'eql)) ) i w x y z)) (z b c d) 4 1 2 3 4) ;;; Keyword tests (deftest sublis.allow-other-keys.1 (sublis nil 'a :bad t :allow-other-keys t) a) (deftest sublis.allow-other-keys.2 (sublis nil 'a :allow-other-keys t :bad t) a) (deftest sublis.allow-other-keys.3 (sublis nil 'a :allow-other-keys t) a) (deftest sublis.allow-other-keys.4 (sublis nil 'a :allow-other-keys nil) a) (deftest sublis.allow-other-keys.5 (sublis nil 'a :allow-other-keys t :allow-other-keys t :bad t) a) (deftest sublis.keywords.6 (sublis '((1 . a)) (list 0 1 2) :key #'(lambda (x) (if (numberp x) (1+ x) x)) :key #'identity) (a 1 2)) ;; Argument error cases (deftest sublis.error.1 (classify-error (sublis)) program-error) (deftest sublis.error.2 (classify-error (sublis nil)) program-error) (deftest sublis.error.3 (classify-error (sublis nil 'a :test)) program-error) (deftest sublis.error.4 (classify-error (sublis nil 'a :bad-keyword t)) program-error) (deftest sublis.error.5 (classify-error (sublis '((a . 1) (b . 2)) (list 'a 'b 'c 'd) :test #'identity)) program-error) (deftest sublis.error.6 (classify-error (sublis '((a . 1) (b . 2)) (list 'a 'b 'c 'd) :key #'cons)) program-error) (deftest sublis.error.7 (classify-error (sublis '((a . 1) (b . 2)) (list 'a 'b 'c 'd) :test-not #'identity)) program-error) (deftest sublis.error.8 (classify-error (sublis '((a . 1) . bad) (list 'a 'b 'c 'd))) type-error) (deftest sublis.shared (let* ((shared-piece (list 'a 'b)) (a (list shared-piece shared-piece))) (check-sublis a '((a . b) (b . a)))) ((b a) (b a)))