X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-pathname.lisp;h=86d1f21525f6c9faf92e53c807f60cee2fdacfd1;hb=15d6e7c9a2c3234f95dfe278046fa2fee1b0c007;hp=5210a0fc66aff136c41be342914dae4ee557fb53;hpb=235c8f10a2d6b6f34e0122aa2b4ac57c74e3a484;p=sbcl.git

diff --git a/src/code/target-pathname.lisp b/src/code/target-pathname.lisp
index 5210a0f..86d1f21 100644
--- a/src/code/target-pathname.lisp
+++ b/src/code/target-pathname.lisp
@@ -716,9 +716,8 @@ a host-structure or string."
 			 host
 			 (defaults *default-pathname-defaults*)
 			 &key (start 0) end junk-allowed)
-  (declare (type pathname-designator thing)
+  (declare (type pathname-designator thing defaults)
 	   (type (or list host string (member :unspecific)) host)
-	   (type pathname defaults)
 	   (type index start)
 	   (type (or index null) end)
 	   (type (or t null) junk-allowed)
@@ -775,8 +774,18 @@ a host-structure or string."
                               supported in this implementation:~%  ~S"
 			      host))
 		      (host
-		       host))))
-    (declare (type (or null host) found-host))
+		       host)))
+	;; According to ANSI defaults may be any valid pathname designator
+	(defaults (etypecase defaults
+		    (pathname   
+		     defaults)
+		    (string
+		     (aver (pathnamep *default-pathname-defaults*))
+		     (parse-namestring defaults))
+		    (stream
+		     (truename defaults)))))
+    (declare (type (or null host) found-host)
+	     (type pathname defaults))
     (etypecase thing
       (simple-string
        (%parse-namestring thing found-host defaults start end junk-allowed))