Fix #638 - update fiber status in certain cases.

This fixes a regression from changes to janet_try. In some cases, we
would not update the status of a fiber when signaling, which left the
fiber's status as whatever it had previously. This could lead to strange
control flow issues.
This commit is contained in:
Calvin Rose 2021-02-20 10:48:10 -06:00
parent 742469a8bc
commit c68264802a
3 changed files with 48 additions and 31 deletions

54
jpm
View File

@ -23,12 +23,12 @@
# Overriden on some installs.
# To configure this script, replace the code between
# the START and END comments and define a function
# the START and END comments and define a function
# (install-paths) that gives the the default paths
# to use. Trailing directory separator not expected.
#
# Example.
#
#
# (defn- install-paths []
# {:headerpath "/usr/local/include/janet"
# :libpath "/usr/local/lib/janet"
@ -169,9 +169,7 @@
[& args]
(if (dyn :verbose)
(print ;(interpose " " args)))
(def res (os/execute args :p))
(unless (zero? res)
(error (string "command exited with status " res))))
(os/execute args :px))
(defn copy
"Copy a file or directory recursively from one location to another."
@ -1424,26 +1422,30 @@ Flags are:
"load-lockfile" load-lockfile
"quickbin" quickbin})
(def- args (tuple/slice (dyn :args) 1))
(def- len (length args))
(var i :private 0)
(defn- main
"Script entry."
[& argv]
# Get flags
(while (< i len)
(if-let [m (peg/match argpeg (args i))]
(if (= 2 (length m))
(let [[key value] m]
(setdyn (keyword key) value))
(setdyn (keyword (m 0)) true))
(break))
(++ i))
(def- args (tuple/slice argv 1))
(def- len (length args))
(var i :private 0)
# Run subcommand
(if (= i len)
(help)
(do
(if-let [com (subcommands (args i))]
(com ;(tuple/slice args (+ i 1)))
(do
(print "invalid command " (args i))
(help)))))
# Get flags
(while (< i len)
(if-let [m (peg/match argpeg (args i))]
(if (= 2 (length m))
(let [[key value] m]
(setdyn (keyword key) value))
(setdyn (keyword (m 0)) true))
(break))
(++ i))
# Run subcommand
(if (= i len)
(help)
(do
(if-let [com (subcommands (args i))]
(com ;(tuple/slice args (+ i 1)))
(do
(print "invalid command " (args i))
(help))))))

View File

@ -1378,6 +1378,7 @@ static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *o
if (janet_vm_root_fiber == fiber) janet_vm_root_fiber = NULL;
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
*out = in;
janet_fiber_set_status(fiber, sig);
return sig;
}
/* Check if we need any special handling for certain opcodes */
@ -1417,23 +1418,23 @@ static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *o
/* Save global state */
JanetTryState tstate;
JanetSignal signal = janet_try(&tstate);
if (!signal) {
JanetSignal sig = janet_try(&tstate);
if (!sig) {
/* Normal setup */
if (janet_vm_root_fiber == NULL) janet_vm_root_fiber = fiber;
janet_vm_fiber = fiber;
janet_fiber_set_status(fiber, JANET_STATUS_ALIVE);
signal = run_vm(fiber, in);
sig = run_vm(fiber, in);
}
/* Restore */
if (janet_vm_root_fiber == fiber) janet_vm_root_fiber = NULL;
janet_fiber_set_status(fiber, signal);
janet_fiber_set_status(fiber, sig);
janet_restore(&tstate);
fiber->last_value = tstate.payload;
*out = tstate.payload;
return signal;
return sig;
}
/* Enter the main vm loop */

View File

@ -146,4 +146,18 @@
# os/execute with environment variables
(assert (= 0 (os/execute [(dyn :executable) "-e" "(+ 1 2 3)"] :pe {"HELLO" "WORLD"})) "os/execute with env")
# Regression #638
(assert
(= [true :caught]
(protect
(try
(do
(ev/sleep 0)
(with-dyns []
(ev/sleep 0)
(error "oops")))
([err] :caught))))
"regression #638")
(end-suite)