mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
7fcc3771ca
This is not quite the right thing, but it's better in so far as causing the test enable a heap verification flag. Shell tests do not restore SB-IMPL:+INTERNAL-FEATURES+ into *FEATURES* and they need to.
46 lines
1.7 KiB
Bash
46 lines
1.7 KiB
Bash
. ./subr.sh
|
|
|
|
use_test_subdirectory
|
|
|
|
tmpcore=$TEST_FILESTEM.core
|
|
|
|
# This test has to do with incorrect GC of funcallable instances
|
|
run_sbcl <<EOF
|
|
(require :sb-bsd-sockets)
|
|
(save-lisp-and-die "$tmpcore")
|
|
EOF
|
|
run_sbcl_with_core "$tmpcore" --noinform --no-userinit --no-sysinit \
|
|
--eval "(require :sb-posix)" --quit
|
|
check_status_maybe_lose "SAVE-LISP-AND-DIE" $? 0 "(saved core ran)"
|
|
|
|
# Verify that for funcallable instances which were moved into the
|
|
# immobile text space by SAVE-LISP-AND-DIE, setting the layout
|
|
# updates the GC card touched bit.
|
|
# Going through instance-obsolescence stuff makes things mostly work
|
|
# by accident, because (SETF %FUNCALLABLE-INSTANCE-INFO) touches
|
|
# the card dirty bit when reassigning the CLOS slot vector.
|
|
# We need to simulate a GC interrupt after altering the layout,
|
|
# but prior to affecting the slot vector.
|
|
run_sbcl <<EOF
|
|
(defclass subgf (standard-generic-function) (a)
|
|
(:metaclass sb-mop:funcallable-standard-class))
|
|
(defgeneric myfun (a)
|
|
(:generic-function-class subgf)
|
|
(:method ((self integer)) 'hey-integer))
|
|
(defun assign-layout ()
|
|
(setf (extern-alien "verify_gens" char) 0)
|
|
(defclass subgf (standard-generic-function) (a b) ; add a slot
|
|
(:metaclass sb-mop:funcallable-standard-class))
|
|
(defclass subgf (standard-generic-function) (a) ; remove a slot
|
|
(:metaclass sb-mop:funcallable-standard-class))
|
|
(let ((nl (sb-kernel:find-layout 'subgf))) ; new layout
|
|
(assert (not (eq (sb-kernel:%fun-layout #'myfun) nl)))
|
|
(sb-kernel:%set-fun-layout #'myfun nl)
|
|
(gc)))
|
|
(save-lisp-and-die "$tmpcore" :toplevel #'assign-layout)
|
|
EOF
|
|
run_sbcl_with_core "$tmpcore" --noinform --no-userinit --no-sysinit
|
|
check_status_maybe_lose "SET-FIN-LAYOUT" $? 0 "(saved core ran)"
|
|
|
|
exit $EXIT_TEST_WIN
|