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