Merge branch 'master' into compile-opt

.builds/openbsd.yml

@@ -1,4 +1,4 @@
-image: openbsd/7.4
+image: openbsd/7.6
 sources:
 - https://git.sr.ht/~bakpakin/janet
 packages:

.github/workflows/test.yml

@@ -25,7 +25,7 @@ jobs:
     name: Build and test on Windows
     strategy:
       matrix:
-        os: [ windows-latest, windows-2019 ]
+        os: [ windows-latest, windows-2022 ]
     runs-on: ${{ matrix.os }}
     steps:
       - name: Checkout the repository
@@ -46,7 +46,7 @@ jobs:
     name: Build and test on Windows Minimal build
     strategy:
       matrix:
-        os: [ windows-2019 ]
+        os: [ windows-2022 ]
     runs-on: ${{ matrix.os }}
     steps:
       - name: Checkout the repository

CHANGELOG.md

@@ -2,7 +2,7 @@
 All notable changes to this project will be documented in this file.
 
 ## Unreleased - ???
-- Add `ev/to-stream`
+- Allow configuring `JANET_THREAD_LOCAL` during builds to allow multi-threading on unknown compilers.
 - Make `ffi/write` append to a buffer instead of insert at 0 by default.
 - Add `os/getpid` to get the current process id.
 - Add `:out` option to `os/spawn` to be able to redirect stderr to stdout with pipes.

meson.build

@@ -105,6 +105,9 @@ endif
 if get_option('arch_name') != ''
   conf.set('JANET_ARCH_NAME', get_option('arch_name'))
 endif
+if get_option('thread_local_prefix') != ''
+  conf.set('JANET_THREAD_LOCAL', get_option('thread_local_prefix'))
+endif
 jconf = configure_file(output : 'janetconf.h',
   configuration : conf)
 

meson_options.txt

@@ -30,6 +30,7 @@ option('max_macro_expand', type : 'integer', min : 1, max : 8000, value : 200)
 option('stack_max', type : 'integer', min : 8096, max : 0x7fffffff, value : 0x7fffffff)
 
 option('arch_name', type : 'string', value: '')
+option('thread_local_prefix', type : 'string', value: '')
 option('os_name', type : 'string', value: '')
 option('shared', type : 'boolean', value: true)
 option('cryptorand', type : 'boolean', value: true)

src/boot/boot.janet

@@ -158,7 +158,7 @@
   ``Define an alias for a keyword that is used as a dynamic binding. The
   alias is a normal, lexically scoped binding that can be used instead of
   a keyword to prevent typos. `defdyn` does not set dynamic bindings or otherwise
-  replace `dyn` and `setdyn`. The alias _must_ start and end with the `*` character, usually
+  replace `dyn` and `setdyn`. The alias *must* start and end with the `*` character, usually
   called "earmuffs".``
   [alias & more]
   (assert (symbol? alias) "alias must be a symbol")
@@ -1933,7 +1933,7 @@
     that will match any value without creating a binding.
 
   While a symbol pattern will ordinarily match any value, the pattern `(@ <sym>)`,
-  where <sym> is any symbol, will attempt to match `x` against a value
+  where `<sym>` is any symbol, will attempt to match `x` against a value
   already bound to `<sym>`, rather than matching and rebinding it.
 
   Any other value pattern will only match if it is equal to `x`.
@@ -2574,7 +2574,7 @@
     * `:env` -- the environment to compile against - default is the current env
 
     * `:source` -- source path for better errors (use keywords for non-paths) - default
-      is :<anonymous>
+      is `:<anonymous>`
 
     * `:on-compile-error` -- callback when compilation fails - default is bad-compile
 
