Commit daa08725 authored by Nikodemus Siivola's avatar Nikodemus Siivola

untabify tests

  Yech. Phui. Tabs.
parent a8fa3994
...@@ -60,43 +60,43 @@ ...@@ -60,43 +60,43 @@
(deftest unwind-protect-case.1 (deftest unwind-protect-case.1
(let (result) (let (result)
(unwind-protect-case () (unwind-protect-case ()
(random 10) (random 10)
(:normal (push :normal result)) (:normal (push :normal result))
(:abort (push :abort result)) (:abort (push :abort result))
(:always (push :always result))) (:always (push :always result)))
result) result)
(:always :normal)) (:always :normal))
(deftest unwind-protect-case.2 (deftest unwind-protect-case.2
(let (result) (let (result)
(unwind-protect-case () (unwind-protect-case ()
(random 10) (random 10)
(:always (push :always result)) (:always (push :always result))
(:normal (push :normal result)) (:normal (push :normal result))
(:abort (push :abort result))) (:abort (push :abort result)))
result) result)
(:normal :always)) (:normal :always))
(deftest unwind-protect-case.3 (deftest unwind-protect-case.3
(let (result1 result2 result3) (let (result1 result2 result3)
(ignore-errors (ignore-errors
(unwind-protect-case () (unwind-protect-case ()
(error "FOOF!") (error "FOOF!")
(:normal (push :normal result1)) (:normal (push :normal result1))
(:abort (push :abort result1)) (:abort (push :abort result1))
(:always (push :always result1)))) (:always (push :always result1))))
(catch 'foof (catch 'foof
(unwind-protect-case () (unwind-protect-case ()
(throw 'foof 42) (throw 'foof 42)
(:normal (push :normal result2)) (:normal (push :normal result2))
(:abort (push :abort result2)) (:abort (push :abort result2))
(:always (push :always result2)))) (:always (push :always result2))))
(block foof (block foof
(unwind-protect-case () (unwind-protect-case ()
(return-from foof 42) (return-from foof 42)
(:normal (push :normal result3)) (:normal (push :normal result3))
(:abort (push :abort result3)) (:abort (push :abort result3))
(:always (push :always result3)))) (:always (push :always result3))))
(values result1 result2 result3)) (values result1 result2 result3))
(:always :abort) (:always :abort)
(:always :abort) (:always :abort)
...@@ -105,17 +105,17 @@ ...@@ -105,17 +105,17 @@
(deftest unwind-protect-case.4 (deftest unwind-protect-case.4
(let (result) (let (result)
(unwind-protect-case (aborted-p) (unwind-protect-case (aborted-p)
(random 42) (random 42)
(:always (setq result aborted-p))) (:always (setq result aborted-p)))
result) result)
nil) nil)
(deftest unwind-protect-case.5 (deftest unwind-protect-case.5
(let (result) (let (result)
(block foof (block foof
(unwind-protect-case (aborted-p) (unwind-protect-case (aborted-p)
(return-from foof) (return-from foof)
(:always (setq result aborted-p)))) (:always (setq result aborted-p))))
result) result)
t) t)
...@@ -280,17 +280,17 @@ ...@@ -280,17 +280,17 @@
(list (list :list (vector :A :B :C)))) (list (list :list (vector :A :B :C))))
(setf (gethash 'list ht) list) (setf (gethash 'list ht) list)
(let* ((shallow-copy (copy-hash-table ht)) (let* ((shallow-copy (copy-hash-table ht))
(deep1-copy (copy-hash-table ht :key 'copy-list)) (deep1-copy (copy-hash-table ht :key 'copy-list))
(list (gethash 'list ht)) (list (gethash 'list ht))
(shallow-list (gethash 'list shallow-copy)) (shallow-list (gethash 'list shallow-copy))
(deep1-list (gethash 'list deep1-copy))) (deep1-list (gethash 'list deep1-copy)))
(list (eq ht shallow-copy) (list (eq ht shallow-copy)
(eq ht deep1-copy) (eq ht deep1-copy)
(eq list shallow-list) (eq list shallow-list)
(eq list deep1-list) ; outer list was copied. (eq list deep1-list) ; outer list was copied.
(eq (second list) (second shallow-list)) (eq (second list) (second shallow-list))
(eq (second list) (second deep1-list)) ; inner vector wasn't copied. (eq (second list) (second deep1-list)) ; inner vector wasn't copied.
))) )))
(nil nil t nil t t)) (nil nil t nil t t))
(deftest maphash-keys.1 (deftest maphash-keys.1
...@@ -1429,26 +1429,26 @@ ...@@ -1429,26 +1429,26 @@
(deftest sequences.passing-improper-lists (deftest sequences.passing-improper-lists
(macrolet ((signals-error-p (form) (macrolet ((signals-error-p (form)
`(handler-case `(handler-case
(progn ,form nil) (progn ,form nil)
(type-error (e) (type-error (e)
t))) t)))
(cut (fn &rest args) (cut (fn &rest args)
(with-gensyms (arg) (with-gensyms (arg)
(print`(lambda (,arg) (print`(lambda (,arg)
(apply ,fn (list ,@(substitute arg '_ args)))))))) (apply ,fn (list ,@(substitute arg '_ args))))))))
(let ((circular-list (make-circular-list 5 :initial-element :foo)) (let ((circular-list (make-circular-list 5 :initial-element :foo))
(dotted-list (list* 'a 'b 'c 'd))) (dotted-list (list* 'a 'b 'c 'd)))
(loop for nth from 0 (loop for nth from 0
for fn in (list for fn in (list
(cut #'lastcar _) (cut #'lastcar _)
(cut #'rotate _ 3) (cut #'rotate _ 3)
(cut #'rotate _ -3) (cut #'rotate _ -3)
(cut #'shuffle _) (cut #'shuffle _)
(cut #'random-elt _) (cut #'random-elt _)
(cut #'last-elt _) (cut #'last-elt _)
(cut #'ends-with :foo _)) (cut #'ends-with :foo _))
nconcing nconcing
(let ((on-circular-p (signals-error-p (funcall fn circular-list))) (let ((on-circular-p (signals-error-p (funcall fn circular-list)))
(on-dotted-p (signals-error-p (funcall fn dotted-list)))) (on-dotted-p (signals-error-p (funcall fn dotted-list))))
(when (or (not on-circular-p) (not on-dotted-p)) (when (or (not on-circular-p) (not on-dotted-p))
...@@ -1656,15 +1656,15 @@ ...@@ -1656,15 +1656,15 @@
(macrolet (macrolet
((test (type numbers) ((test (type numbers)
`(deftest ,(format-symbol t '#:cdr5.~a (string type)) `(deftest ,(format-symbol t '#:cdr5.~a (string type))
(let ((numbers ,numbers)) (let ((numbers ,numbers))
(values (mapcar (of-type ',(format-symbol t '#:negative-~a (string type))) numbers) (values (mapcar (of-type ',(format-symbol t '#:negative-~a (string type))) numbers)
(mapcar (of-type ',(format-symbol t '#:non-positive-~a (string type))) numbers) (mapcar (of-type ',(format-symbol t '#:non-positive-~a (string type))) numbers)
(mapcar (of-type ',(format-symbol t '#:non-negative-~a (string type))) numbers) (mapcar (of-type ',(format-symbol t '#:non-negative-~a (string type))) numbers)
(mapcar (of-type ',(format-symbol t '#:positive-~a (string type))) numbers))) (mapcar (of-type ',(format-symbol t '#:positive-~a (string type))) numbers)))
(t t t nil nil nil nil) (t t t nil nil nil nil)
(t t t t nil nil nil) (t t t t nil nil nil)
(nil nil nil t t t t) (nil nil nil t t t t)
(nil nil nil nil t t t)))) (nil nil nil nil t t t))))
(test fixnum (list most-negative-fixnum -42 -1 0 1 42 most-positive-fixnum)) (test fixnum (list most-negative-fixnum -42 -1 0 1 42 most-positive-fixnum))
(test integer (list (1- most-negative-fixnum) -42 -1 0 1 42 (1+ most-positive-fixnum))) (test integer (list (1- most-negative-fixnum) -42 -1 0 1 42 (1+ most-positive-fixnum)))
(test rational (list (1- most-negative-fixnum) -42/13 -1 0 1 42/13 (1+ most-positive-fixnum))) (test rational (list (1- most-negative-fixnum) -42/13 -1 0 1 42/13 (1+ most-positive-fixnum)))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment