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)