On the latest SBCL compiled myself w/o CLC, my tests all pass on SBCL. The problem is that the tests expect that there should be no filename redirection, but CLC does it.
The attached patch will disable CLC if present and make the tests pass. It will also solve test-module-pathnames.script for clisp. test-retry-loading-component-1.script remains broken on my debian's (old?) clisp 2.48, which looks like a bug in that old clisp (it can find the restart, but not invoke it???) [ François-René ÐVB Rideau | Reflection&Cybernethics | http://fare.tunes.org ] Most economic fallacies derive... from the tendency to assume that there is a fixed pie, that one party can gain only at the expense of another. -- Milton Friedman 2009/10/22 Gary King <[email protected]>: > Weird. > > On my Mac, it's http://common-lisp.net/project/asdf/test-results.html > > SBCL passes all; the others only fail on one. > > I'll check it out. > > > On Oct 22, 2009, at 12:28 PM, Faré wrote: > >> I ran the tests for asdf. Out of 17, 5 fail on sbcl and 7 on clisp. Oops. >> >> On SBCL, the failures seem related to the pathname redirection of ABL / >> CLC. >> test1.script test2.script test3.script test-force.script >> test-static-and-serial.script >> >> On CLISP, the two additional failures are >> test-module-pathnames.script >> where clisp reads "foo.cl" as having directory nil instead of >> (:relative), which I think is legal, and >> test-retry-loading-component-1.script >> which seems to have to do with a restart-case retry in do-one-dep, but >> that's beyond my depth. >> >> The good news is most of these failures are only failures of the test >> themselves. >> The bad news is someone probably has to fix them and commit a fix.
diff --git a/asdf.lisp b/asdf.lisp index f28fbd0..d353785 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -763,32 +763,20 @@ to `~a` which is not a directory.~@:>" (defmethod source-file-type ((c html-file) (s module)) "html") (defmethod source-file-type ((c static-file) (s module)) nil) -#+(or) -(defmethod component-relative-pathname ((component source-file)) - (multiple-value-bind (relative path name) - (split-path-string (component-name component)) - (let ((type (source-file-type component (component-system component))) - (relative-pathname (slot-value component 'relative-pathname)) - (*default-pathname-defaults* (component-parent-pathname component))) - (if relative-pathname - (merge-pathnames - relative-pathname - (if type - (make-pathname :name name :type type) - name)) - (make-pathname :directory `(,relative ,@path) :name name :type type))))) - +(defun merge-component-relative-pathname (pathname name type) + (multiple-value-bind (relative path filename) + (split-path-string name) + (merge-pathnames + (or pathname (make-pathname :directory `(,relative ,@path))) + (if type + (make-pathname :name filename :type type) + filename)))) (defmethod component-relative-pathname ((component source-file)) - (multiple-value-bind (relative path name) - (split-path-string (component-name component)) - (let ((type (source-file-type component (component-system component))) - (relative-pathname (slot-value component 'relative-pathname))) - (merge-pathnames - (or relative-pathname (make-pathname :directory `(,relative ,@path))) - (if type - (make-pathname :name name :type type) - name))))) + (merge-component-relative-pathname + (slot-value component 'relative-pathname) + (component-name component) + (source-file-type component (component-system component)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; operations diff --git a/test/script-support.lisp b/test/script-support.lisp index 5f5407f..b82b3da 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -3,6 +3,9 @@ #+allegro (setf excl:*warn-on-nested-reader-conditionals* nil) +#+common-lisp-controller +(setf common-lisp-controller:*redirect-fasl-files-to-cache* nil) + ;;; code adapted from cl-launch (any errors in transcription are mine!) ;; http://www.cliki.net/cl-launch (defun leave-lisp (message return) diff --git a/test/test-module-pathnames.script b/test/test-module-pathnames.script index 10383b2..dcdd1fd 100644 --- a/test/test-module-pathnames.script +++ b/test/test-module-pathnames.script @@ -14,8 +14,9 @@ (level1 (submodule system "sources/level1")) (static (submodule level1 "level2/static.file")) (test-tmp (submodule level1 "test-tmp.cl"))) - (assert (equal (pathname-foo (asdf:component-relative-pathname test-tmp)) - '((:relative) "test-tmp" "cl")) + (assert (member (pathname-foo (asdf:component-relative-pathname test-tmp)) + '(((:relative) "test-tmp" "cl") + (nil "test-tmp" "cl")) :test 'equal) nil "Didn't get the name of test-tmp.cl right") (assert (equal diff --git a/test/test-retry-loading-component-1.script b/test/test-retry-loading-component-1.script index 995ef44..6f2aff2 100644 --- a/test/test-retry-loading-component-1.script +++ b/test/test-retry-loading-component-1.script @@ -25,6 +25,7 @@ (assert (eq mode :external) nil "Mode of ~s was not external" name) (let ((restart (find-restart name c))) (assert restart) + (format t "~&restart: ~S~&" restart) (when restart (invoke-restart restart))))))) (asdf:oos 'asdf:load-op 'try-reloading-1)) (assert *caught-error*)
_______________________________________________ asdf-devel mailing list [email protected] http://common-lisp.net/cgi-bin/mailman/listinfo/asdf-devel
