common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Allow non-top-level DEFINE-CONDITION.

Browse source 
Don't attempt to dump uninitialized layouts.

Fixes lp#1368764
This commit is contained in:
Stas Boukarev 2018-09-29 18:23:23 +03:00
parent 09ebb6e7db
commit 6273db5991
2 changed files with 16 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
src/code/condition.lisp
View file

@ -465,12 +465,16 @@
;; Maybe kill docstring, but only under the cross-compiler.
#!+(and (not sb-doc) (host-feature sb-xc-host)) (setq documentation nil)
`(progn
(eval-when (:compile-toplevel)
(%compiler-define-condition ',name ',parent-types ',layout
',(all-readers) ',(all-writers)))
,@(when *top-level-form-p*
;; Avoid dumping uninitialized layouts, for sb-fasl::dump-layout
`((eval-when (:compile-toplevel)
(%compiler-define-condition ',name ',parent-types ,layout
',(all-readers) ',(all-writers)))))
(%define-condition ',name
',parent-types
',layout
,(if *top-level-form-p*
layout
`(find-condition-layout ',name ',parent-types))
(list ,@(slots))
(list ,@direct-default-initargs)
',(all-readers)

8
tests/compiler-2.impure-cload.lisp
View file

@ -120,3 +120,11 @@
(let ((uses (zombie-cast-struct-v-uses value)))
(when (zombie-cast-struct-p uses)
(list* uses (l uses)))))))))))
(let ()
(define-condition non-top-level-condition (error) ()))
(with-test (:name :non-top-level-condition)
(assert
(handler-case (signal 'non-top-level-condition)
(non-top-level-condition () t))))