From 95125ba89cc78802f7c43c587a2963e46cc01dc3 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Sun, 25 Sep 2005 21:42:14 +0000 Subject: [PATCH] The defaults arg for PARSE-NAMESTRING is a pathname designator, not a pathname, Adjust PARSE-NAMESTRING to accept pathname designators. --- code/pathname.lisp | 47 +++++++++++++++++++++++----------------------- 1 file changed, 24 insertions(+), 23 deletions(-) diff --git a/code/pathname.lisp b/code/pathname.lisp index 0c1b04ce9..be19c8c8c 100644 --- a/code/pathname.lisp +++ b/code/pathname.lisp @@ -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.79 2005/09/24 01:26:37 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pathname.lisp,v 1.80 2005/09/25 21:42:14 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -951,7 +951,7 @@ a host-structure or string." a physical host structure or host namestring." (declare (type path-designator thing) (type (or list string host (member :unspecific)) host) - (type pathname defaults) + (type path-designator defaults) (type index start) (type (or index null) end)) ;; Generally, redundant specification of information in software, @@ -1006,27 +1006,28 @@ a host-structure or string." (host host)))) (declare (type (or null host) host)) - (etypecase thing - (simple-string - (%parse-namestring thing host defaults start end junk-allowed)) - (string - (%parse-namestring (coerce thing 'simple-string) - host defaults start end junk-allowed)) - (pathname - (let ((host (if host host (%pathname-host defaults)))) - (unless (eq host (%pathname-host thing)) - (error "Hosts do not match: ~S and ~S." - host (%pathname-host thing)))) - (values thing start)) - (stream - (let ((name (file-name thing))) - (unless name - (error 'simple-type-error - :datum thing - :expected-type 'pathname - :format-control "Can't figure out the file associated with stream:~% ~S" - :format-arguments (list thing))) - (values name nil)))))) + (with-pathname (defaults defaults) + (etypecase thing + (simple-string + (%parse-namestring thing host defaults start end junk-allowed)) + (string + (%parse-namestring (coerce thing 'simple-string) + host defaults start end junk-allowed)) + (pathname + (let ((host (if host host (%pathname-host defaults)))) + (unless (eq host (%pathname-host thing)) + (error "Hosts do not match: ~S and ~S." + host (%pathname-host thing)))) + (values thing start)) + (stream + (let ((name (file-name thing))) + (unless name + (error 'simple-type-error + :datum thing + :expected-type 'pathname + :format-control "Can't figure out the file associated with stream:~% ~S" + :format-arguments (list thing))) + (values name nil))))))) ;;; NAMESTRING -- Interface -- GitLab