Commit e93ee420 authored by Daniel Kochmański's avatar Daniel Kochmański

Merge branch 'restructure-wip' into 'master'

restructure

I've moved parts around ansi-cl-tests - flat directory structure makes it unintelligible and I think that if we want to modernize it a little, then such change is necessary. I might accidently screw something up and it's too drastical change to just push it to master, hence merge-request.

See merge request !1
parents 8412195b 94e25073

Too many changes to show.

To preserve performance only 1000 of 1000+ files are displayed.

*~
*.out
*.dat
*.fas
ansi-aux-macros.fas
ansi-aux.fas
array-aux.fas
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Mar 23 08:25:50 2003
;;;; Contains: Tests of the ABORT restart and function
(in-package :cl-test)
(deftest abort.1
(restart-case
(progn (abort) 'bad)
(abort () 'good))
good)
(deftest abort.2
(let ((c1 (make-condition 'error))
(c2 (make-condition 'error)))
(restart-case
(with-condition-restarts
c1
(list (first (compute-restarts)))
(abort c2))
(abort () 'bad)
(abort () 'good)))
good)
(deftest abort.3
(restart-case
(progn (abort nil) 'bad)
(abort () 'good))
good)
(deftest abort.4
(let ((c1 (make-condition 'error))
(c2 (make-condition 'error)))
(restart-case
(with-condition-restarts
c1
(list (first (compute-restarts)))
(abort nil))
(abort () 'good)
(abort () 'bad)))
good)
(deftest abort.5
(signals-error
(let ((c1 (make-condition 'error))
(c2 (make-condition 'error)))
(with-condition-restarts
c1
(compute-restarts)
;; All conditions are now associated with c1
(abort c2)))
control-error)
t)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Mon Sep 1 20:16:42 2003
;;;; Contains: Tests of ABS
(in-package :cl-test)
(compile-and-load "numbers-aux.lsp")
(deftest abs.error.1
(signals-error (abs) program-error)
t)
(deftest abs.error.2
(signals-error (abs 0 0) program-error)
t)
(deftest abs.error.3
(signals-error (abs 0 nil nil) program-error)
t)
(deftest abs.1
(loop for x in *numbers*
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))
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)))
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))
nil)
(deftest abs.5
(let ((bound (ash 1 210)))
(loop
for num = (random-from-interval bound)
for den = (random-from-interval bound)
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.6
(let ((bound (float (ash 1 11) 1.0s0)))
(loop
for x = (random-from-interval bound)
for a = (abs x)
repeat 10000
unless (if (minusp x)
(eql (- x) a)
(eql x a))
collect (list x a)))
nil)
(deftest abs.7
(let ((bound (float (ash 1 22) 1.0f0)))
(loop
for x = (random-from-interval bound)
for a = (abs x)
repeat 10000
unless (if (minusp x)
(eql (- x) a)
(eql x a))
collect (list x a)))
nil)
(deftest abs.8
(let ((bound (float (ash 1 48) 1.0d0)))
(loop
for x = (random-from-interval bound)
for a = (abs x)
repeat 10000
unless (if (minusp x)
(eql (- x) a)
(eql x a))
collect (list x a)))
nil)
(deftest abs.9
(let ((bound (float (ash 1 48) 1.0l0)))
(loop
for x = (random-from-interval bound)
for a = (abs x)
repeat 10000
unless (if (minusp x)
(eql (- x) a)
(eql x a))
collect (list x a)))
nil)
;;; The example on the abs page says that (abs -0.0) should be -0,0.
;;; However, FABS on the x86 returns 0.0 for that. Since the examples
;;; in the hyperspec are not normative, the following four tests
;;; have been commented out.
;;; (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)
;;; Complex numbers
(deftest abs.14
(let ((result (abs #c(3 4))))
(=t result 5))
t)
(deftest abs.15
(let ((result (abs #c(-3 4))))
(=t result 5))
t)
(deftest abs.16
(let ((result (abs #c(3 -4))))
(=t result 5))
t)
(deftest abs.17
(let ((result (abs #c(-3 -4))))
(=t result 5))
t)
(deftest abs.18
(abs #c(3.0s0 4.0s0))
5.0s0)
(deftest abs.19
(abs #c(3.0f0 -4.0f0))
5.0f0)
(deftest abs.20
(abs #c(-3.0d0 4.0d0))
5.0d0)
(deftest abs.21
(abs #c(-3.0l0 4.0l0))
5.0l0)
(deftest abs.22
(macrolet ((%m (z) z))
(abs (expand-in-current-env (%m -4))))
4)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Apr 20 07:26:48 2003
;;;; Contains: Tests of ACONS
(in-package :cl-test)
(compile-and-load "cons-aux.lsp")
(deftest acons.1
(let* ((x (copy-tree '((c . d) (e . f))))
(xcopy (make-scaffold-copy x))
(result (acons 'a 'b x)))
(and
(check-scaffold-copy x xcopy)
(eqt (cdr result) x)
result))
((a . b) (c . d) (e . f)))
(deftest acons.2
(acons 'a 'b nil)
((a . b)))
(deftest acons.3
(acons 'a 'b 'c)
((a . b) . c))
(deftest acons.4
(acons '((a b)) '(((c d) e) f) '((1 . 2)))
(( ((a b)) . (((c d) e) f)) (1 . 2)))
(deftest acons.5
(acons "ancd" 1.143 nil)
(("ancd" . 1.143)))
(deftest acons.6
(acons #\R :foo :bar)
((#\R . :foo) . :bar))
(deftest acons.7
(macrolet ((%m (z) z)) (acons (expand-in-current-env (%m 'a)) 'b '(c)))
((a . b) c))
(deftest acons.8
(macrolet ((%m (z) z)) (acons 'a (expand-in-current-env (%m 'b)) '(c)))
((a . b) c))
(deftest acons.9
(macrolet ((%m (z) z)) (acons 'a 'b (expand-in-current-env (%m '(c)))))
((a . b) c))
(deftest acons.order.1
(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))))
i x y z))
((a . b)(c . d))
3 1 2 3)
(def-fold-test acons.fold.1 (acons 'x 'y nil))
(def-fold-test acons.fold.2 (acons 1 2 '((3 . 4) (5 . 6))))
;;; Error tests
(deftest acons.error.1
(signals-error (acons) program-error)
t)