X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-pathname.lisp;h=8c7d5e78b528063950a8d5665518d1120ea2b49a;hb=dc9d03a1c43398d3a860520c6ea03e8d5838d142;hp=9f72ccd4df4f721a632c35286746c2a946e3e17b;hpb=771b864c8f32af7734bc0550aeaf1539fc4df194;p=sbcl.git

diff --git a/src/code/target-pathname.lisp b/src/code/target-pathname.lisp
index 9f72ccd..8c7d5e7 100644
--- a/src/code/target-pathname.lisp
+++ b/src/code/target-pathname.lisp
@@ -44,7 +44,7 @@
   (let ((namestring (handler-case (namestring pathname)
 		      (error nil))))
     (if namestring
-	(format stream "#P~S" namestring)
+	(format stream "#P~S" (coerce namestring '(simple-array character (*))))
 	(print-unreadable-object (pathname stream :type t)
 	  (format stream
 		  "~@<(with no namestring) ~_:HOST ~S ~_:DEVICE ~S ~_:DIRECTORY ~S ~
@@ -202,12 +202,12 @@
   (or (eq thing wild)
       (eq wild :wild)
       (typecase thing
-	(simple-base-string
+	(simple-string
 	 ;; String is matched by itself, a matching pattern or :WILD.
 	 (typecase wild
 	   (pattern
 	    (values (pattern-matches wild thing)))
-	   (simple-base-string
+	   (simple-string
 	    (string= thing wild))))
 	(pattern
 	 ;; A pattern is only matched by an identical pattern.
@@ -308,7 +308,7 @@
 		    (dolist (x in)
 		      (when (check-for pred x)
 			(return t))))
-		   (simple-base-string
+		   (simple-string
 		    (dotimes (i (length in))
 		      (when (funcall pred (schar in i))
 			(return t))))
@@ -319,7 +319,7 @@
 		    (make-pattern
 		     (mapcar (lambda (piece)
 			       (typecase piece
-				 (simple-base-string
+				 (simple-string
 				  (funcall fun piece))
 				 (cons
 				  (case (car piece)
@@ -333,7 +333,7 @@
 			     (pattern-pieces thing))))
 		   (list
 		    (mapcar fun thing))
-		   (simple-base-string
+		   (simple-string
 		    (funcall fun thing))
 		   (t
 		    thing))))
@@ -702,7 +702,7 @@ a host-structure or string."
 ;;; If NAMESTR begins with a colon-terminated, defined, logical host,
 ;;; then return that host, otherwise return NIL.
 (defun extract-logical-host-prefix (namestr start end)
-  (declare (type simple-base-string namestr)
+  (declare (type simple-string namestr)
 	   (type index start end)
 	   (values (or logical-host null)))
   (let ((colon-pos (position #\: namestr :start start :end end)))
@@ -924,7 +924,7 @@ a host-structure or string."
 (defun substitute-into (pattern subs diddle-case)
   (declare (type pattern pattern)
 	   (type list subs)
-	   (values (or simple-base-string pattern) list))
+	   (values (or simple-string pattern) list))
   (let ((in-wildcard nil)
 	(pieces nil)
 	(strings nil))
@@ -1157,13 +1157,14 @@ a host-structure or string."
   (let ((word (string-upcase word)))
     (dotimes (i (length word))
       (let ((ch (schar word i)))
-	(unless (or (alpha-char-p ch) (digit-char-p ch) (char= ch #\-))
+	(unless (and (typep ch 'standard-char)
+		     (or (alpha-char-p ch) (digit-char-p ch) (char= ch #\-)))
 	  (error 'namestring-parse-error
 		 :complaint "logical namestring character which ~
                              is not alphanumeric or hyphen:~%  ~S"
 		 :args (list ch)
 		 :namestring word :offset i))))
-    word))
+    (coerce word 'base-string)))
 
 ;;; Given a logical host or string, return a logical host. If ERROR-P
 ;;; is NIL, then return NIL when no such host exists.
@@ -1257,7 +1258,7 @@ a host-structure or string."
 ;;; Break up a logical-namestring, always a string, into its
 ;;; constituent parts.
 (defun parse-logical-namestring (namestr start end)
-  (declare (type simple-base-string namestr)
+  (declare (type simple-string namestr)
 	   (type index start end))
   (collect ((directory))
     (let ((host nil)
@@ -1418,7 +1419,7 @@ a host-structure or string."
       (when type-supplied
 	(unless name
 	  (error "cannot specify the type without a file: ~S" pathname))
-	(when (typep type 'simple-base-string)
+	(when (typep type 'simple-string)
 	  (when (position #\. type)
 	    (error "type component can't have a #\. inside: ~S" pathname)))
 	(strings ".")
@@ -1524,12 +1525,9 @@ a host-structure or string."
     (t (translate-logical-pathname (pathname pathname)))))
 
 (defvar *logical-pathname-defaults*
-  (%make-logical-pathname (make-logical-host :name "BOGUS")
-			  :unspecific
-			  nil
-			  nil
-			  nil
-			  nil))
+  (%make-logical-pathname
+   (make-logical-host :name (logical-word-or-lose "BOGUS"))
+   :unspecific nil nil nil nil))
 
 (defun load-logical-pathname-translations (host)
   #!+sb-doc