pairlis.lsp 2.41 KB
Newer Older
1 2 3 4 5 6 7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Apr 20 07:30:55 2003
;;;; Contains: Tests of PAIRLIS

(in-package :cl-test)

8 9
(compile-and-load "cons-aux.lsp")

10 11 12 13 14 15 16 17 18
;; Pairlis has two legal behaviors: the pairs
;; can be prepended in the same order, or in the
;; reverse order, that they appear in the first
;; two arguments

(defun my-pairlis (x y &optional alist)
  (if (null x)
      alist
    (acons (car x) (car y)
sds's avatar
sds committed
19
           (my-pairlis (cdr x) (cdr y) alist))))
20 21 22 23 24 25 26 27 28 29 30

(deftest pairlis.1
    (pairlis nil nil nil)
  nil)

(deftest pairlis.2
    (pairlis '(a) '(b) nil)
  ((a . b)))

(deftest pairlis.3
    (let* ((x (copy-list '(a b c d e)))
sds's avatar
sds committed
31 32 33 34 35
           (xcopy (make-scaffold-copy x))
           (y (copy-list '(1 2 3 4 5)))
           (ycopy (make-scaffold-copy y))
           (result (pairlis x y))
           (expected (my-pairlis x y)))
36 37 38 39
      (and
       (check-scaffold-copy x xcopy)
       (check-scaffold-copy y ycopy)
       (or
sds's avatar
sds committed
40 41
        (equal result expected)
        (equal result (reverse expected)))
42 43 44 45 46
       t))
  t)

(deftest pairlis.4
    (let* ((x (copy-list '(a b c d e)))
sds's avatar
sds committed
47 48 49 50 51 52 53
           (xcopy (make-scaffold-copy x))
           (y (copy-list '(1 2 3 4 5)))
           (ycopy (make-scaffold-copy y))
           (z '((x . 10) (y . 20)))
           (zcopy (make-scaffold-copy z))
           (result (pairlis x y z))
           (expected (my-pairlis x y z)))
54 55 56 57 58 59
      (and
       (check-scaffold-copy x xcopy)
       (check-scaffold-copy y ycopy)
       (check-scaffold-copy z zcopy)
       (eqt (cdr (cddr (cddr result))) z)
       (or
sds's avatar
sds committed
60 61 62
        (equal result expected)
        (equal result (append (reverse (subseq expected 0 5))
                              (subseq expected 5))))
63 64 65
       t))
  t)

pfdietz's avatar
pfdietz committed
66 67 68 69
(def-fold-test pairlis.fold.1 (pairlis '(a b) '(c d)))

;;; Error tests

70
(deftest pairlis.error.1
71 72
  (signals-error (pairlis) program-error)
  t)
73 74

(deftest pairlis.error.2
75 76
  (signals-error (pairlis nil) program-error)
  t)
77 78

(deftest pairlis.error.3
79 80
  (signals-error (pairlis nil nil nil nil) program-error)
  t)
81 82

(deftest pairlis.error.4
83 84
  (signals-error (pairlis 'a '(1)) type-error)
  t)
85 86

(deftest pairlis.error.5
87 88
  (signals-error (pairlis '(a) 'b) type-error)
  t)
89 90

(deftest pairlis.error.6
91 92 93
  (signals-error (pairlis '(a . b) '(c . d)) type-error)
  t)

pfdietz's avatar
pfdietz committed
94 95 96 97 98 99 100
(deftest pairlis.error.7
  (check-type-error #'(lambda (x) (pairlis x '(a b))) #'listp)
  nil)

(deftest pairlis.error.8
  (check-type-error #'(lambda (x) (pairlis '(a b) x)) #'listp)
  nil)