Fix a test.
Some checks failed
Linux qemu / ppc64le (push) Failing after 1s
CL-host / ecl (push) Has been cancelled
CL-host / clisp (push) Has been cancelled
CL-host / ccl (push) Has been cancelled
CL-host / cmucl (push) Has been cancelled
CL-host / sbcl (push) Has been cancelled
Linux / build (x86, --with-sb-thread, ) (push) Has been cancelled
Linux / build (x86, --without-sb-thread, ) (push) Has been cancelled
Linux / build (x86, --without-sb-unicode, ) (push) Has been cancelled
Linux / build (x86-64, --with-mark-region-gc) (push) Has been cancelled
Linux / build (x86-64, --with-sb-fasteval --without-sb-eval, fasteval) (push) Has been cancelled
Linux / build (x86-64, --with-sb-thread, ) (push) Has been cancelled
Linux / build (x86-64, --with-sb-thread, sse4) (push) Has been cancelled
Linux / build (x86-64, --without-sb-thread, ) (push) Has been cancelled
Linux / build (x86-64, --without-sb-unicode, ) (push) Has been cancelled
Mac / build (--without-sb-thread, x86-64) (push) Has been cancelled
Mac / build (arm64, --with-mark-region-gc) (push) Has been cancelled
Mac / build (arm64, --with-sb-thread) (push) Has been cancelled
Mac / build (x86-64, --with-mark-region-gc) (push) Has been cancelled
Mac / build (x86-64, --with-sb-thread) (push) Has been cancelled
Windows / build (push) Has been cancelled
CL-host / compare-xc-host-fasls (ccl, false) (push) Has been cancelled
CL-host / compare-xc-host-fasls (clisp, false) (push) Has been cancelled
CL-host / compare-xc-host-fasls (cmucl, false) (push) Has been cancelled
CL-host / compare-xc-host-fasls (self, false) (push) Has been cancelled

This commit is contained in:
Stas Boukarev 2024-11-01 23:35:01 +03:00
parent 9f061223cf
commit 0aefb19bea

View file

@ -57,6 +57,9 @@
(assert (string= (princ-to-string error)
"EXCEPTION_INT_DIVIDE_BY_ZERO"))))
(defvar *lose-on-corruption* (extern-alien "lose_on_corruption_p" int))
(setf (extern-alien "lose_on_corruption_p" int) 0)
(with-test (:name :raise-access-violation)
(assert (eql 1 (raise-access-violation 1)))
(assert-error (raise-access-violation 0) sb-sys:memory-fault-error))
@ -66,6 +69,8 @@
(assert-error (setf (deref p) 42) sb-sys:memory-fault-error)
(free-readonly-int p)))
(setf (extern-alien "lose_on_corruption_p" int) *lose-on-corruption*)
;;; Not a very robust test since neither free() nor HeapFree() document this
;;; exception. The main result we wish for is not having the process abruptly
;;; terminated.