Prepare for 1.35.0 release.

Fix buffer push uint max

.github/workflows/test.yml

@@ -73,7 +73,7 @@ jobs:
       - name: Compile the project
         run: make clean && make CC=x86_64-w64-mingw32-gcc LD=x86_64-w64-mingw32-gcc UNAME=MINGW RUN=wine
       - name: Test the project
-        run: make test UNAME=MINGW RUN=wine
+        run: make test UNAME=MINGW RUN=wine VERBOSE=1
 
   test-arm-linux:
     name: Build and test ARM32 cross compilation
@@ -88,4 +88,4 @@ jobs:
       - name: Compile the project
         run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" CC=arm-linux-gnueabi-gcc LD=arm-linux-gnueabi-gcc 
       - name: Test the project
-        run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test
+        run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test VERBOSE=1

.gitignore

@@ -48,6 +48,8 @@ janet.wasm
 # Generated files
 *.gen.h
 *.gen.c
+*.tmp
+temp.*
 
 # Generate test files
 *.out
@@ -126,6 +128,9 @@ vgcore.*
 *.idb
 *.pdb
 
+# GGov
+*.gcov
+
 # Kernel Module Compile Results
 *.mod*
 *.cmd

CHANGELOG.md

@@ -1,7 +1,14 @@
 # Changelog
 All notable changes to this project will be documented in this file.
 
-## Unreleased - ???
+## 1.35.0 - 2024-06-15
+- Add `:only` argument to `import` to allow for easier control over imported bindings.
+- Add extra optional `env` argument to `eval` and `eval-string`.
+- Allow naming function literals with a keyword. This allows better stacktraces for macros without
+  accidentally adding new bindings.
+- Add `bundle/` module for managing packages within Janet. This should replace the jpm packaging
+  format eventually and is much simpler and amenable to more complicated builds.
+- Add macros `ev/with-lock`, `ev/with-rlock`, and `ev/with-wlock` for using mutexes and rwlocks.
 - Add `with-env`
 - Add *module-make-env* dynamic binding
 - Add buffer/format-at

Makefile

@@ -204,9 +204,9 @@ build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
 ########################
 
 ifeq ($(UNAME), Darwin)
-SONAME=libjanet.1.34.dylib
+SONAME=libjanet.1.35.dylib
 else
-SONAME=libjanet.so.1.34
+SONAME=libjanet.so.1.35
 endif
 
 build/c/shell.c: src/mainclient/shell.c

examples/sample-bundle/bundle/info.jdn

@@ -0,0 +1,4 @@
+@{
+  :name "sample-bundle"
+  :dependencies ["sample-dep1" "sample-dep2"]
+}

examples/sample-bundle/bundle/init.janet

@@ -0,0 +1,3 @@
+(defn install
+  [manifest &]
+  (bundle/add-file manifest "mymod.janet"))

examples/sample-bundle/mymod.janet

@@ -0,0 +1,7 @@
+(import dep1)
+(import dep2)
+
+(defn myfn
+  [x]
+  (def y (dep2/function x))
+  (dep1/function y))

examples/sample-dep1/bundle/info.jdn

@@ -0,0 +1,4 @@
+@{
+  :name "sample-dep1"
+  :dependencies ["sample-dep2"]
+}

examples/sample-dep1/bundle/init.janet

@@ -0,0 +1,3 @@
+(defn install
+  [manifest &]
+  (bundle/add-file manifest "dep1.janet"))

examples/sample-dep1/dep1.janet

@@ -0,0 +1,3 @@
+(defn function
+  [x]
+  (+ x x))

examples/sample-dep2/bundle/info.jdn

@@ -0,0 +1,3 @@
+@{
+  :name "sample-dep2"
+}

examples/sample-dep2/bundle/init.janet

@@ -0,0 +1,3 @@
+(defn install
+  [manifest &]
+  (bundle/add-file manifest "dep2.janet"))

examples/sample-dep2/dep2.janet

@@ -0,0 +1,3 @@
+(defn function
+  [x]
+  (* x x))

meson.build