@@ -3248,12 +3248,10 @@
   # Terminal codes for emission/tokenization
   (def delimiters
     (if has-color
-      {:underline ["\e[4m" "\e[24m"]
+      {:code ["\e[97m" "\e[39m"]
-       :code ["\e[97m" "\e[39m"]
        :italics ["\e[4m" "\e[24m"]
        :bold ["\e[1m" "\e[22m"]}
-      {:underline ["_" "_"]
+      {:code ["`" "`"]
-       :code ["`" "`"]
        :italics ["*" "*"]
        :bold ["**" "**"]}))
   (def modes @{})
@@ -3384,7 +3382,6 @@
           (= b (chr `\`)) (do
                             (++ token-length)
                             (buffer/push token (get line (++ i))))
-          (= b (chr "_")) (delim :underline)
           (= b (chr "*"))
           (if (= (chr "*") (get line (+ i 1)))
             (do (++ i)
@@ -4483,8 +4480,10 @@
       (errorf "bad path %s - file is a %s" src mode)))
 
   (defn bundle/add-bin
-    `Shorthand for adding scripts during an install. Scripts will be installed to
+    ``
-    (string (dyn *syspath*) "/bin") by default and will be set to be executable.`
+    Shorthand for adding scripts during an install. Scripts will be installed to
+    `(string (dyn *syspath*) "/bin")` by default and will be set to be executable.
+    ``
     [manifest src &opt dest chmod-mode]
     (def s (sep))
     (default dest (last (string/split s src)))

src/conf/janetconf.h

@@ -13,6 +13,7 @@
 
 /* These settings all affect linking, so use cautiously. */
 /* #define JANET_SINGLE_THREADED */
+/* #define JANET_THREAD_LOCAL _Thread_local */
 /* #define JANET_NO_DYNAMIC_MODULES */
 /* #define JANET_NO_NANBOX */
 /* #define JANET_API __attribute__((visibility ("default"))) */

src/core/capi.c

@@ -589,6 +589,16 @@ JanetAtomicInt janet_atomic_load(JanetAtomicInt volatile *x) {
 #endif
 }
 
+JanetAtomicInt janet_atomic_load_relaxed(JanetAtomicInt volatile *x) {
+#ifdef _MSC_VER
+    return _InterlockedOr(x, 0);
+#elif defined(JANET_USE_STDATOMIC)
+    return atomic_load_explicit(x, memory_order_relaxed);
+#else
+    return __atomic_load_n(x, __ATOMIC_RELAXED);
+#endif
+}
+
 /* Some definitions for function-like macros */
 
 JANET_API JanetStructHead *(janet_struct_head)(JanetStruct st) {

src/core/corelib.c

@@ -653,22 +653,15 @@ JANET_CORE_FN(janet_core_check_int,
               "(int? x)",
               "Check if x can be exactly represented as a 32 bit signed two's complement integer.") {
     janet_fixarity(argc, 1);
-    if (!janet_checktype(argv[0], JANET_NUMBER)) goto ret_false;
+    return janet_wrap_boolean(janet_checkint(argv[0]));
-    double num = janet_unwrap_number(argv[0]);
-    return janet_wrap_boolean(num == (double)((int32_t)num));
-ret_false:
-    return janet_wrap_false();
 }
 
 JANET_CORE_FN(janet_core_check_nat,
               "(nat? x)",
               "Check if x can be exactly represented as a non-negative 32 bit signed two's complement integer.") {
     janet_fixarity(argc, 1);
-    if (!janet_checktype(argv[0], JANET_NUMBER)) goto ret_false;
+    if (!janet_checkint(argv[0])) return janet_wrap_false();
-    double num = janet_unwrap_number(argv[0]);
+    return janet_wrap_boolean(janet_unwrap_integer(argv[0]) >= 0);
-    return janet_wrap_boolean(num >= 0 && (num == (double)((int32_t)num)));
-ret_false:
-    return janet_wrap_false();
 }
 
 JANET_CORE_FN(janet_core_is_bytes,

src/core/ev.c

@@ -604,8 +604,43 @@ void janet_ev_init_common(void) {
 #endif
 }
 
+#ifdef JANET_WINDOWS
+static VOID CALLBACK janet_timeout_stop(ULONG_PTR ptr) {
+    UNREFERENCED_PARAMETER(ptr);
+    ExitThread(0);
+}
+#elif JANET_ANDROID
+static void janet_timeout_stop(int sig_num) {
+    if (sig_num == SIGUSR1) {
+        pthread_exit(0);
+    }
+}
+#endif
+
+static void handle_timeout_worker(JanetTimeout to, int cancel) {
+    if (!to.has_worker) return;
+#ifdef JANET_WINDOWS
+    QueueUserAPC(janet_timeout_stop, to.worker, 0);
+    WaitForSingleObject(to.worker, INFINITE);
+    CloseHandle(to.worker);
+#else
+#ifdef JANET_ANDROID
+    if (cancel) janet_assert(!pthread_kill(to.worker, SIGUSR1), "pthread_kill");
+#else
+    if (cancel) janet_assert(!pthread_cancel(to.worker), "pthread_cancel");
+#endif
+    void *res = NULL;
+    janet_assert(!pthread_join(to.worker, &res), "pthread_join");
+#endif
+}
+
 /* Common deinit code */
 void janet_ev_deinit_common(void) {
+    JanetTimeout to;
+    while (peek_timeout(&to)) {
+        handle_timeout_worker(to, 1);
+        pop_timeout(0);
+    }
     janet_q_deinit(&janet_vm.spawn);
     janet_free(janet_vm.tq);
     janet_table_deinit(&janet_vm.threaded_abstracts);
@@ -648,19 +683,6 @@ void janet_addtimeout_nil(double sec) {
     add_timeout(to);
 }
 
-#ifdef JANET_WINDOWS
-static VOID CALLBACK janet_timeout_stop(ULONG_PTR ptr) {
-    UNREFERENCED_PARAMETER(ptr);
-    ExitThread(0);
-}
-#elif JANET_ANDROID
-static void janet_timeout_stop(int sig_num) {
-    if (sig_num == SIGUSR1) {
-        pthread_exit(0);
-    }
-}
-#endif
-
 static void janet_timeout_cb(JanetEVGenericMessage msg) {
     (void) msg;
     janet_interpreter_interrupt_handled(&janet_vm);
@@ -671,11 +693,9 @@ static DWORD WINAPI janet_timeout_body(LPVOID ptr) {
     JanetThreadedTimeout tto = *(JanetThreadedTimeout *)ptr;
     janet_free(ptr);
     SleepEx((DWORD)(tto.sec * 1000), TRUE);
-    if (janet_fiber_can_resume(tto.fiber)) {
-        janet_interpreter_interrupt(tto.vm);
     JanetEVGenericMessage msg = {0};
     janet_ev_post_event(tto.vm, janet_timeout_cb, msg);
-    }
+    janet_interpreter_interrupt(tto.vm);
     return 0;
 }
 #else
@@ -696,11 +716,9 @@ static void *janet_timeout_body(void *ptr) {
                  ? (long)((tto.sec - ((uint32_t)tto.sec)) * 1000000000)
                  : 0;
     nanosleep(&ts, &ts);
-    if (janet_fiber_can_resume(tto.fiber)) {
-        janet_interpreter_interrupt(tto.vm);
     JanetEVGenericMessage msg = {0};
     janet_ev_post_event(tto.vm, janet_timeout_cb, msg);
-    }
+    janet_interpreter_interrupt(tto.vm);
     return NULL;
 }
 #endif
@@ -1452,12 +1470,13 @@ JanetFiber *janet_loop1(void) {
                 }
             }
         }
+        handle_timeout_worker(to, 0);
     }
 
     /* Run scheduled fibers unless interrupts need to be handled. */
     while (janet_vm.spawn.head != janet_vm.spawn.tail) {
         /* Don't run until all interrupts have been marked as handled by calling janet_interpreter_interrupt_handled */
-        if (janet_vm.auto_suspend) break;
+        if (janet_atomic_load_relaxed(&janet_vm.auto_suspend)) break;
         JanetTask task = {NULL, janet_wrap_nil(), JANET_SIGNAL_OK, 0};
         janet_q_pop(&janet_vm.spawn, &task, sizeof(task));
         if (task.fiber->gc.flags & JANET_FIBER_EV_FLAG_SUSPENDED) janet_ev_dec_refcount();
@@ -1499,27 +1518,14 @@ JanetFiber *janet_loop1(void) {
         while ((has_timeout = peek_timeout(&to))) {
             if (to.curr_fiber != NULL) {
                 if (!janet_fiber_can_resume(to.curr_fiber)) {
-                    if (to.has_worker) {
-#ifdef JANET_WINDOWS
-                        QueueUserAPC(janet_timeout_stop, to.worker, 0);
-                        WaitForSingleObject(to.worker, INFINITE);
-                        CloseHandle(to.worker);
-#else
-#ifdef JANET_ANDROID
-                        pthread_kill(to.worker, SIGUSR1);
-#else
-                        pthread_cancel(to.worker);
-#endif
-                        void *res;
-                        pthread_join(to.worker, &res);
-#endif
-                    }
-                    janet_table_remove(&janet_vm.active_tasks, janet_wrap_fiber(to.curr_fiber));
                     pop_timeout(0);
+                    janet_table_remove(&janet_vm.active_tasks, janet_wrap_fiber(to.curr_fiber));
+                    handle_timeout_worker(to, 1);
                     continue;
                 }
             } else if (to.fiber->sched_id != to.sched_id) {
                 pop_timeout(0);
+                handle_timeout_worker(to, 1);
                 continue;
             }
             break;
@@ -3015,7 +3021,8 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
             uint32_t count1;
             memcpy(&count1, nextbytes, sizeof(count1));
             size_t count = (size_t) count1;
-            if (count > (endbytes - nextbytes) * sizeof(JanetCFunRegistry)) {
+            /* Use division to avoid overflowing size_t */
+            if (count > (endbytes - nextbytes - sizeof(count1)) / sizeof(JanetCFunRegistry)) {
                 janet_panic("thread message invalid");
             }
             janet_vm.registry_count = count;
@@ -3173,6 +3180,7 @@ JANET_NO_RETURN void janet_sleep_await(double sec) {
     to.is_error = 0;
     to.sched_id = to.fiber->sched_id;
     to.curr_fiber = NULL;
+    to.has_worker = 0;
     add_timeout(to);
     janet_await();
 }
@@ -3487,39 +3495,6 @@ JANET_CORE_FN(janet_cfun_ev_all_tasks,
     return janet_wrap_array(array);
 }
 
-JANET_CORE_FN(janet_cfun_to_stream,
-              "(ev/to-stream file)",
-              "Convert a core/file to a core/stream. On POSIX operating systems, this will mark "
-              "the underlying open file descriptor as non-blocking.") {
-    janet_fixarity(argc, 1);
-    int32_t flags = 0;
-    int32_t stream_flags = 0;
-    FILE *file = janet_getfile(argv, 0, &flags);
-    if (flags & JANET_FILE_READ) stream_flags |= JANET_STREAM_READABLE;
-    if (flags & JANET_FILE_WRITE) stream_flags |= JANET_STREAM_WRITABLE;
-    if (flags & JANET_FILE_NOT_CLOSEABLE) stream_flags |= JANET_STREAM_NOT_CLOSEABLE;
-    if (flags & JANET_FILE_CLOSED) janet_panic("file is closed");
-#ifdef JANET_WINDOWS
-    HANDLE handle = (HANDLE) _get_osfhandle(_fileno(file));
-    HANDLE prochandle = GetCurrentProcess();
-    HANDLE dupped_handle = INVALID_HANDLE_VALUE;
-    if (!DuplicateHandle(prochandle, handle, prochandle, &dupped_handle, 0, FALSE, DUPLICATE_SAME_ACCESS)) {
-        janet_panic("cannot duplicate handle to file");
-    }
-    JanetStream *stream = janet_stream(dupped_handle, stream_flags, NULL);
-#else
-    int handle = fileno(file);
-    int dupped_handle = 0;
-    int status = 0;
-    RETRY_EINTR(dupped_handle, dup(handle));
-    if (status == -1) janet_panic(janet_strerror(errno));
-    RETRY_EINTR(status, fcntl(dupped_handle, F_SETFL, O_NONBLOCK));
-    if (status == -1) janet_panic(janet_strerror(errno));
-    JanetStream *stream = janet_stream(dupped_handle, stream_flags, NULL);
-#endif
-    return janet_wrap_abstract(stream);
-}
-
 void janet_lib_ev(JanetTable *env) {
     JanetRegExt ev_cfuns_ext[] = {
         JANET_CORE_REG("ev/give", cfun_channel_push),
@@ -3551,7 +3526,6 @@ void janet_lib_ev(JanetTable *env) {
         JANET_CORE_REG("ev/release-rlock", janet_cfun_rwlock_read_release),
         JANET_CORE_REG("ev/release-wlock", janet_cfun_rwlock_write_release),
         JANET_CORE_REG("ev/to-file", janet_cfun_to_file),
-        JANET_CORE_REG("ev/to-stream", janet_cfun_to_stream),
         JANET_CORE_REG("ev/all-tasks", janet_cfun_ev_all_tasks),
         JANET_REG_END
     };

src/core/filewatch.c

@@ -599,33 +599,33 @@ JANET_CORE_FN(cfun_filewatch_make,
 JANET_CORE_FN(cfun_filewatch_add,
               "(filewatch/add watcher path &opt flags)",
               "Add a path to the watcher. Available flags depend on the current OS, and are as follows:\n\n"
-              "Windows/MINGW (flags correspond to FILE_NOTIFY_CHANGE_* flags in win32 documentation):\n\n"
+              "Windows/MINGW (flags correspond to `FILE_NOTIFY_CHANGE_*` flags in win32 documentation):\n\n"
               "* `:all` - trigger an event for all of the below triggers.\n\n"
-              "* `:attributes` - FILE_NOTIFY_CHANGE_ATTRIBUTES\n\n"
+              "* `:attributes` - `FILE_NOTIFY_CHANGE_ATTRIBUTES`\n\n"
-              "* `:creation` - FILE_NOTIFY_CHANGE_CREATION\n\n"
+              "* `:creation` - `FILE_NOTIFY_CHANGE_CREATION`\n\n"
-              "* `:dir-name` - FILE_NOTIFY_CHANGE_DIR_NAME\n\n"
+              "* `:dir-name` - `FILE_NOTIFY_CHANGE_DIR_NAME`\n\n"
-              "* `:last-access` - FILE_NOTIFY_CHANGE_LAST_ACCESS\n\n"
+              "* `:last-access` - `FILE_NOTIFY_CHANGE_LAST_ACCESS`\n\n"
-              "* `:last-write` - FILE_NOTIFY_CHANGE_LAST_WRITE\n\n"
+              "* `:last-write` - `FILE_NOTIFY_CHANGE_LAST_WRITE`\n\n"
-              "* `:security` - FILE_NOTIFY_CHANGE_SECURITY\n\n"
+              "* `:security` - `FILE_NOTIFY_CHANGE_SECURITY`\n\n"
-              "* `:size` - FILE_NOTIFY_CHANGE_SIZE\n\n"
+              "* `:size` - `FILE_NOTIFY_CHANGE_SIZE`\n\n"
               "* `:recursive` - watch subdirectories recursively\n\n"
-              "Linux (flags correspond to IN_* flags from <sys/inotify.h>):\n\n"
+              "Linux (flags correspond to `IN_*` flags from <sys/inotify.h>):\n\n"
-              "* `:access` - IN_ACCESS\n\n"
+              "* `:access` - `IN_ACCESS`\n\n"
-              "* `:all` - IN_ALL_EVENTS\n\n"
+              "* `:all` - `IN_ALL_EVENTS`\n\n"
-              "* `:attrib` - IN_ATTRIB\n\n"
+              "* `:attrib` - `IN_ATTRIB`\n\n"
-              "* `:close-nowrite` - IN_CLOSE_NOWRITE\n\n"
+              "* `:close-nowrite` - `IN_CLOSE_NOWRITE`\n\n"
-              "* `:close-write` - IN_CLOSE_WRITE\n\n"
+              "* `:close-write` - `IN_CLOSE_WRITE`\n\n"
-              "* `:create` - IN_CREATE\n\n"
+              "* `:create` - `IN_CREATE`\n\n"
-              "* `:delete` - IN_DELETE\n\n"
+              "* `:delete` - `IN_DELETE`\n\n"
-              "* `:delete-self` - IN_DELETE_SELF\n\n"
+              "* `:delete-self` - `IN_DELETE_SELF`\n\n"
-              "* `:ignored` - IN_IGNORED\n\n"
+              "* `:ignored` - `IN_IGNORED`\n\n"
-              "* `:modify` - IN_MODIFY\n\n"
+              "* `:modify` - `IN_MODIFY`\n\n"
-              "* `:move-self` - IN_MOVE_SELF\n\n"
+              "* `:move-self` - `IN_MOVE_SELF`\n\n"
-              "* `:moved-from` - IN_MOVED_FROM\n\n"
+              "* `:moved-from` - `IN_MOVED_FROM`\n\n"
-              "* `:moved-to` - IN_MOVED_TO\n\n"
+              "* `:moved-to` - `IN_MOVED_TO`\n\n"
-              "* `:open` - IN_OPEN\n\n"
+              "* `:open` - `IN_OPEN`\n\n"
-              "* `:q-overflow` - IN_Q_OVERFLOW\n\n"
+              "* `:q-overflow` - `IN_Q_OVERFLOW`\n\n"
-              "* `:unmount` - IN_UNMOUNT\n\n\n"
+              "* `:unmount` - `IN_UNMOUNT`\n\n\n"
               "On Windows, events will have the following possible types:\n\n"
               "* `:unknown`\n\n"
               "* `:added`\n\n"

src/core/net.c

@@ -657,7 +657,7 @@ JANET_CORE_FN(cfun_net_listen,
               "The type parameter specifies the type of network connection, either "
               "a :stream (usually tcp), or :datagram (usually udp). If not specified, the default is "
               ":stream. The host and port arguments are the same as in net/address. The last boolean parameter `no-reuse` will "
-              "disable the use of SO_REUSEADDR and SO_REUSEPORT when creating a server on some operating systems.") {
+              "disable the use of `SO_REUSEADDR` and `SO_REUSEPORT` when creating a server on some operating systems.") {
     janet_sandbox_assert(JANET_SANDBOX_NET_LISTEN);
     janet_arity(argc, 2, 4);
 

src/core/pp.c

@@ -1066,7 +1066,7 @@ void janet_buffer_format(
                     if (form[2] == '\0')
                         janet_buffer_push_bytes(b, s, l);
                     else {
-                        if (l != (int32_t) strlen((const char *) s))
+                        if (l != (int32_t) strnlen((const char *) s, l))
                             janet_panic("string contains zeros");
                         if (!strchr(form, '.') && l >= 100) {
                             janet_panic("no precision and string is too long to be formatted");

src/core/vm.c

@@ -115,7 +115,7 @@
 #define vm_maybe_auto_suspend(COND)
 #else
 #define vm_maybe_auto_suspend(COND) do { \
-    if ((COND) && janet_vm.auto_suspend) { \
+    if ((COND) && janet_atomic_load_relaxed(&janet_vm.auto_suspend)) { \
         fiber->flags |= (JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP); \
         vm_return(JANET_SIGNAL_INTERRUPT, janet_wrap_nil()); \
     } \

src/include/janet.h

@@ -170,14 +170,12 @@ extern "C" {
 /* Also enable the thread library only if not single-threaded */
 #ifdef JANET_SINGLE_THREADED
 #define JANET_THREAD_LOCAL
-#undef JANET_THREADS
+#elif !(defined(JANET_THREAD_LOCAL)) && defined(__GNUC__)
-#elif defined(__GNUC__)
 #define JANET_THREAD_LOCAL __thread
-#elif defined(_MSC_BUILD)
+#elif !(defined(JANET_THREAD_LOCAL)) && defined(_MSC_BUILD)
 #define JANET_THREAD_LOCAL __declspec(thread)
-#else
+#elif !(defined(JANET_THREAD_LOCAL))
 #define JANET_THREAD_LOCAL
-#undef JANET_THREADS
 #endif
 
 /* Enable or disable dynamic module loading. Enabled by default. */
@@ -669,6 +667,7 @@ typedef int32_t JanetAtomicInt;
 JANET_API JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x);
 JANET_API JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x);
 JANET_API JanetAtomicInt janet_atomic_load(JanetAtomicInt volatile *x);
+JANET_API JanetAtomicInt janet_atomic_load_relaxed(JanetAtomicInt volatile *x);
 
 /* We provide three possible implementations of Janets. The preferred
  * nanboxing approach, for 32 or 64 bits, and the standard C version. Code in the rest of the

test/suite-ev.janet

@@ -106,6 +106,8 @@
       (calc-2 "(+ 9 10 11 12)"))
     @[10 26 42]) "parallel subprocesses 2")
 
+# (print "file piping")
+
 # File piping
 # a1cc5ca04
 (assert-no-error "file writing 1"
@@ -225,6 +227,8 @@
     (++ iterations)
     (ev/write stream " ")))
 
+# (print "local name / peer name testing")
+
 # Test localname and peername
 # 077bf5eba
 (repeat 10
@@ -407,6 +411,8 @@
         (while (def msg (ev/read connection 100))
           (broadcast name (string msg)))))))
 
+# (print "chat app testing")
+
 # Now launch the chat server
 (def chat-server (net/listen test-host test-port))
 (ev/spawn
@@ -500,6 +506,8 @@
                        (let [s (net/listen :unix uds-path :stream)]
                          (:close s))))))
 
+# (print "accept loop testing")
+
 # net/accept-loop level triggering
 (gccollect)
 (def maxconn 50)
@@ -522,6 +530,8 @@
 (assert (= maxconn connect-count))
 (:close s)
 
+# (print "running deadline tests...")
+
 # Cancel os/proc-wait with ev/deadline
 (let [p (os/spawn [;run janet "-e" "(os/sleep 4)"] :p)]
   (var terminated-normally false)
@@ -546,9 +556,35 @@
   (ev/sleep 0.15)
   (assert (not terminated-normally) "early termination failure 3"))
 
+# Deadline with interrupt
+(defmacro with-deadline2
+  ``
+  Create a fiber to execute `body`, schedule the event loop to cancel
+  the task (root fiber) associated with `body`'s fiber, and start
+  `body`'s fiber by resuming it.
+
+  The event loop will try to cancel the root fiber if `body`'s fiber
+  has not completed after at least `sec` seconds.
+
+  `sec` is a number that can have a fractional part.
+  ``
+  [sec & body]
+  (with-syms [f]
+    ~(let [,f (coro ,;body)]
+       (,ev/deadline ,sec nil ,f true)
+       (,resume ,f))))
+
+(for i 0 10
+  # (print "deadline 1 iteration " i)
+  (assert (= :done (with-deadline2 10
+                     (ev/sleep 0.01)
+                     :done)) "deadline with interrupt exits normally"))
+
+(for i 0 10
+  # (print "deadline 2 iteration " i)
   (let [f (coro (forever :foo))]
     (ev/deadline 0.01 nil f true)
-  (assert-error "deadline expired" (resume f)))
+    (assert-error "deadline expired" (resume f))))
 
 # Use :err :stdout
 (def- subproc-code '(do (eprint "hi") (eflush) (print "there") (flush)))