From 20a36319c35b1b99c4e2deda39b310db3ae247c5 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Fri, 20 Dec 2013 00:23:20 -0500 Subject: [PATCH] More XCL tweaks. --- TODO | 2 ++ test/asdf-pathname-test.script | 14 ++++++++------ uiop/image.lisp | 2 +- 3 files changed, 11 insertions(+), 7 deletions(-) diff --git a/TODO b/TODO index 607996f9..0eb0b41f 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 8beecb31..a5d4e335 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 67a5d8c8..e965c886 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))) -- GitLab