tests/dynamic-extent.impure.lisp

   1 ;;;; tests that dynamic-extent functionality works.
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; While most of SBCL is derived from the CMU CL system, the test
   7 ;;;; files (like this one) were written from scratch after the fork
   8 ;;;; from CMU CL.
   9 ;;;;
  10 ;;;; This software is in the public domain and is provided with
  11 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
  12 ;;;; more information.
  13
  14 (when (eq sb-ext:*evaluator-mode* :interpret)
  15   (sb-ext:quit :unix-status 104))
  16
  17 (setq sb-c::*check-consistency* t
  18       sb-ext:*stack-allocate-dynamic-extent* t)
  19
  20 (defmacro defun-with-dx (name arglist &body body)
  21   `(defun ,name ,arglist
  22      ,@body))
  23
  24 (declaim (notinline opaque-identity))
  25 (defun opaque-identity (x)
  26   x)
  27
  28 ;;; &REST lists
  29 (defun-with-dx dxlength (&rest rest)
  30   (declare (dynamic-extent rest))
  31   (length rest))
  32
  33 (assert (= (dxlength 1 2 3) 3))
  34 (assert (= (dxlength t t t t t t) 6))
  35 (assert (= (dxlength) 0))
  36
  37 (defun callee (list)
  38   (destructuring-bind (a b c d e f &rest g) list
  39     (+ a b c d e f (length g))))
  40
  41 (defun-with-dx dxcaller (&rest rest)
  42   (declare (dynamic-extent rest))
  43   (callee rest))
  44 (assert (= (dxcaller 1 2 3 4 5 6 7) 22))
  45
  46 (defun-with-dx dxcaller-align-1 (x &rest rest)
  47   (declare (dynamic-extent rest))
  48   (+ x (callee rest)))
  49 (assert (= (dxcaller-align-1 17 1 2 3 4 5 6 7) 39))
  50 (assert (= (dxcaller-align-1 17 1 2 3 4 5 6 7 8) 40))
  51
  52 ;;; %NIP-VALUES
  53 (defun-with-dx test-nip-values ()
  54   (flet ((bar (x &rest y)
  55            (declare (dynamic-extent y))
  56            (if (> x 0)
  57                (values x (length y))
  58                (values (car y)))))
  59     (multiple-value-call #'values
  60       (bar 1 2 3 4 5 6)
  61       (bar -1 'a 'b))))
  62
  63 (assert (equal (multiple-value-list (test-nip-values)) '(1 5 a)))
  64
  65 ;;; LET-variable substitution
  66 (defun-with-dx test-let-var-subst1 (x)
  67   (let ((y (list x (1- x))))
  68     (opaque-identity :foo)
  69     (let ((z (the list y)))
  70       (declare (dynamic-extent z))
  71       (length z))))
  72 (assert (eql (test-let-var-subst1 17) 2))
  73
  74 (defun-with-dx test-let-var-subst2 (x)
  75   (let ((y (list x (1- x))))
  76     (declare (dynamic-extent y))
  77     (opaque-identity :foo)
  78     (let ((z (the list y)))
  79       (length z))))
  80 (assert (eql (test-let-var-subst2 17) 2))
  81
  82 ;;; DX propagation through LET-return.
  83 (defun-with-dx test-lvar-subst (x)
  84   (let ((y (list x (1- x))))
  85     (declare (dynamic-extent y))
  86     (second (let ((z (the list y)))
  87               (opaque-identity :foo)
  88               z))))
  89 (assert (eql (test-lvar-subst 11) 10))
  90
  91 ;;; this code is incorrect, but the compiler should not fail
  92 (defun-with-dx test-let-var-subst-incorrect (x)
  93   (let ((y (list x (1- x))))
  94     (opaque-identity :foo)
  95     (let ((z (the list y)))
  96       (declare (dynamic-extent z))
  97       (opaque-identity :bar)
  98       z)))
  99 \f
 100 ;;; alignment
 101 (defvar *x*)
 102 (defun-with-dx test-alignment-dx-list (form)
 103   (multiple-value-prog1 (eval form)
 104     (let ((l (list 1 2 3 4)))
 105       (declare (dynamic-extent l))
 106       (setq *x* (copy-list l)))))
 107 (dotimes (n 64)
 108   (let* ((res (loop for i below n collect i))
 109          (form `(values ,@res)))
 110     (assert (equal (multiple-value-list (test-alignment-dx-list form)) res))
 111     (assert (equal *x* '(1 2 3 4)))))
 112
 113 ;;; closure
 114
 115 (declaim (notinline true))
 116 (defun true (x)
 117   (declare (ignore x))
 118   t)
 119
 120 (defun-with-dx dxclosure (x)
 121   (flet ((f (y)
 122            (+ y x)))
 123     (declare (dynamic-extent #'f))
 124     (true #'f)))
 125
 126 (assert (eq t (dxclosure 13)))
 127
 128 ;;; value-cells
 129
 130 (defun-with-dx dx-value-cell (x)
 131   ;; Not implemented everywhere, yet.
 132   #+(or x86 x86-64 mips)
 133   (let ((cell x))
 134     (declare (sb-int:truly-dynamic-extent cell))
 135     (flet ((f ()
 136              (incf cell)))
 137       (declare (dynamic-extent #'f))
 138       (true #'f))))
 139
 140 ;;; CONS
 141
 142 (defun-with-dx cons-on-stack (x)
 143   (let ((cons (cons x x)))
 144     (declare (dynamic-extent cons))
 145     (true cons)
 146     nil))
 147
 148 ;;; MAKE-ARRAY
 149
 150 (defun-with-dx make-array-on-stack ()
 151   (let ((v (make-array '(42) :element-type 'single-float)))
 152     (declare (dynamic-extent v))
 153     (true v)
 154     nil))
 155
 156 ;;; MAKE-STRUCTURE
 157
 158 (declaim (inline make-fp-struct-1))
 159 (defstruct fp-struct-1
 160   (s 0.0 :type single-float)
 161   (d 0.0d0 :type double-float))
 162
 163 (defun-with-dx test-fp-struct-1.1 (s d)
 164   (let ((fp (make-fp-struct-1 :s s)))
 165     (declare (dynamic-extent fp))
 166     (assert (eql s (fp-struct-1-s fp)))
 167     (assert (eql 0.0d0 (fp-struct-1-d fp)))))
 168
 169 (defun-with-dx test-fp-struct-1.2 (s d)
 170   (let ((fp (make-fp-struct-1 :d d)))
 171     (declare (dynamic-extent fp))
 172     (assert (eql 0.0 (fp-struct-1-s fp)))
 173     (assert (eql d (fp-struct-1-d fp)))))
 174
 175 (defun-with-dx test-fp-struct-1.3 (s d)
 176   (let ((fp (make-fp-struct-1 :d d :s s)))
 177     (declare (dynamic-extent fp))
 178     (assert (eql s (fp-struct-1-s fp)))
 179     (assert (eql d (fp-struct-1-d fp)))))
 180
 181 (defun-with-dx test-fp-struct-1.4 (s d)
 182   (let ((fp (make-fp-struct-1 :s s :d d)))
 183     (declare (dynamic-extent fp))
 184     (assert (eql s (fp-struct-1-s fp)))
 185     (assert (eql d (fp-struct-1-d fp)))))
 186
 187 (test-fp-struct-1.1 123.456 876.243d0)
 188 (test-fp-struct-1.2 123.456 876.243d0)
 189 (test-fp-struct-1.3 123.456 876.243d0)
 190 (test-fp-struct-1.4 123.456 876.243d0)
 191
 192 (declaim (inline make-fp-struct-2))
 193 (defstruct fp-struct-2
 194   (d 0.0d0 :type double-float)
 195   (s 0.0 :type single-float))
 196
 197 (defun-with-dx test-fp-struct-2.1 (s d)
 198   (let ((fp (make-fp-struct-2 :s s)))
 199     (declare (dynamic-extent fp))
 200     (assert (eql s (fp-struct-2-s fp)))
 201     (assert (eql 0.0d0 (fp-struct-2-d fp)))))
 202
 203 (defun-with-dx test-fp-struct-2.2 (s d)
 204   (let ((fp (make-fp-struct-2 :d d)))
 205     (declare (dynamic-extent fp))
 206     (assert (eql 0.0 (fp-struct-2-s fp)))
 207     (assert (eql d (fp-struct-2-d fp)))))
 208
 209 (defun-with-dx test-fp-struct-2.3 (s d)
 210   (let ((fp (make-fp-struct-2 :d d :s s)))
 211     (declare (dynamic-extent fp))
 212     (assert (eql s (fp-struct-2-s fp)))
 213     (assert (eql d (fp-struct-2-d fp)))))
 214
 215 (defun-with-dx test-fp-struct-2.4 (s d)
 216   (let ((fp (make-fp-struct-2 :s s :d d)))
 217     (declare (dynamic-extent fp))
 218     (assert (eql s (fp-struct-2-s fp)))
 219     (assert (eql d (fp-struct-2-d fp)))))
 220
 221 (test-fp-struct-2.1 123.456 876.243d0)
 222 (test-fp-struct-2.2 123.456 876.243d0)
 223 (test-fp-struct-2.3 123.456 876.243d0)
 224 (test-fp-struct-2.4 123.456 876.243d0)
 225
 226 (declaim (inline make-cfp-struct-1))
 227 (defstruct cfp-struct-1
 228   (s (complex 0.0) :type (complex single-float))
 229   (d (complex 0.0d0) :type (complex double-float)))
 230
 231 (defun-with-dx test-cfp-struct-1.1 (s d)
 232   (let ((cfp (make-cfp-struct-1 :s s)))
 233     (declare (dynamic-extent cfp))
 234     (assert (eql s (cfp-struct-1-s cfp)))
 235     (assert (eql (complex 0.0d0) (cfp-struct-1-d cfp)))))
 236
 237 (defun-with-dx test-cfp-struct-1.2 (s d)
 238   (let ((cfp (make-cfp-struct-1 :d d)))
 239     (declare (dynamic-extent cfp))
 240     (assert (eql (complex 0.0) (cfp-struct-1-s cfp)))
 241     (assert (eql d (cfp-struct-1-d cfp)))))
 242
 243 (defun-with-dx test-cfp-struct-1.3 (s d)
 244   (let ((cfp (make-cfp-struct-1 :d d :s s)))
 245     (declare (dynamic-extent cfp))
 246     (assert (eql s (cfp-struct-1-s cfp)))
 247     (assert (eql d (cfp-struct-1-d cfp)))))
 248
 249 (defun-with-dx test-cfp-struct-1.4 (s d)
 250   (let ((cfp (make-cfp-struct-1 :s s :d d)))
 251     (declare (dynamic-extent cfp))
 252     (assert (eql s (cfp-struct-1-s cfp)))
 253     (assert (eql d (cfp-struct-1-d cfp)))))
 254
 255 (test-cfp-struct-1.1 (complex 0.123 123.456) (complex 908132.41d0 876.243d0))
 256 (test-cfp-struct-1.2 (complex 0.123 123.456) (complex 908132.41d0 876.243d0))
 257 (test-cfp-struct-1.3 (complex 0.123 123.456) (complex 908132.41d0 876.243d0))
 258 (test-cfp-struct-1.4 (complex 0.123 123.456) (complex 908132.41d0 876.243d0))
 259
 260 (declaim (inline make-cfp-struct-2))
 261 (defstruct cfp-struct-2
 262   (d (complex 0.0d0) :type (complex double-float))
 263   (s (complex 0.0) :type (complex single-float)))
 264
 265 (defun-with-dx test-cfp-struct-2.1 (s d)
 266   (let ((cfp (make-cfp-struct-2 :s s)))
 267     (declare (dynamic-extent cfp))
 268     (assert (eql s (cfp-struct-2-s cfp)))
 269     (assert (eql (complex 0.0d0) (cfp-struct-2-d cfp)))))
 270
 271 (defun-with-dx test-cfp-struct-2.2 (s d)
 272   (let ((cfp (make-cfp-struct-2 :d d)))
 273     (declare (dynamic-extent cfp))
 274     (assert (eql (complex 0.0) (cfp-struct-2-s cfp)))
 275     (assert (eql d (cfp-struct-2-d cfp)))))
 276
 277 (defun-with-dx test-cfp-struct-2.3 (s d)
 278   (let ((cfp (make-cfp-struct-2 :d d :s s)))
 279     (declare (dynamic-extent cfp))
 280     (assert (eql s (cfp-struct-2-s cfp)))
 281     (assert (eql d (cfp-struct-2-d cfp)))))
 282
 283 (defun-with-dx test-cfp-struct-2.4 (s d)
 284   (let ((cfp (make-cfp-struct-2 :s s :d d)))
 285     (declare (dynamic-extent cfp))
 286     (assert (eql s (cfp-struct-2-s cfp)))
 287     (assert (eql d (cfp-struct-2-d cfp)))))
 288
 289 (test-cfp-struct-2.1 (complex 0.123 123.456) (complex 908132.41d0 876.243d0))
 290 (test-cfp-struct-2.2 (complex 0.123 123.456) (complex 908132.41d0 876.243d0))
 291 (test-cfp-struct-2.3 (complex 0.123 123.456) (complex 908132.41d0 876.243d0))
 292 (test-cfp-struct-2.4 (complex 0.123 123.456) (complex 908132.41d0 876.243d0))
 293
 294 (declaim (inline make-foo1 make-foo2 make-foo3))
 295 (defstruct foo1 x)
 296
 297 (defun-with-dx make-foo1-on-stack (x)
 298   (let ((foo (make-foo1 :x x)))
 299     (declare (dynamic-extent foo))
 300     (assert (eql x (foo1-x foo)))))
 301
 302 (defstruct foo2
 303   (x 0.0 :type single-float)
 304   (y 0.0d0 :type double-float)
 305   a
 306   b
 307   c)
 308
 309 (defmacro assert-eql (expected got)
 310   `(let ((exp ,expected)
 311          (got ,got))
 312      (unless (eql exp got)
 313        (error "Expected ~S, got ~S!" exp got))))
 314
 315 (defun-with-dx make-foo2-on-stack (x y)
 316   (let ((foo (make-foo2 :y y :c 'c)))
 317     (declare (dynamic-extent foo))
 318     (assert-eql 0.0 (foo2-x foo))
 319     (assert-eql y (foo2-y foo))
 320     (assert-eql 'c (foo2-c foo))
 321     (assert-eql nil (foo2-b foo))))
 322
 323 ;;; Check that constants work out as argument for all relevant
 324 ;;; slot types.
 325 (defstruct foo3
 326   (a 0 :type t)
 327   (b 1 :type fixnum)
 328   (c 2 :type sb-vm:word)
 329   (d 3.0 :type single-float)
 330   (e 4.0d0 :type double-float))
 331 (defun-with-dx make-foo3-on-stack ()
 332   (let ((foo (make-foo3)))
 333     (declare (dynamic-extent foo))
 334     (assert (eql 0 (foo3-a foo)))
 335     (assert (eql 1 (foo3-b foo)))
 336     (assert (eql 2 (foo3-c foo)))
 337     (assert (eql 3.0 (foo3-d foo)))
 338     (assert (eql 4.0d0 (foo3-e foo)))))
 339
 340 ;;; Nested DX
 341
 342 (defun-with-dx nested-dx-lists ()
 343   (let ((dx (list (list 1 2) (list 3 4))))
 344     (declare (dynamic-extent dx))
 345     (true dx)
 346     nil))
 347
 348 (defun-with-dx nested-dx-conses ()
 349   (let ((dx (cons 1 (cons 2 (cons 3 (cons (cons t t) nil))))))
 350     (declare (dynamic-extent dx))
 351     (true dx)
 352     nil))
 353
 354 (defun-with-dx nested-dx-not-used (x)
 355   (declare (list x))
 356   (let ((l (setf (car x) (list x x x))))
 357     (declare (dynamic-extent l))
 358     (true l)
 359     (true (length l))
 360     nil))
 361
 362 (defun-with-dx nested-evil-dx-used (x)
 363   (declare (list x))
 364   (let ((l (list x x x)))
 365     (declare (dynamic-extent l))
 366     (unwind-protect
 367          (progn
 368            (setf (car x) l)
 369            (true l))
 370       (setf (car x) nil))
 371     nil))
 372
 373 ;;; multiple uses for dx lvar
 374
 375 (defun-with-dx multiple-dx-uses ()
 376   (let ((dx (if (true t)
 377                 (list 1 2 3)
 378                 (list 2 3 4))))
 379     (declare (dynamic-extent dx))
 380     (true dx)
 381     nil))
 382
 383 ;;; handler-case and handler-bind should use DX internally
 384
 385 (defun dx-handler-bind (x)
 386   (handler-bind ((error
 387                   (lambda (c) (break "OOPS: ~S caused ~S" x c)))
 388                  ((and serious-condition (not error))
 389                   #'(lambda (c) (break "OOPS2: ~S did ~S" x c))))
 390     (/ 2 x)))
 391
 392 (defun dx-handler-case (x)
 393   (assert (zerop (handler-case (/ 2 x)
 394                    (error (c)
 395                      (break "OOPS: ~S caused ~S" x c))
 396                    (:no-error (res)
 397                      (1- res))))))
 398
 399 ;;; with-spinlock and with-mutex should use DX and not cons
 400
 401 (defvar *slock* (sb-thread::make-spinlock :name "slocklock"))
 402
 403 (defun test-spinlock ()
 404   (sb-thread::with-spinlock (*slock*)
 405     (true *slock*)))
 406
 407 (defvar *mutex* (sb-thread::make-mutex :name "mutexlock"))
 408
 409 (defun test-mutex ()
 410   (sb-thread:with-mutex (*mutex*)
 411     (true *mutex*)))
 412
 413 ;;; not really DX, but GETHASH and (SETF GETHASH) should not cons
 414
 415 (defvar *table* (make-hash-table))
 416
 417 (defun test-hash-table ()
 418   (setf (gethash 5 *table*) 13)
 419   (gethash 5 *table*))
 420 \f
 421 (defmacro assert-no-consing (form &optional times)
 422   `(%assert-no-consing (lambda () ,form) ,times))
 423 (defun %assert-no-consing (thunk &optional times)
 424   (let ((before (get-bytes-consed))
 425         (times (or times 10000)))
 426     (declare (type (integer 1 *) times))
 427     (dotimes (i times)
 428       (funcall thunk))
 429     (assert (< (- (get-bytes-consed) before) times))))
 430
 431 (defmacro assert-consing (form &optional times)
 432   `(%assert-consing (lambda () ,form) ,times))
 433 (defun %assert-consing (thunk &optional times)
 434   (let ((before (get-bytes-consed))
 435         (times (or times 10000)))
 436     (declare (type (integer 1 *) times))
 437     (dotimes (i times)
 438       (funcall thunk))
 439     (assert (not (< (- (get-bytes-consed) before) times)))))
 440
 441 (defvar *a-cons* (cons nil nil))
 442
 443 #+(or x86 x86-64 alpha ppc sparc mips)
 444 (progn
 445   (assert-no-consing (dxclosure 42))
 446   (assert-no-consing (dxlength 1 2 3))
 447   (assert-no-consing (dxlength t t t t t t))
 448   (assert-no-consing (dxlength))
 449   (assert-no-consing (dxcaller 1 2 3 4 5 6 7))
 450   (assert-no-consing (test-nip-values))
 451   (assert-no-consing (test-let-var-subst1 17))
 452   (assert-no-consing (test-let-var-subst2 17))
 453   (assert-no-consing (test-lvar-subst 11))
 454   (assert-no-consing (dx-value-cell 13))
 455   (assert-no-consing (cons-on-stack 42))
 456   (assert-no-consing (make-array-on-stack))
 457   (assert-no-consing (make-foo1-on-stack 123))
 458   (#+raw-instance-init-vops assert-no-consing
 459    #-raw-instance-init-vops progn
 460    (make-foo2-on-stack 1.24 1.23d0))
 461   (#+raw-instance-init-vops assert-no-consing
 462    #-raw-instance-init-vops progn
 463    (make-foo3-on-stack))
 464   (assert-no-consing (nested-dx-conses))
 465   (assert-no-consing (nested-dx-lists))
 466   (assert-consing (nested-dx-not-used *a-cons*))
 467   (assert-no-consing (nested-evil-dx-used *a-cons*))
 468   (assert-no-consing (multiple-dx-uses))
 469   (assert-no-consing (dx-handler-bind 2))
 470   (assert-no-consing (dx-handler-case 2))
 471   ;; Not strictly DX..
 472   (assert-no-consing (test-hash-table))
 473   #+sb-thread
 474   (progn
 475     (assert-no-consing (test-spinlock))
 476     (assert-no-consing (test-mutex))))
 477
 478 \f
 479 ;;; Bugs found by Paul F. Dietz
 480 (assert
 481  (eq
 482   (funcall
 483    (compile
 484     nil
 485     '(lambda (a b)
 486       (declare (optimize (speed 2) (space 0) (safety 0)
 487                 (debug 1) (compilation-speed 3)))
 488       (let* ((v5 (cons b b)))
 489         (declare (dynamic-extent v5))
 490         a)))
 491    'x 'y)
 492   'x))
 493
 494 \f
 495 ;;; other bugs
 496
 497 ;;; bug reported by Svein Ove Aas
 498 (defun svein-2005-ii-07 (x y)
 499   (declare (optimize (speed 3) (space 2) (safety 0) (debug 0)))
 500   (let ((args (list* y 1 2 x)))
 501     (declare (dynamic-extent args))
 502     (apply #'aref args)))
 503 (assert (eql
 504          (svein-2005-ii-07
 505           '(0)
 506           #3A(((1 1 1) (1 1 1) (1 1 1))
 507               ((1 1 1) (1 1 1) (4 1 1))
 508               ((1 1 1) (1 1 1) (1 1 1))))
 509          4))
 510
 511 ;;; bug reported by Brian Downing: stack-allocated arrays were not
 512 ;;; filled with zeroes.
 513 (defun-with-dx bdowning-2005-iv-16 ()
 514   (let ((a (make-array 11 :initial-element 0)))
 515     (declare (dynamic-extent a))
 516     (assert (every (lambda (x) (eql x 0)) a))))
 517 (assert-no-consing (bdowning-2005-iv-16))
 518
 519
 520 (defun-with-dx let-converted-vars-dx-allocated-bug (x y z)
 521   (let* ((a (list x y z))
 522          (b (list x y z))
 523          (c (list a b)))
 524     (declare (dynamic-extent c))
 525     (values (first c) (second c))))
 526 (multiple-value-bind (i j) (let-converted-vars-dx-allocated-bug 1 2 3)
 527   (assert (and (equal i j)
 528                (equal i (list 1 2 3)))))
 529
 530 ;;; workaround for bug 419 -- real issue remains, but check that the
 531 ;;; bandaid holds.
 532 (defun-with-dx bug419 (x)
 533   (multiple-value-call #'list
 534     (eval '(values 1 2 3))
 535     (let ((x x))
 536       (declare (dynamic-extent x))
 537       (flet ((mget (y)
 538                (+ x y))
 539              (mset (z)
 540                (incf x z)))
 541         (declare (dynamic-extent #'mget #'mset))
 542         ((lambda (f g) (eval `(progn ,f ,g (values 4 5 6)))) #'mget #'mset)))))
 543 (assert (equal (bug419 42) '(1 2 3 4 5 6)))
 544
 545 ;;; Multiple DX arguments in a local function call
 546 (defun test-dx-flet-test (fun n f1 f2 f3)
 547   (let ((res (with-output-to-string (s)
 548                (assert (eql n (ignore-errors (funcall fun s)))))))
 549     (multiple-value-bind (x pos) (read-from-string res nil)
 550       (assert (equalp f1 x))
 551       (multiple-value-bind (y pos2) (read-from-string res nil nil :start pos)
 552         (assert (equalp f2 y))
 553         (assert (equalp f3 (read-from-string res nil nil :start pos2))))))
 554   (assert-no-consing (assert (eql n (funcall fun nil)))))
 555 (macrolet ((def (n f1 f2 f3)
 556              (let ((name (sb-pcl::format-symbol :cl-user "DX-FLET-TEST.~A" n)))
 557                `(progn
 558                   (defun-with-dx ,name (s)
 559                     (flet ((f (x)
 560                              (declare (dynamic-extent x))
 561                              (when s
 562                                (print x s)
 563                                (finish-output s))
 564                              nil))
 565                       (f ,f1)
 566                       (f ,f2)
 567                       (f ,f3)
 568                       ,n))
 569                   (test-dx-flet-test #',name ,n ,f1 ,f2 ,f3)))))
 570   (def 0 (list :one) (list :two) (list :three))
 571   (def 1 (make-array 128) (list 1 2 3 4 5 6 7 8) (list 'list))
 572   (def 2 (list 1) (list 2 3) (list 4 5 6 7)))
 573
 574 ;;; Test that unknown-values coming after a DX value won't mess up the stack analysis
 575 (defun test-update-uvl-live-sets (x y z)
 576  (declare (optimize speed (safety 0)))
 577  (flet ((bar (a b)
 578           (declare (dynamic-extent a))
 579           (eval `(list (length ',a) ',b))))
 580    (list (bar x y)
 581          (bar (list x y z)                  ; dx push
 582               (list
 583                (multiple-value-call 'list
 584                  (eval '(values 1 2 3))     ; uv push
 585                  (max y z)
 586                )                            ; uv pop
 587                14)
 588          ))))
 589 (assert (equal '((0 4) (3 ((1 2 3 5) 14))) (test-update-uvl-live-sets #() 4 5)))
 590 \f