Skip to content
Snippets Groups Projects
Commit d0a6e0bd authored by toy's avatar toy
Browse files

From Eric Marsden:

  * fix DESCRIBE for arrays of zero rank. Bug and fix reported for
    SBCL on the sbcl-help list by Lutz Euler.

(Slightly modified)
parent 2a176aec
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/describe.lisp,v 1.37 2002/11/14 16:54:33 toy Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/describe.lisp,v 1.38 2002/12/07 18:21:22 toy Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -148,20 +148,22 @@ ...@@ -148,20 +148,22 @@
(format t "~%~A: ~S." (car slot) (cdr slot)))))) (format t "~%~A: ~S." (car slot) (cdr slot))))))
(defun describe-array (x) (defun describe-array (x)
(let ((rank (array-rank x))) (let ((rank (array-rank x))
(cond ((> rank 1) (element-type (array-element-type x)))
(format t "~&~S is " x) (cond ((= rank 1)
(write-string (if (%array-displaced-p x) "a displaced" "an"))
(format t " array of rank ~A." rank)
(format t "~%Its dimensions are ~S." (array-dimensions x)))
(t
(format t "~&~S is a ~:[~;displaced ~]vector of length ~D." x (format t "~&~S is a ~:[~;displaced ~]vector of length ~D." x
(and (array-header-p x) (%array-displaced-p x)) (length x)) (and (array-header-p x) (%array-displaced-p x)) (length x))
(if (array-has-fill-pointer-p x) (if (array-has-fill-pointer-p x)
(format t "~&It has a fill pointer, currently ~d" (format t "~&It has a fill pointer, currently ~d"
(fill-pointer x)) (fill-pointer x))
(format t "~&It has no fill pointer.")))) (format t "~&It has no fill pointer.")))
(format t "~&Its element type is ~S." (array-element-type x)))) (t
(format t "~&~S is " x)
(write-string (if (%array-displaced-p x) "a displaced" "an"))
(format t " array of rank ~A." rank)
(format t "~%Its dimensions are ~S." (array-dimensions x))))
(unless (eq t element-type)
(format t "~&Its element type is specialized to ~S." element-type))))
(defun describe-fixnum (x) (defun describe-fixnum (x)
(cond ((not (or *describe-verbose* (zerop *current-describe-level*)))) (cond ((not (or *describe-verbose* (zerop *current-describe-level*))))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment