From fcda692a28c930d1e3be17c5ccc40da45a106af0 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Sun, 1 May 2005 01:33:08 +0000 Subject: [PATCH] Add tests for *modules*, require, provide. Move some aux functions to ansi-aux.lsp. Get rid of warning in ftruncate.lsp --- ansi-tests/ansi-aux.lsp | 22 +++++- ansi-tests/features.lsp | 4 ++ ansi-tests/ftruncate.lsp | 2 +- ansi-tests/load-environment.lsp | 1 - ansi-tests/load-system-construction.lsp | 4 +- ansi-tests/modules.lsp | 94 +++++++++++++++++++++++++ ansi-tests/modules7.lsp | 2 + ansi-tests/modules8a.lsp | 2 + ansi-tests/modules8b.lsp | 2 + ansi-tests/numbers-aux.lsp | 18 ----- 10 files changed, 127 insertions(+), 24 deletions(-) create mode 100644 ansi-tests/modules.lsp create mode 100644 ansi-tests/modules7.lsp create mode 100644 ansi-tests/modules8a.lsp create mode 100644 ansi-tests/modules8b.lsp diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp index 77a4d004..c59817cd 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 57d0a47c..f243fc86 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 6590fd73..e2c647c0 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 3234fc9a..255792e8 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 d3395f23..32d25c0d 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 00000000..e544e657 --- /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 00000000..905cb719 --- /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 00000000..1e41efd4 --- /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 00000000..7de97404 --- /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 4ae2e9ea..672d0e20 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. -- GitLab