tests/compiler.pure.lisp

   1 ;;;; various compiler tests without side-effects
   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 (cl:in-package :cl-user)
  15
  16 ;;; Exercise a compiler bug (by crashing the compiler).
  17 ;;;
  18 ;;; This test code is from Douglas Crosher's simplified TICKLE-BUG
  19 ;;; (2000-09-06 on cmucl-imp).
  20 ;;;
  21 ;;; The bug was fixed by Douglas Crosher's patch, massaged for SBCL by
  22 ;;; Martin Atzmueller (2000-09-13 on sbcl-devel).
  23 (funcall (compile nil
  24                   '(lambda ()
  25                      (labels ((fun1 ()
  26                                 (fun2))
  27                               (fun2 ()
  28                                 (when nil
  29                                   (tagbody
  30                                    tag
  31                                    (fun2)
  32                                    (go tag)))
  33                                 (when nil
  34                                   (tagbody
  35                                    tag
  36                                    (fun1)
  37                                    (go tag)))))
  38
  39                        (fun1)
  40                        nil))))
  41
  42 ;;; Exercise a compiler bug (by crashing the compiler).
  43 ;;;
  44 ;;; Tim Moore gave a patch for this bug in CMU CL 2000-05-24 on
  45 ;;; cmucl-imp, and Martin Atzmueller applied it to SBCL.
  46 (funcall (compile nil
  47                   '(lambda (x)
  48                      (or (integerp x)
  49                          (block used-by-some-y?
  50                            (flet ((frob (stk)
  51                                     (dolist (y stk)
  52                                       (unless (rejected? y)
  53                                         (return-from used-by-some-y? t)))))
  54                              (declare (inline frob))
  55                              (frob (rstk x))
  56                              (frob (mrstk x)))
  57                            nil))))
  58          13)
  59
  60 ;;; bug 112, reported by Martin Atzmueller 2001-06-25 (originally
  61 ;;; from Bruno Haible in CMU CL bugs collection), fixed by
  62 ;;; Alexey Dejneka 2002-01-27
  63 (assert (= 1 ; (used to give 0 under bug 112)
  64            (let ((x 0))
  65              (declare (special x))
  66              (let ((x 1))
  67                (let ((y x))
  68                  (declare (special x)) y)))))
  69 (assert (= 1 ; (used to give 1 even under bug 112, still works after fix)
  70            (let ((x 0))
  71              (declare (special x))
  72              (let ((x 1))
  73                (let ((y x) (x 5))
  74                  (declare (special x)) y)))))
  75
  76 ;;; another LET-related bug fixed by Alexey Dejneka at the same
  77 ;;; time as bug 112
  78 (multiple-value-bind (value error)
  79     (ignore-errors
  80       ;; should complain about duplicate variable names in LET binding
  81       (compile nil
  82                '(lambda ()
  83                   (let (x
  84                         (x 1))
  85                     (list x)))))
  86   (assert (null value))
  87   (assert (typep error 'error)))