tests/compiler.impure-cload.lisp

   1 ;;; bug 254: compiler falure
   2 (defpackage :bug254 (:use :cl))
   3 (in-package :bug254)
   4 (declaim (optimize (safety 3) (debug 2) (speed 2) (space 1)))
   5 (defstruct foo
   6   (uhw2 nil :type (or package null)))
   7 (macrolet ((defprojection (variant &key lexpr eexpr)
   8              (let ()
   9                `(defmethod uu ((foo foo))
  10                   (let ((uhw2 (foo.uhw2 bar)))
  11                     (let ()
  12                       (u-flunt uhw2
  13                                (baz (funcall ,lexpr south east 1)))))))))
  14   (defprojection h
  15       :lexpr (lambda (south east sched)
  16                (flet ((bd (x) (bref x sched)))
  17                  (let ((avecname (gafp)))
  18                    (declare (type (vector t) avecname))
  19                    (multiple-value-prog1
  20                        (progn
  21                          (setf (avec.count avecname) (length rest))
  22                          (setf (aref avecname 0) (bd (h south)))
  23                          (setf (aref avecname 1) (bd (h east)))
  24                          (stub avecname))
  25                      (paip avecname)))))
  26       :eexpr (lambda (south east))))
  27 (delete-package :bug254)
  28
  29 ;;; bug 255
  30 (defpackage :bug255 (:use :cl))
  31 (in-package :bug255)
  32 (declaim (optimize (safety 3) (debug 2) (speed 2) (space 1)))
  33 (defvar *1*)
  34 (defvar *2*)
  35 (defstruct v a b)
  36 (defstruct w)
  37 (defstruct yam (v nil :type (or v null)))
  38 (defstruct un u)
  39 (defstruct (bod (:include un)) bo)
  40 (defstruct (bad (:include bod)) ba)
  41 (declaim (ftype (function ((or w bad) (or w bad)) (values)) %ufm))
  42 (defun %ufm (base bound) (froj base bound *1*) (values))
  43 (declaim (ftype (function ((vector t)) (or w bad)) %pu))
  44 (defun %pu (pds) *2*)
  45 (defun uu (yam)
  46   (let ((v (yam-v az)))
  47     (%ufm v
  48           (flet ((project (x) (frob x 0)))
  49             (let ((avecname *1*))
  50               (multiple-value-prog1
  51                   (progn (%pu avecname))
  52                 (frob)))))))
  53 (delete-package :bug255)
  54
  55 \f
  56 (sb-ext:quit :unix-status 104)