@@ -20,7 +20,7 @@
 
 project('janet', 'c',
   default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
-  version : '1.34.0')
+  version : '1.35.0')
 
 # Global settings
 janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@@ -249,6 +249,7 @@ test_files = [
   'test/suite-asm.janet',
   'test/suite-boot.janet',
   'test/suite-buffer.janet',
+  'test/suite-bundle.janet',
   'test/suite-capi.janet',
   'test/suite-cfuns.janet',
   'test/suite-compile.janet',

src/boot/boot.janet

@@ -1,5 +1,5 @@
 # The core janet library
-# Copyright 2023 © Calvin Rose
+# Copyright 2024 © Calvin Rose
 
 ###
 ###
@@ -244,7 +244,7 @@
   (let [[[err fib]] catch
         f (gensym)
         r (gensym)]
-    ~(let [,f (,fiber/new (fn [] ,body) :ie)
+    ~(let [,f (,fiber/new (fn :try [] ,body) :ie)
            ,r (,resume ,f)]
        (if (,= (,fiber/status ,f) :error)
          (do (def ,err ,r) ,(if fib ~(def ,fib ,f)) ,;(tuple/slice catch 1))
@@ -256,7 +256,7 @@
   error, and the second is the return value or error.`
   [& body]
   (let [f (gensym) r (gensym)]
-    ~(let [,f (,fiber/new (fn [] ,;body) :ie)
+    ~(let [,f (,fiber/new (fn :protect [] ,;body) :ie)
            ,r (,resume ,f)]
        [(,not= :error (,fiber/status ,f)) ,r])))
 
@@ -313,7 +313,7 @@
   [form & body]
   (with-syms [f r]
     ~(do
-       (def ,f (,fiber/new (fn [] ,;body) :ti))
+       (def ,f (,fiber/new (fn :defer [] ,;body) :ti))
        (def ,r (,resume ,f))
        ,form
        (if (= (,fiber/status ,f) :dead)
@@ -326,7 +326,7 @@
   [form & body]
   (with-syms [f r]
     ~(do
-       (def ,f (,fiber/new (fn [] ,;body) :ti))
+       (def ,f (,fiber/new (fn :edefer [] ,;body) :ti))
        (def ,r (,resume ,f))
        (if (= (,fiber/status ,f) :dead)
          ,r
@@ -338,7 +338,7 @@
   [tag & body]
   (with-syms [res target payload fib]
     ~(do
-       (def ,fib (,fiber/new (fn [] [,tag (do ,;body)]) :i0))
+       (def ,fib (,fiber/new (fn :prompt [] [,tag (do ,;body)]) :i0))
        (def ,res (,resume ,fib))
        (def [,target ,payload] ,res)
        (if (,= ,tag ,target)
@@ -629,17 +629,17 @@
   ``Create a generator expression using the `loop` syntax. Returns a fiber
   that yields all values inside the loop in order. See `loop` for details.``
   [head & body]
-  ~(,fiber/new (fn [] (loop ,head (yield (do ,;body)))) :yi))
+  ~(,fiber/new (fn :generate [] (loop ,head (yield (do ,;body)))) :yi))
 
 (defmacro coro
   "A wrapper for making fibers that may yield multiple values (coroutine). Same as `(fiber/new (fn [] ;body) :yi)`."
   [& body]
-  (tuple fiber/new (tuple 'fn '[] ;body) :yi))
+  (tuple fiber/new (tuple 'fn :coro '[] ;body) :yi))
 
 (defmacro fiber-fn
   "A wrapper for making fibers. Same as `(fiber/new (fn [] ;body) flags)`."
   [flags & body]
-  (tuple fiber/new (tuple 'fn '[] ;body) flags))
+  (tuple fiber/new (tuple 'fn :fiber-fn '[] ;body) flags))
 
 (defn sum
   "Returns the sum of xs. If xs is empty, returns 0."
@@ -688,7 +688,7 @@
           ~(if (def ,(def sym (gensym)) ,br)
              (do (def ,bl ,sym) ,(aux (+ 2 i)))
              ,fal2)))))
-   (aux 0))
+  (aux 0))
 
 (defmacro when-let
   "Same as `(if-let bindings (do ;body))`."
@@ -702,11 +702,11 @@
   (case (length functions)
     0 nil
     1 (in functions 0)
-    2 (let [[f g] functions] (fn [& x] (f (g ;x))))
-    3 (let [[f g h] functions] (fn [& x] (f (g (h ;x)))))
-    4 (let [[f g h i] functions] (fn [& x] (f (g (h (i ;x))))))
+    2 (let [[f g] functions] (fn :comp [& x] (f (g ;x))))
+    3 (let [[f g h] functions] (fn :comp [& x] (f (g (h ;x)))))
+    4 (let [[f g h i] functions] (fn :comp [& x] (f (g (h (i ;x))))))
     (let [[f g h i] functions]
-      (comp (fn [x] (f (g (h (i x)))))
+      (comp (fn :comp [x] (f (g (h (i x)))))
             ;(tuple/slice functions 4 -1)))))
 
 (defn identity
@@ -717,7 +717,7 @@
 (defn complement
   "Returns a function that is the complement to the argument."
   [f]
-  (fn [x] (not (f x))))
+  (fn :complement [x] (not (f x))))
 
 (defmacro- do-extreme
   [order args]
@@ -880,7 +880,7 @@
   ``Sorts `ind` in-place by calling a function `f` on each element and
   comparing the result with `<`.``
   [f ind]
-  (sort ind (fn [x y] (< (f x) (f y)))))
+  (sort ind (fn :sort-by-comp [x y] (< (f x) (f y)))))
 
 (defn sorted
   ``Returns a new sorted array without modifying the old one.
@@ -893,7 +893,7 @@
   ``Returns a new sorted array that compares elements by invoking
   a function `f` on each element and comparing the result with `<`.``
   [f ind]
-  (sorted ind (fn [x y] (< (f x) (f y)))))
+  (sorted ind (fn :sorted-by-comp [x y] (< (f x) (f y)))))
 
 (defn reduce
   ``Reduce, also know as fold-left in many languages, transforms
@@ -1192,7 +1192,7 @@
   ``Returns the juxtaposition of functions. In other words,
   `((juxt* a b c) x)` evaluates to `[(a x) (b x) (c x)]`.``
   [& funs]
-  (fn [& args]
+  (fn :juxt* [& args]
     (def ret @[])
     (each f funs
       (array/push ret (f ;args)))
@@ -1205,7 +1205,7 @@
   (def $args (gensym))
   (each f funs
     (array/push parts (tuple apply f $args)))
-  (tuple 'fn (tuple '& $args) (tuple/slice parts 0)))
+  (tuple 'fn :juxt (tuple '& $args) (tuple/slice parts 0)))
 
 (defmacro defdyn
   ``Define an alias for a keyword that is used as a dynamic binding. The
@@ -1421,12 +1421,12 @@
   (def dyn-forms
     (seq [i :range [0 (length bindings) 2]]
       ~(setdyn ,(bindings i) ,(bindings (+ i 1)))))
-  ~(,resume (,fiber/new (fn [] ,;dyn-forms ,;body) :p)))
+  ~(,resume (,fiber/new (fn :with-dyns [] ,;dyn-forms ,;body) :p)))
 
 (defmacro with-env
   `Run a block of code with a given environment table`
   [env & body]
-  ~(,resume (,fiber/new (fn [] ,;body) : ,env)))
+  ~(,resume (,fiber/new (fn :with-env [] ,;body) : ,env)))
 
 (defmacro with-vars
   ``Evaluates `body` with each var in `vars` temporarily bound. Similar signature to
@@ -1441,7 +1441,7 @@
   (with-syms [ret f s]
     ~(do
        ,;saveold
-       (def ,f (,fiber/new (fn [] ,;setnew ,;body) :ti))
+       (def ,f (,fiber/new (fn :with-vars [] ,;setnew ,;body) :ti))
        (def ,ret (,resume ,f))
        ,;restoreold
        (if (= (,fiber/status ,f) :dead) ,ret (,propagate ,ret ,f)))))
@@ -1450,7 +1450,7 @@
   "Partial function application."
   [f & more]
   (if (zero? (length more)) f
-    (fn [& r] (f ;more ;r))))
+    (fn :partial [& r] (f ;more ;r))))
 
 (defn every?
   ``Evaluates to the last element of `ind` if all preceding elements are truthy,
@@ -1807,7 +1807,6 @@
   (printf (dyn *pretty-format* "%q") x)
   (flush))
 
-
 (defn file/lines
   "Return an iterator over the lines of a file."
   [file]
@@ -2148,8 +2147,8 @@
   (def ret
     (case (type x)
       :tuple (if (= (tuple/type x) :brackets)
-                 (tuple/brackets ;(map recur x))
-                 (dotup x))
+               (tuple/brackets ;(map recur x))
+               (dotup x))
       :array (map recur x)
       :struct (table/to-struct (dotable x recur))
       :table (dotable x recur)
@@ -2330,7 +2329,7 @@
             x)))
       x))
   (def expanded (macex arg on-binding))
-  (def name-splice (if name [name] []))
+  (def name-splice (if name [name] [:short-fn]))
   (def fn-args (seq [i :range [0 (+ 1 max-param-seen)]] (symbol prefix '$ i)))
   ~(fn ,;name-splice [,;fn-args ,;(if vararg ['& (symbol prefix '$&)] [])] ,expanded))
 
@@ -2420,29 +2419,9 @@
     col
     ": parse error: "
     (:error p)
-    (if ec "\e[0m" ""))
+    (if ec "\e[0m"))
   (eflush))
 
-(defn- print-line-col
-  ``Print the source code at a line, column in a source file. If unable to open
-  the file, prints nothing.``
-  [where line col]
-  (if-not line (break))
-  (unless (string? where) (break))
-  (when-with [f (file/open where :r)]
-    (def source-code (file/read f :all))
-    (var index 0)
-    (repeat (dec line)
-      (if-not index (break))
-      (set index (string/find "\n" source-code index))
-      (if index (++ index)))
-    (when index
-      (def line-end (string/find "\n" source-code index))
-      (eprint "  " (string/slice source-code index line-end))
-      (when col
-        (+= index col)
-        (eprint (string/repeat " " (inc col)) "^")))))
-
 (defn warn-compile
   "Default handler for a compile warning."
   [msg level where &opt line col]
@@ -2455,10 +2434,7 @@
     ":"
     col
     ": compile warning (" level "): ")
-  (eprint msg)
-  (when ec
-    (print-line-col where line col)
-    (eprin "\e[0m"))
+  (eprint msg (if ec "\e[0m"))
   (eflush))
 
 (defn bad-compile
@@ -2475,10 +2451,7 @@
     ": compile error: ")
   (if macrof
     (debug/stacktrace macrof msg "")
-    (eprint msg))
-  (when ec
-    (print-line-col where line col)
-    (eprin "\e[0m"))
+    (eprint msg (if ec "\e[0m")))
   (eflush))
 
 (defn curenv
@@ -2547,7 +2520,7 @@
         :read read
         :expander expand} opts)
   (default env (or (fiber/getenv (fiber/current)) @{}))
-  (default chunks (fn [buf p] (getline "" buf env)))
+  (default chunks (fn chunks [buf p] (getline "" buf env)))
   (default onstatus debug/stacktrace)
   (default on-compile-error bad-compile)
   (default on-compile-warning warn-compile)
@@ -2682,8 +2655,8 @@
 (defn eval
   ``Evaluates a form in the current environment. If more control over the
   environment is needed, use `run-context`.``
-  [form]
-  (def res (compile form nil :eval))
+  [form &opt env]
+  (def res (compile form env :eval))
   (if (= (type res) :function)
     (res)
     (error (get res :error))))
@@ -2722,9 +2695,9 @@
 (defn eval-string
   ``Evaluates a string in the current environment. If more control over the
   environment is needed, use `run-context`.``
-  [str]
+  [str &opt env]
   (var ret nil)
-  (each x (parse-all str) (set ret (eval x)))
+  (each x (parse-all str) (set ret (eval x env)))
   ret)
 
 (def load-image-dict
@@ -2867,7 +2840,7 @@
             (set ret [fullpath mod-kind])
             (break))))))
   (if ret ret
-    (let [expander (fn [[t _ chk]]
+    (let [expander (fn :expander [[t _ chk]]
                      (when (string? t)
                        (when (mod-filter chk path)
                          (module/expand-path path t))))
@@ -2934,7 +2907,7 @@
   set to a truthy value."
   [env &opt level is-repl]
   (default level 1)
-  (fn [f x]
+  (fn :debugger [f x]
     (def fs (fiber/status f))
     (if (= :dead fs)
       (when is-repl
@@ -3024,7 +2997,7 @@
   ``A table of loading method names to loading functions.
   This table lets `require` and `import` load many different kinds
   of files as modules.``
-  @{:native (fn native-loader [path &] (native path (make-env)))
+  @{:native (fn native-loader [path &] (native path ((dyn *module-make-env* make-env))))
     :source (fn source-loader [path args]
               (def ml (dyn *module-loading* module/loading))
               (put ml path true)
@@ -3067,9 +3040,10 @@
   ``Merge a module source into the `target` environment with a `prefix`, as with the `import` macro.
   This lets users emulate the behavior of `import` with a custom module table.
   If `export` is truthy, then merged functions are not marked as private. Returns
-  the modified target environment.``
-  [target source &opt prefix export]
-  (loop [[k v] :pairs source :when (symbol? k) :when (not (v :private))]
+  the modified target environment. If an array `only` is passed, only merge keys in `only`.``
+  [target source &opt prefix export only]
+  (def only-set (if only (invert only)))
+  (loop [[k v] :pairs source :when (symbol? k) :when (not (v :private)) :when (or (not only) (in only-set k))]
     (def newv (table/setproto @{:private (not export)} v))
     (put target (symbol prefix k) newv))
   target)
@@ -3082,13 +3056,14 @@
   (def kargs (table ;args))
   (def {:as as
         :prefix prefix
-        :export ep} kargs)
+        :export ep
+        :only only} kargs)
   (def newenv (require-1 path args kargs))
   (def prefix (or
                 (and as (string as "/"))
                 prefix
                 (string (last (string/split "/" path)) "/")))
-  (merge-module env newenv prefix ep))
+  (merge-module env newenv prefix ep only))
 
 (defmacro import
   ``Import a module. First requires the module, and then merges its
@@ -3142,6 +3117,7 @@
   [&opt env local]
   (env-walk keyword? env local))
 
+
 (defdyn *doc-width*
   "Width in columns to print documentation printed with `doc-format`.")
 
@@ -3704,7 +3680,7 @@
   [&opt chunks onsignal env parser read]
   (default env (make-env))
   (default chunks
-    (fn [buf p]
+    (fn :chunks [buf p]
       (getline
         (string
           "repl:"
@@ -3735,23 +3711,47 @@
     Returns a fiber that is scheduled to run the function.
     ```
     [f & args]
-    (ev/go (fn _call [&] (f ;args))))
+    (ev/go (fn :call [&] (f ;args))))
 
   (defmacro ev/spawn
     "Run some code in a new fiber. This is shorthand for `(ev/go (fn [] ;body))`."
     [& body]
-    ~(,ev/go (fn _spawn [&] ,;body)))
+    ~(,ev/go (fn :spawn [&] ,;body)))
 
   (defmacro ev/do-thread
     ``Run some code in a new thread. Suspends the current fiber until the thread is complete, and
     evaluates to nil.``
     [& body]
-    ~(,ev/thread (fn _do-thread [&] ,;body)))
+    ~(,ev/thread (fn :do-thread [&] ,;body)))
+
+  (defn- acquire-release
+    [acq rel lock body]
+    (def l (gensym))
+    ~(do
+       (def ,l ,lock)
+       (,acq ,l)
+       (defer (,rel ,l)
+         ,;body)))
+
+  (defmacro ev/with-lock
+    ``Run a body of code after acquiring a lock. Will automatically release the lock when done.``
+    [lock & body]
+    (acquire-release ev/acquire-lock ev/release-lock lock body))
+
+  (defmacro ev/with-rlock
+    ``Run a body of code after acquiring read access to an rwlock. Will automatically release the lock when done.``
+    [lock & body]
+    (acquire-release ev/acquire-rlock ev/release-rlock lock body))
+
+  (defmacro ev/with-wlock
+    ``Run a body of code after acquiring read access to an rwlock. Will automatically release the lock when done.``
+    [lock & body]
+    (acquire-release ev/acquire-wlock ev/release-wlock lock body))
 
   (defmacro ev/spawn-thread
     ``Run some code in a new thread. Like `ev/do-thread`, but returns nil immediately.``
     [& body]
-    ~(,ev/thread (fn _spawn-thread [&] ,;body) nil :n))
+    ~(,ev/thread (fn :spawn-thread [&] ,;body) nil :n))
 
   (defmacro ev/with-deadline
     ``
@@ -3800,7 +3800,7 @@
          (def ,res @[])
          ,;(seq [[i body] :pairs bodies]
              ~(do
-                (def ,ftemp (,ev/go (fn [] (put ,res ,i ,body)) nil ,chan))
+                (def ,ftemp (,ev/go (fn :ev/gather [] (put ,res ,i ,body)) nil ,chan))
                 (,put ,fset ,ftemp ,ftemp)))
          (,wait-for-fibers ,chan ,fset)
          ,res))))
