diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp index 77a4d004385e5a0dbd00804c6e9f8f87fec244ab..c59817cd3ba39a25fbb544f5e113f001c9942945 100644 --- a/ansi-tests/ansi-aux.lsp +++ b/ansi-tests/ansi-aux.lsp @@ -324,8 +324,8 @@ the condition to go uncaught if it cannot be classified." (or (not (second results)) (not (first results)))))) -(declaim (ftype (function (&rest function) (values function &optional)) - compose)) +;; (declaim (ftype (function (&rest function) (values function &optional)) +;; compose)) (defun compose (&rest fns) (let ((rfns (reverse fns))) @@ -1039,3 +1039,21 @@ the condition to go uncaught if it cannot be classified." ;;; Approximate equality function (defun approx= (x y &optional (eps (epsilon x))) (<= (abs (/ (- x y) (max (abs x) 1))) eps)) + +(defun epsilon (number) + (etypecase number + (complex (* 2 (epsilon (realpart number)))) ;; crude + (short-float short-float-epsilon) + (single-float single-float-epsilon) + (double-float double-float-epsilon) + (long-float long-float-epsilon) + (rational 0))) + +(defun negative-epsilon (number) + (etypecase number + (complex (* 2 (negative-epsilon (realpart number)))) ;; crude + (short-float short-float-negative-epsilon) + (single-float single-float-negative-epsilon) + (double-float double-float-negative-epsilon) + (long-float long-float-negative-epsilon) + (rational 0))) diff --git a/ansi-tests/features.lsp b/ansi-tests/features.lsp index 57d0a47c0a2649f35d0dcf17c56a8d0afb51e0e8..f243fc860398d3dd966e018c0db91c83e95f5ec7 100644 --- a/ansi-tests/features.lsp +++ b/ansi-tests/features.lsp @@ -20,3 +20,7 @@ (deftest features.3 (not (member :cltl2 *features*)) t) + +(deftest features.4 + (notnot (every #'symbolp *features*)) + t) diff --git a/ansi-tests/ftruncate.lsp b/ansi-tests/ftruncate.lsp index 6590fd7335b4a6027ee7bc4e275cd8454f905047..e2c647c013bd5bb3e5466d575785990f0e54c964 100644 --- a/ansi-tests/ftruncate.lsp +++ b/ansi-tests/ftruncate.lsp @@ -6,7 +6,7 @@ (in-package :cl-test) (compile-and-load "numbers-aux.lsp") -(ignore-errors (compile-and-load "ftruncate-aux.lsp")) +(compile-and-load "ftruncate-aux.lsp") ;;; Error tests diff --git a/ansi-tests/load-environment.lsp b/ansi-tests/load-environment.lsp index 3234fc9a2d86eb4dd84d1fb80634c51128983371..255792e89d66e1f8f8fbde05218ebfe250e55cad 100644 --- a/ansi-tests/load-environment.lsp +++ b/ansi-tests/load-environment.lsp @@ -8,7 +8,6 @@ (load "describe.lsp") (load "disassemble.lsp") (load "environment-functions.lsp") -(load "features.lsp") (load "room.lsp") (load "time.lsp") (load "trace.lsp") diff --git a/ansi-tests/load-system-construction.lsp b/ansi-tests/load-system-construction.lsp index d3395f231f849ead0174b81cb77d51d5aff3af9b..32d25c0dd31ce46dbe02ce36d786c9a82d584b74 100644 --- a/ansi-tests/load-system-construction.lsp +++ b/ansi-tests/load-system-construction.lsp @@ -8,5 +8,5 @@ (load "compile-file.lsp") (load "load.lsp") (load "with-compilation-unit.lsp") - - +(load "features.lsp") +(load "modules.lsp") diff --git a/ansi-tests/modules.lsp b/ansi-tests/modules.lsp new file mode 100644 index 0000000000000000000000000000000000000000..e544e6577172a56e3ee89aa7708908deef07a6ce --- /dev/null +++ b/ansi-tests/modules.lsp @@ -0,0 +1,94 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Apr 30 19:51:06 2005 +;;;; Contains: Tests of *MODULES*, PROVIDE, and REQUIRE + +(in-package :cl-test) + +(deftest modules.1 + (notnot (every #'stringp *modules*)) + t) + +(deftest modules.2 + (let ((*modules* *modules*)) + (provide "FOO") + (notnot (member "FOO" *modules* :test #'string=))) + t) + +(deftest modules.3 + (let ((*modules* *modules*)) + (provide "FOO") + (provide "FOO") + (count "FOO" *modules* :test #'string=)) + 1) + +(deftest modules.4 + (let ((*modules* *modules*)) + (provide "FOO") + (require "FOO") + (values))) + +(deftest modules.5 + (let ((*modules* *modules*)) + (provide :|FOO|) + (notnot (member "FOO" *modules* :test #'string=))) + t) + +(deftest modules.6 + (let ((*modules* *modules*)) + (provide "FOO") + (require :|FOO|) + (values))) + +(deftest modules.7 + (let ((*modules* *modules*) + (fn 'modules7-fun)) + (when (fboundp fn) (fmakunbound fn)) + (require "MODULES-7" #p"modules7.lsp") + (funcall fn)) + :good) + +(deftest modules.8 + (let ((*modules* *modules*) + (fns '(modules8a-fun modules8b-fun))) + (dolist (fn fns) + (when (fboundp fn) (fmakunbound fn))) + (require "MODULES-8" '(#p"modules8a.lsp" #p"modules8b.lsp")) + (mapcar #'funcall fns)) + (:good :also-good)) + +(deftest modules.9 + (signals-error (require "AB7djaCgaaL") error) + t) + +(deftest modules.10 + (do-special-strings + (s "FOO") + (let ((*modules* *modules*)) + (provide s) + (assert (member "FOO" *modules* :test #'string=)))) + nil) + +(deftest modules.11 + (do-special-strings + (s "FOO") + (let ((*modules* *modules*)) + (provide "FOO") + (require s) + (values))) + nil) + +(deftest modules.12 + (unless (member "Z" *modules* :test #'string=) + (let ((*modules* *modules*)) + (provide #\Z) + (not (member "Z" *modules* :test #'string=)))) + nil) + +(deftest modules.13 + (unless (member "Z" *modules* :test #'string=) + (let ((*modules* *modules*)) + (provide "Z") + (require #\Z) + nil)) + nil) \ No newline at end of file diff --git a/ansi-tests/modules7.lsp b/ansi-tests/modules7.lsp new file mode 100644 index 0000000000000000000000000000000000000000..905cb719aaf7dba827634047d47fcdf4489f2c84 --- /dev/null +++ b/ansi-tests/modules7.lsp @@ -0,0 +1,2 @@ +(in-package :cl-test) +(defun modules7-fun () :good) diff --git a/ansi-tests/modules8a.lsp b/ansi-tests/modules8a.lsp new file mode 100644 index 0000000000000000000000000000000000000000..1e41efd4bf4c1ebcee77355fee46214123f88596 --- /dev/null +++ b/ansi-tests/modules8a.lsp @@ -0,0 +1,2 @@ +(in-package :cl-test) +(defun modules8a-fun () :good) diff --git a/ansi-tests/modules8b.lsp b/ansi-tests/modules8b.lsp new file mode 100644 index 0000000000000000000000000000000000000000..7de97404beea78b590af3cbbf96dfe7fa93fa85f --- /dev/null +++ b/ansi-tests/modules8b.lsp @@ -0,0 +1,2 @@ +(in-package :cl-test) +(defun modules8b-fun () :also-good) diff --git a/ansi-tests/numbers-aux.lsp b/ansi-tests/numbers-aux.lsp index 4ae2e9ea06d22807ea1135b9543b3fa2db96d848..672d0e20a4cacc0a4fbeffd30a8ed9836ff60c06 100644 --- a/ansi-tests/numbers-aux.lsp +++ b/ansi-tests/numbers-aux.lsp @@ -299,24 +299,6 @@ (floating-point-overflow () t)) collect (list x y (min x y))))) -(defun epsilon (number) - (etypecase number - (complex (* 2 (epsilon (realpart number)))) ;; crude - (short-float short-float-epsilon) - (single-float single-float-epsilon) - (double-float double-float-epsilon) - (long-float long-float-epsilon) - (rational 0))) - -(defun negative-epsilon (number) - (etypecase number - (complex (* 2 (negative-epsilon (realpart number)))) ;; crude - (short-float short-float-negative-epsilon) - (single-float single-float-negative-epsilon) - (double-float double-float-negative-epsilon) - (long-float long-float-negative-epsilon) - (rational 0))) - ;;; Compute the number of digits that can be added to 1.0 in the appropriate ;;; float type, a rational representation of the smallest radix^(-k) s.t. ;;; 1.0 + radix^(-k) /= 1.0, and the float representation of that value.