common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Fix DESCRIBE for non-simple, non-displaced arrays

Browse source
This commit is contained in:
Jan Moringen 2017-09-16 16:47:20 +02:00
parent bdbe5a49d7
commit 3169144206
2 changed files with 11 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
src/code/describe.lisp
View file

@ -260,7 +260,8 @@
(unless (typep x 'simple-array)
(format s "~%Adjustable: ~A" (if (adjustable-array-p x) "yes" "no"))
(multiple-value-bind (to offset) (array-displacement x)
(if (format s "~%Displaced-to: ~A~%Displaced-offset: ~S"
(if to
(format s "~%Displaced-to: ~A~%Displaced-offset: ~S"
(prin1-to-line to)
offset)
(format s "~%Displaced: no"))))

9
tests/describe.impure.lisp
View file

@ -132,3 +132,12 @@
(test 'inline "INLINE names a standard declaration.")
(test 'sb-ext:deprecated "DEPRECATED names an SBCL-specific declaration.")
(test 'my-declaration "MY-DECLARATION names a user-defined declaration.")))
(with-test (:name (describe array :displaced-to))
(assert (search "Displaced: no"
(with-output-to-string (stream)
(describe (make-array 1 :adjustable t) stream))))
(assert (search "Displaced-to: #<"
(with-output-to-string (stream)
(describe (make-array 1 :displaced-to (make-array 1))
stream)))))