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

[mhenoch at common-lisp.net]

Author: mhenoch
Date: Fri Aug 24 00:42:52 2007
New Revision: 123

Modified:
   cl-darcs/trunk/util.lisp
Log:
Add PATHNAME-SANE-P and use it.


Modified: cl-darcs/trunk/util.lisp
==============================================================================
--- cl-darcs/trunk/util.lisp	(original)
+++ cl-darcs/trunk/util.lisp	Fri Aug 24 00:42:52 2007
@@ -1,4 +1,4 @@
-;;; Copyright (C) 2006 Magnus Henoch
+;;; Copyright (C) 2006, 2007 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
@@ -225,10 +225,18 @@
 	 (make-pathname :directory (cons :relative directory)
 			:name filename-without-dot :type type))))))
 
+(defun pathname-sane-p (pathname)
+  "Return true if PATHNAME is a relative path going strictly down."
+  (let ((directory (pathname-directory pathname)))
+    (and (listp directory)
+	 (eql (car directory) :relative)
+	 (every #'stringp (cdr directory)))))
+
 (defun pathname-to-string (pathname)
   "Convert PATHNAME to a string usable in darcs patch files.
 PATHNAME is assumed to be a relative pathname going strictly down,
 as returned by SANITIZE-FILENAME."
+  (assert (pathname-sane-p pathname))
   (apply #'concatenate 'string
 	 "./"
 	 (append