diff --git a/TODO b/TODO index 607996f9f8b6237bd7eb1016b21fecbfe23e5f3a..0eb0b41f3cfe0bd6ccf982e93c7fedf6d631d964 100644 --- a/TODO +++ b/TODO @@ -29,6 +29,8 @@ Maybe O(n^3) behavior or worse in walking the C++ stack? The backtrace frames may contains unprintable objects. make-pathname fails to copy the version from the defaults. + (make-pathname :host "ASDFTEST" :directory '(:absolute "system2" "module4") + :name nil :type nil) fails to handle the logical-pathname-ness of ASDFTEST. * GCL is almost working again; but implementation bugs remain. See November 2013 discussion on gcl-devel diff --git a/test/asdf-pathname-test.script b/test/asdf-pathname-test.script index 8beecb3143f927fdbad5a0799a55da30702a9c8b..a5d4e335750225c18df075dc8d0d576bcba8646e 100644 --- a/test/asdf-pathname-test.script +++ b/test/asdf-pathname-test.script @@ -117,15 +117,12 @@ (with-slots (system-count directory-count file-count system-failures directory-failures file-failures all-tests) test-status (let ((success - (block :foo + (block :foo ;; XCL 0.0.0.291 is confused if using block nil (handler-bind ((error #'(lambda (c) (incf *backtraces*) - (dolist (o (list *trace-output*)) - (format o "BACKTRACES: ~S (max ~S)~%" - *backtraces* *max-backtraces*) + (dolist (o (list *trace-output* *standard-output*)) (when (<= *backtraces* *max-backtraces*) - #+xcl (safe-format! stream "~&Condition:~%~A~&" c) - #-xcl (print-condition-backtrace c :stream o))) + (print-condition-backtrace c :stream o))) (return-from :foo nil)))) (assert (probe-file* (component-pathname file)) () "Can't find pathname ~S for component ~S" (component-pathname file) file) @@ -367,6 +364,11 @@ :direction :output :if-exists :supersede :if-does-not-exist :create) (setup-asdftest-logical-host :root root) + #+asdf-test-logical-pathname + (assert-pathname-equal + (make-pathname :host "ASDFTEST" :directory '(:absolute "system2" "module4") + :name nil :type nil) + (parse-namestring "ASDFTEST:system2;module4;")) (multiple-value-bind (systems modules files test-files) (make-test-files :root root diff --git a/uiop/image.lisp b/uiop/image.lisp index 67a5d8c886201775c0a920679f8147f1123b6e3b..e965c886cffe8d186050a53d80c233fad690d670 100644 --- a/uiop/image.lisp +++ b/uiop/image.lisp @@ -146,7 +146,7 @@ This is designed to abstract away the implementation specific quit forms." #.(if (find-symbol* "*VERBOSITY*" "SB-DEBUG" nil) :stream '(or count most-positive-fixnum)) stream) #+xcl - (loop :for i :from 0 + (loop :for i :from 0 :below (or count most-positive-fixnum) :for frame :in (extensions:backtrace-as-list) :do (safe-format! stream "~&~D: ~S~%" i frame)))