Commit c7bcc4fa authored by sds's avatar sds
Browse files

untabify

parent 33e27a6d
......@@ -13,7 +13,7 @@
(deftest abort.2
(let ((c1 (make-condition 'error))
(c2 (make-condition 'error)))
(c2 (make-condition 'error)))
(restart-case
(with-condition-restarts
c1
......@@ -31,7 +31,7 @@
(deftest abort.4
(let ((c1 (make-condition 'error))
(c2 (make-condition 'error)))
(c2 (make-condition 'error)))
(restart-case
(with-condition-restarts
c1
......@@ -44,7 +44,7 @@
(deftest abort.5
(signals-error
(let ((c1 (make-condition 'error))
(c2 (make-condition 'error)))
(c2 (make-condition 'error)))
(with-condition-restarts
c1
(compute-restarts)
......
......@@ -21,36 +21,36 @@
(deftest abs.1
(loop for x in *numbers*
for a = (abs x)
always (and (realp a) (not (minusp a))))
for a = (abs x)
always (and (realp a) (not (minusp a))))
t)
(deftest abs.2
(loop for x = (random-fixnum)
for a = (abs x)
repeat 10000
unless (if (plusp x) (eql x a) (eql (- x) a))
collect (list x a))
for a = (abs x)
repeat 10000
unless (if (plusp x) (eql x a) (eql (- x) a))
collect (list x a))
nil)
(deftest abs.3
(let ((bound (ash 1 300)))
(loop for x = (random-from-interval bound)
for a = (abs x)
repeat 10000
unless (if (plusp x) (eql x a) (eql (- x) a))
collect (list x a)))
for a = (abs x)
repeat 10000
unless (if (plusp x) (eql x a) (eql (- x) a))
collect (list x a)))
nil)
(deftest abs.4
(loop for num = (random-fixnum)
for den = (random-fixnum)
for den2 = (if (zerop den) 1 den)
for r = (/ num den)
for a = (abs r)
repeat 10000
unless (if (>= r 0) (eql r a) (eql (- r) a))
collect (list num den2 r a))
for den = (random-fixnum)
for den2 = (if (zerop den) 1 den)
for r = (/ num den)
for a = (abs r)
repeat 10000
unless (if (>= r 0) (eql r a) (eql (- r) a))
collect (list num den2 r a))
nil)
(deftest abs.5
......@@ -73,8 +73,8 @@
for a = (abs x)
repeat 10000
unless (if (minusp x)
(eql (- x) a)
(eql x a))
(eql (- x) a)
(eql x a))
collect (list x a)))
nil)
......@@ -85,8 +85,8 @@
for a = (abs x)
repeat 10000
unless (if (minusp x)
(eql (- x) a)
(eql x a))
(eql (- x) a)
(eql x a))
collect (list x a)))
nil)
......@@ -97,8 +97,8 @@
for a = (abs x)
repeat 10000
unless (if (minusp x)
(eql (- x) a)
(eql x a))
(eql (- x) a)
(eql x a))
collect (list x a)))
nil)
......@@ -109,8 +109,8 @@
for a = (abs x)
repeat 10000
unless (if (minusp x)
(eql (- x) a)
(eql x a))
(eql (- x) a)
(eql x a))
collect (list x a)))
nil)
......@@ -122,15 +122,15 @@
;;; (deftest abs.10
;;; (abs -0.0s0)
;;; -0.0s0)
;;;
;;;
;;; (deftest abs.11
;;; (abs -0.0f0)
;;; -0.0f0)
;;;
;;;
;;; (deftest abs.12
;;; (abs -0.0d0)
;;; -0.0d0)
;;;
;;;
;;; (deftest abs.13
;;; (abs -0.0l0)
;;; -0.0l0)
......@@ -175,5 +175,5 @@
(deftest abs.22
(macrolet ((%m (z) z))
(abs (expand-in-current-env (%m -4))))
(abs (expand-in-current-env (%m -4))))
4)
......@@ -9,8 +9,8 @@
(deftest acons.1
(let* ((x (copy-tree '((c . d) (e . f))))
(xcopy (make-scaffold-copy x))
(result (acons 'a 'b x)))
(xcopy (make-scaffold-copy x))
(result (acons 'a 'b x)))
(and
(check-scaffold-copy x xcopy)
(eqt (cdr result) x)
......@@ -53,8 +53,8 @@
(let ((i 0) x y z)
(values
(acons (progn (setf x (incf i)) 'a)
(progn (setf y (incf i)) 'b)
(progn (setf z (incf i)) '((c . d))))
(progn (setf y (incf i)) 'b)
(progn (setf z (incf i)) '((c . d))))
i x y z))
((a . b)(c . d))
3 1 2 3)
......
......@@ -7,50 +7,50 @@
(deftest acos.1
(loop for i from -1000 to 1000
for rlist = (multiple-value-list (acos i))
for y = (car rlist)
always (and (null (cdr rlist))
(numberp y)))
for rlist = (multiple-value-list (acos i))
for y = (car rlist)
always (and (null (cdr rlist))
(numberp y)))
t)
(deftest acos.2
(loop for type in '(short-float single-float double-float long-float)
collect
(let ((a (coerce 2000 type))
(b (coerce -1000 type)))
(loop for x = (- (random a) b)
for rlist = (multiple-value-list (acos x))
for y = (car rlist)
repeat 1000
always (and (null (cdr rlist))
(numberp y)))))
collect
(let ((a (coerce 2000 type))
(b (coerce -1000 type)))
(loop for x = (- (random a) b)
for rlist = (multiple-value-list (acos x))
for y = (car rlist)
repeat 1000
always (and (null (cdr rlist))
(numberp y)))))
(t t t t))
(deftest acos.3
(loop for type in '(integer short-float single-float double-float long-float)
collect
(let ((a (coerce 2000 type))
(b (coerce -1000 type)))
(loop for x = (- (random a) b)
for rlist = (multiple-value-list (acos (complex 0 x)))
for y = (car rlist)
repeat 1000
always (and (null (cdr rlist))
(numberp y)))))
collect
(let ((a (coerce 2000 type))
(b (coerce -1000 type)))
(loop for x = (- (random a) b)
for rlist = (multiple-value-list (acos (complex 0 x)))
for y = (car rlist)
repeat 1000
always (and (null (cdr rlist))
(numberp y)))))
(t t t t t))
(deftest acos.4
(loop for type in '(integer short-float single-float double-float long-float)
collect
(let ((a (coerce 2000 type))
(b (coerce -1000 type)))
(loop for x1 = (- (random a) b)
for x2 = (- (random a) b)
for rlist = (multiple-value-list (acos (complex x1 x2)))
for y = (car rlist)
repeat 1000
always (and (null (cdr rlist))
(numberp y)))))
collect
(let ((a (coerce 2000 type))
(b (coerce -1000 type)))
(loop for x1 = (- (random a) b)
for x2 = (- (random a) b)
for rlist = (multiple-value-list (acos (complex x1 x2)))
for y = (car rlist)
repeat 1000
always (and (null (cdr rlist))
(numberp y)))))
(t t t t t))
(deftest acos.5
......@@ -59,23 +59,23 @@
(deftest acos.6
(loop for type in '(single-float short-float double-float long-float)
unless (approx= (acos (coerce 0 type))
(coerce (/ pi 2) type))
collect type)
unless (approx= (acos (coerce 0 type))
(coerce (/ pi 2) type))
collect type)
nil)
(deftest acos.7
(loop for type in '(single-float short-float double-float long-float)
unless (approx= (acos (coerce 1 type))
(coerce 0 type))
collect type)
unless (approx= (acos (coerce 1 type))
(coerce 0 type))
collect type)
nil)
(deftest acos.8
(loop for type in '(single-float short-float double-float long-float)
unless (approx= (acos (coerce -1 type))
(coerce pi type))
collect type)
unless (approx= (acos (coerce -1 type))
(coerce pi type))
collect type)
nil)
(deftest acos.9
......
......@@ -8,64 +8,64 @@
(deftest acosh.1
(let ((result (acosh 1)))
(or (eqlt result 0)
(eqlt result 0.0)))
(eqlt result 0.0)))
t)
(deftest acosh.2
(loop for type in '(short-float single-float double-float long-float)
for zero = (coerce 0 type)
for one = (coerce 1 type)
unless (equal (multiple-value-list (acosh one))
(list zero))
collect type)
for zero = (coerce 0 type)
for one = (coerce 1 type)
unless (equal (multiple-value-list (acosh one))
(list zero))
collect type)
nil)
(deftest acosh.3
(loop for type in '(short-float single-float double-float long-float)
for zero = (coerce 0 `(complex ,type))
for one = (coerce 1 `(complex ,type))
unless (equal (multiple-value-list (acosh one))
(list zero))
collect type)
for zero = (coerce 0 `(complex ,type))
for one = (coerce 1 `(complex ,type))
unless (equal (multiple-value-list (acosh one))
(list zero))
collect type)
nil)
(deftest acosh.4
(loop for den = (1+ (random 10000))
for num = (random (* 10 den))
for x = (/ num den)
for rlist = (multiple-value-list (acosh x))
for y = (car rlist)
repeat 1000
unless (and (null (cdr rlist))
(numberp y))
collect (list x rlist))
for num = (random (* 10 den))
for x = (/ num den)
for rlist = (multiple-value-list (acosh x))
for y = (car rlist)
repeat 1000
unless (and (null (cdr rlist))
(numberp y))
collect (list x rlist))
nil)
(deftest acosh.5
(loop for type in '(short-float single-float double-float long-float)
nconc
(loop
for x = (1+ (random (coerce 1000 type)))
for rlist = (multiple-value-list (acosh x))
for y = (car rlist)
repeat 1000
unless (and (null (cdr rlist))
(typep y type))
collect (list x rlist)))
nconc
(loop
for x = (1+ (random (coerce 1000 type)))
for rlist = (multiple-value-list (acosh x))
for y = (car rlist)
repeat 1000
unless (and (null (cdr rlist))
(typep y type))
collect (list x rlist)))
nil)
(deftest acosh.6
(loop for type in '(short-float single-float double-float long-float)
nconc
(loop
for x1 = (- (random (coerce 20 type)) 10)
for x2 = (- (random (coerce 20 type)) 10)
for rlist = (multiple-value-list (acosh (complex x1 x2)))
for y = (car rlist)
repeat 1000
unless (and (null (cdr rlist))
(typep y `(complex ,type)))
collect (list x1 x2 rlist)))
nconc
(loop
for x1 = (- (random (coerce 20 type)) 10)
for x2 = (- (random (coerce 20 type)) 10)
for rlist = (multiple-value-list (acosh (complex x1 x2)))
for y = (car rlist)
repeat 1000
unless (and (null (cdr rlist))
(typep y `(complex ,type)))
collect (list x1 x2 rlist)))
nil)
(deftest acosh.7
......@@ -93,8 +93,8 @@
......@@ -23,9 +23,9 @@
(deftest add-method.error.2
(let* ((gf (eval '(defgeneric add-method-gf-03 (x)
(:method ((x t)) 'a))))
(method (find-method #'add-method-gf-03 nil (list (find-class t))))
(gf2 (eval '(defgeneric add-method-gf-04 (x y)))))
(:method ((x t)) 'a))))
(method (find-method #'add-method-gf-03 nil (list (find-class t))))
(gf2 (eval '(defgeneric add-method-gf-04 (x y)))))
(handler-case
(add-method gf2 method)
(error () :error)))
......@@ -33,9 +33,9 @@
(deftest add-method.error.3
(let* ((gf (eval '(defgeneric add-method-gf-05 (x &optional y)
(:method ((x t) &optional y) 'a))))
(method (find-method #'add-method-gf-05 nil (list (find-class t))))
(gf2 (eval '(defgeneric add-method-gf-06 (x y)))))
(:method ((x t) &optional y) 'a))))
(method (find-method #'add-method-gf-05 nil (list (find-class t))))
(gf2 (eval '(defgeneric add-method-gf-06 (x y)))))
(handler-case
(add-method gf2 method)
(error () :error)))
......@@ -52,9 +52,9 @@
(deftest add-method.error.6
(signals-error
(let* ((gf (eval '(defgeneric add-method-gf-07 (x)
(:method ((x t)) 'a))))
(method (find-method #'add-method-gf-07 nil (list (find-class t))))
(gf2 (eval '(defgeneric add-method-gf-08 (x)))))
(:method ((x t)) 'a))))
(method (find-method #'add-method-gf-07 nil (list (find-class t))))
(gf2 (eval '(defgeneric add-method-gf-08 (x)))))
(remove-method gf method)
(add-method gf2 method nil))
program-error)
......@@ -62,10 +62,10 @@
(deftest add-method.error.7
(let* ((gf (eval '(defgeneric add-method-gf-09 (x y)
(:method ((x t) (y t)) 'a))))
(method (find-method #'add-method-gf-09 nil (list (find-class t)
(find-class t))))
(gf2 (eval '(defgeneric add-method-gf-10 (x &optional y)))))
(:method ((x t) (y t)) 'a))))
(method (find-method #'add-method-gf-09 nil (list (find-class t)
(find-class t))))
(gf2 (eval '(defgeneric add-method-gf-10 (x &optional y)))))
(remove-method gf method)
(handler-case
(add-method gf2 method)
......@@ -74,9 +74,9 @@
(deftest add-method.error.8
(let* ((gf (eval '(defgeneric add-method-gf-11 (x &key y)
(:method ((x t) &key y) 'a))))
(method (find-method #'add-method-gf-11 nil (list (find-class t))))
(gf2 (eval '(defgeneric add-method-gf-12 (x)))))
(:method ((x t) &key y) 'a))))
(method (find-method #'add-method-gf-11 nil (list (find-class t))))
(gf2 (eval '(defgeneric add-method-gf-12 (x)))))
(remove-method gf method)
(handler-case
(add-method gf2 method)
......@@ -88,11 +88,11 @@
(deftest add-method.1
(let* ((gf (eval '(defgeneric add-method-gf-13 (x)
(:method ((x integer)) 'a)
(:method ((x t)) 'b))))
(method (find-method #'add-method-gf-13
nil (list (find-class 'integer))))
(gf2 (eval '(defgeneric add-method-gf-14 (x)))))
(:method ((x integer)) 'a)
(:method ((x t)) 'b))))
(method (find-method #'add-method-gf-13
nil (list (find-class 'integer))))
(gf2 (eval '(defgeneric add-method-gf-14 (x)))))
(declare (type generic-function gf gf2))
(values
(funcall gf 0)
......@@ -108,14 +108,14 @@
(deftest add-method.2
(let* ((specializers (list (find-class 'integer)))
(gf (eval '(defgeneric add-method-gf-15 (x)
(:method ((x integer)) 'a)
(:method ((x t)) 'b))))
(method (find-method gf nil specializers))
(gf2 (eval '(defgeneric add-method-gf-16 (x)
(:method ((x integer)) 'c)
(:method ((x t)) 'd))))
(method2 (find-method gf2 nil specializers)))
(gf (eval '(defgeneric add-method-gf-15 (x)
(:method ((x integer)) 'a)
(:method ((x t)) 'b))))
(method (find-method gf nil specializers))
(gf2 (eval '(defgeneric add-method-gf-16 (x)
(:method ((x integer)) 'c)
(:method ((x t)) 'd))))
(method2 (find-method gf2 nil specializers)))
(declare (type generic-function gf gf2))
(values
(funcall gf 0)
......
......@@ -55,35 +55,35 @@
(deftest adjoin.12
(adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
:test-not (complement #'equal))
:test-not (complement #'equal))
(aaa "AAA" "aaa" #\a))
(deftest adjoin.14
(adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
:test #'equal :key #'identity)
:test #'equal :key #'identity)
(aaa "AAA" "aaa" #\a))
(deftest adjoin.15
(adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
:test 'equal :key #'identity)
:test 'equal :key #'identity)
(aaa "AAA" "aaa" #\a))
;; Test that a :key of NIL is the same as no key at all
(deftest adjoin.16
(adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
:test #'equal :key nil)
:test #'equal :key nil)
(aaa "AAA" "aaa" #\a))
;; Test that a :key of NIL is the same as no key at all
(deftest adjoin.17
(adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
:test 'equal :key nil)
:test 'equal :key nil)
(aaa "AAA" "aaa" #\a))
;; Test that a :key of NIL is the same as no key at all
(deftest adjoin.18
(adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
:test-not (complement #'equal) :key nil)
:test-not (complement #'equal) :key nil)
(aaa "AAA" "aaa" #\a))
;;; Ordering in comparison function
......@@ -113,15 +113,15 @@
(deftest adjoin.24
(macrolet ((%m (z) z))
(values
(adjoin (expand-in-current-env (%m 'a)) '(b c))
(adjoin 'a (expand-in-current-env (%m '(b c))))
(adjoin 'a '(b c) (expand-in-current-env (%m :test)) 'eql)
(adjoin 'a '(a a) (expand-in-current-env (%m :test-not)) 'eql)
(adjoin 'a '(b c) :test (expand-in-current-env (%m 'eql)))
(adjoin 'a '(b c) :test (expand-in-current-env (%m #'eql)))
(adjoin 1 '(1 2 3) :key (expand-in-current-env (%m 'identity)))
))
(values
(adjoin (expand-in-current-env (%m 'a)) '(b c))
(adjoin 'a (expand-in-current-env (%m '(b c))))
(adjoin 'a '(b c) (expand-in-current-env (%m :test)) 'eql)
(adjoin 'a '(a a) (expand-in-current-env (%m :test-not)) 'eql)
(adjoin 'a '(b c) :test (expand-in-current-env (%m 'eql)))
(adjoin 'a '(b c) :test (expand-in-current-env (%m #'eql)))
(adjoin 1 '(1 2 3) :key (expand-in-current-env (%m 'identity)))
))
(a b c)
(a b c)
(a b c)
......@@ -140,9 +140,9 @@
(let ((i 0) w x y z)
(values
(adjoin (progn (setf w (incf i)) 'a)
(progn (setf x (incf i)) '(b c d a e))
:key (progn (setf y (incf i)) #'identity)
:test (progn (setf z (incf i)) #'eql))
(progn (setf x (incf i)) '(b c d a e))
:key (progn (setf y (incf i)) #'identity)
:test (progn (setf z (incf i)) #'eql))
i w x y z))
(b c d a e)
4 1 2 3 4)
......@@ -151,10 +151,10 @@
(let ((i 0) w x y z p)
(values
(adjoin (progn (setf w (incf i)) 'a)
(progn (setf x (incf i)) '(b c d e))
:test-not (progn (setf y (incf i)) (complement #'eql))
:key (progn (setf z (incf i)) #'identity)
:key (progn (setf p (incf i)) nil))
(progn (setf x (incf i)) '(b c d e))
:test-not (progn (setf y (incf i)) (complement #'eql))
:key (progn (setf z (incf i)) #'identity)
:key (progn (setf p (incf i)) nil))
i w x y z p))
(a b c d e)
5 1 2 3 4 5)
......
This diff is collapsed.
......@@ -27,15 +27,15 @@
(deftest adjustable-array-p.6
(macrolet ((%m (z) z))
(let ((a (make-array '(5) :adjustable t)))
(notnot (adjustable-array-p (expand-in-current-env (%m a))))))
(let ((a (make-array '(5) :adjustable t)))
(notnot (adjustable-array-p (expand-in-current-env (%m a))))))
t)
(deftest adjustable-array-p.order.1
(let ((i 0) x)
(values
(notnot (adjustable-array-p (progn (setf x (incf i))
(make-array '(5) :adjustable t))))
(make-array '(5) :adjustable t))))
i x))
t 1 1)
......@@ -63,7 +63,7 @@
(deftest adjustable-array-p.error.6
(signals-error (let ((x 10))
(locally (declare (optimize (safety 3)))
(adjustable-array-p x)))
type-error)
(locally (declare (optimize (safety 3)))
(adjustable-array-p x)))
type-error)
t)
......@@ -17,7 +17,7 @@
(deftest allocate-instance.1
(let* ((class (find-class 'allocate-instance-class-01))
(obj (allocate-instance class)))
(obj (allocate-instance class)))
(values
(eqt (class-of obj) class)
(typep* obj 'allocate-instance-class-01)
......@@ -28,9 +28,9 @@
(deftest allocate-instance.2
(let* ((class (find-class 'allocate-instance-class-01))
(obj (allocate-instance class
:foo t :a 10 :b 12 :c 1.0 :d 'a :e 17
:f nil :bar t)))
(obj (allocate-instance class
:foo t :a 10 :b 12 :c 1.0 :d 'a :e 17
:f nil :bar t)))
(values
(eqt (class-of obj) class)
(typep* obj 'allocate-instance-class-01)
......@@ -41,7 +41,7 @@