Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
ansi-test
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Deploy
Releases
Container Registry
Model registry
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Michał Herda
ansi-test
Commits
c6fa246e
Commit
c6fa246e
authored
22 years ago
by
pfdietz
Browse files
Options
Downloads
Patches
Plain Diff
Style, indentation and comment changes.
parent
40b05dcb
No related branches found
No related tags found
No related merge requests found
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
ansi-tests/ansi-aux.lsp
+160
-144
160 additions, 144 deletions
ansi-tests/ansi-aux.lsp
ansi-tests/char-aux.lsp
+3
-3
3 additions, 3 deletions
ansi-tests/char-aux.lsp
with
163 additions
and
147 deletions
ansi-tests/ansi-aux.lsp
+
160
−
144
View file @
c6fa246e
...
@@ -8,6 +8,9 @@
...
@@ -8,6 +8,9 @@
(declaim (optimize (safety 3)))
(declaim (optimize (safety 3)))
;;; Comparison functions that are like various builtins,
;;; but are guaranteed to return T for true.
(defun eqt (x y)
(defun eqt (x y)
"Like EQ, but guaranteed to return T for true."
"Like EQ, but guaranteed to return T for true."
(if (eq x y) t nil))
(if (eq x y) t nil))
...
@@ -28,6 +31,9 @@
...
@@ -28,6 +31,9 @@
"Like =, but guaranteed to return T for true."
"Like =, but guaranteed to return T for true."
(if (apply #'= x args) t nil))
(if (apply #'= x args) t nil))
;;; A function for coercing truth values to BOOLEAN
(defun notnot (x) (not (not x)))
(defun notnot (x) (not (not x)))
(defun make-int-list (n)
(defun make-int-list (n)
...
@@ -38,6 +44,9 @@
...
@@ -38,6 +44,9 @@
(loop for i from 0 below n do (setf (aref a i) i))
(loop for i from 0 below n do (setf (aref a i) i))
a))
a))
;;; Return true if A1 and A2 are arrays with the same rank
;;; and dimensions whose elements are EQUAL
(defun equal-array (a1 a2)
(defun equal-array (a1 a2)
(and (typep a1 'array)
(and (typep a1 'array)
(typep a2 'array)
(typep a2 'array)
...
@@ -56,13 +65,14 @@
...
@@ -56,13 +65,14 @@
always (equal (row-major-aref a1 i)
always (equal (row-major-aref a1 i)
(row-major-aref a2 i))))))))))
(row-major-aref a2 i))))))))))
;;; *universe* is defined elsewhere -- it is a list of various
;;; lisp objects used when stimulating things in various tests.
(declaim (special *universe*))
(declaim (special *universe*))
(defun check-type-predicate (P TYPE)
(defun check-type-predicate (P TYPE)
"Check that a predicate P is the same as #'(lambda (x) (typep x TYPE))
"Check that a predicate P is the same as #'(lambda (x) (typep x TYPE))
by applying both to all elements of *UNIVERSE*. Print message
by applying both to all elements of *UNIVERSE*. Print message
when a mismatch is found, and return number of mistakes."
when a mismatch is found, and return number of mistakes."
(loop
(loop
for x in *universe* count
for x in *universe* count
(block failed
(block failed
...
@@ -193,8 +203,8 @@ the condition to go uncaught if it cannot be classified."
...
@@ -193,8 +203,8 @@ the condition to go uncaught if it cannot be classified."
(defun subtypep* (obj type)
(defun subtypep* (obj type)
(multiple-value-bind (result good)
(multiple-value-bind (result good)
(subtypep obj type)
(subtypep obj type)
(values (not
(
not result)
)
(values (notnot result)
(not
(
not good))))
)
(notnot good))))
;;; (eval-when (load eval compile)
;;; (eval-when (load eval compile)
;;; (unless (fboundp 'complement)
;;; (unless (fboundp 'complement)
...
@@ -206,10 +216,10 @@ the condition to go uncaught if it cannot be classified."
...
@@ -206,10 +216,10 @@ the condition to go uncaught if it cannot be classified."
#'(lambda (x) (loop for f in rfns do (setf x (funcall f x))) x)))
#'(lambda (x) (loop for f in rfns do (setf x (funcall f x))) x)))
(defun evendigitp (c)
(defun evendigitp (c)
(not
(
not (find c "02468")))
)
(notnot (find c "02468")))
(defun odddigitp (c)
(defun odddigitp (c)
(not
(
not (find c "13579")))
)
(notnot (find c "13579")))
(defun nextdigit (c)
(defun nextdigit (c)
(cadr (member c '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))))
(cadr (member c '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))))
...
@@ -335,6 +345,7 @@ the condition to go uncaught if it cannot be classified."
...
@@ -335,6 +345,7 @@ the condition to go uncaught if it cannot be classified."
(defun make-displaced-array (n displacement)
(defun make-displaced-array (n displacement)
(make-array n :displaced-to *displaced*
(make-array n :displaced-to *displaced*
:displaced-index-offset displacement))
:displaced-index-offset displacement))
;;; used in fill.lsp
;;; used in fill.lsp
...
@@ -366,16 +377,15 @@ the condition to go uncaught if it cannot be classified."
...
@@ -366,16 +377,15 @@ the condition to go uncaught if it cannot be classified."
(defun types-6-body ()
(defun types-6-body ()
(loop
(loop
for p in *subtype-table* count
for p in *subtype-table* count
(let ((tp (car p)))
(let ((tp (car p)))
(cond
(when (and (not (member tp '(sequence cons list t)))
((and (not (member tp '(sequence cons list t)))
(not (subtypep* tp 'atom)))
(not (subtypep* tp 'atom)))
(format t "~%Problem! Did not find to be an atomic type: ~S" tp)
(format t "~%Problem! Did not find to be an atomic type: ~S" tp)
t))))
t)))))
(defvar *type-list* nil)
(defvar *type-list* nil)
(defvar *supertype-table* nil)
(defvar *supertype-table* nil)
(declaim (special *subtype-table*
*universe*
))
(declaim (special *subtype-table*))
(defun types-9-body ()
(defun types-9-body ()
(let ((tp-list (append '(keyword atom list)
(let ((tp-list (append '(keyword atom list)
...
@@ -428,42 +438,42 @@ the condition to go uncaught if it cannot be classified."
...
@@ -428,42 +438,42 @@ the condition to go uncaught if it cannot be classified."
(defun types-9a-body ()
(defun types-9a-body ()
(cond
(cond
((not (and *type-list* *supertype-table*))
((not (and *type-list* *supertype-table*))
(format nil "Run test type-9 first~%")
(format nil "Run test type-9 first~%")
nil)
nil)
(t
(t
(loop
(loop
for tp in *type-list*
for tp in *type-list*
sum
sum
(let ((sups (gethash tp *supertype-table*)))
(let ((sups (gethash tp *supertype-table*)))
(loop
(loop
for x in *universe*
for x in *universe*
sum
sum
(handler-case
(handler-case
(cond
(cond
((not (typep x tp)) 0)
((not (typep x tp)) 0)
(t
(t
(loop
(loop
for tp2 in sups
for tp2 in sups
count
count
(handler-case
(handler-case
(and (not (typep x tp2))
(and (not (typep x tp2))
(progn
(progn
(format t "Found element of ~S not in ~S: ~S~%"
(format t "Found element of ~S not in ~S: ~S~%"
tp tp2 x)
tp tp2 x)
t))
t))
(condition (c) (format t "Error ~S occured: ~S~%"
(condition (c) (format t "Error ~S occured: ~S~%"
c tp2)
c tp2)
t)))))
t)))))
(condition (c) (format t "Error ~S occured: ~S~%" c tp)
(condition (c) (format t "Error ~S occured: ~S~%" c tp)
1))))))))
1))))))))
(defun even-size-p (a)
(defun even-size-p (a)
(some #'evenp (array-dimensions a)))
(some #'evenp (array-dimensions a)))
(defun check-cons-copy (x y)
(defun check-cons-copy (x y)
"Check that the tree x is a copy of the tree y,
"Check that the tree x is a copy of the tree y,
returning t if
f
it is."
returning t if it is
, nil if not
."
(cond
(cond
((consp x)
((consp x)
(and (consp y)
(and (consp y)
...
@@ -602,30 +612,30 @@ the condition to go uncaught if it cannot be classified."
...
@@ -602,30 +612,30 @@ the condition to go uncaught if it cannot be classified."
(let* ((cal (min 2048 call-arguments-limit))
(let* ((cal (min 2048 call-arguments-limit))
(step (max 1 (floor (/ cal) 64))))
(step (max 1 (floor (/ cal) 64))))
(loop
(loop
for n from 0
for n from 0
below cal
below cal
by step
by step
count
count
(not
(not
(equal
(equal
(apply #'append (loop for i from 1 to n
(apply #'append (loop for i from 1 to n
collect '(a)))
collect '(a)))
(make-list n :initial-element 'a))))))
(make-list n :initial-element 'a))))))
(defun is-intersection (x y z)
(defun is-intersection (x y z)
"Check that z is the intersection of x and y."
"Check that z is the intersection of x and y."
(and
(and
(
every #'(lambda (e
)
(
listp x
)
(or (not (member e
y)
)
(listp
y)
(member e
z)
))
(listp
z)
x
)
(loop for e in
x
(every #'(lambda (e
)
always (or (not (member e y)
)
(or (not
(member e
x
))
(member e
z)
))
(
member e z)))
(
loop for e in y
y
)
always (or (not (member e x)
)
(
every #'(lambda (e
)
(
member e z))
)
(and (member e x) (member e y)))
(loop for e in z
z
)
always (and (member e x) (member e y))
)
t))
t))
(defun shuffle (x)
(defun shuffle (x)
...
@@ -650,14 +660,16 @@ the condition to go uncaught if it cannot be classified."
...
@@ -650,14 +660,16 @@ the condition to go uncaught if it cannot be classified."
(defun intersection-12-body (size niters &optional (maxelem (* 2 size)))
(defun intersection-12-body (size niters &optional (maxelem (* 2 size)))
(let ((state (make-random-state)))
(let ((state (make-random-state)))
(loop
(loop
for i from 1 to niters do
for i from 1 to niters do
(let ((x (shuffle (loop for j from 1 to size collect (random maxelem state))))
(let ((x (shuffle (loop for j from 1 to size
(y (shuffle (loop for j from 1 to size collect (random maxelem state)))))
collect (random maxelem state))))
(let ((z (intersection x y)))
(y (shuffle (loop for j from 1 to size
(let ((is-good (is-intersection x y z)))
collect (random maxelem state)))))
(unless is-good (return (values x y z)))))))
(let ((z (intersection x y)))
nil))
(let ((is-good (is-intersection x y z)))
(unless is-good (return (values x y z)))))))
nil))
(defun nintersection-with-check (x y &key test)
(defun nintersection-with-check (x y &key test)
(let ((ycopy (make-scaffold-copy y)))
(let ((ycopy (make-scaffold-copy y)))
...
@@ -672,8 +684,10 @@ the condition to go uncaught if it cannot be classified."
...
@@ -672,8 +684,10 @@ the condition to go uncaught if it cannot be classified."
(let ((state (make-random-state t)))
(let ((state (make-random-state t)))
(loop
(loop
for i from 1 to niters do
for i from 1 to niters do
(let ((x (shuffle (loop for j from 1 to size collect (random maxelem state))))
(let ((x (shuffle (loop for j from 1 to size
(y (shuffle (loop for j from 1 to size collect (random maxelem state)))))
collect (random maxelem state))))
(y (shuffle (loop for j from 1 to size
collect (random maxelem state)))))
(let ((z (nintersection-with-check (copy-list x) y)))
(let ((z (nintersection-with-check (copy-list x) y)))
(when (eqt z 'failed) (return (values x y z)))
(when (eqt z 'failed) (return (values x y z)))
(let ((is-good (is-intersection x y z)))
(let ((is-good (is-intersection x y z)))
...
@@ -688,8 +702,7 @@ the condition to go uncaught if it cannot be classified."
...
@@ -688,8 +702,7 @@ the condition to go uncaught if it cannot be classified."
(test (union x y :test test))
(test (union x y :test test))
(test-not (union x y :test-not test-not))
(test-not (union x y :test-not test-not))
(t (union x y)))))
(t (union x y)))))
(if
(if (and (check-scaffold-copy x xcopy)
(and (check-scaffold-copy x xcopy)
(check-scaffold-copy y ycopy))
(check-scaffold-copy y ycopy))
result
result
'failed))))
'failed))))
...
@@ -701,8 +714,7 @@ the condition to go uncaught if it cannot be classified."
...
@@ -701,8 +714,7 @@ the condition to go uncaught if it cannot be classified."
(test (union x y :key key :test test))
(test (union x y :key key :test test))
(test-not (union x y :key key :test-not test-not))
(test-not (union x y :key key :test-not test-not))
(t (union x y :key key)))))
(t (union x y :key key)))))
(if
(if (and (check-scaffold-copy x xcopy)
(and (check-scaffold-copy x xcopy)
(check-scaffold-copy y ycopy))
(check-scaffold-copy y ycopy))
result
result
'failed))))
'failed))))
...
@@ -711,11 +723,9 @@ the condition to go uncaught if it cannot be classified."
...
@@ -711,11 +723,9 @@ the condition to go uncaught if it cannot be classified."
(and (listp x)
(and (listp x)
(listp y)
(listp y)
(listp z)
(listp z)
(every #'(lambda (e) (or (member e x)
(loop for e in z always (or (member e x) (member e y)))
(member e y)))
(loop for e in x always (member e z))
z)
(loop for e in y always (member e z))
(every #'(lambda (e) (member e z)) x)
(every #'(lambda (e) (member e z)) y)
t))
t))
(defun do-random-unions (size niters &optional (maxelem (* 2 size)))
(defun do-random-unions (size niters &optional (maxelem (* 2 size)))
...
@@ -781,27 +791,30 @@ the condition to go uncaught if it cannot be classified."
...
@@ -781,27 +791,30 @@ the condition to go uncaught if it cannot be classified."
(defun check-set-difference (x y z &key (key #'identity)
(defun check-set-difference (x y z &key (key #'identity)
(test #'eql))
(test #'eql))
(and
(and
(not (eqt 'failed z))
;; (not (eqt 'failed z))
(every #'(lambda (e) (member e x :key key :test test)) z)
(listp x)
(every #'(lambda (e) (or (member e y :key key :test test)
(listp y)
(member e z :key key :test test))) x)
(listp z)
(every #'(lambda (e) (not (member e z :key key :test test))) y)
(loop for e in z always (member e x :key key :test test))
(loop for e in x always (or (member e y :key key :test test)
(member e z :key key :test test)))
(loop for e in y never (member e z :key key :test test))
t))
t))
(defun do-random-set-differences (size niters &optional (maxelem (* 2 size)))
(defun do-random-set-differences (size niters &optional (maxelem (* 2 size)))
(let ((state (make-random-state)))
(let ((state (make-random-state)))
(loop
(loop
for i from 1 to niters do
for i from 1 to niters do
(let ((x (shuffle (loop for j from 1 to size collect
(let ((x (shuffle (loop for j from 1 to size collect
(random maxelem state))))
(random maxelem state))))
(y (shuffle (loop for j from 1 to size collect
(y (shuffle (loop for j from 1 to size collect
(random maxelem state)))))
(random maxelem state)))))
(let ((z (set-difference-with-check x y)))
(let ((z (set-difference-with-check x y)))
(let ((is-good (check-set-difference x y z)))
(let ((is-good (check-set-difference x y z)))
(unless is-good (return (values x y z)))))))
(unless is-good (return (values x y z)))))))
nil))
nil))
(defun nset-difference-with-check (x y &key (key 'no-key)
(defun nset-difference-with-check (x y &key (key 'no-key)
test test-not)
test test-not)
(setf x (copy-list x))
(setf x (copy-list x))
(setf y (copy-list y))
(setf y (copy-list y))
(apply #'nset-difference
(apply #'nset-difference
...
@@ -811,29 +824,32 @@ the condition to go uncaught if it cannot be classified."
...
@@ -811,29 +824,32 @@ the condition to go uncaught if it cannot be classified."
,@(when test-not `(:test-not ,test-not)))))
,@(when test-not `(:test-not ,test-not)))))
(defun check-nset-difference (x y z &key (key #'identity)
(defun check-nset-difference (x y z &key (key #'identity)
(test #'eql))
(test #'eql))
(and
(and
(every #'(lambda (e) (member e x :key key :test test)) z)
(listp x)
(every #'(lambda (e) (or (member e y :key key :test test)
(listp y)
(member e z :key key :test test))) x)
(listp z)
(every #'(lambda (e) (not (member e z :key key :test test))) y)
(loop for e in z always (member e x :key key :test test))
(loop for e in x always (or (member e y :key key :test test)
(member e z :key key :test test)))
(loop for e in y never (member e z :key key :test test))
t))
t))
(defun do-random-nset-differences (size niters &optional (maxelem (* 2 size)))
(defun do-random-nset-differences (size niters &optional (maxelem (* 2 size)))
(let ((state (make-random-state)))
(let ((state (make-random-state)))
(loop
(loop
for i from 1 to niters do
for i from 1 to niters do
(let ((x (shuffle (loop for j from 1 to size collect
(let ((x (shuffle (loop for j from 1 to size collect
(random maxelem state))))
(random maxelem state))))
(y (shuffle (loop for j from 1 to size collect
(y (shuffle (loop for j from 1 to size collect
(random maxelem state)))))
(random maxelem state)))))
(let ((z (nset-difference-with-check x y)))
(let ((z (nset-difference-with-check x y)))
(let ((is-good (check-nset-difference x y z)))
(let ((is-good (check-nset-difference x y z)))
(unless is-good (return (values x y z)))))))
(unless is-good (return (values x y z)))))))
nil))
nil))
(defun set-exclusive-or-with-check (x y &key (key 'no-key)
(defun set-exclusive-or-with-check (x y &key (key 'no-key)
test test-not)
test test-not)
(setf x (copy-list x))
(setf x (copy-list x))
(setf y (copy-list y))
(setf y (copy-list y))
(let ((xcopy (make-scaffold-copy x))
(let ((xcopy (make-scaffold-copy x))
...
@@ -841,8 +857,8 @@ the condition to go uncaught if it cannot be classified."
...
@@ -841,8 +857,8 @@ the condition to go uncaught if it cannot be classified."
(let ((result (apply #'set-exclusive-or
(let ((result (apply #'set-exclusive-or
x y
x y
`(,@(unless (eqt key 'no-key) `(:key ,key))
`(,@(unless (eqt key 'no-key) `(:key ,key))
,@(when test `(:test ,test))
,@(when test `(:test ,test))
,@(when test-not `(:test-not ,test-not))))))
,@(when test-not `(:test-not ,test-not))))))
(cond
(cond
((and (check-scaffold-copy x xcopy)
((and (check-scaffold-copy x xcopy)
(check-scaffold-copy y ycopy))
(check-scaffold-copy y ycopy))
...
@@ -851,37 +867,37 @@ the condition to go uncaught if it cannot be classified."
...
@@ -851,37 +867,37 @@ the condition to go uncaught if it cannot be classified."
'failed)))))
'failed)))))
(defun check-set-exclusive-or (x y z &key (key #'identity)
(defun check-set-exclusive-or (x y z &key (key #'identity)
(test #'eql))
(test #'eql))
(and
(and
(not (eqt 'failed z))
;;
(not (eqt 'failed z))
(
every #'(lambda (e) (or (member e x :key key :test test
)
(
listp x
)
(member e y :key key :test test))
)
(listp y
)
z)
(listp
z)
(
every #'(lambda (e) (if
(member e
y
:key key :test test)
(
loop for e in z always (or
(member e
x
:key key :test test)
(not
(member e
z
:key key :test test))
(member e
y
:key key :test test))
)
(member e
z
:key key :test test)
))
(loop for e in x always (if
(member e
y
:key key :test test)
x
)
(not (member e z :key key :test test)
)
(every #'(lambda (e) (if
(member e
x
:key key :test test)
(member e
z
:key key :test test)
))
(not
(member e
z
:key key :test test)
)
(loop for e in y always (if
(member e
x
:key key :test test)
(member e z :key key :test test))
)
(not
(member e z :key key :test test))
y
)
(member e z :key key :test test))
)
t))
t))
(defun do-random-set-exclusive-ors (size niters &optional (maxelem (* 2 size)))
(defun do-random-set-exclusive-ors (size niters &optional (maxelem (* 2 size)))
(let ((state (make-random-state)))
(let ((state (make-random-state)))
(loop
(loop
for i from 1 to niters do
for i from 1 to niters do
(let ((x (shuffle (loop for j from 1 to size collect
(let ((x (shuffle (loop for j from 1 to size collect
(random maxelem state))))
(random maxelem state))))
(y (shuffle (loop for j from 1 to size collect
(y (shuffle (loop for j from 1 to size collect
(random maxelem state)))))
(random maxelem state)))))
(let ((z (set-exclusive-or-with-check x y)))
(let ((z (set-exclusive-or-with-check x y)))
(let ((is-good (check-set-exclusive-or x y z)))
(let ((is-good (check-set-exclusive-or x y z)))
(unless is-good (return (values x y z)))))))
(unless is-good (return (values x y z)))))))
nil))
nil))
(defun nset-exclusive-or-with-check (x y &key (key 'no-key)
(defun nset-exclusive-or-with-check (x y &key (key 'no-key)
test test-not)
test test-not)
(setf x (copy-list x))
(setf x (copy-list x))
(setf y (copy-list y))
(setf y (copy-list y))
(apply #'nset-exclusive-or
(apply #'nset-exclusive-or
...
@@ -893,14 +909,14 @@ the condition to go uncaught if it cannot be classified."
...
@@ -893,14 +909,14 @@ the condition to go uncaught if it cannot be classified."
(defun do-random-nset-exclusive-ors (size niters &optional (maxelem (* 2 size)))
(defun do-random-nset-exclusive-ors (size niters &optional (maxelem (* 2 size)))
(let ((state (make-random-state)))
(let ((state (make-random-state)))
(loop
(loop
for i from 1 to niters do
for i from 1 to niters do
(let ((x (shuffle (loop for j from 1 to size collect
(let ((x (shuffle (loop for j from 1 to size collect
(random maxelem state))))
(random maxelem state))))
(y (shuffle (loop for j from 1 to size collect
(y (shuffle (loop for j from 1 to size collect
(random maxelem state)))))
(random maxelem state)))))
(let ((z (nset-exclusive-or-with-check x y)))
(let ((z (nset-exclusive-or-with-check x y)))
(let ((is-good (check-set-exclusive-or x y z)))
(let ((is-good (check-set-exclusive-or x y z)))
(unless is-good (return (values x y z)))))))
(unless is-good (return (values x y z)))))))
nil))
nil))
(defun subsetp-with-check (x y &key (key 'no-key) test test-not)
(defun subsetp-with-check (x y &key (key 'no-key) test test-not)
...
@@ -910,8 +926,8 @@ the condition to go uncaught if it cannot be classified."
...
@@ -910,8 +926,8 @@ the condition to go uncaught if it cannot be classified."
(apply #'subsetp x y
(apply #'subsetp x y
`(,@(unless (eqt key 'no-key)
`(,@(unless (eqt key 'no-key)
`(:key ,key))
`(:key ,key))
,@(when test `(:test ,test))
,@(when test `(:test ,test))
,@(when test-not `(:test-not ,test-not))))))
,@(when test-not `(:test-not ,test-not))))))
(cond
(cond
((and (check-scaffold-copy x xcopy)
((and (check-scaffold-copy x xcopy)
(check-scaffold-copy y ycopy))
(check-scaffold-copy y ycopy))
...
@@ -919,4 +935,4 @@ the condition to go uncaught if it cannot be classified."
...
@@ -919,4 +935,4 @@ the condition to go uncaught if it cannot be classified."
(t 'failed)))))
(t 'failed)))))
(defun safe-elt (x n)
(defun safe-elt (x n)
(classify-error* (elt x n)))
(classify-error* (elt x n)))
\ No newline at end of file
This diff is collapsed.
Click to expand it.
ansi-tests/char-aux.lsp
+
3
−
3
View file @
c6fa246e
...
@@ -35,8 +35,8 @@
...
@@ -35,8 +35,8 @@
(cond
(cond
((null args) t)
((null args) t)
((car args)
((car args)
(
every #'identity
(cdr args)))
(
loop for e in
(cdr args)
always e
))
(t (
every #'not
(cdr args)))))
(t (
loop for e in
(cdr args)
never e
))))
;;; From character.lsp
;;; From character.lsp
(defun char-type-error-check (fn)
(defun char-type-error-check (fn)
...
@@ -86,7 +86,7 @@
...
@@ -86,7 +86,7 @@
(loop for x in *universe*
(loop for x in *universe*
always (let ((p (characterp x))
always (let ((p (characterp x))
(q (typep x 'character)))
(q (typep x 'character)))
(if p (not
(
not q)
)
(not q)))))
(if p (notnot q) (not q)))))
(defun alphanumericp.4.body ()
(defun alphanumericp.4.body ()
(loop for x in *universe*
(loop for x in *universe*
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment