Changeset 916

Timestamp:

Feb 16, 2005, 11:31:03 AM (20 years ago)

Author:

bryan

Message:

ccl::hash-pname loses when given a non-simple-string

find-all-symbols did no checking and didn't massage. added a
ccl::ensure-simple-string to both check and massage.

make-symbol checked that the arg was a 'simple-string using
#'require-type. replacing that with ccl::ensure-simple-string both
checks and massages.

ccl::pkg-arg (called by a bunch of symbol iterator macros) did check
that if the arg was a string, that it was a simple string. i rewrote
the initial if form as a cond that will call ccl::ensure-simple-string
if the arg is indeed a string.

also updated ccl::new-package-name.

Location:

trunk/ccl

Files:

• level-0/l0-symbol.lisp (modified) (1 diff)
• level-0/nfasload.lisp (modified) (1 diff)
• level-1/l1-symhash.lisp (modified) (2 diffs)

trunk/ccl/level-0/l0-symbol.lisp

@@ -165 +165 @@
 (defun make-symbol (name)
   (%gvector ppc32::subtag-symbol
-                (require-type name 'simple-string) ; pname
+                (ensure-simple-string name) ; pname
                 (%unbound-marker)       ; value cell
                 %unbound-function%      ; function cell

trunk/ccl/level-0/nfasload.lisp

@@ -205 +205 @@
 
 (defun pkg-arg (thing &optional deleted-ok)
-  (let* ((xthing (if (or (symbolp thing)
-                         (typep thing 'character))
-                   (string thing)
-                   thing)))
+  (let* ((xthing (cond ((or (symbolp thing) (typep thing 'character))
+                        (string thing))
+                       ((typep thing 'string)
+                        (ensure-simple-string thing))
+                       (t
+                        thing))))
     (let* ((typecode (typecode xthing)))
         (declare (fixnum typecode))

trunk/ccl/level-1/l1-symhash.lisp

@@ -126 +126 @@
 (defun find-all-symbols (name)
   (let* ((syms ())
-         (pname (string name))
+         (pname (ensure-simple-string (string name)))
          (len (length pname)))
     (with-package-list-read-lock
@@ -197 +197 @@
 (defun new-package-name (name &optional package)
   (do* ((prompt "Enter package name to use instead of ~S ."))
-       ((let* ((found (find-package (setq name (string name)))))
+       ((let* ((found (find-package (setq name (ensure-simple-string (string name))))))
           (or (not found)
               (eq package found)))