[Cl-darcs-cvs] r167 - cl-darcs/trunk

[mhenoch at common-lisp.net]

Author: mhenoch
Date: Wed Mar  5 03:10:11 2008
New Revision: 167

Modified:
   cl-darcs/trunk/upath.lisp
Log:
UPATH-SUBDIR: assume that base pathname is a directory, and use PATHNAME-AS-DIRECTORY


Modified: cl-darcs/trunk/upath.lisp
==============================================================================
--- cl-darcs/trunk/upath.lisp	(original)
+++ cl-darcs/trunk/upath.lisp	Wed Mar  5 03:10:11 2008
@@ -1,4 +1,4 @@
-;;; Copyright (C) 2006 Magnus Henoch
+;;; Copyright (C) 2006, 2008 Magnus Henoch
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License as
@@ -37,7 +37,8 @@
 	 (pathname path)))))
 
 (defun upath-subdir (base subdirs &optional filename)
-  "From BASE, descend into SUBDIRS and FILENAME."
+  "From BASE, descend into SUBDIRS and FILENAME.
+PATH is assumed to refer to a directory, not a file."
   (setf base (make-upath base))
   (let* ((subdirs-list (remove-if #'keywordp 
 				  (if (pathnamep subdirs)
@@ -59,6 +60,7 @@
 	 new-uri))
       ;; this won't work correctly if BASE has a filename
       (pathname
+       (setf base (fad:pathname-as-directory base))
        (merge-pathnames
 	(make-pathname :directory (cons :relative subdirs-list)
 		       :name filename)