Fix infinite loop and empty-dlist error when an error is thrown from a callback running in a thread other than the initial thread. This addresses part of issue #92
parent
4994483be4
commit
daf40ea0c6
|
@ -0,0 +1,43 @@
|
|||
USING: accessors io io.encodings.ascii io.launcher kernel make
|
||||
sequences system tools.test ;
|
||||
IN: compiler.tests.callback-error
|
||||
|
||||
: run-vm-with-script ( string -- lines )
|
||||
[ <process> ] dip
|
||||
[ vm , , ] { } make >>command
|
||||
+closed+ >>stdin
|
||||
+stdout+ >>stderr
|
||||
ascii <process-reader> stream-lines ;
|
||||
|
||||
! Callback error from initial thread
|
||||
[ t ] [
|
||||
"""-e=USING: alien alien.c-types alien.syntax kernel ;
|
||||
IN: scratchpad
|
||||
|
||||
: callback-death ( -- callback )
|
||||
void { } cdecl [ "Error!" throw ] alien-callback ;
|
||||
|
||||
: callback-invoke ( callback -- )
|
||||
void { } cdecl alien-indirect ;
|
||||
|
||||
callback-death callback-invoke"""
|
||||
run-vm-with-script
|
||||
"\"Error!\"" swap member?
|
||||
] unit-test
|
||||
|
||||
! Callback error from another thread
|
||||
[ t ] [
|
||||
"""-e=USING: alien alien.c-types alien.syntax kernel threads ;
|
||||
IN: scratchpad
|
||||
|
||||
: callback-death ( -- callback )
|
||||
void { } cdecl [ "Error!" throw ] alien-callback ;
|
||||
|
||||
: callback-invoke ( callback -- )
|
||||
void { } cdecl alien-indirect ;
|
||||
|
||||
[ callback-death callback-invoke ] in-thread
|
||||
stop"""
|
||||
run-vm-with-script
|
||||
"\"Error!\"" swap member?
|
||||
] unit-test
|
|
@ -1,7 +1,8 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! Copyright (C) 2008, 2011 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors debugger continuations threads threads.private
|
||||
io io.styles prettyprint kernel math.parser namespaces make ;
|
||||
USING: accessors alien debugger continuations threads
|
||||
threads.private io io.styles prettyprint kernel make math.parser
|
||||
namespaces ;
|
||||
IN: debugger.threads
|
||||
|
||||
: error-in-thread. ( thread -- )
|
||||
|
@ -12,17 +13,21 @@ IN: debugger.threads
|
|||
", " % dup quot>> unparse-short % ")" %
|
||||
] "" make swap write-object ":" print ;
|
||||
|
||||
M: thread error-in-thread ( error thread -- )
|
||||
initial-thread get-global eq? [
|
||||
die drop
|
||||
] [
|
||||
global [
|
||||
error-thread get-global error-in-thread. nl
|
||||
print-error nl
|
||||
:c
|
||||
flush
|
||||
] bind
|
||||
] if ;
|
||||
: call-thread-error-handler? ( thread -- ? )
|
||||
initial-thread get-global eq?
|
||||
in-callback?
|
||||
or not ;
|
||||
|
||||
[ self error-in-thread stop ]
|
||||
thread-error-hook set-global
|
||||
M: thread error-in-thread ( error thread -- )
|
||||
global [
|
||||
error-in-thread. nl
|
||||
print-error nl
|
||||
:c
|
||||
flush
|
||||
] bind ;
|
||||
|
||||
[
|
||||
dup call-thread-error-handler?
|
||||
[ self error-in-thread stop ]
|
||||
[ [ die ] call( error thread -- * ) ] if
|
||||
] thread-error-hook set-global
|
||||
|
|
|
@ -103,6 +103,7 @@ SYMBOL: callbacks
|
|||
|
||||
! Used by compiler.codegen to wrap callback bodies
|
||||
: do-callback ( callback-quot wait-quot: ( callback -- ) -- )
|
||||
t 3 set-context-object
|
||||
init-namespaces
|
||||
init-catchstack
|
||||
current-callback
|
||||
|
@ -117,6 +118,8 @@ TUPLE: expiry-check object alien ;
|
|||
|
||||
PRIVATE>
|
||||
|
||||
: in-callback? ( -- ? ) 3 context-object ;
|
||||
|
||||
: initialize-alien ( symbol quot -- )
|
||||
swap dup get-global dup recompute-value?
|
||||
[ drop [ call dup 31337 <alien> expiry-check boa ] dip set-global ]
|
||||
|
|
|
@ -7,6 +7,7 @@ enum context_object {
|
|||
OBJ_NAMESTACK,
|
||||
OBJ_CATCHSTACK,
|
||||
OBJ_CONTEXT,
|
||||
OBJ_IN_CALLBACK_P,
|
||||
};
|
||||
|
||||
static const cell stack_reserved = 1024;
|
||||
|
|
Loading…
Reference in New Issue