Skip to content
Snippets Groups Projects
Commit 5686e055 authored by pmai's avatar pmai
Browse files

Applied patch by Raymond Toy to make pathname-host ANSI compliant.

parent 34ee4813
Branches
Tags
No related merge requests found
......@@ -4,7 +4,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pathname.lisp,v 1.59 2002/11/14 13:24:33 toy Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pathname.lisp,v 1.60 2003/03/21 21:36:34 pmai Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -642,7 +642,7 @@ a host-structure or string."
(with-pathname (defaults defaults) defaults)))
(default-host (if defaults
(%pathname-host defaults)
(pathname-host *default-pathname-defaults*)))
(%pathname-host *default-pathname-defaults*)))
;; toy@rtp.ericsson.se: 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.
......@@ -687,7 +687,7 @@ a host-structure or string."
(flet ((check-component-validity (name name-or-type)
(when (stringp name)
(let ((unix-directory-separator #\/))
(when (eq host (pathname-host *default-pathname-defaults*))
(when (eq host (%pathname-host *default-pathname-defaults*))
(when (find unix-directory-separator name)
(warn "Silly argument for a unix ~A: ~S"
name-or-type name)))))))
......@@ -721,10 +721,9 @@ a host-structure or string."
"Accessor for the pathname's host."
(declare (type path-designator pathname)
(type (member :local :common) case)
(values host)
(values (or string null))
(ignore case))
(with-pathname (pathname pathname)
(%pathname-host pathname)))
(host-namestring pathname))
;;; PATHNAME-DEVICE -- Interface
;;;
......@@ -827,7 +826,7 @@ a host-structure or string."
(host (if (and host (stringp host))
(find-logical-host host)
host))
(default-host (pathname-host defaults))
(default-host (%pathname-host defaults))
(parse-host (or host
(extract-logical-host-prefix namestr start end)
default-host)))
......@@ -1441,7 +1440,7 @@ a host-structure or string."
The expansion for a search-list can be set with SETF."
(with-pathname (pathname pathname)
(let ((search-list (extract-search-list pathname t))
(host (pathname-host pathname)))
(host (%pathname-host pathname)))
(if (search-list-defined search-list)
(mapcar #'(lambda (directory)
(make-pathname :host host
......@@ -1867,7 +1866,7 @@ a host-structure or string."
;; DEF-DIR is :absolute, as handled above. so return
;; the original directory.
path-dir))))
(make-pathname :host (pathname-host pathname)
(make-pathname :host (%pathname-host pathname)
:directory enough-dir
:name (pathname-name pathname)
:type (pathname-type pathname)
......
......@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/fndb.lisp,v 1.107 2003/02/28 16:36:14 emarsden Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/fndb.lisp,v 1.108 2003/03/21 21:36:35 pmai Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -975,7 +975,7 @@
(defknown pathnamep (t) boolean (movable flushable))
(defknown pathname-host (pathnamelike &key (:case (member :local :common)))
pathname-host (flushable))
(or simple-string null) (flushable))
(defknown pathname-device (pathnamelike &key (:case (member :local :common)))
pathname-device (flushable))
(defknown pathname-directory (pathnamelike &key (:case (member :local :common)))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment