[bknr-cvs] r1826 - in trunk/bknr: . src/data

bknr at bknr.net bknr at bknr.net
Wed Feb 8 06:02:22 UTC 2006


Author: hhubner
Date: 2006-02-08 00:02:22 -0600 (Wed, 08 Feb 2006)
New Revision: 1826

Modified:
   trunk/bknr/init.lisp
   trunk/bknr/src/data/object-tests.lisp
Log:
>From Tchadvar Roussanov:

Here is a minor patch to make object-tests.lisp working with
sbcl-0.9.9. It also includes sbcl changes to init.lisp for logical
path translations (assuming installation in user's home directory).

Note that in order for datastore to compile I have to replace cxml
and porableaserve with their latest cvs versions.



Modified: trunk/bknr/init.lisp
===================================================================
--- trunk/bknr/init.lisp	2006-02-07 11:18:43 UTC (rev 1825)
+++ trunk/bknr/init.lisp	2006-02-08 06:02:22 UTC (rev 1826)
@@ -1,78 +1,106 @@
-(in-package :cl-user)
-
-;;;;;;;;;;;;;
-;; Tweak this
-(eval-when (:execute :compile-toplevel :load-toplevel)
-  #+allegro
-  (setf (logical-pathname-translations "bknr")
-	`(("**;*.*.*" "bknr/**/"))
-	(logical-pathname-translations "bknr-thirdparty")
-	`(("**;*.*.*" "thirdparty/**/"))
-	(logical-pathname-translations "eboy")
-	`(("**;*.*.*" "eboy/**/")))
-
-  #+cmu
-  (setf (logical-pathname-translations "bknr")
-	`(("**;*.*.*" "home:bknr-sputnik/bknr/**/"))
-	(logical-pathname-translations "bknr-thirdparty")
-	`(("**;*.*.*" "home:bknr-sputnik/thirdparty/**/"))
-	(logical-pathname-translations "eboy")
-	`(("**;*.*.*" "home:bknr-sputnik/eboy/**/"))))
-
-(eval-when (:execute :compile-toplevel :load-toplevel)
-  (load #p"bknr-thirdparty:asdf;asdf"))
-
-(push (translate-logical-pathname #p"bknr:src;") asdf:*central-registry*)
-(push (translate-logical-pathname #p"eboy:src;") asdf:*central-registry*)
-
-(defparameter *patch-directory* "bknr:patches;")
-
-(defun load-patches (&optional (directory *patch-directory*))
-  (dolist (file (directory (merge-pathnames directory #p"patch-*.lisp")))
-    (warn "; Loading patch from file ~A~%" file)
-    (load file)))
-
-(defun fix-dpd ()
-  #+cmu
-  ;; Die Sache mit dem aktuellen Verzeichnis hat CMUCL noch immer nicht im
-  ;; Griff.  Nachbessern!
-  (setf *default-pathname-defaults*
-        (pathname
-         (concatenate 'string
-                      (nth-value 1 (unix:unix-current-directory))
-                      "/"))))
-
-(defun make-wild-pathname (type directory)
-  (merge-pathnames (make-pathname :type type
-				  :directory '(:relative :wild-inferiors))
-		   directory))
-
-(defun setup-registry ()
-  (mapc #'(lambda (asd-pathname)
-	    (pushnew (make-pathname :directory (pathname-directory asd-pathname))
-		     asdf:*central-registry*
-		     :test #'equal))
-	(append (directory #p"bknr-thirdparty:**;*.asd")
-		(directory #p"bknr:**;*.asd"))))
-
-(defun clean-registry (&optional (dirs asdf:*central-registry*))
-  (let ((files (mapcan #'directory
-		       (mapcan #'(lambda (dir)
-				   (when (pathnamep dir)
-				     (list (make-wild-pathname "fas" dir)
-					   (make-wild-pathname "lib" dir)
-					   (make-wild-pathname "x86f" dir)
-					   (make-wild-pathname "fasl" dir))))
-			       dirs))))
-    (dolist (file files)
-      (when (probe-file file)
-	(format t "Deleting binary file ~S~%" file)
-	(delete-file file)))))
-
-#+cmu
-(load-patches)
-
-(setup-registry)
-(fix-dpd)
-
-(push :cl-gd-gif *features*)
+(in-package :cl-user)
+
+;;;;;;;;;;;;;
+;; Tweak this
+(eval-when (:execute :compile-toplevel :load-toplevel)
+  #+allegro
+  (setf (logical-pathname-translations "bknr")
+	`(("**;*.*.*" "bknr/**/"))
+	(logical-pathname-translations "bknr-thirdparty")
+	`(("**;*.*.*" "thirdparty/**/"))
+	(logical-pathname-translations "eboy")
+	`(("**;*.*.*" "eboy/**/")))
+
+  #+cmu
+  (setf (logical-pathname-translations "bknr")
+	`(("**;*.*.*" "home:bknr-sputnik/bknr/**/"))
+	(logical-pathname-translations "bknr-thirdparty")
+	`(("**;*.*.*" "home:bknr-sputnik/thirdparty/**/"))
+	(logical-pathname-translations "eboy")
+	`(("**;*.*.*" "home:bknr-sputnik/eboy/**/")))
+
+  #+sbcl
+  (setf (logical-pathname-translations "bknr")
+      `(("**;*.*.*"
+         ,(merge-pathnames
+           (make-pathname :directory '(:relative "bknr-svn" "bknr"  :wild-inferiors)
+                          :name    :wild
+                          :type    :wild
+                          :version :wild)
+           (user-homedir-pathname))))
+       (logical-pathname-translations "bknr-thirdparty")
+      `(("**;*.*.*"
+         ,(merge-pathnames
+           (make-pathname :directory '(:relative "bknr-svn" "thirdparty" :wild-inferiors)
+                          :name    :wild
+                          :type    :wild
+                          :version :wild)
+           (user-homedir-pathname))))
+       (logical-pathname-translations "eboy")
+      `(("**;*.*.*"
+         ,(merge-pathnames
+           (make-pathname :directory '(:relative "bknr-svn" "eboy" :wild-inferiors)
+                          :name    :wild
+                          :type    :wild
+                          :version :wild)
+           (user-homedir-pathname))))))
+
+#-sbcl
+(eval-when (:execute :compile-toplevel :load-toplevel)
+  (load #p"bknr-thirdparty:asdf;asdf"))
+
+(push (translate-logical-pathname #p"bknr:src;") asdf:*central-registry*)
+(push (translate-logical-pathname #p"eboy:src;") asdf:*central-registry*)
+
+(defparameter *patch-directory* "bknr:patches;")
+
+(defun load-patches (&optional (directory *patch-directory*))
+  (dolist (file (directory (merge-pathnames directory #p"patch-*.lisp")))
+    (warn "; Loading patch from file ~A~%" file)
+    (load file)))
+
+(defun fix-dpd ()
+  #+cmu
+  ;; Die Sache mit dem aktuellen Verzeichnis hat CMUCL noch immer nicht im
+  ;; Griff.  Nachbessern!
+  (setf *default-pathname-defaults*
+        (pathname
+         (concatenate 'string
+                      (nth-value 1 (unix:unix-current-directory))
+                      "/"))))
+
+(defun make-wild-pathname (type directory)
+  (merge-pathnames (make-pathname :type type
+				  :name :wild
+				  :directory '(:relative :wild-inferiors))
+		   directory))
+
+(defun setup-registry ()
+  (mapc #'(lambda (asd-pathname)
+	    (pushnew (make-pathname :directory (pathname-directory asd-pathname))
+		     asdf:*central-registry*
+		     :test #'equal))
+	(append (directory #p"bknr-thirdparty:**;*.asd")
+		(directory #p"bknr:**;*.asd"))))
+
+(defun clean-registry (&optional (dirs asdf:*central-registry*))
+  (let ((files (mapcan #'directory
+		       (mapcan #'(lambda (dir)
+				   (when (pathnamep dir)
+				     (list (make-wild-pathname "fas" dir)
+					   (make-wild-pathname "lib" dir)
+					   (make-wild-pathname "x86f" dir)
+					   (make-wild-pathname "fasl" dir))))
+			       dirs))))
+    (dolist (file files)
+      (when (probe-file file)
+	(format t "Deleting binary file ~S~%" file)
+	(delete-file file)))))
+
+#+cmu
+(load-patches)
+
+(setup-registry)
+(fix-dpd)
+
+(push :cl-gd-gif *features*)

Modified: trunk/bknr/src/data/object-tests.lisp
===================================================================
--- trunk/bknr/src/data/object-tests.lisp	2006-02-07 11:18:43 UTC (rev 1825)
+++ trunk/bknr/src/data/object-tests.lisp	2006-02-08 06:02:22 UTC (rev 1826)
@@ -16,7 +16,20 @@
     #+allegro
     (excl:delete-directory-and-files pathname)
     #+cmu
-    (unix:unix-rmdir (namestring pathname))))
+    (unix:unix-rmdir (namestring pathname))
+    #+sbcl
+    (loop for file in (directory 
+		       (merge-pathnames
+			(make-pathname 
+			 :name    :wild
+			 :type    :wild
+			 :version :wild
+			 )
+			pathname)) 
+	  when (pathname-name file) do (delete-file file)
+	  unless (pathname-name file) do (delete-directory file))
+    #+sbcl
+    (sb-posix:rmdir (namestring pathname))))
 
 (defvar *test-datastore-directory* #p"/tmp/test-datastore/")
 (defvar *test-datastore* nil)




More information about the Bknr-cvs mailing list