tests/bug-255.lisp

   1 (defpackage :bug255 (:use :cl))
   2 (in-package :bug255)
   3 (declaim (optimize (safety 3) (debug 2) (speed 2) (space 1)))
   4 (defvar *1*)
   5 (defvar *2*)
   6 (defstruct v a b)
   7 (defstruct w)
   8 (defstruct yam (v nil :type (or v null)))
   9 (defstruct un u)
  10 (defstruct (bod (:include un)) bo)
  11 (defstruct (bad (:include bod)) ba)
  12 (declaim (ftype (function ((or w bad) (or w bad)) (values)) %ufm))
  13 (defun %ufm (base bound) (froj base bound *1*) (values))
  14 (declaim (ftype (function ((vector t)) (or w bad)) %pu))
  15 (defun %pu (pds) (declare (ignore pds)) *2*)
  16 (defun uu (yam)
  17   (declare (ignore yam))
  18   (let ((v (yam-v az)))
  19     (%ufm v
  20           (flet ((project (x) (frob x 0)))
  21             (let ((avecname *1*))
  22               (multiple-value-prog1
  23                   (progn (%pu avecname))
  24                 (frob)))))))