← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/member-if-not.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/member-if-not.lsp
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Sat Mar 28 07:39:29 1998
 
4
;;;; Contains: Tests of MEMBER-IF-NOT
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
(compile-and-load "cons-aux.lsp")
 
9
 
 
10
(deftest member-if-not.1
 
11
  (member-if-not #'listp nil)
 
12
  nil)
 
13
 
 
14
(deftest member-if-not.2
 
15
  (member-if-not #'(lambda (x) (eqt x 'a)) '(a 1 2 a 3 4))
 
16
  (1 2 a 3 4))
 
17
 
 
18
(deftest member-if-not.3
 
19
  (member-if-not #'(lambda (x) (not (eql x 12))) '(4 12 11 73 11) :key #'1+)
 
20
  (11 73 11))
 
21
 
 
22
(deftest member-if-not.4
 
23
  (let ((test-inputs
 
24
         `(1 a 11.3121 11.31s3 1.123f5 -1 0
 
25
             13.13122d34 581.131e-10
 
26
             ((a) (b) (c) . d)
 
27
             ,(make-array '(10))
 
28
             "ancadas"  #\w)))
 
29
    (not (every
 
30
          #'(lambda (x)
 
31
              (let ((result (catch-type-error (member-if-not #'listp x))))
 
32
                (or (eqt result 'type-error)
 
33
                    (progn
 
34
                      (format t "~%On x = ~S, returns: ~%~S" x result)
 
35
                      nil))))
 
36
          test-inputs)))
 
37
  nil)
 
38
 
 
39
(deftest member-if-not.5
 
40
  (member-if-not #'not '(1 2 3 4 5) :key #'evenp)
 
41
  (2 3 4 5))
 
42
 
 
43
;;; Order of evaluation tests
 
44
 
 
45
(deftest member-if-not.order.1
 
46
  (let ((i 0) x y)
 
47
    (values
 
48
     (member-if-not (progn (setf x (incf i))
 
49
                           #'not)
 
50
                    (progn (setf y (incf i))
 
51
                           '(nil nil a b nil c d)))
 
52
     i x y))
 
53
  (a b nil c d) 2 1 2)
 
54
 
 
55
(deftest member-if-not.order.2
 
56
  (let ((i 0) x y z w)
 
57
    (values
 
58
     (member-if-not (progn (setf x (incf i))
 
59
                           #'not)
 
60
                    (progn (setf y (incf i))
 
61
                           '(nil nil a b nil c d))
 
62
                    :key (progn (setf z (incf i)) #'identity)
 
63
                    :key (progn (setf w (incf i)) #'not))
 
64
                            
 
65
     i x y z w))
 
66
  (a b nil c d) 4 1 2 3 4)
 
67
 
 
68
;;; Keyword tests
 
69
 
 
70
(deftest member-if-not.keywords.1
 
71
  (member-if-not #'not '(1 2 3 4 5) :key #'evenp :key #'oddp)
 
72
  (2 3 4 5))
 
73
 
 
74
(deftest member-if-not.allow-other-keys.2
 
75
  (member-if-not #'not '(nil 2 3 4 5) :allow-other-keys t :bad t)
 
76
  (2 3 4 5))
 
77
 
 
78
(deftest member-if-not.allow-other-keys.3
 
79
  (member-if-not #'not '(nil 2 3 4 5) :bad t :allow-other-keys t)
 
80
  (2 3 4 5))
 
81
 
 
82
(deftest member-if-not.allow-other-keys.4
 
83
  (member-if-not #'not '(nil 2 3 4 5) :allow-other-keys t)
 
84
  (2 3 4 5))
 
85
 
 
86
(deftest member-if-not.allow-other-keys.5
 
87
  (member-if-not #'not '(nil 2 3 4 5) :allow-other-keys nil)
 
88
  (2 3 4 5))
 
89
 
 
90
(deftest member-if-not.allow-other-keys.6
 
91
  (member-if-not #'not '(nil 2 3 4 5) :allow-other-keys t
 
92
                 :allow-other-keys nil :key #'identity :key #'null)
 
93
  (2 3 4 5))
 
94
 
 
95
;;; Error tests
 
96
 
 
97
(deftest member-if-not.error.1
 
98
  (signals-error (member-if-not #'identity 'a) type-error)
 
99
  t)
 
100
  
 
101
(deftest member-if-not.error.2
 
102
  (signals-error (member-if-not) program-error)
 
103
  t)
 
104
  
 
105
(deftest member-if-not.error.3
 
106
  (signals-error (member-if-not #'null) program-error)
 
107
  t)
 
108
  
 
109
(deftest member-if-not.error.4
 
110
  (signals-error (member-if-not #'null '(a b c) :bad t) program-error)
 
111
  t)
 
112
  
 
113
(deftest member-if-not.error.5
 
114
  (signals-error (member-if-not #'null '(a b c) :bad t :allow-other-keys nil)
 
115
                 program-error)
 
116
  t)
 
117
  
 
118
(deftest member-if-not.error.6
 
119
  (signals-error (member-if-not #'null '(a b c) :key) program-error)
 
120
  t)
 
121
  
 
122
(deftest member-if-not.error.7
 
123
  (signals-error (member-if-not #'null '(a b c) 1 2) program-error)
 
124
  t)
 
125
 
 
126
(deftest member-if-not.error.8
 
127
  (signals-error (locally (member-if-not #'identity 'a) t)
 
128
                 type-error)
 
129
  t)
 
130
 
 
131
(deftest member-if-not.error.9
 
132
  (signals-error (member-if-not #'cons '(a b c)) program-error)
 
133
  t)
 
134
 
 
135
(deftest member-if-not.error.10
 
136
  (signals-error (member-if-not #'identity '(a b c) :key #'cons)
 
137
                 program-error)
 
138
  t)