X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-load.lisp;h=b36fefb838e074cf9ed1f3dfe78cd50728fae9d8;hb=4e3b57699314dbd3883470d9b196287b178f3e6d;hp=9254a35e0eefe67ff9ac60cddc220063dd9db132;hpb=7cec182a00d4143dc7cfd43fc55c6691e356e609;p=sbcl.git diff --git a/src/code/target-load.lisp b/src/code/target-load.lisp index 9254a35..b36fefb 100644 --- a/src/code/target-load.lisp +++ b/src/code/target-load.lisp @@ -96,7 +96,7 @@ ;;; possible types are ".lisp" and ".cl", and both "foo.lisp" and ;;; "foo.cl" exist?) (defun try-default-type (pathname type) - (let ((pn (make-pathname :type type :defaults pathname))) + (let ((pn (translate-logical-pathname (make-pathname :type type :defaults pathname)))) (values pn (probe-file pn)))) ;;; a helper function for LOAD: Handle the case of INTERNAL-LOAD where @@ -183,40 +183,19 @@ '(unsigned-byte 8))) (load-as-fasl filespec verbose print) (load-as-source filespec verbose print)) - (let (;; FIXME: MERGE-PATHNAMES doesn't work here for - ;; FILESPEC="TEST:Load-Test" and - ;; (LOGICAL-PATHNAME-TRANSLATIONS "TEST") - ;; = (("**;*.*.*" "/foo/bar/**/*.*")). - ;; Physicalizing the pathname before merging - ;; is a workaround, but the ANSI spec talks about - ;; MERGE-PATHNAMES accepting (and returning) - ;; logical pathnames, so a true fix would probably - ;; include fixing MERGE-PATHNAMES, then probably - ;; revisiting this code. - (ppn (physicalize-pathname (pathname filespec)))) - (if (wild-pathname-p ppn) - (let ((files (directory ppn))) - #!+high-security - (when (null files) - (error 'file-error :pathname filespec)) - (dolist (file files t) - (internal-load ppn - file - internal-if-does-not-exist - verbose - print))) - (let ((tn (probe-file ppn))) - (if (or tn (pathname-type ppn)) - (internal-load ppn - tn - internal-if-does-not-exist - verbose - print) - (internal-load-default-type - ppn - internal-if-does-not-exist - verbose - print))))))))) + (let* ((pathname (pathname filespec)) + (physical-pathname (translate-logical-pathname pathname))) + (if (or (probe-file physical-pathname) (pathname-type physical-pathname)) + (internal-load physical-pathname + (truename physical-pathname) + internal-if-does-not-exist + verbose + print) + + (internal-load-default-type pathname + internal-if-does-not-exist + verbose + print))))))) ;;; Load a code object. BOX-NUM objects are popped off the stack for ;;; the boxed storage section, then SIZE bytes of code are read in.