From: Kevin Rosenberg Date: Sun, 20 Apr 2003 08:48:46 +0000 (+0000) Subject: 0.pre8.81: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=545603e9715ada6be5fbd958c3f1df24ce18c666;p=sbcl.git 0.pre8.81: - sb-aclrepl: more bug fixes for the inspector, added "istep" tests to test interactive object traversal. --- diff --git a/contrib/sb-aclrepl/aclrepl-tests.lisp b/contrib/sb-aclrepl/aclrepl-tests.lisp index 602af92..25a78a5 100644 --- a/contrib/sb-aclrepl/aclrepl-tests.lisp +++ b/contrib/sb-aclrepl/aclrepl-tests.lisp @@ -7,9 +7,14 @@ sb-aclrepl::inspected-elements sb-aclrepl::parts-count sb-aclrepl::parts-seq-type sb-aclrepl::find-part-id sb-aclrepl::element-at sb-aclrepl::label-at + sb-aclrepl::reset-cmd + sb-aclrepl::inspector + sb-aclrepl::display-inspect sb-aclrepl::display-inspected-parts sb-aclrepl::display-labeled-element - sb-aclrepl::*inspect-unbound-object-marker*)) + sb-aclrepl::*inspect-unbound-object-marker* + sb-aclrepl::*skip-address-display* + )) (eval-when (:compile-toplevel :load-toplevel :execute) (unless (find-package 'regression-test) @@ -85,6 +90,21 @@ (aref (the simple-vector (elements-labels object print skip)) pos) strm))) +(defun display (object &optional print (skip 0)) + (with-output-to-string (strm) + (let ((*skip-address-display* t)) + (display-inspect object strm print skip)))) + +(defun inspect (object) + (with-output-to-string (strm) + (let ((*skip-address-display* t)) + (inspector `(quote ,object) nil strm)))) + +(defun istep (args) + (with-output-to-string (strm) + (let ((*skip-address-display* t)) + (sb-aclrepl::istep args strm)))) + (deftest find.list.0 (find-position *normal-list* 0) 0) (deftest find.list.1 (find-position *normal-list* 0) 0) (deftest find.list.2 (find-position *normal-list* 1) 1) @@ -190,66 +210,66 @@ #((0 . "FIRST") (1 . "SLOT-2") (2 . "REALLY-LONG-STRUCT-SLOT-NAME"))) -(deftest display.simple-struct.0 (labeled-element *simple-struct* 0) +(deftest label.simple-struct.0 (labeled-element *simple-struct* 0) " 0 FIRST ----------> the symbol NIL") -(deftest display.simple-struct.1 (labeled-element *simple-struct* 1) +(deftest label.simple-struct.1 (labeled-element *simple-struct* 1) " 1 SLOT-2 ---------> the symbol A-VALUE") -(deftest display.simple-struct.2 (labeled-element *simple-struct* 2) +(deftest label.simple-struct.2 (labeled-element *simple-struct* 2) " 2 REALLY-LONG-STRUCT-SLOT-NAME -> a simple-string (4) \"defg\"") -(deftest display.simple-class.0 (labeled-element *simple-class* 0) +(deftest label.simple-class.0 (labeled-element *simple-class* 0) " 0 A --------------> ..unbound..") -(deftest display.simple-class.1 (labeled-element *simple-class* 1) +(deftest label.simple-class.1 (labeled-element *simple-class* 1) " 1 SECOND ---------> fixnum 0") -(deftest display.simple-class.2 (labeled-element *simple-class* 2) +(deftest label.simple-class.2 (labeled-element *simple-class* 2) " 2 REALLY-LONG-SLOT-NAME -> a simple-string (3) \"abc\"") -(deftest display.complex.0 (labeled-element *complex* 0) +(deftest label.complex.0 (labeled-element *complex* 0) " 0 real -----------> fixnum 1") -(deftest display.complex.1 (labeled-element *complex* 1) +(deftest label.complex.1 (labeled-element *complex* 1) " 1 imag -----------> fixnum 2") -(deftest display.ratio.0 (labeled-element *ratio* 0) +(deftest label.ratio.0 (labeled-element *ratio* 0) " 0 numerator ------> fixnum 22") -(deftest display.ratio.1 (labeled-element *ratio* 1) +(deftest label.ratio.1 (labeled-element *ratio* 1) " 1 denominator ----> fixnum 7") -(deftest display.dotted-list.0 (labeled-element *dotted-list* 0) +(deftest label.dotted-list.0 (labeled-element *dotted-list* 0) " 0-> the symbol A") -(deftest display.dotted-list.1 (labeled-element *dotted-list* 1) +(deftest label.dotted-list.1 (labeled-element *dotted-list* 1) " 1-> the symbol B") -(deftest display.dotted-list.2 (labeled-element *dotted-list* 2) +(deftest label.dotted-list.2 (labeled-element *dotted-list* 2) "tail-> fixnum 3") -(deftest display.normal-list.0 +(deftest label.normal-list.0 (labeled-element *normal-list* 0) " 0-> the symbol A") -(deftest display.normal-list.1 (labeled-element *normal-list* 1) +(deftest label.normal-list.1 (labeled-element *normal-list* 1) " 1-> the symbol B") -(deftest display.normal-list.2 (labeled-element *normal-list* 2) +(deftest label.normal-list.2 (labeled-element *normal-list* 2) " 2-> fixnum 3") -(deftest display.vector.0 (labeled-element *vector* 0) +(deftest label.vector.0 (labeled-element *vector* 0) " 0-> fixnum 0") -(deftest display.vector.1 (labeled-element *vector* 1) +(deftest label.vector.1 (labeled-element *vector* 1) " 1-> fixnum 1") -(deftest display.vector.skip1.0 (labeled-element *vector* 0 nil 2) +(deftest label.vector.skip1.0 (labeled-element *vector* 0 nil 2) " ...") -(deftest display.vector.skip1.1 (labeled-element *vector* 1 nil 2) +(deftest label.vector.skip1.1 (labeled-element *vector* 1 nil 2) " 2-> fixnum 2") -(deftest display.consp.0 (labeled-element *cons-pair* 0) +(deftest label.consp.0 (labeled-element *cons-pair* 0) " 0 car ------------> complex number #C(1 2)") -(deftest display.consp.1 (labeled-element *cons-pair* 1) +(deftest label.consp.1 (labeled-element *cons-pair* 1) " 1 cdr ------------> the symbol A-SYMBOL") (deftest nil.parts.0 (elements-count nil) 5) (deftest tiny.struct.0 (elements-count *tiny-struct*) 1) (deftest tiny.struct.1 (elements *tiny-struct*) #(10)) -(deftest tiny.struct.1 (elements-labels *tiny-struct*) #((0 . "FIRST"))) +(deftest tiny.struct.2 (elements-labels *tiny-struct*) #((0 . "FIRST"))) (deftest tiny.struct.skip1.0 (elements-count *tiny-struct* nil 1) 1) (deftest tiny.struct.skip1.1 (elements *tiny-struct* nil 1) @@ -265,7 +285,107 @@ (deftest tiny.doubel.skip1.2 (elements-labels *double* nil 1) nil) - +(deftest display.consp.0 (display *cons-pair*) + "a cons cell + 0 car ------------> complex number #C(1 2) + 1 cdr ------------> the symbol A-SYMBOL") + +(deftest display.struct.0 (display *simple-struct*) + "# + 0 FIRST ----------> the symbol NIL + 1 SLOT-2 ---------> the symbol A-VALUE + 2 REALLY-LONG-STRUCT-SLOT-NAME -> a simple-string (4) \"defg\"") + +(deftest display.struct.1 (display *simple-struct* nil 2 ) + "# + ... + 2 REALLY-LONG-STRUCT-SLOT-NAME -> a simple-string (4) \"defg\"") + +(deftest display.vector.0 (display *vector* 5 6) + "a simple T vector (20) + ... + 6-> fixnum 6 + 7-> fixnum 7 + 8-> fixnum 8 + 9-> fixnum 9 + 10-> fixnum 10 + ... + 19-> fixnum 19") + +#+ignore +(deftest inspect.0 (prog1 (inspect *simple-struct*)) + "# + 0 FIRST ----------> the symbol NIL + 1 SLOT-2 ---------> the symbol A-VALUE + 2 REALLY-LONG-STRUCT-SLOT-NAME -> a simple-string (4) \"defg\"") + +(deftest istep.0 (prog1 + (progn (inspect *simple-struct*) (istep '("="))) + (reset-cmd)) + "# + 0 FIRST ----------> the symbol NIL + 1 SLOT-2 ---------> the symbol A-VALUE + 2 REALLY-LONG-STRUCT-SLOT-NAME -> a simple-string (4) \"defg\"") + +(deftest istep.1 (prog1 + (progn (inspect *simple-struct*) (istep '("first"))) + (reset-cmd)) +"the symbol NIL + 0 NAME -----------> a simple-string (3) \"NIL\" + 1 PACKAGE --------> the COMMON-LISP package + 2 VALUE ----------> the symbol NIL + 3 FUNCTION -------> ..unbound.. + 4 PLIST ----------> the symbol NIL") + +(deftest istep.2 (prog1 + (progn (inspect *simple-struct*) (istep '("first")) + (istep '(">"))) + (reset-cmd)) +"the symbol A-VALUE + 0 NAME -----------> a simple-string (7) \"A-VALUE\" + 1 PACKAGE --------> the ACLREPL-TESTS package + 2 VALUE ----------> ..unbound.. + 3 FUNCTION -------> ..unbound.. + 4 PLIST ----------> the symbol NIL") + +(deftest istep.3 (prog1 + (progn (inspect *simple-struct*) (istep '("first")) + (istep '(">")) (istep '("<"))) + (reset-cmd)) +"the symbol NIL + 0 NAME -----------> a simple-string (3) \"NIL\" + 1 PACKAGE --------> the COMMON-LISP package + 2 VALUE ----------> the symbol NIL + 3 FUNCTION -------> ..unbound.. + 4 PLIST ----------> the symbol NIL") + +(deftest istep.4 (prog1 + (progn (inspect *simple-struct*) (istep '("first")) + (istep '(">")) (istep '("<")) (istep '("tree"))) + (reset-cmd)) +"The current object is: +the symbol NIL, which was selected by FIRST +#, which was selected by (inspect ...) +") + +(deftest istep.5 (prog1 + (progn (inspect *simple-struct*) (istep '("first")) + (istep '(">")) (istep '("<")) (istep '("-"))) + (reset-cmd)) + "# + 0 FIRST ----------> the symbol NIL + 1 SLOT-2 ---------> the symbol A-VALUE + 2 REALLY-LONG-STRUCT-SLOT-NAME -> a simple-string (4) \"defg\"") + +(deftest istep.6 (prog1 + (progn (inspect *dotted-list*) (istep '("tail"))) + (reset-cmd)) +"fixnum 3") + +(deftest istep.7 (prog1 + (progn (inspect *dotted-list*) (istep '("2"))) + (reset-cmd)) +"fixnum 3") (do-tests) diff --git a/contrib/sb-aclrepl/inspect.lisp b/contrib/sb-aclrepl/inspect.lisp index 807767c..a456db9 100644 --- a/contrib/sb-aclrepl/inspect.lisp +++ b/contrib/sb-aclrepl/inspect.lisp @@ -27,6 +27,8 @@ "maximum number of components to print") (defparameter *inspect-skip* 0 "number of initial components to skip when displaying an object") +(defparameter *skip-address-display* nil + "Skip displaying addresses of objects.") (defvar *inspect-help* ":istep takes between 0 to 3 arguments. @@ -61,7 +63,8 @@ i set
set named component to evalated form (let ((*current-inspect* nil) (*inspect-raw* nil) (*inspect-length* +default-inspect-length+) - (*inspect-skip* 0)) + (*inspect-skip* 0) + (*skip-address-display* nil)) (defun inspector (object input-stream output-stream) (declare (ignore input-stream)) @@ -71,7 +74,7 @@ i set set named component to evalated form (reset-stack) (setf (inspect-object-stack *current-inspect*) (list object)) (setf (inspect-select-stack *current-inspect*) - (list (format nil "(inspect ~S)" object))) + (list (format nil "(inspect ...)"))) (redisplay output-stream)) (setq sb-impl::*inspect-fun* #'inspector) @@ -308,7 +311,7 @@ i set set named component to evalated form (let ((object (eval form))) (setf (inspect-object-stack *current-inspect*) (list object)) (setf (inspect-select-stack *current-inspect*) - (list (format nil ":i ~S" object)))) + (list (format nil ":i ...")))) (set-break-inspect *current-inspect*) (redisplay stream)) @@ -329,13 +332,14 @@ i set set named component to evalated form ) ;; end binding for multithreading -(defun display-inspect (object stream &optional length skip) +(defun display-inspect (object stream &optional length (skip 0)) (multiple-value-bind (elements labels count) (inspected-elements object length skip) - (format stream "~&~A" (inspected-description object)) - (unless (or (characterp object) (typep object 'fixnum)) + (fresh-line stream) + (format stream "~A" (inspected-description object)) + (unless (or *skip-address-display* + (characterp object) (typep object 'fixnum)) (format stream " at #x~X" (sb-kernel:get-lisp-obj-address object))) - (princ #\newline stream) (dotimes (i count) (fresh-line stream) (display-labeled-element (elt elements i) (elt labels i) stream)))) @@ -392,7 +396,7 @@ i set set named component to evalated form Returns (VALUES POSITION PARTS). POSITION is NIL if the id is invalid or not found." (let* ((parts (inspected-parts object)) - (name (when (symbolp id) (symbol-name id) id))) + (name (if (symbolp id) (symbol-name id) id))) (values (if (numberp id) (when (< -1 id (parts-count parts)) id) @@ -786,4 +790,3 @@ position with the label if the label is a string." (defmethod set-component-value ((object t) id value element) (format nil "Object does not support setting of component ~A" id)) - diff --git a/version.lisp-expr b/version.lisp-expr index 59756f4..636210d 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.pre8.80" +"0.pre8.81"