Commit fcda692a authored by pfdietz's avatar pfdietz

Add tests for *modules*, require, provide. Move some aux functions to...

Add tests for *modules*, require, provide.  Move some aux functions to ansi-aux.lsp.  Get rid of warning in ftruncate.lsp
parent 57371c7e
......@@ -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)))
......@@ -20,3 +20,7 @@
(deftest features.3
(not (member :cltl2 *features*))
t)
(deftest features.4
(notnot (every #'symbolp *features*))
t)
......@@ -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
......
......@@ -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")
......
......@@ -8,5 +8,5 @@
(load "compile-file.lsp")
(load "load.lsp")
(load "with-compilation-unit.lsp")
(load "features.lsp")
(load "modules.lsp")
;-*- 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
(in-package :cl-test)
(defun modules7-fun () :good)
(in-package :cl-test)
(defun modules8a-fun () :good)
(in-package :cl-test)
(defun modules8b-fun () :also-good)
......@@ -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.
......
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