From f4b2df30d28c890bda36fdeea2c2243de09982eb Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Wed, 27 Oct 2004 09:44:22 +0000 Subject: [PATCH] 0.8.16.7: Fix for some RENAME-PACKAGE badness (from PFD ansi-tests) ... package-namify the new name; ... add a simple test; ... one or two other package-related declaration frobbings. --- NEWS | 3 +++ src/code/defpackage.lisp | 10 +++++----- src/code/package.lisp | 4 ++-- src/code/target-package.lisp | 2 +- tests/packages.impure.lisp | 20 ++++++++++++++++++++ version.lisp-expr | 2 +- 6 files changed, 32 insertions(+), 9 deletions(-) create mode 100644 tests/packages.impure.lisp diff --git a/NEWS b/NEWS index 0b85b4a..5ecb0d5 100644 --- a/NEWS +++ b/NEWS @@ -12,6 +12,9 @@ changes in sbcl-0.8.17 relative to sbcl-0.8.16: name conflict situations in CLHS 11.1.1.2.5, and provide a restart permitting resolution in favour of any of the conflicting symbols. (reported by Bruno Haible for CMUCL) + * fixed some bugs revealed by Paul Dietz' test suite: + ** RENAME-PACKAGE allows all package designators as new package + names. changes in sbcl-0.8.16 relative to sbcl-0.8.15: * enhancement: saving cores with foreign code loaded is now diff --git a/src/code/defpackage.lisp b/src/code/defpackage.lisp index dfd5b99..c7772c8 100644 --- a/src/code/defpackage.lisp +++ b/src/code/defpackage.lisp @@ -159,10 +159,10 @@ (defun stringify-name (name kind) (typecase name - (simple-base-string name) - (string (coerce name 'simple-base-string)) + (simple-string name) + (string (coerce name 'simple-string)) (symbol (symbol-name name)) - (base-char (string name)) + (character (string name)) (t (error "bogus ~A name: ~S" kind name)))) @@ -173,11 +173,11 @@ (defun %defpackage (name nicknames size shadows shadowing-imports use imports interns exports implement lock doc-string) - (declare (type simple-base-string name) + (declare (type simple-string name) (type list nicknames shadows shadowing-imports imports interns exports) (type (or list (member :default)) use) - (type (or simple-base-string null) doc-string) + (type (or simple-string null) doc-string) #!-sb-package-locks (ignore implement lock)) (let ((package (or (find-package name) diff --git a/src/code/package.lisp b/src/code/package.lisp index 66c9242..80455ac 100644 --- a/src/code/package.lisp +++ b/src/code/package.lisp @@ -73,7 +73,7 @@ #!+sb-doc "the standard structure for the description of a package" ;; the name of the package, or NIL for a deleted package - (%name nil :type (or simple-base-string null)) + (%name nil :type (or simple-string null)) ;; nickname strings (%nicknames () :type list) ;; packages used by this package @@ -99,7 +99,7 @@ ;; shadowing symbols (%shadowing-symbols () :type list) ;; documentation string for this package - (doc-string nil :type (or simple-base-string null)) + (doc-string nil :type (or simple-string null)) ;; package locking #!+sb-package-locks (lock nil :type boolean) diff --git a/src/code/target-package.lisp b/src/code/target-package.lisp index 4a6f3da..f85db16 100644 --- a/src/code/target-package.lisp +++ b/src/code/target-package.lisp @@ -545,7 +545,7 @@ error if any of PACKAGES is not a valid package designator." #!+sb-doc "Changes the name and nicknames for a package." (let* ((package (find-undeleted-package-or-lose package)) - (name (string name)) + (name (package-namify name)) (found (find-package name)) (nicks (mapcar #'string nicknames))) (unless (or (not found) (eq found package)) diff --git a/tests/packages.impure.lisp b/tests/packages.impure.lisp new file mode 100644 index 0000000..c1910ee --- /dev/null +++ b/tests/packages.impure.lisp @@ -0,0 +1,20 @@ +;;;; miscellaneous tests of package-related stuff + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; While most of SBCL is derived from the CMU CL system, the test +;;;; files (like this one) were written from scratch after the fork +;;;; from CMU CL. +;;;; +;;;; This software is in the public domain and is provided with +;;;; absolutely no warranty. See the COPYING and CREDITS files for +;;;; more information. + +(make-package "FOO") +(defvar *foo* (find-package (coerce "FOO" 'base-string))) +(rename-package "FOO" (make-array 0 :element-type nil)) +(assert (eq *foo* (find-package ""))) +(assert (delete-package "")) + +(sb-ext:quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index 84cf4c3..4279061 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.16.6" +"0.8.16.7" -- 1.7.10.4