tests/compiler-1.impure.lisp

   1 (cl:in-package :cl-user)
   2
   3 (declaim (optimize (debug 3) (speed 2) (space 1)))
   4
   5 ;;; Until version 0.6.9 or so, SBCL's version of Python couldn't this
   6 ;;; correctly, due to the bug patched by Rob MacLachlan on the
   7 ;;; cmucl-imp list 2000-06-21, and apply to SBCL by Martin Atzmueller.
   8 ;;; (The effectiveness of the test also depends on the implicit
   9 ;;; function typing of Python (where DEFUN is like DECLAIM FTYPE),
  10 ;;; which violates the ANSI spec, and should be fixed. Once that
  11 ;;; unrelated bug is fixed, this code will no longer test the type
  12 ;;; inference behavior it's intended to test.)
  13 (defun emptyvalues (&rest rest) (declare (ignore rest)) (values))
  14 (defstruct foo x y)
  15 (defun bar ()
  16   (let ((res (emptyvalues)))
  17     (unless (typep res 'foo)
  18       'expected-value)))
  19 (assert (eq (bar) 'expected-value))
  20
  21 (declaim (ftype (function (real) (values integer single-float)) valuesify))
  22 (defun valuesify (x)
  23   (values (round x)
  24           (coerce x 'single-float)))
  25 (defun exercise-valuesify (x)
  26   (multiple-value-bind (i f) (valuesify x)
  27     (declare (type integer i))
  28     (declare (type single-float f))
  29     (+ i f)))
  30 (assert (= (exercise-valuesify 1.25) 2.25))
  31
  32 (sb-ext:quit :unix-status 104) ; success