tests/jump-table.pure.lisp

   1 (unless (gethash 'sb-c:jump-table sb-c::*backend-parsed-vops*)
   2   (invoke-restart 'run-tests::skip-file))
   3
   4 (with-test (:name :symbol-case-as-jump-table)
   5   ;; Assert that a prototypical example of (CASE symbol ...)
   6   ;; was converted to a jump table.
   7   (let ((c (sb-kernel:fun-code-header #'sb-debug::parse-trace-options)))
   8     (assert (>= (sb-kernel:code-jump-table-words c) 14))))
   9
  10 (with-test (:name :type-derivation)
  11   (assert-type
  12    (lambda (x)
  13      (declare ((member a b c d) x)
  14               (optimize speed))
  15      (case x
  16        (a (print 1))
  17        (b (print 2))
  18        (c (print 4))
  19        (d (print 3))
  20        (e (print 5))))
  21    (integer 1 4))
  22   (assert-type
  23    (lambda (x)
  24      (declare ((member a b c d) x)
  25               (optimize speed))
  26      (case x
  27        (a 1)
  28        (b 2)
  29        (c 4)
  30        (d 3)
  31        (e 5)))
  32    (integer 1 4))
  33   (assert-type
  34    (lambda (x)
  35      (case x
  36        (a
  37         (error "x"))
  38        ((b k)
  39         (if (eq x 'a)
  40             11
  41             2))
  42        (c 3)
  43        (d 4)
  44        (e 5))
  45      (eq x 'a))
  46    null)
  47   (assert-type
  48    (lambda (a)
  49      (declare ((integer 1 5) a))
  50      (case a
  51        (1 1)
  52        ((2 4) (print 2))
  53        (3 2)
  54        (5 3)))
  55    (integer 1 3))
  56   (assert-type
  57    (lambda (a)
  58      (declare ((integer 1 5) a))
  59      (case a
  60        (1 1)
  61        ((2 4) 2)
  62        (3 2)
  63        (5 3)))
  64    (integer 1 3)))
  65
  66 (with-test (:name :type-derivation-constraints)
  67   (assert-type
  68    (lambda (x)
  69      (declare ((not (member b)) x)
  70               (optimize speed))
  71      (unless (eq x 'a)
  72        (case x
  73          (a (print 1))
  74          (b (print 2))
  75          (c (print 3))
  76          (d (print 4))
  77          (e (print 6))
  78          (g (print 5)))))
  79    (or null (integer 3 6)))
  80   (assert-type
  81    (lambda (x)
  82      (case x
  83        (a
  84         (if (eq x 'a)
  85             1
  86             10))
  87        ((b k)
  88         (if (eq x 'a)
  89             11
  90             2))
  91        (c 3)
  92        (d 4)
  93        (e 5)
  94        (t (if (eq x 'd)
  95               30
  96               6))))
  97    (integer 1 6)))
  98
  99 (defstruct a)
 100 (defstruct (achild (:include a)))
 101 (defstruct (agrandchild (:include achild)))
 102 (defstruct (achild2 (:include a)))
 103 (defstruct b)
 104 (defstruct c)
 105 (defstruct d)
 106 (defstruct e)
 107 (defstruct (echild (:include e)))
 108 (defstruct f)
 109
 110 (declaim (freeze-type a b c d e f))
 111 (defun typecase-jump-table (x)
 112   (typecase x
 113     (a 'is-a)
 114     (b 'is-b)
 115     (c 'is-c)
 116     ((or d e) 'is-d-or-e)
 117     (f 'is-f)))
 118 (compile 'typecase-jump-table)
 119
 120 (with-test (:name :typecase-jump-table)
 121   (assert (eql (sb-kernel:code-jump-table-words
 122                 (sb-kernel:fun-code-header #'typecase-jump-table))
 123                ;; 6 cases including NIL return, plus the size
 124                7)))
 125
 126 (with-test (:name :duplicates)
 127   (checked-compile-and-assert
 128       ()
 129       `(lambda (c)
 130          (position c "aaaaa"))
 131     ((#\a) 0)
 132     ((#\b) nil)))
 133
 134 (with-test (:name :array-subtype-dispatch-table)
 135   (assert (> (sb-kernel:code-jump-table-words
 136               (sb-kernel:fun-code-header #'sb-kernel:vector-subseq*))
 137              20)))
 138
 139 (with-test (:name :cleanups)
 140   (checked-compile-and-assert
 141    ()
 142    `(lambda (b c &optional f)
 143       (block b
 144         (case
 145             (let ((* b))
 146               (if (eql c 0)
 147                   (return-from b (funcall f 11))
 148                   b))
 149           (t (case c
 150                ((197 97 399) b)
 151                (t 0))))))
 152    ((33 0 (lambda (x) (+ x *))) 44)
 153    ((1 1) 0)
 154    ((2 197) 2)
 155    ((3 97) 3)
 156    ((4 399) 4)))