Skip to content
Snippets Groups Projects
Commit 0c177417 authored by pfdietz's avatar pfdietz
Browse files

Moved package tests to files following the naming conventions used elsewhere. ...

Moved package tests to files following the naming conventions used elsewhere.  Added some missing tests.
parent 2da1ee96
Branches
Tags
No related merge requests found
Showing
with 457 additions and 78 deletions
......@@ -28,3 +28,5 @@ Things to do to the test suite (not a complete list)
12. Make sure all string operators work on displaced character vectors.
14. Finish testing DEFSETF
15. All tests for DO-ALL-SYMBOLS
\ No newline at end of file
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Apr 25 08:09:18 1998
;;;; Contains: Package test code, part 16
;;;; Contains: Tests of DEFPACKAGE
(in-package :cl-test)
(declaim (optimize (safety 3)))
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Apr 25 08:01:58 1998
;;;; Contains: Package test code, part 08
;;;; Contains: Tests of DELETE-PACKAGE
(in-package :cl-test)
(declaim (optimize (safety 3)))
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Feb 21 18:27:22 2004
;;;; Contains: Tests of DO-ALL-SYMBOLS
(in-package :cl-test)
(def-macro-test do-all-symbols.error.1
(do-all-symbols (x)))
;;; FIXME Add tests for non-error cases
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Feb 21 18:26:08 2004
;;;; Contains: Tests of DO-EXTERNAL-SYMBOLS
(in-package :cl-test)
(declaim (optimize (safety 3)))
(defun collect-external-symbols (pkg)
(remove-duplicates
(sort-symbols
(let ((all nil))
(do-external-symbols (x pkg all) (push x all))))))
(deftest do-external-symbols.1
(collect-external-symbols "DS1")
(DS1:A DS1:B))
(deftest do-external-symbols.2
(collect-external-symbols "DS2")
(DS2:A DS2:G DS2:H))
(deftest do-external-symbols.3
(collect-external-symbols "DS3")
(DS1:A DS3:B DS2:G DS3:I DS3:J DS3:K))
(deftest do-external-symbols.4
(collect-external-symbols "DS4")
())
(deftest do-external-symbols.5
(equalt (collect-external-symbols "KEYWORD")
(collect-symbols "KEYWORD"))
t)
;; Test that do-external-symbols works without
;; a return value (and that the default return value is nil)
(deftest do-external-symbols.6
(do-external-symbols (s "DS1") (declare (ignore s)) t)
nil)
;; Test that do-external-symbols works without
;; a package being specified
(deftest do-external-symbols.7
(let ((x nil)
(*package* (find-package "DS1")))
(declare (special *package*))
(list
(do-external-symbols (s) (push s x))
(sort-symbols x)))
(nil (DS1:A DS1:B)))
;; Test that the tags work in the tagbody,
;; and that multiple statements work
(deftest do-external-symbols.8
(handler-case
(let ((x nil))
(list
(do-external-symbols
(s "DS1")
(when (equalt (symbol-name s) "A") (go bar))
(push s x)
(go foo)
bar
(push t x)
foo)
(sort-symbols x)))
(error (c) c))
(NIL (DS1:B T)))
(def-macro-test do-external-symbols.error.1
(do-external-symbols (x "CL")))
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Apr 25 19:20:29 1998
;;;; Contains: Package test code, part 17
;;;; Created: Sat Feb 21 18:24:59 2004
;;;; Contains: Tests of DO-SYMBOLS
(in-package :cl-test)
(declaim (optimize (safety 3)))
......@@ -25,12 +25,6 @@
(let ((all nil))
(do-symbols (x pkg all) (push x all))))))
(defun collect-external-symbols (pkg)
(remove-duplicates
(sort-symbols
(let ((all nil))
(do-external-symbols (x pkg all) (push x all))))))
(deftest do-symbols.2
(collect-symbols "DS1")
(DS1:A DS1:B DS1::C DS1::D))
......@@ -52,40 +46,14 @@
(DS1:A DS1:B DS2::F DS3:G DS3:I DS3:J DS3:K DS4::X DS4::Y DS4::Z))
(deftest do-external-symbols.1
(collect-external-symbols "DS1")
(DS1:A DS1:B))
(deftest do-external-symbols.2
(collect-external-symbols "DS2")
(DS2:A DS2:G DS2:H))
(deftest do-external-symbols.3
(collect-external-symbols "DS3")
(DS1:A DS3:B DS2:G DS3:I DS3:J DS3:K))
(deftest do-external-symbols.4
(collect-external-symbols "DS4")
())
(deftest do-external-symbols.5
(equalt (collect-external-symbols "KEYWORD")
(collect-symbols "KEYWORD"))
t)
;; Test that do-symbols, do-external-symbols work without
;; Test that do-symbols works without
;; a return value (and that the default return value is nil)
(deftest do-symbols.6
(do-symbols (s "DS1") (declare (ignore s)) t)
nil)
(deftest do-external-symbols.6
(do-external-symbols (s "DS1") (declare (ignore s)) t)
nil)
;; Test that do-symbols, do-external-symbols work without
;; a package being specified
;; Test that do-symbols works without a package being specified
(deftest do-symbols.7
(let ((x nil)
......@@ -96,15 +64,6 @@
(sort-symbols x)))
(nil (DS1:A DS1:B DS1::C DS1::D)))
(deftest do-external-symbols.7
(let ((x nil)
(*package* (find-package "DS1")))
(declare (special *package*))
(list
(do-external-symbols (s) (push s x))
(sort-symbols x)))
(nil (DS1:A DS1:B)))
;; Test that the tags work in the tagbody,
;; and that multiple statements work
......@@ -124,30 +83,6 @@
(error (c) c))
(NIL (DS1:A DS1:B DS1::D T)))
(deftest do-external-symbols.8
(handler-case
(let ((x nil))
(list
(do-external-symbols
(s "DS1")
(when (equalt (symbol-name s) "A") (go bar))
(push s x)
(go foo)
bar
(push t x)
foo)
(sort-symbols x)))
(error (c) c))
(NIL (DS1:B T)))
(def-macro-test do-symbols.error.1
(do-symbols (x "CL")))
(def-macro-test do-external-symbols.error.1
(do-external-symbols (x "CL")))
(def-macro-test do-all-symbols.error.1
(do-all-symbols (x)))
;;; Need to add DO-ALL-SYMBOLS tests
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Apr 25 07:59:45 1998
;;;; Contains: Package test code, part 05
;;;; Contains: Tests of EXPORT
(in-package :cl-test)
(declaim (optimize (safety 3)))
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Feb 22 07:10:22 2004
;;;; Contains: Tests for FIND-ALL-SYMBOLS
(in-package :cl-test)
(deftest find-all-symbols.1
(let ((all-packages (list-all-packages)))
(loop
for package in all-packages
append
(let ((failures nil))
(do-symbols (sym package failures)
(when (eql (symbol-package sym) package)
(let* ((name (symbol-name sym))
(similar (find-all-symbols name))
(similar2 (find-all-symbols sym)))
(unless (and (member sym similar)
(subsetp similar similar2)
(subsetp similar2 similar)
(loop for sym2 in similar
always (and (string= name (symbol-name sym2))
(member (symbol-package sym2)
all-packages))))
(push sym failures))))))))
nil)
(deftest find-all-symbols.2
(loop for i from 0 to 255
for c = (code-char i)
when (and (characterp c)
(loop for sym in (find-all-symbols c)
thereis (not (string= (symbol-name sym)
(string c)))))
collect c)
nil)
;;; Error tests
(deftest find-all-symbols.error.1
(signals-error (find-all-symbols) program-error)
t)
(deftest find-all-symbols.error.2
(signals-error (find-all-symbols "CAR" nil) program-error)
t)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Apr 25 07:50:39 1998
;;;; Contains: Package test code, aprt 02
;;;; Contains: Tests for FIND-PACKAGE
(in-package :cl-test)
(declaim (optimize (safety 3)))
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Apr 25 07:49:34 1998
;;;; Contains: Package test code, part 01
;;;; Contains: Tests for FIND-SYMBOL
(in-package :cl-test)
(declaim (optimize (safety 3)))
......
......@@ -29,7 +29,7 @@
;;; Tests of packages
(load "packages.lsp")
(load "load-packages.lsp")
;;; Tests of numbers (section 12)
(load "load-numbers.lsp")
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Apr 25 08:06:03 1998
;;;; Contains: Package test code, part 13
;;;; Contains: Tests of IN-PACKAGE
(in-package :cl-test)
(declaim (optimize (safety 3)))
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Apr 25 07:59:10 1998
;;;; Contains: Package test code, part 04
;;;; Contains: Tests of INTERN
(in-package :cl-test)
(declaim (optimize (safety 3)))
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Tue May 5 17:22:49 1998
;;;; Contains: Packages test code, part 19. Tests of the keyword package.
;;;; See also cl-symbols.lsp (for keywordp test cases)
;;;; Created: Sun Feb 22 06:53:55 2004
;;;; Contains: Tests of the KEYWORD package
(in-package :cl-test)
(declaim (optimize (safety 3)))
;; Check that each keyword satisfies keywordp
......@@ -32,29 +30,3 @@
(return (list s (eval s)))))
t)
;;; Other error tests
(deftest package-shadowing-symbols.error.1
(signals-error (package-shadowing-symbols) program-error)
t)
(deftest package-shadowing-symbols.error.2
(signals-error (package-shadowing-symbols "CL" nil) program-error)
t)
(deftest package-use-list.error.1
(signals-error (package-use-list) program-error)
t)
(deftest package-use-list.error.2
(signals-error (package-use-list "CL" nil) program-error)
t)
(deftest package-used-by-list.error.1
(signals-error (package-used-by-list) program-error)
t)
(deftest package-used-by-list.error.2
(signals-error (package-used-by-list "CL" nil) program-error)
t)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Feb 21 17:47:37 2004
;;;; Contains: Tests of LIST-ALL-PACKAGES
(in-package :cl-test)
(declaim (optimize (safety 3)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; list-all-packages
;; list-all-packages returns a list
(deftest list-all-packages.1
(numberp (ignore-errors (list-length (list-all-packages))))
t)
;; The required packages are present
(deftest list-all-packages.2
(subsetp
(list (find-package "CL")
(find-package "CL-USER")
(find-package "KEYWORD")
(find-package "A")
(find-package "REGRESSION-TEST")
(find-package "CL-TEST")
(find-package "B"))
(list-all-packages))
t)
;; The list returned has only packages in it
(deftest list-all-packages.3
(notnot-mv (every #'packagep (list-all-packages)))
t)
;; It returns a list of the same packages each time it is called
(deftest list-all-packages.4
(let ((p1 (list-all-packages))
(p2 (list-all-packages)))
(and (subsetp p1 p2)
(subsetp p2 p1)))
t)
(deftest list-all-packages.error.1
(signals-error (list-all-packages nil) program-error)
t)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Oct 6 00:32:56 2002
;;;; Contains: Loader for files containing package tests
(load "packages-00.lsp")
(load "find-symbol.lsp")
(load "find-all-symbols.lsp")
(load "find-package.lsp")
(load "list-all-packages.lsp")
(load "package-name.lsp")
(load "package-nicknames.lsp")
(load "intern.lsp")
(load "export.lsp")
(load "rename-package.lsp")
(load "shadow.lsp")
(load "delete-package.lsp")
(load "make-package.lsp")
(load "with-package-iterator.lsp")
(load "unexport.lsp")
(load "unintern.lsp")
(load "in-package.lsp")
(load "unuse-package.lsp")
(load "use-package.lsp")
(load "defpackage.lsp")
(load "do-symbols.lsp")
(load "do-external-symbols.lsp")
(load "do-all-symbols.lsp")
(load "packagep.lsp")
(load "package-error.lsp")
(load "package-error-package.lsp")
(load "keyword.lsp")
(load "package-shadowing-symbols.lsp")
(load "package-use-list.lsp")
(load "package-used-by-list.lsp")
(load "import.lsp")
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Apr 25 08:02:43 1998
;;;; Contains: Package test code, part 09
;;;; Contains: Tests of MAKE-PACKAGE
(in-package :cl-test)
(declaim (optimize (safety 3)))
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Apr 25 08:07:31 1998
;;;; Contains: Package test code, part 18
;;;; Created: Sun Feb 22 06:52:56 2004
;;;; Contains: Tests of PACKAGE-ERROR-PACKAGE
(in-package :cl-test)
(declaim (optimize (safety 3)))
(declaim (special *universe*))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; packagep, typep * 'package
(deftest packagep.1
(loop
for x in *universe* count
(unless (eqt (not (packagep x))
(not (typep x 'package)))
(format t
"(packagep ~S) = ~S, (typep x 'package) = ~S~%"
x (packagep x) x (typep x 'package))
t))
0)
;;; *package* is always a package
(deftest packagep.2
(not-mv (packagep *package*))
nil)
(deftest packagep.error.1
(signals-error (packagep) program-error)
t)
(deftest packagep.error.2
(signals-error (packagep nil nil) program-error)
t)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; package-error
(deftest package-error.1
(not
(typep (make-condition 'package-error :package "CL")
'package-error))
nil)
(deftest package-error.2
(not
(typep (make-condition 'package-error
:package (find-package "CL"))
'package-error))
nil)
(deftest package-error.3
(subtypep* 'package-error 'error)
t t)
(deftest package-error.4
(not
(typep (make-condition 'package-error
:package (find-package '#:|CL|))
'package-error))
nil)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; package-error-package
(deftest package-error-package.1
(eqt (find-package (package-error-package
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Feb 22 06:52:21 2004
;;;; Contains: Tests of the condition PACKAGE-ERROR
(in-package :cl-test)
(deftest package-error.1
(not
(typep (make-condition 'package-error :package "CL")
'package-error))
nil)
(deftest package-error.2
(not
(typep (make-condition 'package-error
:package (find-package "CL"))
'package-error))
nil)
(deftest package-error.3
(subtypep* 'package-error 'error)
t t)
(deftest package-error.4
(not
(typep (make-condition 'package-error
:package (find-package '#:|CL|))
'package-error))
nil)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Apr 25 07:51:26 1998
;;;; Contains: Package test code, part 03
;;;; Created: Sat Feb 21 17:48:05 2004
;;;; Contains: Tests of PACKAGE-NAME
(in-package :cl-test)
(declaim (optimize (safety 3)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; list-all-packages
;; list-all-packages returns a list
(deftest list-all-packages.1
(numberp (ignore-errors (list-length (list-all-packages))))
t)
;; The required packages are present
(deftest list-all-packages.2
(subsetp
(list (find-package "CL")
(find-package "CL-USER")
(find-package "KEYWORD")
(find-package "A")
(find-package "REGRESSION-TEST")
(find-package "CL-TEST")
(find-package "B"))
(list-all-packages))
t)
;; The list returned has only packages in it
(deftest list-all-packages.3
(notnot-mv (every #'packagep (list-all-packages)))
t)
;; It returns a list of the same packages each time it is called
(deftest list-all-packages.4
(let ((p1 (list-all-packages))
(p2 (list-all-packages)))
(and (subsetp p1 p2)
(subsetp p2 p1)))
t)
(deftest list-all-packages.error.1
(signals-error (list-all-packages nil) program-error)
t)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; package-name
......@@ -151,88 +112,3 @@
(signals-error (package-name "CL" nil) program-error)
t)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; package-nicknames
(deftest package-nicknames.1
(let () (ignore-errors (package-nicknames "A")))
("Q"))
(deftest package-nicknames.2
(let () (ignore-errors (package-nicknames #\A)))
("Q"))
(deftest package-nicknames.3
(let () (ignore-errors (package-nicknames ':|A|)))
("Q"))
(deftest package-nicknames.4
(let () (ignore-errors (package-nicknames "B")))
nil)
(deftest package-nicknames.5
(let () (ignore-errors (package-nicknames #\B)))
nil)
(deftest package-nicknames.6
(let () (ignore-errors (package-nicknames '#:|B|)))
nil)
(deftest package-nicknames.7
(let ()
(ignore-errors
(subsetp '(#.(string '#:cl))
(package-nicknames "COMMON-LISP")
:test #'string=)))
t)
(deftest package-nicknames.8
(let ()
(ignore-errors
(notnot
(subsetp '(#.(string '#:cl-user))
(package-nicknames "COMMON-LISP-USER")
:test #'string=))))
t)
(deftest package-nicknames.9
(signals-error (package-nicknames 10) type-error)
t)
(deftest package-nicknames.9a
(signals-error (locally (package-nicknames 10) t) type-error)
t)
(deftest package-nicknames.10
(let () (ignore-errors (package-nicknames (find-package "A"))))
("Q"))
(deftest package-nicknames.11
(handler-case
(locally (declare (optimize safety))
(eval '(package-nicknames "NOT-A-PACKAGE-NAME"))
nil)
(type-error () t)
(package-error () t))
t)
;; (find-package n) == p for each n in (package-nicknames p),
;; for any package p
(deftest package-nicknames.12
(loop
for p in (list-all-packages) sum
(loop
for nk in (package-nicknames p) count
(not
(and (stringp nk)
(eqt p (find-package nk))))))
0)
(deftest package-nicknames.error.1
(signals-error (package-nicknames) program-error)
t)
(deftest package-nicknames.error.2
(signals-error (package-nicknames "CL" nil) program-error)
t)
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment