From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Thu, 10 Aug 2006 12:48:45 +0000 (+0000)
Subject: 0.9.15.25: COMPILE-FILE-PATHNAME when output-file doesn't have a type
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=8886298f2c0e50e595cf481c426b6331ab898a23;p=sbcl.git

0.9.15.25: COMPILE-FILE-PATHNAME when output-file doesn't have a type
 * Bug reported by Robert Dodier.
---

diff --git a/NEWS b/NEWS
index 4fca016..788c122 100644
--- a/NEWS
+++ b/NEWS
@@ -26,6 +26,9 @@ changes in sbcl-0.9.16 relative to sbcl-0.9.15:
   * bug fix: format strings with ~> without matching ~< no longer
     trigger an AVER, but signal an understandable error instead.
     (reported by Antonio Martinez)
+  * bug fix: specifying an output-file without a pathname-type for
+    COMPILE-FILE or COMPILE-FILE-PATHNAME resulted in using the type
+    of input-file instead of "fasl". (reported by Robert Dodier)
 
 changes in sbcl-0.9.15 relative to sbcl-0.9.14:
   * added support for the ucs-2 external format.  (contributed by Ivan
diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index c3afdc7..8e4e154 100644
--- a/src/compiler/main.lisp
+++ b/src/compiler/main.lisp
@@ -1708,13 +1708,14 @@ SPEED and COMPILATION-SPEED optimization values, and the
 ;;; -- WHN 2000-12-09
 (defun sb!xc:compile-file-pathname (input-file
                                     &key
-                                    (output-file (cfp-output-file-default
-                                                  input-file))
+                                    (output-file nil output-file-p)
                                     &allow-other-keys)
   #!+sb-doc
   "Return a pathname describing what file COMPILE-FILE would write to given
    these arguments."
-  (merge-pathnames output-file (merge-pathnames input-file)))
+  (if output-file-p
+      (merge-pathnames output-file (cfp-output-file-default input-file))
+      (cfp-output-file-default input-file)))
 
 ;;;; MAKE-LOAD-FORM stuff
 
diff --git a/tests/pathnames.impure.lisp b/tests/pathnames.impure.lisp
index e6b5d10..845d70f 100644
--- a/tests/pathnames.impure.lisp
+++ b/tests/pathnames.impure.lisp
@@ -400,5 +400,12 @@
 (assert (eq :false
             (if (ignore-errors (merge-pathnames sb-sys::*tty*)) :true :false)))
 
+;;; This used to return "quux/bar.lisp"
+(assert (equal #p"quux/bar.fasl"
+               (let ((*default-pathname-defaults* #p"quux/"))
+                 (compile-file-pathname "foo.lisp" :output-file "bar"))))
+(assert (equal #p"quux/bar.fasl"
+               (let ((*default-pathname-defaults* #p"quux/"))
+                 (compile-file-pathname "bar.lisp"))))
 
 ;;;; success
diff --git a/version.lisp-expr b/version.lisp-expr
index 625c1e7..fcc68b6 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.15.24"
+"0.9.15.25"