X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-pathname.lisp;h=a63916ff6d4eaa88a653dc0887045589743e2c5f;hb=fbe6e22af842835f7c70309f4d48064ca3984ad0;hp=0ef34ff9408befb77c74b32f11678de8af454140;hpb=a18f0a95bc9a457e4d2d00c702b746f29c2662b1;p=sbcl.git diff --git a/src/code/target-pathname.lisp b/src/code/target-pathname.lisp index 0ef34ff..a63916f 100644 --- a/src/code/target-pathname.lisp +++ b/src/code/target-pathname.lisp @@ -71,7 +71,7 @@ ;; but the arguments given in the X3J13 cleanup issue ;; PATHNAME-LOGICAL:ADD seem compelling: we should canonicalize the ;; case, and uppercase is the ordinary way to do that. - (flet ((upcase-maybe (x) (typecase x (string (string-upcase x)) (t x)))) + (flet ((upcase-maybe (x) (typecase x (string (logical-word-or-lose x)) (t x)))) (if (typep host 'logical-host) (%make-logical-pathname host :unspecific @@ -849,7 +849,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))) + (values (or simple-base-string pattern) list)) (let ((in-wildcard nil) (pieces nil) (strings nil)) @@ -1198,27 +1198,18 @@ a host-structure or string." values) (defun %enumerate-search-list (pathname function) - (/show0 "entering %ENUMERATE-SEARCH-LIST") - (let* ((pathname (if (typep pathname 'logical-pathname) - (translate-logical-pathname pathname) - pathname)) + (let* ((pathname (physicalize-pathname pathname)) (search-list (extract-search-list pathname nil))) - (/show0 "PATHNAME and SEARCH-LIST computed") (cond ((not search-list) - (/show0 "no search list") (funcall function pathname)) ((not (search-list-defined search-list)) - (/show0 "undefined search list") (error "undefined search list: ~A" (search-list-name search-list))) (t - (/show0 "general case") (let ((tail (cddr (pathname-directory pathname)))) - (/show0 "TAIL computed") (dolist (expansion (search-list-expansions search-list)) - (/show0 "tail recursing in %ENUMERATE-SEARCH-LIST") (%enumerate-search-list (make-pathname :defaults pathname :directory (cons :absolute @@ -1234,7 +1225,7 @@ a host-structure or string." ;;;; utilities -;;; Canonicalize a logical pathanme word by uppercasing it checking that it +;;; Canonicalize a logical pathname word by uppercasing it checking that it ;;; contains only legal characters. (defun logical-word-or-lose (word) (declare (string word)) @@ -1427,12 +1418,10 @@ a host-structure or string." :namestring namestr :offset (cdadr chunks))))) (parse-host (logical-chunkify namestr start end))) - (values host :unspecific - (and (not (equal (directory)'(:absolute))) - (directory)) - name type version)))) + (values host :unspecific (directory) name type version)))) -;;; We can't initialize this yet because not all host methods are loaded yet. +;;; We can't initialize this yet because not all host methods are +;;; loaded yet. (defvar *logical-pathname-defaults*) (defun logical-pathname (pathspec)