(,pathname (etypecase ,pd0
(pathname ,pd0)
(string (parse-namestring ,pd0))
- (stream (file-name ,pd0)))))
+ (file-stream (file-name ,pd0)))))
,@body)))
;;; Convert the var, a host or string name for a host, into a
(default-host (if defaults
(%pathname-host defaults)
(pathname-host *default-pathname-defaults*)))
- ;; toy@rtp.ericsson.se: CLHS says make-pathname can take a
+ ;; Raymond Toy writes: CLHS says make-pathname can take a
;; string (as a logical-host) for the host part. We map that
;; string into the corresponding logical host structure.
;;
- ;; pw@snoopy.mv.com:
+ ;; Paul Werkowski writes:
;; HyperSpec says for the arg to MAKE-PATHNAME;
;; "host---a valid physical pathname host. ..."
;; where it probably means -- a valid pathname host.
;; It seems an error message is appropriate.
(host (typecase host
(host host) ; A valid host, use it.
+ ((string 0) *unix-host*) ; "" cannot be a logical host
(string (find-logical-host host t)) ; logical-host or lose.
(t default-host))) ; unix-host
(diddle-args (and (eq (host-customary-case host) :lower)
;; A logical host is an object of implementation-dependent nature. In
;; SBCL, it's a member of the HOST class (a subclass of STRUCTURE-OBJECT).
(let ((found-host (etypecase host
+ ((string 0)
+ ;; This is a special host. It's not valid as a
+ ;; logical host, so it is a sensible thing to
+ ;; designate the physical Unix host object. So
+ ;; we do that.
+ *unix-host*)
(string
;; In general ANSI-compliant Common Lisps, a
;; string might also be a physical pathname host,
;;; contains only legal characters.
(defun logical-word-or-lose (word)
(declare (string word))
+ (when (string= word "")
+ (error 'namestring-parse-error
+ :complaint "Attempted to treat invalid logical hostname ~
+ as a logical host:~% ~S"
+ :args (list word)
+ :namestring word :offset 0))
(let ((word (string-upcase word)))
(dotimes (i (length word))
(let ((ch (schar word i)))
(return (translate-logical-pathname
(translate-pathname pathname from to)))))))
(pathname pathname)
- (stream (translate-logical-pathname (pathname pathname)))
- (t (translate-logical-pathname (logical-pathname pathname)))))
+ (t (translate-logical-pathname (pathname pathname)))))
(defun translate-logical-pathname (pathname &key)
#!+sb-doc