@@ -3883,12 +3883,12 @@
       ~(defn ,alias ,;meta [,;formal-args]
          (,ffi/call (,(delay (make-ptr))) (,(delay (make-sig))) ,;formal-args))
       ~(defn ,alias ,;meta [,;formal-args]
-         (,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args)))))
+         (,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args))))
 
   (defmacro ffi/defbind
     "Generate bindings for native functions in a convenient manner."
     [name ret-type & body]
-    ~(ffi/defbind-alias ,name ,name ,ret-type ,;body))
+    ~(ffi/defbind-alias ,name ,name ,ret-type ,;body)))
 
 ###
 ###
@@ -3965,6 +3965,382 @@
   (merge-into module/cache old-modcache)
   nil)
 
+###
+###
+### Bundle tools
+###
+###
+
+(compwhen (dyn 'os/stat)
+
+  (def- seps {:windows "\\" :mingw "\\" :cygwin "\\"})
+  (defn- sep [] (get seps (os/which) "/"))
+
+  (defn- bundle-rpath
+    [path]
+    (os/realpath path))
+
+  (defn- bundle-dir
+    [&opt bundle-name]
+    (def s (sep))
+    (string (bundle-rpath (dyn *syspath*)) s "bundle" (if bundle-name s) bundle-name))
+
+  (defn- bundle-file
+    [bundle-name filename]
+    (def s (sep))
+    (string (bundle-rpath (dyn *syspath*)) s "bundle" s bundle-name s filename))
+
+  (defn- get-manifest-filename
+    [bundle-name]
+    (bundle-file bundle-name "manifest.jdn"))
+
+  (defn- prime-bundle-paths
+    []
+    (def s (sep))
+    (def path (bundle-dir))
+    (os/mkdir path)
+    (assert (os/stat path :mode)))
+
+  (defn- get-files [manifest]
+    (def files (get manifest :files @[]))
+    (put manifest :files files)
+    files)
+
+  (defn- rmrf
+    "rm -rf in janet"
+    [x]
+    (case (os/lstat x :mode)
+      nil nil
+      :directory (do
+                   (def s (sep))
+                   (each y (os/dir x)
+                     (rmrf (string x s y)))
+                   (os/rmdir x))
+      (os/rm x))
+    nil)
+
+  (defn- copyfile
+    [from to]
+    (def mode (os/stat from :permissions))
+    (def b (buffer/new 0x10000))
+    (with [ffrom (file/open from :rb)]
+      (with [fto (file/open to :wb)]
+        (forever
+          (file/read ffrom 0x10000 b)
+          (when (empty? b) (buffer/trim b) (os/chmod to mode) (break))
+          (file/write fto b)
+          (buffer/clear b)))))
+
+  (defn- copyrf
+    [from to]
+    (case (os/stat from :mode)
+      :file (copyfile from to)
+      :directory (do
+                   (def s (sep))
+                   (os/mkdir to)
+                   (each y (os/dir from)
+                     (copyrf (string from s y) (string to s y)))))
+    nil)
+
+  (defn- sync-manifest
+    [manifest]
+    (def bn (get manifest :name))
+    (def manifest-name (get-manifest-filename bn))
+    (spit manifest-name (string/format "%j\n" manifest)))
+
+  (defn bundle/manifest
+    "Get the manifest for a give installed bundle"
+    [bundle-name]
+    (def name (get-manifest-filename bundle-name))
+    (assert (fexists name) (string "no bundle " bundle-name " found"))
+    (parse (slurp name)))
+
+  (defn- get-bundle-module
+    [bundle-name]
+    (def manifest (bundle/manifest bundle-name))
+    (def dir (os/cwd))
+    (def workdir (get manifest :local-source "."))
+    (def fixed-syspath (bundle-rpath (dyn *syspath*)))
+    (try
+      (os/cd workdir)
+      ([_] (print "cannot enter source directory " workdir " for bundle " bundle-name)))
+    (defer (os/cd dir)
+      (def new-env (make-env (curenv)))
+      (put new-env *module-cache* @{})
+      (put new-env *module-loading* @{})
+      (put new-env *module-make-env* (fn make-bundle-env [&] (make-env new-env)))
+      (put new-env :workdir workdir)
+      (put new-env :name bundle-name)
+      (put new-env *syspath* fixed-syspath)
+      (with-env new-env
+        (put new-env :bundle-dir (bundle-dir bundle-name)) # get the syspath right
+        (require (string "@syspath/bundle/" bundle-name)))))
+
+  (defn- do-hook
+    [module bundle-name hook & args]
+    (def hookf (module/value module (symbol hook)))
+    (unless hookf (break))
+    (def manifest (bundle/manifest bundle-name))
+    (def dir (os/cwd))
+    (os/cd (get module :workdir "."))
+    (defer (os/cd dir)
+      (print "running hook " hook " for bundle " bundle-name)
+      (hookf ;args)))
+
+  (defn bundle/list
+    "Get a list of all installed bundles in lexical order."
+    []
+    (def d (bundle-dir))
+    (if (os/stat d :mode)
+      (sort (os/dir d))
+      @[]))
+
+  (defn- bundle-uninstall-unchecked
+    [bundle-name]
+    (def man (bundle/manifest bundle-name))
+    (def all-hooks (get man :hooks @[]))
+    (when (index-of :uninstall all-hooks)
+      (def module (get-bundle-module bundle-name))
+      (do-hook module bundle-name :uninstall man))
+    (def files (get man :files []))
+    (each file (reverse files)
+      (print "remove " file)
+      (case (os/stat file :mode)
+        :file (os/rm file)
+        :directory (os/rmdir file)))
+    (rmrf (bundle-dir bundle-name))
+    nil)
+
+  (defn bundle/uninstall
+    "Remove a bundle from the current syspath"
+    [bundle-name]
+    (def breakage @{})
+    (each b (bundle/list)
+      (unless (= b bundle-name)
+        (def m (bundle/manifest b))
+        (def deps (get m :dependencies []))
+        (each d deps
+          (if (= d bundle-name) (put breakage b true)))))
+    (when (next breakage)
+      (def breakage-list (sorted (keys breakage)))
+      (errorf "cannot uninstall %s, breaks dependent bundles %n" bundle-name breakage-list))
+    (bundle-uninstall-unchecked bundle-name))
+
+  (defn bundle/topolist
+    "Get topological order of all bundles, such that each bundle is listed after its dependencies."
+    []
+    (def visited @{})
+    (def cycle-detect @{})
+    (def order @[])
+    (def stack @[])
+    (defn visit
+      [b]
+      (array/push stack b)
+      (if (get visited b) (break))
+      (if (get cycle-detect b) (errorf "cycle detected in bundle dependencies: %s" (string/join stack " -> ")))
+      (put cycle-detect b true)
+      (each d (get (bundle/manifest b) :dependencies []) (visit d))
+      (put cycle-detect b nil)
+      (put visited b true)
+      (array/pop stack)
+      (array/push order b))
+    (each b (bundle/list) (visit b))
+    order)
+
+  (defn bundle/prune
+    "Remove all orphaned bundles from the syspath. An orphaned bundle is a bundle that is
+     marked for :auto-remove and is not depended on by any other bundle."
+    []
+    (def topo (bundle/topolist))
+    (def rtopo (reverse topo))
+    # Check which auto-remove packages can be dropped
+    # Iterate in (reverse) topological order, and if we see an auto-remove package and have not already seen
+    # something that depends on it, then it is a root package and can be pruned.
+    (def exempt @{})
+    (def to-drop @[])
+    (each b rtopo
+      (def m (bundle/manifest b))
+      (if (or (get exempt b) (not (get m :auto-remove)))
+        (do
+          (put exempt b true)
+          (each d (get m :dependencies []) (put exempt d true)))
+        (array/push to-drop b)))
+    (print "pruning " (length to-drop) " bundles")
+    (each b to-drop
+      (print "uninstall " b))
+    (each b to-drop
+      (print "uninstalling " b)
+      (bundle-uninstall-unchecked b)))
+
+  (defn bundle/installed?
+    "Check if a bundle is installed."
+    [bundle-name]
+    (not (not (os/stat (bundle-dir bundle-name) :mode))))
+
+  (defn bundle/install
+    "Install a bundle from the local filesystem with a name `bundle-name`."
+    [path &keys config]
+    (def path (bundle-rpath path))
+    (def clean (get config :clean))
+    (def check (get config :check))
+    (def s (sep))
+    # Check meta file for dependencies and default name
+    (def infofile-pre (string path s "bundle" s "info.jdn"))
+    (var default-bundle-name nil)
+    (when (os/stat infofile-pre :mode)
+      (def info (-> infofile-pre slurp parse))
+      (def deps (get info :dependencies @[]))
+      (set default-bundle-name (get info :name))
+      (def missing (seq [d :in deps :when (not (bundle/installed? d))] (string d)))
+      (when (next missing) (errorf "missing dependencies %s" (string/join missing ", "))))
+    (def bundle-name (get config :name default-bundle-name))
+    (assert bundle-name (errorf "unable to infer bundle name for %v, use :name argument" path))
+    (assert (not (string/check-set "\\/" bundle-name))
+            (string "bundle name "
+                    bundle-name
+                    " cannot contain path separators"))
+    (assert (next bundle-name) "cannot use empty bundle-name")
+    (assert (not (fexists (get-manifest-filename bundle-name)))
+            "bundle is already installed")
+    # Setup installed paths
+    (prime-bundle-paths)
+    (os/mkdir (bundle-dir bundle-name))
+    # Copy some files into the new location unconditionally
+    (def implicit-sources (string path s "bundle"))
+    (when (= :directory (os/stat implicit-sources :mode))
+      (copyrf implicit-sources (bundle-dir bundle-name)))
+    (def man @{:name bundle-name :local-source path :files @[]})
+    (merge-into man config)
+    (def infofile (bundle-file bundle-name "info.jdn"))
+    (put man :auto-remove (get config :auto-remove))
+    (sync-manifest man)
+    (edefer (do (print "installation error, uninstalling") (bundle/uninstall bundle-name))
+      (when (os/stat infofile :mode)
+        (def info (-> infofile slurp parse))
+        (def deps (get info :dependencies @[]))
+        (def missing (filter (complement bundle/installed?) deps))
+        (when (next missing)
+          (error (string "missing dependencies " (string/join missing ", "))))
+        (put man :dependencies deps)
+        (put man :info info))
+      (def module (get-bundle-module bundle-name))
+      (def all-hooks (seq [[k v] :pairs module :when (symbol? k) :unless (get v :private)] (keyword k)))
+      (put man :hooks all-hooks)
+      (do-hook module bundle-name :dependencies man)
+      (when clean
+        (do-hook module bundle-name :clean man))
+      (do-hook module bundle-name :build man)
+      (do-hook module bundle-name :install man)
+      (when check
+        (do-hook module bundle-name :check man))
+      (if (empty? (get man :files)) (print "no files installed, is this a valid bundle?"))
+      (sync-manifest man))
+    (print "installed " bundle-name)
+    bundle-name)
+
+  (defn- bundle/pack
+    "Take an installed bundle and create a bundle source directory that can be used to
+     reinstall the bundle on a compatible system. This is used to create backups for installed
+     bundles without rebuilding, or make a prebuilt bundle for other systems."
+    [bundle-name dest-dir &opt is-backup]
+    (var i 0)
+    (def man (bundle/manifest bundle-name))
+    (def files (get man :files @[]))
+    (assert (os/mkdir dest-dir) (string "could not create directory " dest-dir " (or it already exists)"))
+    (def s (sep))
+    (os/mkdir (string dest-dir s "bundle"))
+    (def install-hook (string dest-dir s "bundle" s "init.janet"))
+    (edefer (rmrf dest-dir) # don't leave garbage on failure
+      (def install-source @[])
+      (def syspath (bundle-rpath (dyn *syspath*)))
+      (when is-backup (copyrf (bundle-dir bundle-name) (string dest-dir s "old-bundle")))
+      (each file files
+        (def {:mode mode :permissions perm} (os/stat file))
+        (def relpath (string/triml (slice file (length syspath) -1) s))
+        (case mode
+          :directory (array/push install-source ~(bundle/add-directory manifest ,relpath ,perm))
+          :file (do
+                  (def filename (string/format "file_%06d" (++ i)))
+                  (copyfile file (string dest-dir s filename))
+                  (array/push install-source ~(bundle/add-file manifest ,filename ,relpath ,perm)))
+          (errorf "unexpected file %v" file)))
+      (def b @"(defn install [manifest]")
+      (each form install-source (buffer/format b "\n  %j" form))
+      (buffer/push b ")\n")
+      (spit install-hook b))
+    dest-dir)
+
+  (defn bundle/reinstall
+    "Reinstall an existing bundle from the local source code."
+    [bundle-name &keys new-config]
+    (def manifest (bundle/manifest bundle-name))
+    (def path (get manifest :local-source))
+    (def config (get manifest :config @{}))
+    (def s (sep))
+    (assert (= :directory (os/stat path :mode)) "local source not available")
+    (def backup-dir (string (dyn *syspath*) s bundle-name ".backup"))
+    (rmrf backup-dir)
+    (def backup-bundle-source (bundle/pack bundle-name backup-dir true))
+    (edefer (do
+              (bundle/install backup-bundle-source :name bundle-name)
+              (copyrf (string backup-bundle-source s "old-bundle") (bundle-dir bundle-name))
+              (rmrf backup-bundle-source))
+      (bundle-uninstall-unchecked bundle-name)
+      (bundle/install path :name bundle-name ;(kvs config) ;(kvs new-config)))
+    (rmrf backup-bundle-source)
+    bundle-name)
+
+  (defn bundle/add-directory
+    "Add a directory during the install process relative to `(dyn *syspath*)`"
+    [manifest dest &opt chmod-mode]
+    (def files (get-files manifest))
+    (def s (sep))
+    (def absdest (string (dyn *syspath*) s dest))
+    (unless (os/mkdir absdest)
+      (errorf "collision at %s, directory already exists" absdest))
+    (def absdest (os/realpath absdest))
+    (array/push files absdest)
+    (when chmod-mode
+      (os/chmod absdest chmod-mode))
+    (print "add " absdest)
+    absdest)
+
+  (defn bundle/add-file
+    "Add files during an install relative to `(dyn *syspath*)`"
+    [manifest src &opt dest chmod-mode]
+    (default dest src)
+    (def files (get-files manifest))
+    (def s (sep))
+    (def absdest (string (dyn *syspath*) s dest))
+    (when (os/stat absdest :mode)
+      (errorf "collision at %s, file already exists" absdest))
+    (copyfile src absdest)
+    (def absdest (os/realpath absdest))
+    (array/push files absdest)
+    (when chmod-mode
+      (os/chmod absdest chmod-mode))
+    (print "add " absdest)
+    absdest)
+
+  (defn bundle/add
+    "Add files and directories during a bundle install relative to `(dyn *syspath*)`.
+     Added paths will be recorded in the bundle manifest such that they are properly tracked
+     and removed during an upgrade or uninstall."
+    [manifest src &opt dest chmod-mode]
+    (default dest src)
+    (def s (sep))
+    (case (os/stat src :mode)
+      :directory
+      (let [absdest (bundle/add-directory manifest dest chmod-mode)]
+        (each d (os/dir src) (bundle/add manifest (string src s d) (string dest s d) chmod-mode))
+        absdest)
+      :file (bundle/add-file manifest src dest chmod-mode)))
+
+  (defn bundle/update-all
+    "Reinstall all bundles"
+    [&keys configs]
+    (each bundle (bundle/topolist)
+      (bundle/reinstall bundle ;(kvs configs)))))
 
 ###
 ###
@@ -4002,6 +4378,28 @@
 (compwhen (not (dyn 'os/isatty))
   (defmacro os/isatty [&] true))
 
+(def- long-to-short
+  "map long options to short options"
+  {"-help" "h"
+   "-version" "v"
+   "-stdin" "s"
+   "-eval" "e"
+   "-expression" "E"
+   "-debug" "d"
+   "-repl" "r"
+   "-noprofile" "R"
+   "-persistent" "p"
+   "-quiet" "q"
+   "-flycheck" "k"
+   "-syspath" "m"
+   "-compile" "c"
+   "-image" "i"
+   "-nocolor" "n"
+   "-color" "N"
+   "-library" "l"
+   "-lint-warn" "w"
+   "-lint-error" "x"})
+
 (defn cli-main
   `Entrance for the Janet CLI tool. Call this function with the command line
   arguments as an array or tuple of strings to invoke the CLI interface.`
@@ -4033,28 +4431,6 @@
     (def x (in args (+ i 1)))
     (or (scan-number x) (keyword x)))
 
-  (def- long-to-short
-    "map long options to short options"
-    {"-help" "h"
-     "-version" "v"
-     "-stdin" "s"
-     "-eval" "e"
-     "-expression" "E"
-     "-debug" "d"
-     "-repl" "r"
-     "-noprofile" "R"
-     "-persistent" "p"
-     "-quiet" "q"
-     "-flycheck" "k"
-     "-syspath" "m"
-     "-compile" "c"
-     "-image" "i"
-     "-nocolor" "n"
-     "-color" "N"
-     "-library" "l"
-     "-lint-warn" "w"
-     "-lint-error" "x"})
-
   # Flag handlers
   (def handlers
     {"h" (fn [&]
@@ -4326,9 +4702,8 @@
   (each s core-sources
     (do-one-file s))
 
-  # Create C source file that contains images a uint8_t buffer. This
-  # can be compiled and linked statically into the main janet library
-  # and example client.
+  # Create C source file that contains the boot image in a uint8_t buffer. This
+  # can be compiled and linked statically into the main janet library and client
   (print "static const unsigned char janet_core_image_bytes[] = {")
   (loop [line :in (partition 16 image)]
     (prin "  ")

src/conf/janetconf.h

@@ -7,7 +7,7 @@
 #define JANET_VERSION_MINOR 34
 #define JANET_VERSION_PATCH 0
 #define JANET_VERSION_EXTRA ""
-#define JANET_VERSION "1.34.0"
+#define JANET_VERSION "1.35.0"
 
 /* #define JANET_BUILD "local" */
 

src/core/buffer.c

@@ -375,7 +375,7 @@ JANET_CORE_FN(cfun_buffer_push_uint16,
         uint16_t data;
         uint8_t bytes[2];
     } u;
-    u.data = (uint16_t) janet_getinteger(argv, 2);
+    u.data = janet_getuinteger16(argv, 2);
     if (reverse) {
         uint8_t temp = u.bytes[1];
         u.bytes[1] = u.bytes[0];
@@ -396,7 +396,7 @@ JANET_CORE_FN(cfun_buffer_push_uint32,
         uint32_t data;
         uint8_t bytes[4];
     } u;
-    u.data = (uint32_t) janet_getinteger(argv, 2);
+    u.data = janet_getuinteger(argv, 2);
     if (reverse)
         reverse_u32(u.bytes);
     janet_buffer_push_u32(buffer, *(uint32_t *) u.bytes);
@@ -414,7 +414,7 @@ JANET_CORE_FN(cfun_buffer_push_uint64,
         uint64_t data;
         uint8_t bytes[8];
     } u;
-    u.data = (uint64_t) janet_getuinteger64(argv, 2);
+    u.data = janet_getuinteger64(argv, 2);
     if (reverse)
         reverse_u64(u.bytes);
     janet_buffer_push_u64(buffer, *(uint64_t *) u.bytes);

src/core/capi.c

@@ -303,11 +303,28 @@ int32_t janet_getinteger(const Janet *argv, int32_t n) {
 uint32_t janet_getuinteger(const Janet *argv, int32_t n) {
     Janet x = argv[n];
     if (!janet_checkuint(x)) {
-        janet_panicf("bad slot #%d, expected 32 bit signed integer, got %v", n, x);
+        janet_panicf("bad slot #%d, expected 32 bit unsigned integer, got %v", n, x);
     }
-    return janet_unwrap_integer(x);
+    return (uint32_t) janet_unwrap_number(x);
 }
 
+int16_t janet_getinteger16(const Janet *argv, int32_t n) {
+    Janet x = argv[n];
+    if (!janet_checkint16(x)) {
+        janet_panicf("bad slot #%d, expected 16 bit signed integer, got %v", n, x);
+    }
+    return (int16_t) janet_unwrap_number(x);
+}
+
+uint16_t janet_getuinteger16(const Janet *argv, int32_t n) {
+    Janet x = argv[n];
+    if (!janet_checkuint16(x)) {
+        janet_panicf("bad slot #%d, expected 16 bit unsigned integer, got %v", n, x);
+    }
+    return (uint16_t) janet_unwrap_number(x);
+}
+
+
 int64_t janet_getinteger64(const Janet *argv, int32_t n) {
 #ifdef JANET_INT_TYPES
     return janet_unwrap_s64(argv[n]);

src/core/compile.c

@@ -934,7 +934,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
         int32_t slotchunks = (def->slotcount + 31) >> 5;
         /* numchunks is min of slotchunks and scope->ua.count */
         int32_t numchunks = slotchunks > scope->ua.count ? scope->ua.count : slotchunks;
-        uint32_t *chunks = janet_calloc(1, slotchunks * sizeof(uint32_t));
+        uint32_t *chunks = janet_calloc(slotchunks, sizeof(uint32_t));
         if (NULL == chunks) {
             JANET_OUT_OF_MEMORY;
         }
@@ -1056,7 +1056,7 @@ JanetCompileResult janet_compile_lint(Janet source,
 
     if (c.result.status == JANET_COMPILE_OK) {
         JanetFuncDef *def = janetc_pop_funcdef(&c);
-        def->name = janet_cstring("_thunk");
+        def->name = janet_cstring("thunk");
         janet_def_addflags(def);
         c.result.funcdef = def;
     } else {

src/core/debug.c

@@ -164,7 +164,7 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
                 }
             }
             if (frame->flags & JANET_STACKFRAME_TAILCALL)
-                janet_eprintf(" (tailcall)");
+                janet_eprintf(" (tail call)");
             if (frame->func && frame->pc) {
                 int32_t off = (int32_t)(frame->pc - def->bytecode);
                 if (def->sourcemap) {
@@ -180,6 +180,11 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
                 }
             }
             janet_eprintf("\n");
+            /* Print fiber points optionally. Clutters traces but provides info
+            if (i <= 0 && fi > 0) {
+                janet_eprintf("  in parent fiber\n");
+            }
+            */
         }
     }
 

src/core/ev.c

@@ -281,13 +281,9 @@ void janet_async_start(JanetStream *stream, JanetAsyncMode mode, JanetEVCallback
     janet_assert(!fiber->ev_callback, "double async on fiber");
     if (mode & JANET_ASYNC_LISTEN_READ) {
         stream->read_fiber = fiber;
-    } else {
-        stream->read_fiber = NULL;
     }
     if (mode & JANET_ASYNC_LISTEN_WRITE) {
         stream->write_fiber = fiber;
-    } else {
-        stream->write_fiber = NULL;
     }
     fiber->ev_callback = callback;
     fiber->ev_stream = stream;
@@ -2095,7 +2091,7 @@ void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage ar
     int err = pthread_create(&waiter_thread, &janet_vm.new_thread_attr, janet_thread_body, init);
     if (err) {
         janet_free(init);
-        janet_panicf("%s", strerror(err));
+        janet_panicf("%s", janet_strerror(err));
     }
 #endif
 
@@ -2204,7 +2200,7 @@ Janet janet_ev_lasterr(void) {
 }
 #else
 Janet janet_ev_lasterr(void) {
-    return janet_cstringv(strerror(errno));
+    return janet_cstringv(janet_strerror(errno));
 }
 #endif
 

src/core/features.h

@@ -76,4 +76,6 @@
 #define __BSD_VISIBLE 1
 #endif
 
+#define _FILE_OFFSET_BITS 64
+
 #endif

src/core/io.c

@@ -41,6 +41,11 @@ static void io_file_marshal(void *p, JanetMarshalContext *ctx);
 static void *io_file_unmarshal(JanetMarshalContext *ctx);
 static Janet io_file_next(void *p, Janet key);
 
+#ifdef JANET_WINDOWS
+#define ftell _ftelli64
+#define fseek _fseeki64
+#endif
+
 const JanetAbstractType janet_file_type = {
     "core/file",
     cfun_io_gc,
@@ -126,7 +131,7 @@ JANET_CORE_FN(cfun_io_temp,
     // XXX use mkostemp when we can to avoid CLOEXEC race.
     FILE *tmp = tmpfile();
     if (!tmp)
-        janet_panicf("unable to create temporary file - %s", strerror(errno));
+        janet_panicf("unable to create temporary file - %s", janet_strerror(errno));
     return janet_makefile(tmp, JANET_FILE_WRITE | JANET_FILE_READ | JANET_FILE_BINARY);
 }
 
@@ -168,7 +173,7 @@ JANET_CORE_FN(cfun_io_fopen,
         }
     }
     return f ? janet_makefile(f, flags)
-           : (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, strerror(errno)), janet_wrap_nil())
+           : (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, janet_strerror(errno)), janet_wrap_nil())
            : janet_wrap_nil();
 }
 
@@ -337,7 +342,7 @@ JANET_CORE_FN(cfun_io_fseek,
     JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
     if (iof->flags & JANET_FILE_CLOSED)
         janet_panic("file is closed");
-    long int offset = 0;
+    int64_t offset = 0;
     int whence = SEEK_CUR;
     if (argc >= 2) {
         const uint8_t *whence_sym = janet_getkeyword(argv, 1);
@@ -351,7 +356,7 @@ JANET_CORE_FN(cfun_io_fseek,
             janet_panicf("expected one of :cur, :set, :end, got %v", argv[1]);
         }
         if (argc == 3) {
-            offset = (long) janet_getinteger64(argv, 2);
+            offset = (int64_t) janet_getinteger64(argv, 2);
         }
     }
     if (fseek(iof->file, offset, whence)) janet_panic("error seeking file");
@@ -365,7 +370,7 @@ JANET_CORE_FN(cfun_io_ftell,
     JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
     if (iof->flags & JANET_FILE_CLOSED)
         janet_panic("file is closed");
-    long pos = ftell(iof->file);
+    int64_t pos = ftell(iof->file);
     if (pos == -1) janet_panic("error getting position in file");
     return janet_wrap_number((double)pos);
 }

src/core/net.c

@@ -152,7 +152,7 @@ void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
         if (res == 0) {
             janet_schedule(fiber, janet_wrap_abstract(stream));
         } else {
-            janet_cancel(fiber, janet_cstringv(strerror(res)));
+            janet_cancel(fiber, janet_cstringv(janet_strerror(res)));
             stream->flags |= JANET_STREAM_TOCLOSE;
         }
     } else {
@@ -1035,7 +1035,7 @@ JANET_CORE_FN(cfun_net_setsockopt,
 
     int r = setsockopt((JSock) stream->handle, st->level, st->optname, optval, optlen);
     if (r == -1) {
-        janet_panicf("setsockopt(%q): %s", argv[1], strerror(errno));
+        janet_panicf("setsockopt(%q): %s", argv[1], janet_strerror(errno));
     }
 
     return janet_wrap_nil();

src/core/os.c

@@ -38,23 +38,14 @@
 #include <string.h>
 #include <sys/stat.h>
 #include <signal.h>
-
+#include <locale.h>
 
 #ifdef JANET_BSD
 #include <sys/sysctl.h>
 #endif
 
-#if defined(__FreeBSD__) || defined(__DragonFly__) || defined(JANET_APPLE)
-/* It seems only some bsds use this header for xlocale */
-#include <xlocale.h>
-#define JANET_EXTENDED_LOCALE
-#else
-#include <locale.h>
-#endif
-
 #ifdef JANET_LINUX
 #include <sched.h>
-#define JANET_EXTENDED_LOCALE
 #endif
 
 #ifdef JANET_WINDOWS
@@ -771,7 +762,7 @@ JANET_CORE_FN(os_proc_kill,
     }
     int status = kill(proc->pid, signal == -1 ? SIGKILL : signal);
     if (status) {
-        janet_panic(strerror(errno));
+        janet_panic(janet_strerror(errno));
     }
 #endif
     /* After killing process we wait on it. */
@@ -1284,7 +1275,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
                 status = execv(cargv[0], cargv);
             }
         } while (status == -1 && errno == EINTR);
-        janet_panicf("%p: %s", cargv[0], strerror(errno ? errno : ENOENT));
+        janet_panicf("%p: %s", cargv[0], janet_strerror(errno ? errno : ENOENT));
 #endif
     }
 
@@ -1341,7 +1332,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
     os_execute_cleanup(envp, child_argv);
     if (status) {
         /* correct for macos bug where errno is not set */
-        janet_panicf("%p: %s", argv[0], strerror(errno ? errno : ENOENT));
+        janet_panicf("%p: %s", argv[0], janet_strerror(errno ? errno : ENOENT));
     }
 
 #endif
@@ -1442,7 +1433,7 @@ JANET_CORE_FN(os_posix_fork,
         result = fork();
     } while (result == -1 && errno == EINTR);
     if (result == -1) {
-        janet_panic(strerror(errno));
+        janet_panic(janet_strerror(errno));
     }
     if (result) {
         JanetProc *proc = janet_abstract(&ProcAT, sizeof(JanetProc));
@@ -1654,7 +1645,7 @@ JANET_CORE_FN(os_isatty,
     return janet_wrap_boolean(_isatty(fd));
 #else
     int fd = fileno(f);
-    if (fd == -1) janet_panic(strerror(errno));
+    if (fd == -1) janet_panic(janet_strerror(errno));
     return janet_wrap_boolean(isatty(fd));
 #endif
 }
@@ -1889,7 +1880,7 @@ JANET_CORE_FN(os_mktime,
     }
 
     if (t == (time_t) -1) {
-        janet_panicf("%s", strerror(errno));
+        janet_panicf("%s", janet_strerror(errno));
     }
 
     return janet_wrap_number((double)t);
@@ -1902,68 +1893,40 @@ JANET_CORE_FN(os_mktime,
 #endif
 
 JANET_CORE_FN(os_setlocale,
-              "(os/setlocale category &opt locale)",
+              "(os/setlocale &opt locale category)",
               "Set the system locale, which affects how dates and numbers are formatted. "
-              "Passing nil to locale will return the current locale.") {
-    janet_arity(argc, 1, 2);
-    const char *locale_name = janet_optcstring(argv, argc, 1, NULL);
-    int category_int = 0;
-#ifdef JANET_EXTENDED_LOCALE
-    if (janet_keyeq(argv[0], "all")) {
-        category_int = LC_ALL_MASK;
-    } else if (janet_keyeq(argv[0], "collate")) {
-        category_int = LC_COLLATE_MASK;
-    } else if (janet_keyeq(argv[0], "ctype")) {
-        category_int = LC_CTYPE_MASK;
-    } else if (janet_keyeq(argv[0], "monetary")) {
-        category_int = LC_MONETARY_MASK;
-    } else if (janet_keyeq(argv[0], "numeric")) {
-        category_int = LC_NUMERIC_MASK;
-    } else if (janet_keyeq(argv[0], "time")) {
-        category_int = LC_TIME_MASK;
-    } else {
-        janet_panicf("expected one of :all, :collate, :ctype, :monetary, :numeric, or :time, got %v", argv[0]);
-    }
-    if (locale_name == NULL) {
-        const char *old = setlocale(category_int, NULL);
-        if (old == NULL) return janet_wrap_nil();
-        return janet_cstringv(old);
-    }
-    /* Use newlocale instead of setlocale for per-thread behavior */
-    locale_t loc = newlocale(category_int, locale_name, 0);
-    if (loc == 0) {
-        janet_panicf("failed to make locale - %s", strerror(errno));
-    }
-    locale_t old_locale = uselocale(loc);
-    if (old_locale == 0) {
-        janet_panicf("failed to set locale - %s", strerror(errno));
-    }
-    if (old_locale != LC_GLOBAL_LOCALE) {
-        freelocale(old_locale);
-    }
-    return janet_wrap_nil();
-#else
-    if (janet_keyeq(argv[0], "all")) {
-        category_int = LC_ALL;
-    } else if (janet_keyeq(argv[0], "collate")) {
-        category_int = LC_COLLATE;
-    } else if (janet_keyeq(argv[0], "ctype")) {
-        category_int = LC_CTYPE;
-    } else if (janet_keyeq(argv[0], "monetary")) {
-        category_int = LC_MONETARY;
-    } else if (janet_keyeq(argv[0], "numeric")) {
-        category_int = LC_NUMERIC;
-    } else if (janet_keyeq(argv[0], "time")) {
-        category_int = LC_TIME;
-    } else {
-        janet_panicf("expected one of :all, :collate, :ctype, :monetary, :numeric, or :time, got %v", argv[0]);
+              "Passing nil to locale will return the current locale. Category can be one of:\n\n"
+              " * :all (default)\n"
+              " * :collate\n"
+              " * :ctype\n"
+              " * :monetary\n"
+              " * :numeric\n"
+              " * :time\n\n"
+              "Returns the new locale if set successfully, otherwise nil. Note that this will affect "
+              "other functions such as `os/strftime` and even `printf`.") {
+    janet_arity(argc, 0, 2);
+    const char *locale_name = janet_optcstring(argv, argc, 0, NULL);
+    int category_int = LC_ALL;
+    if (argc > 1 && !janet_checktype(argv[1], JANET_NIL)) {
+        if (janet_keyeq(argv[1], "all")) {
+            category_int = LC_ALL;
+        } else if (janet_keyeq(argv[1], "collate")) {
+            category_int = LC_COLLATE;
+        } else if (janet_keyeq(argv[1], "ctype")) {
+            category_int = LC_CTYPE;
+        } else if (janet_keyeq(argv[1], "monetary")) {
+            category_int = LC_MONETARY;
+        } else if (janet_keyeq(argv[1], "numeric")) {
+            category_int = LC_NUMERIC;
+        } else if (janet_keyeq(argv[1], "time")) {
+            category_int = LC_TIME;
+        } else {
+            janet_panicf("expected one of :all, :collate, :ctype, :monetary, :numeric, or :time, got %v", argv[1]);
+        }
     }
     const char *old = setlocale(category_int, locale_name);
-    if (old == NULL) {
-        janet_panicf("failed to set locale - %s", strerror(errno));
-    }
-    return janet_wrap_nil();
-#endif
+    if (old == NULL) return janet_wrap_nil();
+    return janet_cstringv(old);
 }
 
 JANET_CORE_FN(os_link,
@@ -1983,7 +1946,7 @@ JANET_CORE_FN(os_link,
     const char *oldpath = janet_getcstring(argv, 0);
     const char *newpath = janet_getcstring(argv, 1);
     int res = ((argc == 3 && janet_truthy(argv[2])) ? j_symlink : link)(oldpath, newpath);
-    if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath);
+    if (-1 == res) janet_panicf("%s: %s -> %s", janet_strerror(errno), oldpath, newpath);
     return janet_wrap_nil();
 #endif
 }
@@ -2002,7 +1965,7 @@ JANET_CORE_FN(os_symlink,
     const char *oldpath = janet_getcstring(argv, 0);
     const char *newpath = janet_getcstring(argv, 1);
     int res = j_symlink(oldpath, newpath);
-    if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath);
+    if (-1 == res) janet_panicf("%s: %s -> %s", janet_strerror(errno), oldpath, newpath);
     return janet_wrap_nil();
 #endif
 }
@@ -2024,7 +1987,7 @@ JANET_CORE_FN(os_mkdir,
 #endif
     if (res == 0) return janet_wrap_true();
     if (errno == EEXIST) return janet_wrap_false();
-    janet_panicf("%s: %s", strerror(errno), path);
+    janet_panicf("%s: %s", janet_strerror(errno), path);
 }
 
 JANET_CORE_FN(os_rmdir,
@@ -2038,7 +2001,7 @@ JANET_CORE_FN(os_rmdir,
 #else
     int res = rmdir(path);
 #endif
-    if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
+    if (-1 == res) janet_panicf("%s: %s", janet_strerror(errno), path);
     return janet_wrap_nil();
 }
 
@@ -2053,7 +2016,7 @@ JANET_CORE_FN(os_cd,
 #else
     int res = chdir(path);
 #endif
-    if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
+    if (-1 == res) janet_panicf("%s: %s", janet_strerror(errno), path);
     return janet_wrap_nil();
 }
 
@@ -2077,7 +2040,7 @@ JANET_CORE_FN(os_touch,
         bufp = NULL;
     }
     int res = utime(path, bufp);
-    if (-1 == res) janet_panic(strerror(errno));
+    if (-1 == res) janet_panic(janet_strerror(errno));
     return janet_wrap_nil();
 }
 
@@ -2087,7 +2050,7 @@ JANET_CORE_FN(os_remove,
     janet_fixarity(argc, 1);
     const char *path = janet_getcstring(argv, 0);
     int status = remove(path);
-    if (-1 == status) janet_panicf("%s: %s", strerror(errno), path);
+    if (-1 == status) janet_panicf("%s: %s", janet_strerror(errno), path);
     return janet_wrap_nil();
 }
 
@@ -2106,7 +2069,7 @@ JANET_CORE_FN(os_readlink,
     const char *path = janet_getcstring(argv, 0);
     ssize_t len = readlink(path, buffer, sizeof buffer);
     if (len < 0 || (size_t)len >= sizeof buffer)
-        janet_panicf("%s: %s", strerror(errno), path);
+        janet_panicf("%s: %s", janet_strerror(errno), path);
     return janet_stringv((const uint8_t *)buffer, len);
 #endif
 }
@@ -2401,7 +2364,7 @@ JANET_CORE_FN(os_chmod,
 #else
     int res = chmod(path, os_getmode(argv, 1));
 #endif
-    if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
+    if (-1 == res) janet_panicf("%s: %s", janet_strerror(errno), path);
     return janet_wrap_nil();
 }
 
@@ -2437,7 +2400,7 @@ JANET_CORE_FN(os_dir,
         janet_panicf("path too long: %s", dir);
     sprintf(pattern, "%s/*", dir);
     intptr_t res = _findfirst(pattern, &afile);
-    if (-1 == res) janet_panicv(janet_cstringv(strerror(errno)));
+    if (-1 == res) janet_panicv(janet_cstringv(janet_strerror(errno)));
     do {
         if (strcmp(".", afile.name) && strcmp("..", afile.name)) {
             janet_array_push(paths, janet_cstringv(afile.name));
@@ -2448,8 +2411,18 @@ JANET_CORE_FN(os_dir,
     /* Read directory items with opendir / readdir / closedir */
     struct dirent *dp;
     DIR *dfd = opendir(dir);
-    if (dfd == NULL) janet_panicf("cannot open directory %s", dir);
-    while ((dp = readdir(dfd)) != NULL) {
+    if (dfd == NULL) janet_panicf("cannot open directory %s: %s", dir, janet_strerror(errno));
+    for (;;) {
+        errno = 0;
+        dp = readdir(dfd);
+        if (dp == NULL) {
+            if (errno) {
+                int olderr = errno;
+                closedir(dfd);
+                janet_panicf("failed to read directory %s: %s", dir, janet_strerror(olderr));
+            }
+            break;
+        }
         if (!strcmp(dp->d_name, ".") || !strcmp(dp->d_name, "..")) {
             continue;
         }
@@ -2469,7 +2442,7 @@ JANET_CORE_FN(os_rename,
     const char *dest = janet_getcstring(argv, 1);
     int status = rename(src, dest);
     if (status) {
-        janet_panic(strerror(errno));
+        janet_panic(janet_strerror(errno));
     }
     return janet_wrap_nil();
 }
@@ -2489,7 +2462,7 @@ JANET_CORE_FN(os_realpath,
 #else
     char *dest = realpath(src, NULL);
 #endif
-    if (NULL == dest) janet_panicf("%s: %s", strerror(errno), src);
+    if (NULL == dest) janet_panicf("%s: %s", janet_strerror(errno), src);
     Janet ret = janet_cstringv(dest);
     janet_free(dest);
     return ret;
@@ -2820,8 +2793,5 @@ void janet_lib_os(JanetTable *env) {
 #endif
         JANET_REG_END
     };
-#if defined(JANET_WINDOWS) && !defined(JANET_REDUCED_OS)
-    _configthreadlocale(_ENABLE_PER_THREAD_LOCALE);
-#endif
     janet_core_cfuns_ext(env, NULL, os_cfuns);
 }

src/core/pp.c

@@ -379,15 +379,10 @@ static int print_jdn_one(struct pretty *S, Janet x, int depth) {
             break;
         case JANET_NUMBER:
             janet_buffer_ensure(S->buffer, S->buffer->count + BUFSIZE, 2);
-            int count = snprintf((char *) S->buffer->data + S->buffer->count, BUFSIZE, "%.17g", janet_unwrap_number(x));
-            /* fix locale issues with commas */
-            for (int i = 0; i < count; i++) {
-                char c = S->buffer->data[S->buffer->count + i];
-                if (c == ',' || c == '\'') {
-                    S->buffer->data[S->buffer->count + i] = '.';
-                }
-            }
-            S->buffer->count += count;
+            double num = janet_unwrap_number(x);
+            if (isnan(num)) return 1;
+            if (isinf(num)) return 1;
+            janet_buffer_dtostr(S->buffer, num);
             break;
         case JANET_SYMBOL:
         case JANET_KEYWORD:

src/core/specials.c

@@ -925,6 +925,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
     int structarg = 0;
     int allow_extra = 0;
     int selfref = 0;
+    int hasname = 0;
     int seenamp = 0;
     int seenopt = 0;
     int namedargs = 0;
@@ -943,6 +944,10 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
     head = argv[0];
     if (janet_checktype(head, JANET_SYMBOL)) {
         selfref = 1;
+        hasname = 1;
+        parami = 1;
+    } else if (janet_checktype(head, JANET_KEYWORD)) {
+        hasname = 1;
         parami = 1;
     }
     if (parami >= argn || !janet_checktype(argv[parami], JANET_TUPLE)) {
@@ -1103,7 +1108,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
     if (vararg) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
     if (structarg) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
 
-    if (selfref) def->name = janet_unwrap_symbol(head);
+    if (hasname) def->name = janet_unwrap_symbol(head); /* Also correctly unwraps keyword */
     janet_def_addflags(def);
     defindex = janetc_addfuncdef(c, def);
 

src/core/state.h

@@ -149,6 +149,11 @@ struct JanetVM {
     JanetTraversalNode *traversal_top;
     JanetTraversalNode *traversal_base;
 
+    /* Thread safe strerror error buffer - for janet_strerror */
+#ifndef JANET_WINDOWS
+    char strerror_buf[256];
+#endif
+
     /* Event loop and scheduler globals */
 #ifdef JANET_EV
     size_t tq_count;

src/core/strtod.c

@@ -490,3 +490,18 @@ int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out) {
 }
 
 #endif
+
+void janet_buffer_dtostr(JanetBuffer *buffer, double x) {
+#define BUFSIZE 32
+    janet_buffer_extra(buffer, BUFSIZE);
+    int count = snprintf((char *) buffer->data + buffer->count, BUFSIZE, "%.17g", x);
+#undef BUFSIZE
+    /* fix locale issues with commas */
+    for (int i = 0; i < count; i++) {
+        char c = buffer->data[buffer->count + i];
+        if (c == ',') {
+            buffer->data[buffer->count + i] = '.';
+        }
+    }
+    buffer->count += count;
+}

src/core/table.c

@@ -319,13 +319,6 @@ JANET_CORE_FN(cfun_table_new,
     int32_t cap = janet_getnat(argv, 0);
     return janet_wrap_table(janet_table(cap));
 }
-/*
-    uint32_t flags = janet_getflags(argv, 1, "kv");
-    if (flags == 0) return janet_wrap_table(janet_table(cap));
-    if (flags == 1) return janet_wrap_table(janet_table_weakk(cap));
-    if (flags == 2) return janet_wrap_table(janet_table_weakv(cap));
-    return janet_wrap_table(janet_table_weakkv(cap));
-    */
 
 JANET_CORE_FN(cfun_table_weak,
               "(table/weak capacity)",

src/core/util.c

@@ -826,6 +826,20 @@ int janet_checkuint64(Janet x) {
     return janet_checkuint64range(dval);
 }
 
+int janet_checkint16(Janet x) {
+    if (!janet_checktype(x, JANET_NUMBER))
+        return 0;
+    double dval = janet_unwrap_number(x);
+    return janet_checkint16range(dval);
+}
+
+int janet_checkuint16(Janet x) {
+    if (!janet_checktype(x, JANET_NUMBER))
+        return 0;
+    double dval = janet_unwrap_number(x);
+    return janet_checkuint16range(dval);
+}
+
 int janet_checksize(Janet x) {
     if (!janet_checktype(x, JANET_NUMBER))
         return 0;
@@ -953,6 +967,20 @@ int janet_gettime(struct timespec *spec, enum JanetTimeSource source) {
 #endif
 #endif
 
+/* Better strerror (thread-safe if available) */
+const char *janet_strerror(int e) {
+#ifdef JANET_WINDOWS
+    /* Microsoft strerror seems sane here and is thread safe by default */
+    return strerror(e);
+#elif defined(_GNU_SOURCE)
+    /* See https://linux.die.net/man/3/strerror_r */
+    return strerror_r(e, janet_vm.strerror_buf, sizeof(janet_vm.strerror_buf));
+#else
+    strerror_r(e, janet_vm.strerror_buf, sizeof(janet_vm.strerror_buf));
+    return janet_vm.strerror_buf;
+#endif
+}
+
 /* Setting C99 standard makes this not available, but it should
  * work/link properly if we detect a BSD */
 #if defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)

src/core/util.h

@@ -80,6 +80,8 @@ void janet_memempty(JanetKV *mem, int32_t count);
 void *janet_memalloc_empty(int32_t count);
 JanetTable *janet_get_core_table(const char *name);
 void janet_def_addflags(JanetFuncDef *def);
+void janet_buffer_dtostr(JanetBuffer *buffer, double x);
+const char *janet_strerror(int e);
 const void *janet_strbinsearch(
     const void *tab,
     size_t tabcount,

src/core/vm.c

@@ -318,7 +318,7 @@ static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lh
         Janet lr = janet_method_lookup(rhs, rmethod);
         Janet argv[2] = { rhs, lhs };
         if (janet_checktype(lr, JANET_NIL)) {
-            janet_panicf("could not find method :%s for %v, or :%s for %v",
+            janet_panicf("could not find method :%s for %v or :%s for %v",
                          lmethod, lhs,
                          rmethod, rhs);
         }

src/include/janet.h

@@ -897,12 +897,16 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
 /* End of tagged union implementation */
 #endif
 
+JANET_API int janet_checkint16(Janet x);
+JANET_API int janet_checkuint16(Janet x);
 JANET_API int janet_checkint(Janet x);
 JANET_API int janet_checkuint(Janet x);
 JANET_API int janet_checkint64(Janet x);
 JANET_API int janet_checkuint64(Janet x);
 JANET_API int janet_checksize(Janet x);
 JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at);
+#define janet_checkint16range(x) ((x) >= INT16_MIN && (x) <= INT16_MAX && (x) == (int16_t)(x))
+#define janet_checkuint16range(x) ((x) >= 0 && (x) <= UINT16_MAX && (x) == (uint16_t)(x))
 #define janet_checkintrange(x) ((x) >= INT32_MIN && (x) <= INT32_MAX && (x) == (int32_t)(x))
 #define janet_checkuintrange(x) ((x) >= 0 && (x) <= UINT32_MAX && (x) == (uint32_t)(x))
 #define janet_checkint64range(x) ((x) >= JANET_INTMIN_DOUBLE && (x) <= JANET_INTMAX_DOUBLE && (x) == (int64_t)(x))
@@ -2020,7 +2024,10 @@ JANET_API void *janet_getpointer(const Janet *argv, int32_t n);
 
 JANET_API int32_t janet_getnat(const Janet *argv, int32_t n);
 JANET_API int32_t janet_getinteger(const Janet *argv, int32_t n);
+JANET_API int16_t janet_getinteger16(const Janet *argv, int32_t n);
 JANET_API int64_t janet_getinteger64(const Janet *argv, int32_t n);
+JANET_API uint32_t janet_getuinteger(const Janet *argv, int32_t n);
+JANET_API uint16_t janet_getuinteger16(const Janet *argv, int32_t n);
 JANET_API uint64_t janet_getuinteger64(const Janet *argv, int32_t n);
 JANET_API size_t janet_getsize(const Janet *argv, int32_t n);
 JANET_API JanetView janet_getindexed(const Janet *argv, int32_t n);

test/suite-buffer.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2023 Calvin Rose
+# Copyright (c) 2024 Calvin Rose
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to
@@ -85,9 +85,11 @@
 (buffer/push-uint16 buffer-uint16-le :le 0x0102)
 (assert (= "\x02\x01" (string buffer-uint16-le)) "buffer/push-uint16 little endian")
 
-(def buffer-uint16-negative @"")
-(buffer/push-uint16 buffer-uint16-negative :be -1)
-(assert (= "\xff\xff" (string buffer-uint16-negative)) "buffer/push-uint16 negative")
+(def buffer-uint16-max @"")
+(buffer/push-uint16 buffer-uint16-max :be 0xFFFF)
+(assert (= "\xff\xff" (string buffer-uint16-max)) "buffer/push-uint16 max")
+(assert-error "too large" (buffer/push-uint16 @"" 0x1FFFF))
+(assert-error "too small" (buffer/push-uint16 @"" -0x1))
 
 (def buffer-uint32-be @"")
 (buffer/push-uint32 buffer-uint32-be :be 0x01020304)
@@ -97,9 +99,9 @@
 (buffer/push-uint32 buffer-uint32-le :le 0x01020304)
 (assert (= "\x04\x03\x02\x01" (string buffer-uint32-le)) "buffer/push-uint32 little endian")
 
-(def buffer-uint32-negative @"")
-(buffer/push-uint32 buffer-uint32-negative :be -1)
-(assert (= "\xff\xff\xff\xff" (string buffer-uint32-negative)) "buffer/push-uint32 negative")
+(def buffer-uint32-max @"")
+(buffer/push-uint32 buffer-uint32-max :be 0xFFFFFFFF)
+(assert (= "\xff\xff\xff\xff" (string buffer-uint32-max)) "buffer/push-uint32 max")
 
 (def buffer-float32-be @"")
 (buffer/push-float32 buffer-float32-be :be 1.234)

test/suite-bundle.janet

@@ -0,0 +1,125 @@
+# Copyright (c) 2024 Calvin Rose
+#
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to
+# deal in the Software without restriction, including without limitation the
+# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+# sell copies of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
+# IN THE SOFTWARE.
+
+(import ./helper :prefix "" :exit true)
+(start-suite)
+
+(assert true) # smoke test
+
+# Copy since not exposed in boot.janet
+(defn- bundle-rpath
+  [path]
+  (string/replace-all "\\" "/" (os/realpath path)))
+
+(defn- rmrf
+  "rm -rf in janet"
+  [x]
+  (case (os/lstat x :mode)
+    nil nil
+    :directory (do
+                 (each y (os/dir x)
+                   (rmrf (string x "/" y)))
+                 (os/rmdir x))
+    (os/rm x))
+  nil)
+
+# Test mkdir -> rmdir
+(assert (os/mkdir "tempdir123"))
+(rmrf "tempdir123")
+
+# Setup a temporary syspath for manipultation
+(math/seedrandom (os/cryptorand 16))
+(def syspath (string (math/random) "_jpm_tree.tmp"))
+(rmrf syspath)
+(assert (os/mkdir syspath))
+(put root-env *syspath* (bundle-rpath syspath))
+(unless (os/getenv "VERBOSE")
+  (setdyn *out* @""))
+(assert (empty? (bundle/list)) "initial bundle/list")
+(assert (empty? (bundle/topolist)) "initial bundle/topolist")
+
+# Try (and fail) to install sample-bundle (missing deps)
+(assert-error "missing dependencies sample-dep1, sample-dep2"
+              (bundle/install "./examples/sample-bundle"))
+(assert (empty? (bundle/list)))
+
+# Install deps (dep1 as :auto-remove)
+(assert-no-error "sample-dep2"
+                 (bundle/install "./examples/sample-dep2"))
+(assert (= 1 (length (bundle/list))))
+(assert-no-error "sample-dep1" (bundle/install "./examples/sample-dep1"))
+(assert (= 2 (length (bundle/list))))
+
+(assert-no-error "sample-dep2 reinstall" (bundle/reinstall "sample-dep2"))
+(assert-no-error "sample-dep1 reinstall" (bundle/reinstall "sample-dep1" :auto-remove true))
+
+(assert (= 2 (length (bundle/list))) "bundles are listed correctly 1")
+(assert (= 2 (length (bundle/topolist))) "bundles are listed correctly 2")
+
+# Now install sample-bundle
+(assert-no-error "sample-bundle install" (bundle/install "./examples/sample-bundle"))
+
+(assert-error "" (bundle/install "./examples/sample-dep11111"))
+
+(assert (= 3 (length (bundle/list))) "bundles are listed correctly 3")
+(assert (= 3 (length (bundle/topolist))) "bundles are listed correctly 4")
+
+# Check topolist has not bad order
+(def tlist (bundle/topolist))
+(assert (> (index-of "sample-bundle" tlist) (index-of "sample-dep2" tlist)) "topolist 1")
+(assert (> (index-of "sample-bundle" tlist) (index-of "sample-dep1" tlist)) "topolist 2")
+(assert (> (index-of "sample-dep1" tlist) (index-of "sample-dep2" tlist)) "topolist 3")
+
+# Prune should do nothing
+(assert-no-error "first prune" (bundle/prune))
+(assert (= 3 (length (bundle/list))) "bundles are listed correctly 3")
+(assert (= 3 (length (bundle/topolist))) "bundles are listed correctly 4")
+
+# Check that we can import the main dependency
+(import mymod)
+(assert (= 288 (mymod/myfn 12)) "using sample-bundle")
+
+# Manual uninstall of dep1 and dep2 shouldn't work either since that would break dependencies
+(assert-error "cannot uninstall sample-dep1, breaks dependent bundles @[\"sample-bundle\"]"
+              (bundle/uninstall "sample-dep1"))
+
+# Now re-install sample-bundle as auto-remove
+(assert-no-error "sample-bundle install" (bundle/reinstall "sample-bundle" :auto-remove true))
+
+# Reinstallation should also work without being concerned about breaking dependencies
+(assert-no-error "reinstall dep" (bundle/reinstall "sample-dep2"))
+
+# Now prune should get rid of everything except sample-dep2
+(assert-no-error "second prune" (bundle/prune))
+
+# Now check that we exactly one package left, which is dep2
+(assert (= 1 (length (bundle/list))) "bundles are listed correctly 5")
+(assert (= 1 (length (bundle/topolist))) "bundles are listed correctly 6")
+
+# Which we can uninstall manually
+(assert-no-error "uninstall dep2" (bundle/uninstall "sample-dep2"))
+
+# Now check bundle listing is again empty
+(assert (= 0 (length (bundle/list))) "bundles are listed correctly 7")
+(assert (= 0 (length (bundle/topolist))) "bundles are listed correctly 8")
+
+(rmrf syspath)
+
+(end-suite)

test/suite-value.janet

@@ -42,7 +42,7 @@
 
 (defn buffer-factory
   []
-  @"im am a buffer")
+  @"i am a buffer")
 
 (assert (not= (buffer-factory) (buffer-factory)) "buffer instantiation")