contrib/sb-aclrepl/aclrepl-tests.lisp

   1 ;; Tests for sb-aclrepl
   2
   3 (defpackage #:aclrepl-tests (:use #:sb-aclrepl #:cl))
   4 (in-package #:aclrepl-tests)
   5
   6 (import '(sb-aclrepl::inspected-parts sb-aclrepl::inspected-description
   7           sb-aclrepl::inspected-elements sb-aclrepl::parts-count
   8           sb-aclrepl::parts-seq-type sb-aclrepl::find-part-id
   9           sb-aclrepl::element-at sb-aclrepl::label-at
  10           sb-aclrepl::reset-cmd
  11           sb-aclrepl::inspector
  12           sb-aclrepl::display-inspect
  13           sb-aclrepl::display-inspected-parts
  14           sb-aclrepl::display-labeled-element
  15           sb-aclrepl::*inspect-unbound-object-marker*
  16           sb-aclrepl::*skip-address-display*
  17           ))
  18
  19 (eval-when (:compile-toplevel :load-toplevel :execute)
  20   (unless (find-package 'regression-test)
  21     (load (sb-aclrepl::compile-file-as-needed "rt.lisp"))))
  22 (use-package :regression-test)
  23 (setf regression-test::*catch-errors* nil)
  24
  25 (rem-all-tests)
  26
  27 (deftest hook.1 (boundp 'sb-impl::*inspect-fun*) t)
  28 (deftest hook.2 (boundp 'sb-int:*repl-prompt-fun*) t)
  29 (deftest hook.3 (boundp 'sb-int:*repl-read-form-fun*) t)
  30 ;(deftest (boundp 'sb-debug::*invoke-debugger-fun*) t)
  31
  32 ;;; Inspector tests
  33
  34 (defclass empty-class ()
  35   ())
  36 (defparameter *empty-class* (make-instance 'empty-class))
  37
  38 (defclass empty-class ()
  39   ())
  40
  41 (defclass simple-class ()
  42   ((a)
  43    (second :initform 0)
  44    (really-long-slot-name :initform "abc")))
  45
  46 (defstruct empty-struct
  47   )
  48
  49 (defstruct tiny-struct
  50   (first 10))
  51
  52 (defstruct simple-struct
  53   (first)
  54   (slot-2 'a-value)
  55   (really-long-struct-slot-name "defg"))
  56
  57 (defparameter *empty-class* (make-instance 'empty-class))
  58 (defparameter *simple-class* (make-instance 'simple-class))
  59 (defparameter *empty-struct* (make-empty-struct))
  60 (defparameter *tiny-struct* (make-tiny-struct))
  61 (defparameter *simple-struct* (make-simple-struct))
  62 (defparameter *normal-list* '(a b 3))
  63 (defparameter *dotted-list* '(a b . 3))
  64 (defparameter *cons-pair* '(#c(1 2) . a-symbol))
  65 (defparameter *complex* #c(1 2))
  66 (defparameter *ratio* 22/7)
  67 (defparameter *double* 5.5d0)
  68 (defparameter *array* (make-array '(3 3 2) :initial-element nil))
  69 (defparameter *vector* (make-array '(20):initial-contents
  70                              '(0 1 2 3 4 5 6 7 8 9
  71                                10 11 12 13 14 15 16 17 18 19)))
  72
  73 (defun find-position (object id)
  74     (nth-value 0 (find-part-id object id)))
  75 (defun parts (object)
  76     (inspected-parts object))
  77 (defun description (object)
  78   (inspected-description object))
  79 (defun elements (object &optional print (skip 0))
  80   (nth-value 0 (inspected-elements object print skip )))
  81 (defun elements-labels (object &optional print (skip 0))
  82   (nth-value 1 (inspected-elements object print skip)))
  83 (defun elements-count (object &optional print (skip 0))
  84   (nth-value 2 (inspected-elements object print skip)))
  85
  86 (defun labeled-element (object pos &optional print (skip 0))
  87   (with-output-to-string (strm)
  88     (display-labeled-element
  89      (aref (the simple-vector (elements object print skip)) pos)
  90      (aref (the simple-vector (elements-labels object print skip)) pos)
  91      strm)))
  92
  93 (defun display (object &optional print (skip 0))
  94   (with-output-to-string (strm)
  95     (let ((*skip-address-display* t))
  96       (display-inspect object strm print skip))))
  97
  98 (defun inspect (object)
  99   (with-output-to-string (strm)
 100     (let ((*skip-address-display* t))
 101       (inspector `(quote ,object) nil strm))))
 102
 103 (defun istep (args)
 104   (with-output-to-string (strm)
 105     (let ((*skip-address-display* t))
 106       (sb-aclrepl::istep args strm))))
 107
 108 (deftest find.list.0 (find-position *normal-list* 0) 0)
 109 (deftest find.list.1 (find-position *normal-list* 0) 0)
 110 (deftest find.list.2 (find-position *normal-list* 1) 1)
 111 (deftest find.list.3 (find-position *normal-list* 2) 2)
 112 (deftest parts.list.1 (parts-count (parts *normal-list*)) 3)
 113 (deftest parts.list.2 (element-at (parts *normal-list*) 0) a)
 114 (deftest parts.list.3 (element-at (parts *normal-list*) 1) b)
 115 (deftest parts.list.4 (element-at (parts *normal-list*) 2) 3)
 116 (deftest parts.list.5 (label-at (parts *normal-list*) 0) 0)
 117 (deftest parts.list.6 (label-at (parts *normal-list*) 1) 1)
 118 (deftest parts.list.7 (label-at (parts *normal-list*) 2) 2)
 119 (deftest parts.list.8 (parts-seq-type (parts *normal-list*)) :list)
 120
 121 (deftest elem.list.0 (elements-count *normal-list*) 3)
 122 (deftest elem.list.1 (elements *normal-list*) #(a b 3))
 123 (deftest elem.list.2 (elements-labels *normal-list*) #(0 1 2))
 124
 125 (deftest elem.dotted.0 (elements-count *dotted-list*) 3)
 126 (deftest elem.dotted.1 (elements *dotted-list*) #(a b 3))
 127 (deftest elem.dotted.2 (elements-labels *dotted-list*) #(0 1 :tail))
 128
 129 (deftest elem.consp.0 (elements-count *cons-pair*) 2)
 130 (deftest elem.consp.1 (elements *cons-pair*) #(#c(1 2) a-symbol))
 131 (deftest elem.consp.2 (elements-labels *cons-pair*)
 132   #((0 . "car") (1 . "cdr")))
 133
 134 (deftest elem.complex.0 (elements-count *complex*) 2)
 135 (deftest elem.complex.1 (elements *complex*) #(1 2))
 136 (deftest elem.complex.2 (elements-labels *complex*)
 137   #((0 . "real") (1 . "imag")))
 138
 139 (deftest elem.ratio.0 (elements-count *ratio*) 2)
 140 (deftest elem.ratio.1 (elements *ratio*) #(22 7))
 141 (deftest elem.ratio.2 (elements-labels *ratio*)
 142   #((0 . "numerator") (1 . "denominator")))
 143
 144 (deftest elem.vector.0 (elements-count *vector*) 20)
 145 (deftest elem.vector.1 (elements *vector*)
 146   #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19))
 147 (deftest elem.vector.2 (elements-labels *vector*)
 148   #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19))
 149
 150 (deftest elem.vector.skip1.0 (elements-count *vector* nil 3) 18)
 151 (deftest elem.vector.skip1.1 (elements *vector* nil 3)
 152   #(nil 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19))
 153 (deftest elem.vector.skip1.2 (elements-labels *vector* nil 3)
 154   #(:ellipses 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19))
 155
 156 (deftest elem.vector.skip2.0 (elements-count *vector* 10 3) 13)
 157 (deftest elem.vector.skip2.1 (elements *vector* 10 3)
 158   #(nil 3 4 5 6 7 8 9 10 11 12 nil 19))
 159 (deftest elem.vector.skip2.2 (elements-labels *vector* 10 3)
 160   #(:ellipses 3 4 5 6 7 8 9 10 11 12 :ellipses 19))
 161
 162 (deftest elem.vector.skip3.0 (elements-count *vector* 5 16) 5)
 163 (deftest elem.vector.skip3.1 (elements *vector* 5 16)
 164   #(nil 16 17 18 19))
 165 (deftest elem.vector.skip3.2 (elements-labels *vector* 5 16)
 166   #(:ellipses 16 17 18 19))
 167
 168 (deftest elem.vector.skip4.0 (elements-count *vector* 2 16) 5)
 169 (deftest elem.vector.skip4.1 (elements *vector* 2 16)
 170   #(nil 16 17 18 19))
 171 (deftest elem.vector.skip4.2 (elements-labels *vector* 2 16)
 172   #(:ellipses 16 17 18 19))
 173
 174 (deftest elem.vector.skip5.0 (elements-count *vector* 2 15) 5)
 175 (deftest elem.vector.skip5.1 (elements *vector* 2 15)
 176   #(nil 15 16 nil 19))
 177 (deftest elem.vector.skip5.2 (elements-labels *vector* 2 15)
 178   #(:ellipses 15 16 :ellipses 19))
 179
 180 (deftest elem.array.0 (elements-count *array*) 18)
 181 (deftest elem.array.1 (elements *array*)
 182    #(NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL
 183                 NIL NIL))
 184 (deftest elem.array.2 (elements-labels *array*)
 185   #((0 . "[0,0,0]") (1 . "[0,0,1]") (2 . "[0,1,0]") (3 . "[0,1,1]")
 186     (4 . "[0,2,0]") (5 . "[0,2,1]") (6 . "[1,0,0]") (7 . "[1,0,1]")
 187     (8 . "[1,1,0]") (9 . "[1,1,1]") (10 . "[1,2,0]")
 188     (11 . "[1,2,1]") (12 . "[2,0,0]") (13 . "[2,0,1]")
 189     (14 . "[2,1,0]") (15 . "[2,1,1]") (16 . "[2,2,0]")
 190     (17 . "[2,2,1]")))
 191
 192 (deftest empty.class.0 (elements-count *empty-class*) 0)
 193 (deftest empty.class.1 (elements *empty-class*) nil)
 194 (deftest empty.class.2 (elements-labels *empty-class*) nil)
 195
 196 (deftest simple.class.0 (elements-count *simple-class*) 3)
 197 (deftest simple.class.1 (elements *simple-class*)
 198   #(#.*inspect-unbound-object-marker* 0 "abc"))
 199 (deftest simple.class.2 (elements-labels *simple-class*)
 200   #((0 . "A") (1 . "SECOND") (2 . "REALLY-LONG-SLOT-NAME")))
 201
 202 (deftest empty.struct.0 (elements-count *empty-struct*) 0)
 203 (deftest empty.struct.1 (elements *empty-struct*) nil)
 204 (deftest empty.struct.2 (elements-labels *empty-struct*) nil)
 205
 206 (deftest simple.struct.0 (elements-count *simple-struct*) 3)
 207 (deftest simple.struct.1 (elements *simple-struct*)
 208   #(nil a-value "defg"))
 209 (deftest simple.struct.2 (elements-labels *simple-struct*)
 210   #((0 . "FIRST") (1 . "SLOT-2")
 211     (2 . "REALLY-LONG-STRUCT-SLOT-NAME")))
 212
 213 (deftest label.simple-struct.0 (labeled-element *simple-struct* 0)
 214   "   0 FIRST ----------> the symbol NIL")
 215 (deftest label.simple-struct.1 (labeled-element *simple-struct* 1)
 216   "   1 SLOT-2 ---------> the symbol A-VALUE")
 217 (deftest label.simple-struct.2 (labeled-element *simple-struct* 2)
 218   "   2 REALLY-LONG-STRUCT-SLOT-NAME -> a simple-string (4) \"defg\"")
 219
 220 (deftest label.simple-class.0 (labeled-element *simple-class* 0)
 221   "   0 A --------------> ..unbound..")
 222 (deftest label.simple-class.1 (labeled-element *simple-class* 1)
 223   "   1 SECOND ---------> fixnum 0")
 224 (deftest label.simple-class.2 (labeled-element *simple-class* 2)
 225   "   2 REALLY-LONG-SLOT-NAME -> a simple-string (3) \"abc\"")
 226
 227 (deftest label.complex.0 (labeled-element *complex* 0)
 228   "   0 real -----------> fixnum 1")
 229 (deftest label.complex.1 (labeled-element *complex* 1)
 230   "   1 imag -----------> fixnum 2")
 231
 232 (deftest label.ratio.0 (labeled-element *ratio* 0)
 233   "   0 numerator ------> fixnum 22")
 234 (deftest label.ratio.1 (labeled-element *ratio* 1)
 235   "   1 denominator ----> fixnum 7")
 236
 237 (deftest label.dotted-list.0 (labeled-element *dotted-list* 0)
 238   "   0-> the symbol A")
 239 (deftest label.dotted-list.1 (labeled-element *dotted-list* 1)
 240   "   1-> the symbol B")
 241 (deftest label.dotted-list.2 (labeled-element *dotted-list* 2)
 242   "tail-> fixnum 3")
 243
 244 (deftest label.normal-list.0
 245     (labeled-element *normal-list* 0)
 246   "   0-> the symbol A")
 247 (deftest label.normal-list.1 (labeled-element *normal-list* 1)
 248   "   1-> the symbol B")
 249 (deftest label.normal-list.2 (labeled-element *normal-list* 2)
 250   "   2-> fixnum 3")
 251
 252
 253 (deftest label.vector.0 (labeled-element *vector* 0)
 254   "   0-> fixnum 0")
 255 (deftest label.vector.1 (labeled-element *vector* 1)
 256   "   1-> fixnum 1")
 257
 258 (deftest label.vector.skip1.0 (labeled-element *vector* 0 nil 2)
 259   "   ...")
 260 (deftest label.vector.skip1.1 (labeled-element *vector* 1 nil 2)
 261   "   2-> fixnum 2")
 262
 263 (deftest label.consp.0 (labeled-element *cons-pair* 0)
 264   "   0 car ------------> complex number #C(1 2)")
 265 (deftest label.consp.1 (labeled-element *cons-pair* 1)
 266   "   1 cdr ------------> the symbol A-SYMBOL")
 267
 268 (deftest nil.parts.0 (elements-count nil) 5)
 269
 270 (deftest tiny.struct.0 (elements-count *tiny-struct*) 1)
 271 (deftest tiny.struct.1 (elements *tiny-struct*) #(10))
 272 (deftest tiny.struct.2 (elements-labels *tiny-struct*) #((0 . "FIRST")))
 273
 274 (deftest tiny.struct.skip1.0 (elements-count *tiny-struct* nil 1) 1)
 275 (deftest tiny.struct.skip1.1 (elements *tiny-struct* nil 1)
 276   #(nil))
 277 (deftest tiny.struct.skip1.2 (elements-labels *tiny-struct* nil 1)
 278   #(:ellipses))
 279
 280 (deftest tiny.double.0 (elements-count *double*) 0)
 281
 282 (deftest tiny.double.skip1.0 (elements-count *double* nil 1) 0)
 283 (deftest tiny.double.skip1.1 (elements *double* nil 0)
 284   nil)
 285 (deftest tiny.doubel.skip1.2 (elements-labels *double* nil 1)
 286   nil)
 287
 288 (deftest display.consp.0 (display *cons-pair*)
 289   "a cons cell
 290    0 car ------------> complex number #C(1 2)
 291    1 cdr ------------> the symbol A-SYMBOL")
 292
 293 (deftest display.struct.0 (display *simple-struct*)
 294  "#<STRUCTURE-CLASS SIMPLE-STRUCT>
 295    0 FIRST ----------> the symbol NIL
 296    1 SLOT-2 ---------> the symbol A-VALUE
 297    2 REALLY-LONG-STRUCT-SLOT-NAME -> a simple-string (4) \"defg\"")
 298
 299 (deftest display.struct.1 (display *simple-struct* nil 2 )
 300   "#<STRUCTURE-CLASS SIMPLE-STRUCT>
 301    ...
 302    2 REALLY-LONG-STRUCT-SLOT-NAME -> a simple-string (4) \"defg\"")
 303
 304 (deftest display.vector.0 (display *vector* 5 6)
 305   "a simple T vector (20)
 306    ...
 307    6-> fixnum 6
 308    7-> fixnum 7
 309    8-> fixnum 8
 310    9-> fixnum 9
 311   10-> fixnum 10
 312    ...
 313   19-> fixnum 19")
 314
 315 #+ignore
 316 (deftest inspect.0 (prog1 (inspect *simple-struct*))
 317   "#<STRUCTURE-CLASS SIMPLE-STRUCT>
 318    0 FIRST ----------> the symbol NIL
 319    1 SLOT-2 ---------> the symbol A-VALUE
 320    2 REALLY-LONG-STRUCT-SLOT-NAME -> a simple-string (4) \"defg\"")
 321
 322 (deftest istep.0 (prog1
 323                      (progn (inspect *simple-struct*) (istep '("=")))
 324                    (reset-cmd))
 325     "#<STRUCTURE-CLASS SIMPLE-STRUCT>
 326    0 FIRST ----------> the symbol NIL
 327    1 SLOT-2 ---------> the symbol A-VALUE
 328    2 REALLY-LONG-STRUCT-SLOT-NAME -> a simple-string (4) \"defg\"")
 329
 330 (deftest istep.1 (prog1
 331                      (progn (inspect *simple-struct*) (istep '("first")))
 332                    (reset-cmd))
 333 "the symbol NIL
 334    0 NAME -----------> a simple-string (3) \"NIL\"
 335    1 PACKAGE --------> the COMMON-LISP package
 336    2 VALUE ----------> the symbol NIL
 337    3 FUNCTION -------> ..unbound..
 338    4 PLIST ----------> the symbol NIL")
 339
 340 (deftest istep.2 (prog1
 341                      (progn (inspect *simple-struct*) (istep '("first"))
 342                             (istep '(">")))
 343                    (reset-cmd))
 344 "the symbol A-VALUE
 345    0 NAME -----------> a simple-string (7) \"A-VALUE\"
 346    1 PACKAGE --------> the ACLREPL-TESTS package
 347    2 VALUE ----------> ..unbound..
 348    3 FUNCTION -------> ..unbound..
 349    4 PLIST ----------> the symbol NIL")
 350
 351 (deftest istep.3 (prog1
 352                      (progn (inspect *simple-struct*) (istep '("first"))
 353                             (istep '(">")) (istep '("<")))
 354                    (reset-cmd))
 355 "the symbol NIL
 356    0 NAME -----------> a simple-string (3) \"NIL\"
 357    1 PACKAGE --------> the COMMON-LISP package
 358    2 VALUE ----------> the symbol NIL
 359    3 FUNCTION -------> ..unbound..
 360    4 PLIST ----------> the symbol NIL")
 361
 362 (deftest istep.4 (prog1
 363                      (progn (inspect *simple-struct*) (istep '("first"))
 364                             (istep '(">")) (istep '("<")) (istep '("tree")))
 365                    (reset-cmd))
 366 "The current object is:
 367 the symbol NIL, which was selected by FIRST
 368 #<STRUCTURE-CLASS SIMPLE-STRUCT>, which was selected by (inspect ...)
 369 ")
 370
 371 (deftest istep.5 (prog1
 372                      (progn (inspect *simple-struct*) (istep '("first"))
 373                             (istep '(">")) (istep '("<")) (istep '("-")))
 374                    (reset-cmd))
 375   "#<STRUCTURE-CLASS SIMPLE-STRUCT>
 376    0 FIRST ----------> the symbol NIL
 377    1 SLOT-2 ---------> the symbol A-VALUE
 378    2 REALLY-LONG-STRUCT-SLOT-NAME -> a simple-string (4) \"defg\"")
 379
 380 (deftest istep.6 (prog1
 381                      (progn (inspect *dotted-list*) (istep '("tail")))
 382                    (reset-cmd))
 383 "fixnum 3")
 384
 385 (deftest istep.7 (prog1
 386                      (progn (inspect *dotted-list*) (istep '("2")))
 387                    (reset-cmd))
 388 "fixnum 3")
 389
 390 (do-tests)
 391
 392 (when (pending-tests)
 393   (error "Some tests failed."))
 394