Prepare for 1.30.0 release.

Move `range` to corelib

.github/workflows/test.yml

@@ -74,3 +74,18 @@ jobs:
         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
+
+  test-arm-linux:
+    name: Build and test ARM32 cross compilation
+    runs-on: ubuntu-latest
+    steps:
+      - name: Checkout the repository
+        uses: actions/checkout@master
+      - name: Setup qemu and cross compiler
+        run: |
+          sudo apt-get update
+          sudo apt-get install gcc-arm-linux-gnueabi qemu-user
+      - 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

CHANGELOG.md

@@ -1,7 +1,34 @@
 # Changelog
 All notable changes to this project will be documented in this file.
 
-## ??? - Unreleased
+## 1.30.0 - 2023-08-05
+- Change indexing of `array/remove` to start from -1 at the end instead of -2.
+- Add new string escape sequences `\\a`, `\\b`, `\\?`, and `\\'`.
+- Fix bug with marshalling channels
+- Add `div` for floored division
+- Make `div` and `mod` variadic
+- Support `bnot` for integer types.
+- Define `(mod x 0)` as `x`
+- Add `ffi/pointer-cfunction` to convert pointers to cfunctions
+
+## 1.29.1 - 2023-06-19
+- Add support for passing booleans to PEGs for "always" and "never" matching.
+- Allow dictionary types for `take` and `drop`
+- Fix bug with closing channels while other fibers were waiting on them - `ev/take`, `ev/give`, and `ev/select`  will now return the correct (documented) value when another fiber closes the channel.
+- Add `ffi/calling-conventions` to show all available calling conventions for FFI.
+- Add `net/setsockopt`
+- Add `signal` argument to `os/proc-kill` to send signals besides `SIGKILL` on Posix.
+- Add `source` argument to `os/clock` to get different time sources.
+- Various combinator functions now are variadic like `map`
+- Add `file/lines` to iterate over lines in a file lazily.
+- Reorganize test suite to be sorted by module rather than pseudo-randomly.
+- Add `*task-id*`
+- Add `env` argument to `fiber/new`.
+- Add `JANET_NO_AMALG` flag to Makefile to properly incremental builds
+- Optimize bytecode compiler to generate fewer instructions and improve loops.
+- Fix bug with `ev/gather` and hung fibers.
+- Add `os/isatty`
+- Add `has-key?` and `has-value?`
 - Make imperative arithmetic macros variadic
 - `ev/connect` now yields to the event loop instead of blocking while waiting for an ACK.
 

Makefile

@@ -39,6 +39,8 @@ JANET_PATH?=$(LIBDIR)/janet
 JANET_MANPATH?=$(PREFIX)/share/man/man1/
 JANET_PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
 JANET_DIST_DIR?=janet-dist
+JANET_BOOT_FLAGS:=. JANET_PATH '$(JANET_PATH)'
+JANET_TARGET_OBJECTS=build/janet.o build/shell.o
 JPM_TAG?=master
 DEBUGGER=gdb
 SONAME_SETTER=-Wl,-soname,
@@ -46,6 +48,7 @@ SONAME_SETTER=-Wl,-soname,
 # For cross compilation
 HOSTCC?=$(CC)
 HOSTAR?=$(AR)
+# Symbols are (optionally) removed later, keep -g as default!
 CFLAGS?=-O2 -g
 LDFLAGS?=-rdynamic
 RUN:=$(RUN)
@@ -54,6 +57,12 @@ COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidd
 BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) -O0 $(COMMON_CFLAGS) -g
 BUILD_CFLAGS:=$(CFLAGS) $(COMMON_CFLAGS)
 
+# Disable amalgamated build
+ifeq ($(JANET_NO_AMALG), 1)
+	JANET_TARGET_OBJECTS+=$(patsubst src/%.c,build/%.bin.o,$(JANET_CORE_SOURCES))
+	JANET_BOOT_FLAGS+=image-only
+endif
+
 # For installation
 LDCONFIG:=ldconfig "$(LIBDIR)"
 
@@ -88,7 +97,7 @@ ifeq ($(findstring MINGW,$(UNAME)), MINGW)
 	JANET_BOOT:=$(JANET_BOOT).exe
 endif
 
-$(shell mkdir -p build/core build/c build/boot)
+$(shell mkdir -p build/core build/c build/boot build/mainclient)
 all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.h
 
 ######################
@@ -172,17 +181,24 @@ $(JANET_BOOT): $(JANET_BOOT_OBJECTS)
 
 # Now the reason we bootstrap in the first place
 build/c/janet.c: $(JANET_BOOT) src/boot/boot.janet
-	$(RUN) $(JANET_BOOT) . JANET_PATH '$(JANET_PATH)' > $@
+	$(RUN) $(JANET_BOOT) $(JANET_BOOT_FLAGS) > $@
 	cksum $@
 
+##################
+##### Quicky #####
+##################
+
+build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
+	$(HOSTCC) $(BUILD_CFLAGS) -o $@ -c $<
+
 ########################
 ##### Amalgamation #####
 ########################
 
 ifeq ($(UNAME), Darwin)
-SONAME=libjanet.1.28.dylib
+SONAME=libjanet.1.30.dylib
 else
-SONAME=libjanet.so.1.28
+SONAME=libjanet.so.1.30
 endif
 
 build/c/shell.c: src/mainclient/shell.c
@@ -200,13 +216,13 @@ build/janet.o: build/c/janet.c $(JANETCONF_HEADER) src/include/janet.h
 build/shell.o: build/c/shell.c $(JANETCONF_HEADER) src/include/janet.h
 	$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@
 
-$(JANET_TARGET): build/janet.o build/shell.o
+$(JANET_TARGET): $(JANET_TARGET_OBJECTS)
 	$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) -o $@ $^ $(CLIBS)
 
-$(JANET_LIBRARY): build/janet.o build/shell.o
+$(JANET_LIBRARY): $(JANET_TARGET_OBJECTS)
 	$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
 
-$(JANET_STATIC_LIBRARY): build/janet.o build/shell.o
+$(JANET_STATIC_LIBRARY): $(JANET_TARGET_OBJECTS)
 	$(HOSTAR) rcs $@ $^
 
 ###################
@@ -251,6 +267,7 @@ build/janet-%.tar.gz: $(JANET_TARGET) \
 	README.md build/c/janet.c build/c/shell.c
 	mkdir -p build/$(JANET_DIST_DIR)/bin
 	cp $(JANET_TARGET) build/$(JANET_DIST_DIR)/bin/
+	strip -x -S 'build/$(JANET_DIST_DIR)/bin/janet'
 	mkdir -p build/$(JANET_DIST_DIR)/include
 	cp build/janet.h build/$(JANET_DIST_DIR)/include/
 	mkdir -p build/$(JANET_DIST_DIR)/lib/
@@ -293,7 +310,7 @@ build/janet.pc: $(JANET_TARGET)
 install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc build/janet.h
 	mkdir -p '$(DESTDIR)$(BINDIR)'
 	cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
-	strip '$(DESTDIR)$(BINDIR)/janet'
+	strip -x -S '$(DESTDIR)$(BINDIR)/janet'
 	mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
 	cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet'
 	ln -sf ./janet/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet.h'
@@ -342,14 +359,14 @@ uninstall:
 #################
 
 format:
-	tools/format.sh
+	sh tools/format.sh
 
 grammar: build/janet.tmLanguage
 build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
 	$(RUN) $(JANET_TARGET) $< > $@
 
 compile-commands:
-	# Requires pip install copmiledb
+	# Requires pip install compiledb
 	compiledb make
 
 clean:

README.md

@@ -6,10 +6,12 @@
 
 <img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
 
-**Janet** is a functional and imperative programming language and bytecode interpreter. It is a
-Lisp-like language, but lists are replaced
-by other data structures (arrays, tables (hash table), struct (immutable hash table), tuples).
-The language also supports bridging to native code written in C, meta-programming with macros, and bytecode assembly.
+**Janet** is a programming language for system scripting, expressive automation, and
+extending programs written in C or C++ with user scripting capabilities.
+
+Janet makes a good system scripting language, or a language to embed in other programs.
+It's like Lua and GNU Guile in that regard. It has more built-in functionality and a richer core language than
+Lua, but smaller than GNU Guile or Python. However, it is much easier to embed and port than Python or Guile.
 
 There is a REPL for trying out the language, as well as the ability
 to run script files. This client program is separate from the core runtime, so
@@ -21,38 +23,109 @@ If you'd like to financially support the ongoing development of Janet, consider
 
 <br>
 
-## Use Cases
+## Examples
 
-Janet makes a good system scripting language, or a language to embed in other programs.
-It's like Lua and Guile in that regard. It has more built-in functionality and a richer core language than
-Lua, but smaller than GNU Guile or Python.
+See the examples directory for all provided example programs.
 
-## Features
+### Game of Life
 
-* Configurable at build time - turn features on or off for a smaller or more featureful build
-* Minimal setup - one binary and you are good to go!
+```janet
+# John Conway's Game of Life
+
+(def- window
+  (seq [x :range [-1 2]
+         y :range [-1 2]
+         :when (not (and (zero? x) (zero? y)))]
+       [x y]))
+
+(defn- neighbors
+  [[x y]]
+  (map (fn [[x1 y1]] [(+ x x1) (+ y y1)]) window))
+
+(defn tick
+  "Get the next state in the Game Of Life."
+  [state]
+  (def cell-set (frequencies state))
+  (def neighbor-set (frequencies (mapcat neighbors state)))
+  (seq [coord :keys neighbor-set
+         :let [count (get neighbor-set coord)]
+         :when (or (= count 3) (and (get cell-set coord) (= count 2)))]
+      coord))
+
+(defn draw
+  "Draw cells in the game of life from (x1, y1) to (x2, y2)"
+  [state x1 y1 x2 y2]
+  (def cellset @{})
+  (each cell state (put cellset cell true))
+  (loop [x :range [x1 (+ 1 x2)]
+         :after (print)
+         y :range [y1 (+ 1 y2)]]
+    (file/write stdout (if (get cellset [x y]) "X " ". ")))
+  (print))
+
+# Print the first 20 generations of a glider
+(var *state* '[(0 0) (-1 0) (1 0) (1 1) (0 2)])
+(for i 0 20
+  (print "generation " i)
+  (draw *state* -7 -7 7 7)
+  (set *state* (tick *state*)))
+```
+
+### TCP Echo Server
+
+```janet
+# A simple TCP echo server using the built-in socket networking and event loop.
+
+(defn handler
+  "Simple handler for connections."
+  [stream]
+  (defer (:close stream)
+    (def id (gensym))
+    (def b @"")
+    (print "Connection " id "!")
+    (while (:read stream 1024 b)
+      (printf " %v -> %v" id b)
+      (:write stream b)
+      (buffer/clear b))
+    (printf "Done %v!" id)
+    (ev/sleep 0.5)))
+
+(net/server "127.0.0.1" "8000" handler)
+```
+
+### Windows FFI Hello, World!
+
+```janet
+# Use the FFI to popup a Windows message box - no C required
+
+(ffi/context "user32.dll")
+
+(ffi/defbind MessageBoxA :int
+  [w :ptr text :string cap :string typ :int])
+
+(MessageBoxA nil "Hello, World!" "Test" 0)
+```
+
+## Language Features
+
+* 600+ functions and macros in the core library
+* Built-in socket networking, threading, subprocesses, and file system functions.
+* Parsing Expression Grammars (PEG) engine as a more robust Regex alternative
+* Macros and compile-time computation
+* Per-thread event loop for efficient IO (epoll/IOCP/kqueue)
+* First-class green threads (continuations) as well as OS threads
+* Erlang-style supervision trees that integrate with the event loop
 * First-class closures
 * Garbage collection
-* First-class green threads (continuations)
+* Distributed as janet.c and janet.h for embedding into a larger program.
 * Python-style generators (implemented as a plain macro)
 * Mutable and immutable arrays (array/tuple)
 * Mutable and immutable hashtables (table/struct)
 * Mutable and immutable strings (buffer/string)
-* Macros
-* Multithreading
-* Per-thread event loop for efficient evented IO
-* Bytecode interpreter with an assembly interface, as well as bytecode verification
-* Tail-call optimization
-* Direct interop with C via abstract types and C functions
-* Dynamically load C libraries
-* Functional and imperative standard library
-* Lexical scoping
-* Imperative programming as well as functional
-* REPL
-* Parsing Expression Grammars built into the core library
-* 400+ functions and macros in the core library
-* Embedding Janet in other programs
-* Interactive environment with detailed stack traces
+* Tail recursion
+* Interface with C functions and dynamically load plugins ("natives").
+* Built-in C FFI for when the native bindings are too much work
+* REPL development with debugger and inspectable runtime
 
 ## Documentation
 
@@ -240,10 +313,6 @@ there is no need for dynamic modules, add the define
 
 See the [Embedding Section](https://janet-lang.org/capi/embedding.html) on the website for more information.
 
-## Examples
-
-See the examples directory for some example Janet code.
-
 ## Discussion
 
 Feel free to ask questions and join the discussion on the [Janet Gitter channel](https://gitter.im/janet-language/community).
@@ -251,6 +320,20 @@ Gitter provides Matrix and IRC bridges as well.
 
 ## FAQ
 
+### How fast is it?
+
+It is about the same speed as most interpreted languages without a JIT compiler. Tight, critical
+loops should probably be written in C or C++ . Programs tend to be a bit faster than
+they would be in a language like Python due to the discouragement of slow Object-Oriented abstraction
+with lots of hash-table lookups, and making late-binding explicit. All values are boxed in an 8-byte
+representation by default and allocated on the heap, with the exception of numbers, nils and booleans. The
+PEG engine is a specialized interpreter that can efficiently process string and buffer data.
+
+The GC is simple and stop-the-world, but GC knobs are exposed in the core library and separate threads
+have isolated heaps and garbage collectors. Data that is shared between threads is reference counted.
+
+YMMV.
+
 ### Where is (favorite feature from other language)?
 
 It may exist, it may not. If you want to propose a major language feature, go ahead and open an issue, but
@@ -268,7 +351,7 @@ Nope. There are no cons cells here.
 ### Is this a Clojure port?
 
 No. It's similar to Clojure superficially because I like Lisps and I like the aesthetics.
-Internally, Janet is not at all like Clojure.
+Internally, Janet is not at all like Clojure, Scheme, or Common Lisp.
 
 ### Are the immutable data structures (tuples and structs) implemented as hash tries?
 
@@ -297,6 +380,14 @@ Usually, one of a few reasons:
   without feeling "bolted on", especially when compared to ALGOL-like languages. Adding features
   to the core also makes it a bit more difficult to keep Janet maximally portable.
 
+### Can I bind to Rust/Zig/Go/Java/Nim/C++/D/Pascal/Fortran/Odin/Jai/(Some new "Systems" Programming Language)?
+
+Probably, if that language has a good interface with C. But the programmer may need to do
+some extra work to map Janet's internal memory model may need some to that of the bound language. Janet
+also uses `setjmp`/`longjmp` for non-local returns internally. This
+approach is out of favor with many programmers now and doesn't always play well with other languages
+that have exceptions or stack-unwinding.
+
 ### Why is my terminal spitting out junk when I run the REPL?
 
 Make sure your terminal supports ANSI escape codes. Most modern terminals will

examples/ffi/so.c

@@ -78,7 +78,6 @@ double double_lots(
     return i + j;
 }
 
-
 EXPORTER
 double double_lots_2(
     double a,
@@ -204,5 +203,3 @@ EXPORTER
 int sixints_fn_3(SixInts s, int x) {
     return x + s.u + s.v + s.w + s.x + s.y + s.z;
 }
-
-

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.28.0')
+  version : '1.30.0')
 
 # Global settings
 janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@@ -227,21 +227,34 @@ docs = custom_target('docs',
 
 # Tests
 test_files = [
-  'test/suite0000.janet',
-  'test/suite0001.janet',
-  'test/suite0002.janet',
-  'test/suite0003.janet',
-  'test/suite0004.janet',
-  'test/suite0005.janet',
-  'test/suite0006.janet',
-  'test/suite0007.janet',
-  'test/suite0008.janet',
-  'test/suite0009.janet',
-  'test/suite0010.janet',
-  'test/suite0011.janet',
-  'test/suite0012.janet',
-  'test/suite0013.janet',
-  'test/suite0014.janet'
+  'test/suite-array.janet',
+  'test/suite-asm.janet',
+  'test/suite-boot.janet',
+  'test/suite-buffer.janet',
+  'test/suite-capi.janet',
+  'test/suite-cfuns.janet',
+  'test/suite-compile.janet',
+  'test/suite-corelib.janet',
+  'test/suite-debug.janet',
+  'test/suite-ev.janet',
+  'test/suite-ffi.janet',
+  'test/suite-inttypes.janet',
+  'test/suite-io.janet',
+  'test/suite-marsh.janet',
+  'test/suite-math.janet',
+  'test/suite-os.janet',
+  'test/suite-parse.janet',
+  'test/suite-peg.janet',
+  'test/suite-pp.janet',
+  'test/suite-specials.janet',
+  'test/suite-string.janet',
+  'test/suite-strtod.janet',
+  'test/suite-struct.janet',
+  'test/suite-symcache.janet',
+  'test/suite-table.janet',
+  'test/suite-unknown.janet',
+  'test/suite-value.janet',
+  'test/suite-vm.janet'
 ]
 foreach t : test_files
   test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir())

src/boot/boot.janet

@@ -151,7 +151,7 @@
 (defmacro -= "Decrements the var x by n." [x & ns] ~(set ,x (,- ,x ,;ns)))
 (defmacro *= "Shorthand for (set x (\\* x n))." [x & ns] ~(set ,x (,* ,x ,;ns)))
 (defmacro /= "Shorthand for (set x (/ x n))." [x & ns] ~(set ,x (,/ ,x ,;ns)))
-(defmacro %= "Shorthand for (set x (% x n))." [x n] ~(set ,x (,% ,x ,n)))
+(defmacro %= "Shorthand for (set x (% x n))." [x & ns] ~(set ,x (,% ,x ,;ns)))
 
 (defmacro assert
   "Throw an error if x is not truthy. Will not evaluate `err` if x is truthy."
@@ -445,7 +445,7 @@
            ,(case kind
               :each ~(,in ,ds ,k)
               :keys k
-              :pairs ~(,tuple ,k (,in ,ds ,k))))
+              :pairs ~[,k (,in ,ds ,k)]))
          ,;body
          (set ,k (,next ,ds ,k))))))
 
@@ -668,28 +668,20 @@
   (def len (length bindings))
   (if (= 0 len) (error "expected at least 1 binding"))
   (if (odd? len) (error "expected an even number of bindings"))
+  (def res (gensym))
   (defn aux [i]
     (if (>= i len)
-      tru
+      ~(do (set ,res ,tru) true)
       (do
         (def bl (in bindings i))
         (def br (in bindings (+ 1 i)))
-        (def atm (idempotent? bl))
-        (def sym (if atm bl (gensym)))
-        (if atm
-          # Simple binding
-          (tuple 'do
-                 (tuple 'def sym br)
-                 (tuple 'if sym (aux (+ 2 i)) fal))
-          # Destructured binding
-          (tuple 'do
-                 (tuple 'def sym br)
-                 (tuple 'if sym
-                        (tuple 'do
-                               (tuple 'def bl sym)
-                               (aux (+ 2 i)))
-                        fal))))))
-  (aux 0))
+        (if (symbol? bl)
+          ~(if (def ,bl ,br) ,(aux (+ 2 i)))
+          ~(if (def ,(def sym (gensym)) ,br)
+             (do (def ,bl ,sym) ,(aux (+ 2 i))))))))
+  ~(do
+     (var ,res nil)
+     (if ,(aux 0) ,res ,fal)))
 
 (defmacro when-let
   "Same as `(if-let bindings (do ;body))`."
@@ -939,37 +931,37 @@
   indexed beyond the first.`
   [n maptype res f ind inds]
   ~(do
-    (def ,(seq [k :range [0 n]] (symbol 'ind k)) ,inds)
-    ,;(seq [k :range [0 n]] ~(var ,(symbol 'key k) nil))
-    (each x ,ind
-      ,;(seq [k :range [0 n]]
-        ~(if (= nil (set ,(symbol 'key k) (next ,(symbol 'ind k) ,(symbol 'key k)))) (break)))
-      (map-aggregator ,maptype ,res (,f x ,;(seq [k :range [0 n]] ~(in ,(symbol 'ind k) ,(symbol 'key k))))))))
+     (def ,(seq [k :range [0 n]] (symbol 'ind k)) ,inds)
+     ,;(seq [k :range [0 n]] ~(var ,(symbol 'key k) nil))
+     (each x ,ind
+       ,;(seq [k :range [0 n]]
+           ~(if (= nil (set ,(symbol 'key k) (next ,(symbol 'ind k) ,(symbol 'key k)))) (break)))
+       (map-aggregator ,maptype ,res (,f x ,;(seq [k :range [0 n]] ~(in ,(symbol 'ind k) ,(symbol 'key k))))))))
 
 (defmacro- map-template
   [maptype res f ind inds]
   ~(do
-    (def ninds (length ,inds))
-    (case ninds
-      0 (each x ,ind (map-aggregator ,maptype ,res (,f x)))
-      1 (map-n 1 ,maptype ,res ,f ,ind ,inds)
-      2 (map-n 2 ,maptype ,res ,f ,ind ,inds)
-      3 (map-n 3 ,maptype ,res ,f ,ind ,inds)
-      4 (map-n 4 ,maptype ,res ,f ,ind ,inds)
-      (do
-        (def iter-keys (array/new-filled ninds))
-        (def call-buffer (array/new-filled ninds))
-        (var done false)
-        (each x ,ind
-          (forv i 0 ninds
-            (let [old-key (in iter-keys i)
-                  ii (in ,inds i)
-                  new-key (next ii old-key)]
-              (if (= nil new-key)
-                (do (set done true) (break))
-                (do (set (iter-keys i) new-key) (set (call-buffer i) (in ii new-key))))))
-          (if done (break))
-          (map-aggregator ,maptype ,res (,f x ;call-buffer)))))))
+     (def ninds (length ,inds))
+     (case ninds
+       0 (each x ,ind (map-aggregator ,maptype ,res (,f x)))
+       1 (map-n 1 ,maptype ,res ,f ,ind ,inds)
+       2 (map-n 2 ,maptype ,res ,f ,ind ,inds)
+       3 (map-n 3 ,maptype ,res ,f ,ind ,inds)
+       4 (map-n 4 ,maptype ,res ,f ,ind ,inds)
+       (do
+         (def iter-keys (array/new-filled ninds))
+         (def call-buffer (array/new-filled ninds))
+         (var done false)
+         (each x ,ind
+           (forv i 0 ninds
+             (let [old-key (in iter-keys i)
+                   ii (in ,inds i)
+                   new-key (next ii old-key)]
+               (if (= nil new-key)
+                 (do (set done true) (break))
+                 (do (set (iter-keys i) new-key) (set (call-buffer i) (in ii new-key))))))
+           (if done (break))
+           (map-aggregator ,maptype ,res (,f x ;call-buffer)))))))
 
 (defn map
   `Map a function over every value in a data structure and
@@ -1015,30 +1007,6 @@
   (map-template :keep res pred ind inds)
   res)
 
-(defn range
-  `Create an array of values [start, end) with a given step.
-  With one argument, returns a range [0, end). With two arguments, returns
-  a range [start, end). With three, returns a range with optional step size.`
-  [& args]
-  (case (length args)
-    1 (do
-        (def [n] args)
-        (def arr (array/new n))
-        (forv i 0 n (put arr i i))
-        arr)
-    2 (do
-        (def [n m] args)
-        (def arr (array/new (- m n)))
-        (forv i n m (put arr (- i n) i))
-        arr)
-    3 (do
-        (def [n m s] args)
-        (cond
-          (zero? s) @[]
-          (neg? s) (seq [i :down [n m (- s)]] i)
-          (seq [i :range [n m s]] i)))
-    (error "expected 1 to 3 arguments to range")))
-
 (defn find-index
   ``Find the index of indexed type for which `pred` is true. Returns `dflt` if not found.``
   [pred ind &opt dflt]
@@ -1080,42 +1048,33 @@
     (set k (next ind k)))
   ret)
 
-(defn- take-n-fallback
-  [n xs]
-  (def res @[])
-  (when (> n 0)
-    (var left n)
-    (each x xs
-      (array/push res x)
-      (-- left)
-      (if (= 0 left) (break))))
-  res)
-
-(defn- take-until-fallback
-  [pred xs]
-  (def res @[])
-  (each x xs
-    (if (pred x) (break))
-    (array/push res x))
-  res)
-
-(defn- slice-n
+(defn- take-n-slice
   [f n ind]
   (def len (length ind))
-  # make sure end is in [0, len]
-  (def m (if (> n 0) n 0))
-  (def end (if (> m len) len m))
-  (f ind 0 end))
+  (def m (+ len n))
+  (def start (if (< n 0 m) m 0))
+  (def end (if (<= 0 n len) n len))
+  (f ind start end))
 
 (defn take
-  "Take the first n elements of a fiber, indexed or bytes type. Returns a new array, tuple or string, respectively."
+  ``Take the first n elements of a fiber, indexed or bytes type. Returns a new array, tuple or string,
+  respectively. If `n` is negative, takes the last `n` elements instead.``
   [n ind]
   (cond
-    (bytes? ind) (slice-n string/slice n ind)
-    (indexed? ind) (slice-n tuple/slice n ind)
-    (take-n-fallback n ind)))
+    (indexed? ind) (take-n-slice tuple/slice n ind)
+    (bytes? ind) (take-n-slice string/slice n ind)
+    (dictionary? ind) (do
+                        (var left n)
+                        (tabseq [[i x] :pairs ind :until (< (-- left) 0)] i x))
+    (do
+      (def res @[])
+      (var key nil)
+      (repeat n
+        (if (= nil (set key (next ind key))) (break))
+        (array/push res (in ind key)))
+      res)))
 
-(defn- slice-until
+(defn- take-until-slice
   [f pred ind]
   (def len (length ind))
   (def i (find-index pred ind))
@@ -1126,9 +1085,10 @@
   "Same as `(take-while (complement pred) ind)`."
   [pred ind]
   (cond
-    (bytes? ind) (slice-until string/slice pred ind)
-    (indexed? ind) (slice-until tuple/slice pred ind)
-    (take-until-fallback pred ind)))
+    (indexed? ind) (take-until-slice tuple/slice pred ind)
+    (bytes? ind) (take-until-slice string/slice pred ind)
+    (dictionary? ind) (tabseq [[i x] :pairs ind :until (pred x)] i x)
+    (seq [x :in ind :until (pred x)] x)))
 
 (defn take-while
   `Given a predicate, take only elements from a fiber, indexed, or bytes type that satisfy
@@ -1136,27 +1096,58 @@
   [pred ind]
   (take-until (complement pred) ind))
 
+(defn- drop-n-slice
+  [f n ind]
+  (def len (length ind))
+  (cond
+    (<= 0 n len) (f ind n)
+    (< (- len) n 0) (f ind 0 (+ len n))
+    (f ind len)))
+
+(defn- drop-n-dict
+  [f n ind]
+  (def res (f ind))
+  (var left n)
+  (loop [[i x] :pairs ind :until (< (-- left) 0)] (set (res i) nil))
+  res)
+
 (defn drop
-  ``Drop the first `n elements in an indexed or bytes type. Returns a new tuple or string
+  ``Drop the first `n` elements in an indexed or bytes type. Returns a new tuple or string
   instance, respectively. If `n` is negative, drops the last `n` elements instead.``
   [n ind]
-  (def use-str (bytes? ind))
-  (def f (if use-str string/slice tuple/slice))
+  (cond
+    (indexed? ind) (drop-n-slice tuple/slice n ind)
+    (bytes? ind) (drop-n-slice string/slice n ind)
+    (struct? ind) (drop-n-dict struct/to-table n ind)
+    (table? ind) (drop-n-dict table/clone n ind)
+    (do
+      (var key nil)
+      (repeat n
+        (if (= nil (set key (next ind key))) (break)))
+      ind)))
+
+(defn- drop-until-slice
+  [f pred ind]
   (def len (length ind))
-  (def negn (>= n 0))
-  (def start (if negn (min n len) 0))
-  (def end (if negn len (max 0 (+ len n))))
-  (f ind start end))
+  (def i (find-index pred ind))
+  (def start (if (nil? i) len i))
+  (f ind start))
+
+(defn- drop-until-dict
+  [f pred ind]
+  (def res (f ind))
+  (loop [[i x] :pairs ind :until (pred x)] (set (res i) nil))
+  res)
 
 (defn drop-until
   "Same as `(drop-while (complement pred) ind)`."
   [pred ind]
-  (def use-str (bytes? ind))
-  (def f (if use-str string/slice tuple/slice))
-  (def i (find-index pred ind))
-  (def len (length ind))
-  (def start (if (nil? i) len i))
-  (f ind start))
+  (cond
+    (indexed? ind) (drop-until-slice tuple/slice pred ind)
+    (bytes? ind) (drop-until-slice string/slice pred ind)
+    (struct? ind) (drop-until-dict struct/to-table pred ind)
+    (table? ind) (drop-until-dict table/clone pred ind)
+    (do (find pred ind) ind)))
 
 (defn drop-while
   `Given a predicate, remove elements from an indexed or bytes type that satisfy
@@ -1196,6 +1187,16 @@
   (def kw (keyword prefix (slice alias 1 -2)))
   ~(def ,alias :dyn ,;more ,kw))
 
+(defn has-key?
+  "Check if a data structure `ds` contains the key `key`."
+  [ds key]
+  (not= nil (get ds key)))
+
+(defn has-value?
+  "Check if a data structure `ds` contains the value `value`. Will run in time proportional to the size of `ds`."
+  [ds value]
+  (not= nil (index-of value ds)))
+
 (defdyn *defdyn-prefix* ``Optional namespace prefix to add to keywords declared with `defdyn`.
   Use this to prevent keyword collisions between dynamic bindings.``)
 (defdyn *out* "Where normal print functions print output to.")
@@ -1204,6 +1205,7 @@
 (defdyn *debug* "Enables a built in debugger on errors and other useful features for debugging in a repl.")
 (defdyn *exit* "When set, will cause the current context to complete. Can be set to exit from repl (or file), for example.")
 (defdyn *exit-value* "Set the return value from `run-context` upon an exit. By default, `run-context` will return nil.")
+(defdyn *task-id* "When spawning a thread or fiber, the task-id can be assigned for concurrecny control.")
 
 (defdyn *macro-form*
   "Inside a macro, is bound to the source form that invoked the macro")
@@ -2120,23 +2122,23 @@
     (not= tx (type y))
     (case tx
       :tuple (or (not= (length x) (length y))
-                (do
-                  (var ret false)
-                  (forv i 0 (length x)
-                    (def xx (in x i))
-                    (def yy (in y i))
-                    (if (deep-not= xx yy)
-                      (break (set ret true))))
-                  ret))
+                 (do
+                   (var ret false)
+                   (forv i 0 (length x)
+                     (def xx (in x i))
+                     (def yy (in y i))
+                     (if (deep-not= xx yy)
+                       (break (set ret true))))
+                   ret))
       :array (or (not= (length x) (length y))
-                (do
-                  (var ret false)
-                  (forv i 0 (length x)
-                    (def xx (in x i))
-                    (def yy (in y i))
-                    (if (deep-not= xx yy)
-                      (break (set ret true))))
-                  ret))
+                 (do
+                   (var ret false)
+                   (forv i 0 (length x)
+                     (def xx (in x i))
+                     (def yy (in y i))
+                     (if (deep-not= xx yy)
+                       (break (set ret true))))
+                   ret))
       :struct (deep-not= (kvs x) (kvs y))
       :table (deep-not= (table/to-struct x) (table/to-struct y))
       :buffer (not= (string x) (string y))
@@ -2519,8 +2521,8 @@
                 (set good false)
                 (def {:error err :line line :column column :fiber errf} res)
                 (on-compile-error err errf where (or line l) (or column c))))))
-        guard))
-    (fiber/setenv f env)
+        guard
+        env))
     (while (fiber/can-resume? f)
       (def res (resume f resumeval))
       (when good (set resumeval (onstatus f res)))))
@@ -2857,7 +2859,7 @@
     (if (= :dead fs)
       (when is-repl
         (put env '_ @{:value x})
-        (printf (get env :pretty-format "%q") x)
+        (printf (get env *pretty-format* "%q") x)
         (flush))
       (do
         (debug/stacktrace f x "")
@@ -3202,16 +3204,17 @@
       (cond
         (or (= b (chr "\n")) (= b (chr " "))) (endtoken)
         (= b (chr "`")) (delim :code)
-        (not (modes :code)) (cond
+        (not (modes :code))
+        (cond
           (= 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)
-                (delim :bold))
-              (delim :italics))
+          (if (= (chr "*") (get line (+ i 1)))
+            (do (++ i)
+              (delim :bold))
+            (delim :italics))
           (do (++ token-length) (buffer/push token b)))
         (do (++ token-length) (buffer/push token b))))
     (endtoken)
@@ -3493,6 +3496,24 @@
     (when-let [constants (dasm :constants)]
       (eprintf "  constants:  %.4q" constants))
     (eprintf "  slots:      %.4q\n" (frame :slots))
+    (when-let [src-path (in dasm :source)]
+      (when (and (fexists src-path)
+                 sourcemap)
+        (defn dump
+          [src cur]
+          (def offset 5)
+          (def beg (max 1 (- cur offset)))
+          (def lines (array/concat @[""] (string/split "\n" src)))
+          (def end (min (+ cur offset) (length lines)))
+          (def digits (inc (math/floor (math/log10 end))))
+          (def fmt-str (string "%" digits "d: %s"))
+          (for i beg end
+            (eprin " ") # breakpoint someday?
+            (eprin (if (= i cur) "> " "  "))
+            (eprintf fmt-str i (get lines i))))
+        (let [[sl _] (sourcemap pc)]
+          (dump (slurp src-path) sl)
+          (eprint))))
     (def padding (string/repeat " " 20))
     (loop [i :range [0 (length bytecode)]
            :let [instr (bytecode i)]]
@@ -3651,17 +3672,21 @@
          (,ev/deadline ,deadline nil ,f)
          (,resume ,f))))
 
-  (defn- cancel-all [fibers reason] (each f fibers (ev/cancel f reason) (put fibers f nil)))
+  (defn- cancel-all [chan fibers reason]
+    (each f fibers (ev/cancel f reason))
+    (let [n (length fibers)]
+      (table/clear fibers)
+      (repeat n (ev/take chan))))
 
   (defn- wait-for-fibers
     [chan fibers]
-    (defer (cancel-all fibers "parent canceled")
+    (defer (cancel-all chan fibers "parent canceled")
       (repeat (length fibers)
         (def [sig fiber] (ev/take chan))
         (if (= sig :ok)
           (put fibers fiber nil)
           (do
-            (cancel-all fibers "sibling canceled")
+            (cancel-all chan fibers "sibling canceled")
             (propagate (fiber/last-value fiber) fiber))))))
 
   (defmacro ev/gather
@@ -3755,10 +3780,10 @@
     (defn make-ptr []
       (assert (ffi/lookup (if lazy (llib) lib) raw-symbol) (string "failed to find ffi symbol " raw-symbol)))
     (if lazy
-        ~(defn ,name ,;meta [,;formal-args]
-           (,ffi/call (,(delay (make-ptr))) (,(delay (make-sig))) ,;formal-args))
-        ~(defn ,name ,;meta [,;formal-args]
-           (,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args)))))
+      ~(defn ,name ,;meta [,;formal-args]
+         (,ffi/call (,(delay (make-ptr))) (,(delay (make-sig))) ,;formal-args))
+      ~(defn ,name ,;meta [,;formal-args]
+         (,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args)))))
 
 ###
 ###
@@ -3852,8 +3877,7 @@
     (def guard (if (get env :debug) :ydt :y))
     (defn wrap-main [&]
       (main ;subargs))
-    (def f (fiber/new wrap-main guard))
-    (fiber/setenv f env)
+    (def f (fiber/new wrap-main guard env))
     (var res nil)
     (while (fiber/can-resume? f)
       (set res (resume f res))
@@ -3870,6 +3894,9 @@
 (defdyn *profilepath*
   "Path to profile file loaded when starting up the repl.")
 
+(compwhen (not (dyn 'os/isatty))
+  (defmacro os/isatty [&] true))
+
 (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.`
@@ -3892,7 +3919,9 @@
 
   (if-let [jp (getenv-alias "JANET_PATH")] (setdyn *syspath* jp))
   (if-let [jprofile (getenv-alias "JANET_PROFILE")] (setdyn *profilepath* jprofile))
-  (set colorize (not (getenv-alias "NO_COLOR")))
+  (set colorize (and
+                  (not (getenv-alias "NO_COLOR"))
+                  (os/isatty stdout)))
 
   (defn- get-lint-level
     [i]
@@ -4146,10 +4175,11 @@
 
   (defn do-one-file
     [fname]
-    (print "\n/* " fname " */")
-    (print "#line 0 \"" fname "\"\n")
-    (def source (slurp fname))
-    (print (string/replace-all "\r" "" source)))
+    (unless (has-value? boot/args "image-only")
+      (print "\n/* " fname " */")
+      (print "#line 0 \"" fname "\"\n")
+      (def source (slurp fname))
+      (print (string/replace-all "\r" "" source))))
 
   (do-one-file feature-header)
 

src/boot/system_test.c

@@ -70,6 +70,5 @@ int system_test() {
 
     assert(janet_equals(tuple1, tuple2));
 
-
     return 0;
 }

src/conf/janetconf.h

@@ -4,10 +4,10 @@
 #define JANETCONF_H
 
 #define JANET_VERSION_MAJOR 1
-#define JANET_VERSION_MINOR 28
+#define JANET_VERSION_MINOR 30
 #define JANET_VERSION_PATCH 0
-#define JANET_VERSION_EXTRA "-dev"
-#define JANET_VERSION "1.28.0-dev"
+#define JANET_VERSION_EXTRA ""
+#define JANET_VERSION "1.30.0"
 
 /* #define JANET_BUILD "local" */
 

src/core/array.c

@@ -211,7 +211,7 @@ JANET_CORE_FN(cfun_array_slice,
               "Takes a slice of array or tuple from `start` to `end`. The range is half open, "
               "[start, end). Indexes can also be negative, indicating indexing from the "
               "end of the array. By default, `start` is 0 and `end` is the length of the array. "
-              "Note that index -1 is synonymous with index `(length arrtup)` to allow a full "
+              "Note that if the range is negative, it is taken as (start, end] to allow a full "
               "negative slice range. Returns a new array.") {
     JanetView view = janet_getindexed(argv, 0);
     JanetRange range = janet_getslice(argc, argv);
@@ -259,8 +259,8 @@ JANET_CORE_FN(cfun_array_insert,
               "(array/insert arr at & xs)",
               "Insert all `xs` into array `arr` at index `at`. `at` should be an integer between "
               "0 and the length of the array. A negative value for `at` will index backwards from "
-              "the end of the array, such that inserting at -1 appends to the array. "
-              "Returns the array.") {
+              "the end of the array, inserting after the index such that inserting at -1 appends to "
+              "the array. Returns the array.") {
     size_t chunksize, restsize;
     janet_arity(argc, 2, -1);
     JanetArray *array = janet_getarray(argv, 0);
@@ -297,7 +297,7 @@ JANET_CORE_FN(cfun_array_remove,
     int32_t at = janet_getinteger(argv, 1);
     int32_t n = 1;
     if (at < 0) {
-        at = array->count + at + 1;
+        at = array->count + at;
     }
     if (at < 0 || at > array->count)
         janet_panicf("removal index %d out of range [0,%d]", at, array->count);

src/core/asm.c

@@ -75,6 +75,7 @@ static const JanetInstructionDef janet_ops[] = {
     {"cmp", JOP_COMPARE},
     {"cncl", JOP_CANCEL},
     {"div", JOP_DIVIDE},
+    {"divf", JOP_DIVIDE_FLOOR},
     {"divim", JOP_DIVIDE_IMMEDIATE},
     {"eq", JOP_EQUALS},
     {"eqim", JOP_EQUALS_IMMEDIATE},
@@ -137,6 +138,7 @@ static const JanetInstructionDef janet_ops[] = {
     {"sru", JOP_SHIFT_RIGHT_UNSIGNED},
     {"sruim", JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE},
     {"sub", JOP_SUBTRACT},
+    {"subim", JOP_SUBTRACT_IMMEDIATE},
     {"tcall", JOP_TAILCALL},
     {"tchck", JOP_TYPECHECK}
 };
@@ -949,7 +951,6 @@ static Janet janet_disasm_symbolslots(JanetFuncDef *def) {
     return janet_wrap_array(symbolslots);
 }
 
-
 static Janet janet_disasm_bytecode(JanetFuncDef *def) {
     JanetArray *bcode = janet_array(def->bytecode_length);
     for (int32_t i = 0; i < def->bytecode_length; i++) {

src/core/buffer.c

@@ -354,7 +354,6 @@ JANET_CORE_FN(cfun_buffer_push,
     return argv[0];
 }
 
-
 JANET_CORE_FN(cfun_buffer_clear,
               "(buffer/clear buffer)",
               "Sets the size of a buffer to 0 and empties it. The buffer retains "
@@ -463,13 +462,15 @@ JANET_CORE_FN(cfun_buffer_blit,
     int same_buf = src.bytes == dest->data;
     int32_t offset_dest = 0;
     int32_t offset_src = 0;
-    if (argc > 2)
+    if (argc > 2 && !janet_checktype(argv[2], JANET_NIL))
         offset_dest = janet_gethalfrange(argv, 2, dest->count, "dest-start");
-    if (argc > 3)
+    if (argc > 3 && !janet_checktype(argv[3], JANET_NIL))
         offset_src = janet_gethalfrange(argv, 3, src.len, "src-start");
     int32_t length_src;
     if (argc > 4) {
-        int32_t src_end = janet_gethalfrange(argv, 4, src.len, "src-end");
+        int32_t src_end = src.len;
+        if (!janet_checktype(argv[4], JANET_NIL))
+            src_end = janet_gethalfrange(argv, 4, src.len, "src-end");
         length_src = src_end - offset_src;
         if (length_src < 0) length_src = 0;
     } else {

src/core/bytecode.c

@@ -37,11 +37,13 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
     JINT_0, /* JOP_RETURN_NIL, */
     JINT_SSI, /* JOP_ADD_IMMEDIATE, */
     JINT_SSS, /* JOP_ADD, */
+    JINT_SSI, /* JOP_SUBTRACT_IMMEDIATE, */
     JINT_SSS, /* JOP_SUBTRACT, */
     JINT_SSI, /* JOP_MULTIPLY_IMMEDIATE, */
     JINT_SSS, /* JOP_MULTIPLY, */
     JINT_SSI, /* JOP_DIVIDE_IMMEDIATE, */
     JINT_SSS, /* JOP_DIVIDE, */
+    JINT_SSS, /* JOP_DIVIDE_FLOOR */
     JINT_SSS, /* JOP_MODULO, */
     JINT_SSS, /* JOP_REMAINDER, */
     JINT_SSS, /* JOP_BAND, */
@@ -170,6 +172,7 @@ void janet_bytecode_remove_noops(JanetFuncDef *def) {
     }
 
     def->bytecode_length = new_bytecode_length;
+    def->bytecode = janet_realloc(def->bytecode, def->bytecode_length * sizeof(uint32_t));
     janet_sfree(pc_map);
 }
 
@@ -249,6 +252,7 @@ void janet_bytecode_movopt(JanetFuncDef *def) {
                 case JOP_SIGNAL:
                 /* Write A, Read B */
                 case JOP_ADD_IMMEDIATE:
+                case JOP_SUBTRACT_IMMEDIATE:
                 case JOP_MULTIPLY_IMMEDIATE:
                 case JOP_DIVIDE_IMMEDIATE:
                 case JOP_SHIFT_LEFT_IMMEDIATE:
@@ -300,6 +304,7 @@ void janet_bytecode_movopt(JanetFuncDef *def) {
                 case JOP_SUBTRACT:
                 case JOP_MULTIPLY:
                 case JOP_DIVIDE:
+                case JOP_DIVIDE_FLOOR:
                 case JOP_MODULO:
                 case JOP_REMAINDER:
                 case JOP_SHIFT_LEFT:

src/core/capi.c

@@ -216,12 +216,32 @@ const char *janet_getcstring(const Janet *argv, int32_t n) {
 }
 
 const char *janet_getcbytes(const Janet *argv, int32_t n) {
+    /* Ensure buffer 0-padded */
+    if (janet_checktype(argv[n], JANET_BUFFER)) {
+        JanetBuffer *b = janet_unwrap_buffer(argv[n]);
+        if ((b->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC) && b->count == b->capacity) {
+            /* Make a copy with janet_smalloc in the rare case we have a buffer that
+             * cannot be realloced and pushing a 0 byte would panic. */
+            char *new_string = janet_smalloc(b->count + 1);
+            memcpy(new_string, b->data, b->count);
+            new_string[b->count] = 0;
+            if (strlen(new_string) != (size_t) b->count) goto badzeros;
+            return new_string;
+        } else {
+            /* Ensure trailing 0 */
+            janet_buffer_push_u8(b, 0);
+            b->count--;
+            if (strlen((char *)b->data) != (size_t) b->count) goto badzeros;
+            return (const char *) b->data;
+        }
+    }
     JanetByteView view = janet_getbytes(argv, n);
     const char *cstr = (const char *)view.bytes;
-    if (strlen(cstr) != (size_t) view.len) {
-        janet_panic("bytes contain embedded 0s");
-    }
+    if (strlen(cstr) != (size_t) view.len) goto badzeros;
     return cstr;
+
+badzeros:
+    janet_panic("bytes contain embedded 0s");
 }
 
 const char *janet_optcbytes(const Janet *argv, int32_t argc, int32_t n, const char *dflt) {
@@ -273,6 +293,14 @@ int32_t janet_getinteger(const Janet *argv, int32_t n) {
     return janet_unwrap_integer(x);
 }
 
+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);
+    }
+    return janet_unwrap_integer(x);
+}
+
 int64_t janet_getinteger64(const Janet *argv, int32_t n) {
 #ifdef JANET_INT_TYPES
     return janet_unwrap_s64(argv[n]);
@@ -290,7 +318,7 @@ uint64_t janet_getuinteger64(const Janet *argv, int32_t n) {
     return janet_unwrap_u64(argv[n]);
 #else
     Janet x = argv[n];
-    if (!janet_checkint64(x)) {
+    if (!janet_checkuint64(x)) {
         janet_panicf("bad slot #%d, expected 64 bit unsigned integer, got %v", n, x);
     }
     return (uint64_t) janet_unwrap_number(x);
@@ -314,6 +342,20 @@ int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const c
     return not_raw;
 }
 
+int32_t janet_getstartrange(const Janet *argv, int32_t argc, int32_t n, int32_t length) {
+    if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {
+        return 0;
+    }
+    return janet_gethalfrange(argv, n, length, "start");
+}
+
+int32_t janet_getendrange(const Janet *argv, int32_t argc, int32_t n, int32_t length) {
+    if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {
+        return length;
+    }
+    return janet_gethalfrange(argv, n, length, "end");
+}
+
 int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which) {
     int32_t raw = janet_getinteger(argv, n);
     int32_t not_raw = raw;
@@ -366,24 +408,10 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) {
     janet_arity(argc, 1, 3);
     JanetRange range;
     int32_t length = janet_length(argv[0]);
-    if (argc == 1) {
-        range.start = 0;
-        range.end = length;
-    } else if (argc == 2) {
-        range.start = janet_checktype(argv[1], JANET_NIL)
-                      ? 0
-                      : janet_gethalfrange(argv, 1, length, "start");
-        range.end = length;
-    } else {
-        range.start = janet_checktype(argv[1], JANET_NIL)
-                      ? 0
-                      : janet_gethalfrange(argv, 1, length, "start");
-        range.end = janet_checktype(argv[2], JANET_NIL)
-                    ? length
-                    : janet_gethalfrange(argv, 2, length, "end");
-        if (range.end < range.start)
-            range.end = range.start;
-    }
+    range.start = janet_getstartrange(argv, argc, 1, length);
+    range.end = janet_getendrange(argv, argc, 2, length);
+    if (range.end < range.start)
+        range.end = range.start;
     return range;
 }
 

src/core/cfuns.c

@@ -99,7 +99,7 @@ static JanetSlot opfunction(
 static int can_be_imm(Janet x, int8_t *out) {
     if (!janet_checkint(x)) return 0;
     int32_t integer = janet_unwrap_integer(x);
-    if (integer > 127 || integer < -127) return 0;
+    if (integer > INT8_MAX || integer < INT8_MIN) return 0;
     *out = (int8_t) integer;
     return 1;
 }
@@ -116,12 +116,11 @@ static JanetSlot opreduce(
     JanetSlot *args,
     int op,
     int opim,
-    Janet nullary) {
+    Janet nullary,
+    Janet unary) {
     JanetCompiler *c = opts.compiler;
     int32_t i, len;
     int8_t imm = 0;
-    int neg = opim < 0;
-    if (opim < 0) opim = -opim;
     len = janet_v_count(args);
     JanetSlot t;
     if (len == 0) {
@@ -132,19 +131,19 @@ static JanetSlot opreduce(
         if (op == JOP_SUBTRACT) {
             janetc_emit_ssi(c, JOP_MULTIPLY_IMMEDIATE, t, args[0], -1, 1);
         } else {
-            janetc_emit_sss(c, op, t, janetc_cslot(nullary), args[0], 1);
+            janetc_emit_sss(c, op, t, janetc_cslot(unary), args[0], 1);
         }
         return t;
     }
     t = janetc_gettarget(opts);
     if (opim && can_slot_be_imm(args[1], &imm)) {
-        janetc_emit_ssi(c, opim, t, args[0], neg ? -imm : imm, 1);
+        janetc_emit_ssi(c, opim, t, args[0], imm, 1);
     } else {
         janetc_emit_sss(c, op, t, args[0], args[1], 1);
     }
     for (i = 2; i < len; i++) {
         if (opim && can_slot_be_imm(args[i], &imm)) {
-            janetc_emit_ssi(c, opim, t, t, neg ? -imm : imm, 1);
+            janetc_emit_ssi(c, opim, t, t, imm, 1);
         } else {
             janetc_emit_sss(c, op, t, t, args[i], 1);
         }
@@ -155,7 +154,7 @@ static JanetSlot opreduce(
 /* Function optimizers */
 
 static JanetSlot do_propagate(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil());
+    return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil(), janet_wrap_nil());
 }
 static JanetSlot do_error(JanetFopts opts, JanetSlot *args) {
     janetc_emit_s(opts.compiler, JOP_ERROR, args[0], 0);
@@ -172,7 +171,7 @@ static JanetSlot do_debug(JanetFopts opts, JanetSlot *args) {
     return t;
 }
 static JanetSlot do_in(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil());
+    return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil(), janet_wrap_nil());
 }
 static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
     if (janet_v_count(args) == 3) {
@@ -192,20 +191,14 @@ static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
         c->buffer[label] |= (current - label) << 16;
         return t;
     } else {
-        return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil());
+        return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil(), janet_wrap_nil());
     }
 }
 static JanetSlot do_next(JanetFopts opts, JanetSlot *args) {
     return opfunction(opts, args, JOP_NEXT, janet_wrap_nil());
 }
-static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_nil());
-}
-static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_REMAINDER, 0, janet_wrap_nil());
-}
 static JanetSlot do_cmp(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil());
+    return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil(), janet_wrap_nil());
 }
 static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
     if (opts.flags & JANET_FOPTS_DROP) {
@@ -262,34 +255,43 @@ static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
 /* Variadic operators specialization */
 
 static JanetSlot do_add(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
+    return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0), janet_wrap_integer(0));
 }
 static JanetSlot do_sub(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_SUBTRACT, -JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
+    return opreduce(opts, args, JOP_SUBTRACT, JOP_SUBTRACT_IMMEDIATE, janet_wrap_integer(0), janet_wrap_integer(0));
 }
 static JanetSlot do_mul(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1));
+    return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
 }
 static JanetSlot do_div(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1));
+    return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
+}
+static JanetSlot do_divf(JanetFopts opts, JanetSlot *args) {
+    return opreduce(opts, args, JOP_DIVIDE_FLOOR, 0, janet_wrap_integer(1), janet_wrap_integer(1));
+}
+static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
+    return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_integer(0), janet_wrap_integer(1));
+}
+static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
+    return opreduce(opts, args, JOP_REMAINDER, 0, janet_wrap_integer(0), janet_wrap_integer(1));
 }
 static JanetSlot do_band(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1));
+    return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1), janet_wrap_integer(-1));
 }
 static JanetSlot do_bor(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0));
+    return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0), janet_wrap_integer(0));
 }
 static JanetSlot do_bxor(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0));
+    return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0), janet_wrap_integer(0));
 }
 static JanetSlot do_lshift(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1));
+    return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
 }
 static JanetSlot do_rshift(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1));
+    return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
 }
 static JanetSlot do_rshiftu(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1));
+    return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
 }
 static JanetSlot do_bnot(JanetFopts opts, JanetSlot *args) {
     return genericSS(opts, JOP_BNOT, args[0]);
@@ -383,10 +385,11 @@ static const JanetFunOptimizer optimizers[] = {
     {fixarity2, do_propagate},
     {arity2or3, do_get},
     {arity1or2, do_next},
-    {fixarity2, do_modulo},
-    {fixarity2, do_remainder},
+    {NULL, do_modulo},
+    {NULL, do_remainder},
     {fixarity2, do_cmp},
     {fixarity2, do_cancel},
+    {NULL, do_divf}
 };
 
 const JanetFunOptimizer *janetc_funopt(uint32_t flags) {

src/core/compile.c

@@ -746,12 +746,14 @@ static int macroexpand1(
     int lock = janet_gclock();
     Janet mf_kw = janet_ckeywordv("macro-form");
     janet_table_put(c->env, mf_kw, x);
+    Janet ml_kw = janet_ckeywordv("macro-lints");
+    if (c->lints) {
+        janet_table_put(c->env, ml_kw, janet_wrap_array(c->lints));
+    }
     Janet tempOut;
     JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &tempOut);
     janet_table_put(c->env, mf_kw, janet_wrap_nil());
-    if (c->lints) {
-        janet_table_put(c->env, janet_ckeywordv("macro-lints"), janet_wrap_array(c->lints));
-    }
+    janet_table_put(c->env, ml_kw, janet_wrap_nil());
     janet_gcunlock(lock);
     if (status != JANET_SIGNAL_OK) {
         const uint8_t *es = janet_formatc("(macro) %V", tempOut);
@@ -971,12 +973,21 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
     for (int32_t i = 0; i < janet_v_count(scope->syms); i++) {
         SymPair pair = scope->syms[i];
         if (pair.sym2) {
-            if (pair.death_pc == UINT32_MAX) {
-                pair.death_pc = def->bytecode_length;
-            }
             JanetSymbolMap jsm;
-            jsm.birth_pc = pair.birth_pc;
-            jsm.death_pc = pair.death_pc;
+            if (pair.death_pc == UINT32_MAX) {
+                jsm.death_pc = def->bytecode_length;
+            } else {
+                jsm.death_pc = pair.death_pc - scope->bytecode_start;
+            }
+            /* Handle birth_pc == 0 correctly */
+            if ((uint32_t) scope->bytecode_start > pair.birth_pc) {
+                jsm.birth_pc = 0;
+            } else {
+                jsm.birth_pc = pair.birth_pc - scope->bytecode_start;
+            }
+            janet_assert(jsm.birth_pc <= jsm.death_pc, "birth pc after death pc");
+            janet_assert(jsm.birth_pc < (uint32_t) def->bytecode_length, "bad birth pc");
+            janet_assert(jsm.death_pc <= (uint32_t) def->bytecode_length, "bad death pc");
             jsm.slot_index = pair.slot.index;
             jsm.symbol = pair.sym2;
             janet_v_push(locals, jsm);

src/core/compile.h

@@ -69,6 +69,7 @@ typedef enum {
 #define JANET_FUN_REMAINDER 30
 #define JANET_FUN_CMP 31
 #define JANET_FUN_CANCEL 32
+#define JANET_FUN_DIVIDE_FLOOR 33
 
 /* Compiler typedefs */
 typedef struct JanetCompiler JanetCompiler;

src/core/corelib.c

@@ -426,6 +426,36 @@ JANET_CORE_FN(janet_core_slice,
     }
 }
 
+JANET_CORE_FN(janet_core_range,
+              "(range & args)",
+              "Create an array of values [start, end) with a given step. "
+              "With one argument, returns a range [0, end). With two arguments, returns "
+              "a range [start, end). With three, returns a range with optional step size.") {
+    janet_arity(argc, 1, 3);
+    int32_t start = 0, stop = 0, step = 1, count = 0;
+    if (argc == 3) {
+        start = janet_getinteger(argv, 0);
+        stop = janet_getinteger(argv, 1);
+        step = janet_getinteger(argv, 2);
+        count = (step > 0) ? (stop - start - 1) / step + 1 :
+                ((step < 0) ? (stop - start + 1) / step + 1 : 0);
+    } else if (argc == 2) {
+        start = janet_getinteger(argv, 0);
+        stop = janet_getinteger(argv, 1);
+        count = stop - start;
+    } else {
+        stop = janet_getinteger(argv, 0);
+        count = stop;
+    }
+    count = (count > 0) ? count : 0;
+    JanetArray *array = janet_array(count);
+    for (int32_t i = 0; i < count; i++) {
+        array->data[i] = janet_wrap_number(start + i * step);
+    }
+    array->count = count;
+    return janet_wrap_array(array);
+}
+
 JANET_CORE_FN(janet_core_table,
               "(table & kvs)",
               "Creates a new table from a variadic number of keys and values. "
@@ -677,6 +707,9 @@ static const SandboxOption sandbox_options[] = {
     {"all", JANET_SANDBOX_ALL},
     {"env", JANET_SANDBOX_ENV},
     {"ffi", JANET_SANDBOX_FFI},
+    {"ffi-define", JANET_SANDBOX_FFI_DEFINE},
+    {"ffi-jit", JANET_SANDBOX_FFI_JIT},
+    {"ffi-use", JANET_SANDBOX_FFI_USE},
     {"fs", JANET_SANDBOX_FS},
     {"fs-read", JANET_SANDBOX_FS_READ},
     {"fs-temp", JANET_SANDBOX_FS_TEMP},
@@ -698,6 +731,9 @@ JANET_CORE_FN(janet_core_sandbox,
               "* :all - disallow all (except IO to stdout, stderr, and stdin)\n"
               "* :env - disallow reading and write env variables\n"
               "* :ffi - disallow FFI (recommended if disabling anything else)\n"
+              "* :ffi-define - disallow loading new FFI modules and binding new functions\n"
+              "* :ffi-jit - disallow calling `ffi/jitfn`\n"
+              "* :ffi-use - disallow using any previously bound FFI functions and memory-unsafe functions.\n"
               "* :fs - disallow access to the file system\n"
               "* :fs-read - disallow read access to the file system\n"
               "* :fs-temp - disallow creating temporary files\n"
@@ -979,14 +1015,6 @@ static const uint32_t next_asm[] = {
     JOP_NEXT | (1 << 24),
     JOP_RETURN
 };
-static const uint32_t modulo_asm[] = {
-    JOP_MODULO | (1 << 24),
-    JOP_RETURN
-};
-static const uint32_t remainder_asm[] = {
-    JOP_REMAINDER | (1 << 24),
-    JOP_RETURN
-};
 static const uint32_t cmp_asm[] = {
     JOP_COMPARE | (1 << 24),
     JOP_RETURN
@@ -1026,6 +1054,7 @@ static void janet_load_libs(JanetTable *env) {
         JANET_CORE_REG("int?", janet_core_check_int),
         JANET_CORE_REG("nat?", janet_core_check_nat),
         JANET_CORE_REG("slice", janet_core_slice),
+        JANET_CORE_REG("range", janet_core_range),
         JANET_CORE_REG("signal", janet_core_signal),
         JANET_CORE_REG("memcmp", janet_core_memcmp),
         JANET_CORE_REG("getproto", janet_core_getproto),
@@ -1071,14 +1100,6 @@ static void janet_load_libs(JanetTable *env) {
 
 JanetTable *janet_core_env(JanetTable *replacements) {
     JanetTable *env = (NULL != replacements) ? replacements : janet_table(0);
-    janet_quick_asm(env, JANET_FUN_MODULO,
-                    "mod", 2, 2, 2, 2, modulo_asm, sizeof(modulo_asm),
-                    JDOC("(mod dividend divisor)\n\n"
-                         "Returns the modulo of dividend / divisor."));
-    janet_quick_asm(env, JANET_FUN_REMAINDER,
-                    "%", 2, 2, 2, 2, remainder_asm, sizeof(remainder_asm),
-                    JDOC("(% dividend divisor)\n\n"
-                         "Returns the remainder of dividend / divisor."));
     janet_quick_asm(env, JANET_FUN_CMP,
                     "cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm),
                     JDOC("(cmp x y)\n\n"
@@ -1177,6 +1198,18 @@ JanetTable *janet_core_env(JanetTable *replacements) {
                           "Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns "
                           "the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
                           "values."));
+    templatize_varop(env, JANET_FUN_DIVIDE_FLOOR, "div", 1, 1, JOP_DIVIDE_FLOOR,
+                     JDOC("(div & xs)\n\n"
+                          "Returns the floored division of xs. If xs is empty, returns 1. If xs has one value x, returns "
+                          "the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
+                          "values."));
+    templatize_varop(env, JANET_FUN_MODULO, "mod", 0, 1, JOP_MODULO,
+                     JDOC("(mod & xs)\n\n"
+                          "Returns the result of applying the modulo operator on the first value of xs with each remaining value. "
+                          "`(mod x 0)` is defined to be `x`."));
+    templatize_varop(env, JANET_FUN_REMAINDER, "%", 0, 1, JOP_REMAINDER,
+                     JDOC("(% & xs)\n\n"
+                          "Returns the remainder of dividing the first value of xs by each remaining value."));
     templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND,
                      JDOC("(band & xs)\n\n"
                           "Returns the bit-wise and of all values in xs. Each x in xs must be an integer."));

src/core/debug.c

@@ -314,6 +314,7 @@ static Janet doframe(JanetStackFrame *frame) {
     if (frame->func && frame->pc) {
         Janet *stack = (Janet *)frame + JANET_FRAME_SIZE;
         JanetArray *slots;
+        janet_assert(def != NULL, "def != NULL");
         off = (int32_t)(frame->pc - def->bytecode);
         janet_table_put(t, janet_ckeywordv("pc"), janet_wrap_integer(off));
         if (def->sourcemap) {

src/core/ev.c

@@ -20,7 +20,6 @@
 * IN THE SOFTWARE.
 */
 
-
 #ifndef JANET_AMALG
 #include "features.h"
 #include <janet.h>
@@ -365,7 +364,6 @@ void janet_stream_close(JanetStream *stream) {
     janet_stream_close_impl(stream, 0);
 }
 
-
 /* Called to clean up a stream */
 static int janet_stream_gc(void *p, size_t s) {
     (void) s;
@@ -403,11 +401,11 @@ static void janet_stream_marshal(void *p, JanetMarshalContext *ctx) {
     }
     janet_marshal_abstract(ctx, p);
     janet_marshal_int(ctx, (int32_t) s->flags);
-    janet_marshal_int64(ctx, (intptr_t) s->methods);
+    janet_marshal_ptr(ctx, s->methods);
 #ifdef JANET_WINDOWS
     /* TODO - ref counting to avoid situation where a handle is closed or GCed
      * while in transit, and it's value gets reused. DuplicateHandle does not work
-     * for network sockets, and in general for winsock it is better to nipt duplicate
+     * for network sockets, and in general for winsock it is better to not duplicate
      * unless there is a need to. */
     HANDLE duph = INVALID_HANDLE_VALUE;
     if (s->flags & JANET_STREAM_SOCKET) {
@@ -440,7 +438,7 @@ static void *janet_stream_unmarshal(JanetMarshalContext *ctx) {
     p->_mask = 0;
     p->state = NULL;
     p->flags = (uint32_t) janet_unmarshal_int(ctx);
-    p->methods = (void *) janet_unmarshal_int64(ctx);
+    p->methods =  janet_unmarshal_ptr(ctx);
 #ifdef JANET_WINDOWS
     p->handle = (JanetHandle) janet_unmarshal_int64(ctx);
 #else
@@ -1171,9 +1169,9 @@ JANET_CORE_FN(cfun_channel_close,
                 janet_ev_post_event(vm, janet_thread_chan_cb, msg);
             } else {
                 if (writer.mode == JANET_CP_MODE_CHOICE_WRITE) {
-                    janet_schedule(writer.fiber, janet_wrap_nil());
-                } else {
                     janet_schedule(writer.fiber, make_close_result(channel));
+                } else {
+                    janet_schedule(writer.fiber, janet_wrap_nil());
                 }
             }
         }
@@ -1190,9 +1188,9 @@ JANET_CORE_FN(cfun_channel_close,
                 janet_ev_post_event(vm, janet_thread_chan_cb, msg);
             } else {
                 if (reader.mode == JANET_CP_MODE_CHOICE_READ) {
-                    janet_schedule(reader.fiber, janet_wrap_nil());
-                } else {
                     janet_schedule(reader.fiber, make_close_result(channel));
+                } else {
+                    janet_schedule(reader.fiber, janet_wrap_nil());
                 }
             }
         }
@@ -1226,6 +1224,7 @@ static Janet janet_chanat_next(void *p, Janet key) {
 
 static void janet_chanat_marshal(void *p, JanetMarshalContext *ctx) {
     JanetChannel *channel = (JanetChannel *)p;
+    janet_marshal_abstract(ctx, channel);
     janet_marshal_byte(ctx, channel->closed);
     janet_marshal_int(ctx, channel->limit);
     int32_t count = janet_q_count(&channel->items);
@@ -1453,7 +1452,6 @@ JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, in
     return state;
 }
 
-
 static void janet_unlisten(JanetListenerState *state, int is_gc) {
     janet_unlisten_impl(state, is_gc);
 }
@@ -2173,7 +2171,6 @@ void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value) {
     janet_gcunroot(janet_wrap_fiber(return_value.fiber));
 }
 
-
 /* Convenience method for common case */
 JANET_NO_RETURN
 void janet_ev_threaded_await(JanetThreadedSubroutine fp, int tag, int argi, void *argp) {
@@ -2320,6 +2317,7 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
             if (state->mode == JANET_ASYNC_READMODE_RECVFROM) {
                 state->wbuf.len = (ULONG) chunk_size;
                 state->wbuf.buf = (char *) state->chunk_buf;
+                state->fromlen = sizeof(state->from);
                 status = WSARecvFrom((SOCKET) s->stream->handle, &state->wbuf, 1,
                                      NULL, &state->flags, &state->from, &state->fromlen, &state->overlapped, NULL);
                 if (status && (WSA_IO_PENDING != WSAGetLastError())) {
@@ -2522,7 +2520,6 @@ static JanetAsyncStatus handle_connect(JanetListenerState *s) {
     return JANET_ASYNC_STATUS_DONE;
 }
 
-
 JanetAsyncStatus ev_machine_write(JanetListenerState *s, JanetAsyncEvent event) {
     StateWrite *state = (StateWrite *) s;
     switch (event) {
@@ -2702,7 +2699,6 @@ static void janet_ev_write_generic(JanetStream *stream, void *buf, void *dest_ab
 #endif
 }
 
-
 void janet_ev_write_buffer(JanetStream *stream, JanetBuffer *buf) {
     janet_ev_write_generic(stream, buf, NULL, JANET_ASYNC_WRITEMODE_WRITE, 1, 0);
 }
@@ -2914,10 +2910,10 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
                 janet_panicf("expected function or fiber, got %v", fiberv);
             }
             JanetFunction *func = janet_unwrap_function(fiberv);
-            if (func->def->min_arity > 1) {
+            fiber = janet_fiber(func, 64, func->def->min_arity, &value);
+            if (fiber == NULL) {
                 janet_panicf("thread function must accept 0 or 1 arguments");
             }
-            fiber = janet_fiber(func, 64, func->def->min_arity, &value);
             fiber->flags |=
                 JANET_FIBER_MASK_ERROR |
                 JANET_FIBER_MASK_USER0 |

src/core/ffi.c

@@ -1303,7 +1303,7 @@ JANET_CORE_FN(cfun_ffi_jitfn,
               "(ffi/jitfn bytes)",
               "Create an abstract type that can be used as the pointer argument to `ffi/call`. The content "
               "of `bytes` is architecture specific machine code that will be copied into executable memory.") {
-    janet_sandbox_assert(JANET_SANDBOX_FFI);
+    janet_sandbox_assert(JANET_SANDBOX_FFI_JIT);
     janet_fixarity(argc, 1);
     JanetByteView bytes = janet_getbytes(argv, 0);
 
@@ -1356,7 +1356,7 @@ JANET_CORE_FN(cfun_ffi_call,
               "(ffi/call pointer signature & args)",
               "Call a raw pointer as a function pointer. The function signature specifies "
               "how Janet values in `args` are converted to native machine types.") {
-    janet_sandbox_assert(JANET_SANDBOX_FFI);
+    janet_sandbox_assert(JANET_SANDBOX_FFI_USE);
     janet_arity(argc, 2, -1);
     void *function_pointer = janet_ffi_get_callable_pointer(argv, 0);
     JanetFFISignature *signature = janet_getabstract(argv, 1, &janet_signature_type);
@@ -1364,6 +1364,7 @@ JANET_CORE_FN(cfun_ffi_call,
     switch (signature->cc) {
         default:
         case JANET_FFI_CC_NONE:
+            (void) function_pointer;
             janet_panic("calling convention not supported");
 #ifdef JANET_FFI_WIN64_ENABLED
         case JANET_FFI_CC_WIN_64:
@@ -1381,7 +1382,7 @@ JANET_CORE_FN(cfun_ffi_buffer_write,
               "Append a native type to a buffer such as it would appear in memory. This can be used "
               "to pass pointers to structs in the ffi, or send C/C++/native structs over the network "
               "or to files. Returns a modifed buffer or a new buffer if one is not supplied.") {
-    janet_sandbox_assert(JANET_SANDBOX_FFI);
+    janet_sandbox_assert(JANET_SANDBOX_FFI_USE);
     janet_arity(argc, 2, 4);
     JanetFFIType type = decode_ffi_type(argv[0]);
     uint32_t el_size = (uint32_t) type_size(type);
@@ -1404,7 +1405,7 @@ JANET_CORE_FN(cfun_ffi_buffer_read,
               "Parse a native struct out of a buffer and convert it to normal Janet data structures. "
               "This function is the inverse of `ffi/write`. `bytes` can also be a raw pointer, although "
               "this is unsafe.") {
-    janet_sandbox_assert(JANET_SANDBOX_FFI);
+    janet_sandbox_assert(JANET_SANDBOX_FFI_USE);
     janet_arity(argc, 2, 3);
     JanetFFIType type = decode_ffi_type(argv[0]);
     size_t offset = (size_t) janet_optnat(argv, argc, 2, 0);
@@ -1451,7 +1452,7 @@ JANET_CORE_FN(janet_core_raw_native,
               " or run any code from it. This is different than `native`, which will "
               "run initialization code to get a module table. If `path` is nil, opens the current running binary. "
               "Returns a `core/native`.") {
-    janet_sandbox_assert(JANET_SANDBOX_FFI);
+    janet_sandbox_assert(JANET_SANDBOX_FFI_DEFINE);
     janet_arity(argc, 0, 1);
     const char *path = janet_optcstring(argv, argc, 0, NULL);
     Clib lib = load_clib(path);
@@ -1467,7 +1468,7 @@ JANET_CORE_FN(janet_core_native_lookup,
               "(ffi/lookup native symbol-name)",
               "Lookup a symbol from a native object. All symbol lookups will return a raw pointer "
               "if the symbol is found, else nil.") {
-    janet_sandbox_assert(JANET_SANDBOX_FFI);
+    janet_sandbox_assert(JANET_SANDBOX_FFI_DEFINE);
     janet_fixarity(argc, 2);
     JanetAbstractNative *anative = janet_getabstract(argv, 0, &janet_native_type);
     const char *sym = janet_getcstring(argv, 1);
@@ -1481,7 +1482,7 @@ JANET_CORE_FN(janet_core_native_close,
               "(ffi/close native)",
               "Free a native object. Dereferencing pointers to symbols in the object will have undefined "
               "behavior after freeing.") {
-    janet_sandbox_assert(JANET_SANDBOX_FFI);
+    janet_sandbox_assert(JANET_SANDBOX_FFI_DEFINE);
     janet_fixarity(argc, 1);
     JanetAbstractNative *anative = janet_getabstract(argv, 0, &janet_native_type);
     if (anative->closed) janet_panic("native object already closed");
@@ -1494,7 +1495,7 @@ JANET_CORE_FN(janet_core_native_close,
 JANET_CORE_FN(cfun_ffi_malloc,
               "(ffi/malloc size)",
               "Allocates memory directly using the janet memory allocator. Memory allocated in this way must be freed manually! Returns a raw pointer, or nil if size = 0.") {
-    janet_sandbox_assert(JANET_SANDBOX_FFI);
+    janet_sandbox_assert(JANET_SANDBOX_FFI_USE);
     janet_fixarity(argc, 1);
     size_t size = janet_getsize(argv, 0);
     if (size == 0) return janet_wrap_nil();
@@ -1504,7 +1505,7 @@ JANET_CORE_FN(cfun_ffi_malloc,
 JANET_CORE_FN(cfun_ffi_free,
               "(ffi/free pointer)",
               "Free memory allocated with `ffi/malloc`. Returns nil.") {
-    janet_sandbox_assert(JANET_SANDBOX_FFI);
+    janet_sandbox_assert(JANET_SANDBOX_FFI_USE);
     janet_fixarity(argc, 1);
     if (janet_checktype(argv[0], JANET_NIL)) return janet_wrap_nil();
     void *pointer = janet_getpointer(argv, 0);
@@ -1519,7 +1520,7 @@ JANET_CORE_FN(cfun_ffi_pointer_buffer,
               "to be manipulated with buffer functions. Attempts to resize or extend the buffer "
               "beyond its initial capacity will raise an error. As with many FFI functions, this is memory "
               "unsafe and can potentially allow out of bounds memory access. Returns a new buffer.") {
-    janet_sandbox_assert(JANET_SANDBOX_FFI);
+    janet_sandbox_assert(JANET_SANDBOX_FFI_USE);
     janet_arity(argc, 2, 4);
     void *pointer = janet_getpointer(argv, 0);
     int32_t capacity = janet_getnat(argv, 1);
@@ -1529,6 +1530,42 @@ JANET_CORE_FN(cfun_ffi_pointer_buffer,
     return janet_wrap_buffer(janet_pointer_buffer_unsafe(offset_pointer, capacity, count));
 }
 
+JANET_CORE_FN(cfun_ffi_pointer_cfunction,
+              "(ffi/pointer-cfunction pointer &opt name source-file source-line)",
+              "Create a C Function from a raw pointer. Optionally give the cfunction a name and "
+              "source location for stack traces and debugging.") {
+    janet_sandbox_assert(JANET_SANDBOX_FFI_USE);
+    janet_arity(argc, 1, 4);
+    void *pointer = janet_getpointer(argv, 0);
+    const char *name = janet_optcstring(argv, argc, 1, NULL);
+    const char *source = janet_optcstring(argv, argc, 2, NULL);
+    int32_t line = janet_optinteger(argv, argc, 3, -1);
+    if ((name != NULL) || (source != NULL) || (line != -1)) {
+        janet_registry_put((JanetCFunction) pointer, name, NULL, source, line);
+    }
+    return janet_wrap_cfunction((JanetCFunction) pointer);
+}
+
+JANET_CORE_FN(cfun_ffi_supported_calling_conventions,
+              "(ffi/calling-conventions)",
+              "Get an array of all supported calling conventions on the current arhcitecture. Some architectures may have some FFI "
+              "functionality (ffi/malloc, ffi/free, ffi/read, ffi/write, etc.) but not support "
+              "any calling conventions. This function can be used to get all supported calling conventions "
+              "that can be used on this architecture. All architectures support the :none calling "
+              "convention which is a placeholder that cannot be used at runtime.") {
+    janet_fixarity(argc, 0);
+    (void) argv;
+    JanetArray *array = janet_array(4);
+#ifdef JANET_FFI_WIN64_ENABLED
+    janet_array_push(array, janet_ckeywordv("win64"));
+#endif
+#ifdef JANET_FFI_SYSV64_ENABLED
+    janet_array_push(array, janet_ckeywordv("sysv64"));
+#endif
+    janet_array_push(array, janet_ckeywordv("none"));
+    return janet_wrap_array(array);
+}
+
 void janet_lib_ffi(JanetTable *env) {
     JanetRegExt ffi_cfuns[] = {
         JANET_CORE_REG("ffi/native", janet_core_raw_native),
@@ -1546,6 +1583,8 @@ void janet_lib_ffi(JanetTable *env) {
         JANET_CORE_REG("ffi/malloc", cfun_ffi_malloc),
         JANET_CORE_REG("ffi/free", cfun_ffi_free),
         JANET_CORE_REG("ffi/pointer-buffer", cfun_ffi_pointer_buffer),
+        JANET_CORE_REG("ffi/pointer-cfunction", cfun_ffi_pointer_cfunction),
+        JANET_CORE_REG("ffi/calling-conventions", cfun_ffi_supported_calling_conventions),
         JANET_REG_END
     };
     janet_core_cfuns_ext(env, NULL, ffi_cfuns);

src/core/fiber.c

@@ -81,6 +81,7 @@ JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t
         }
         fiber->stacktop = newstacktop;
     }
+    /* Don't panic on failure since we use this to implement janet_pcall */
     if (janet_fiber_funcframe(fiber, callee)) return NULL;
     janet_fiber_frame(fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
 #ifdef JANET_EV
@@ -477,10 +478,10 @@ JANET_CORE_FN(cfun_fiber_setenv,
 }
 
 JANET_CORE_FN(cfun_fiber_new,
-              "(fiber/new func &opt sigmask)",
+              "(fiber/new func &opt sigmask env)",
               "Create a new fiber with function body func. Can optionally "
-              "take a set of signals to block from the current parent fiber "
-              "when called. The mask is specified as a keyword where each character "
+              "take a set of signals `sigmask` to capture from child fibers, "
+              "and an environment table `env`. The mask is specified as a keyword where each character "
               "is used to indicate a signal to block. If the ev module is enabled, and "
               "this fiber is used as an argument to `ev/go`, these \"blocked\" signals "
               "will result in messages being sent to the supervisor channel. "
@@ -502,14 +503,18 @@ JANET_CORE_FN(cfun_fiber_new,
               "exclusive flags are present, the last flag takes precedence.\n\n"
               "* :i - inherit the environment from the current fiber\n"
               "* :p - the environment table's prototype is the current environment table") {
-    janet_arity(argc, 1, 2);
+    janet_arity(argc, 1, 3);
     JanetFunction *func = janet_getfunction(argv, 0);
     JanetFiber *fiber;
     if (func->def->min_arity > 1) {
         janet_panicf("fiber function must accept 0 or 1 arguments");
     }
     fiber = janet_fiber(func, 64, func->def->min_arity, NULL);
-    if (argc == 2) {
+    janet_assert(fiber != NULL, "bad fiber arity check");
+    if (argc == 3 && !janet_checktype(argv[2], JANET_NIL)) {
+        fiber->env = janet_gettable(argv, 2);
+    }
+    if (argc >= 2) {
         int32_t i;
         JanetByteView view = janet_getbytes(argv, 1);
         fiber->flags = JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;

src/core/inttypes.c

@@ -118,10 +118,9 @@ int64_t janet_unwrap_s64(Janet x) {
         default:
             break;
         case JANET_NUMBER : {
-            double dbl = janet_unwrap_number(x);
-            if (fabs(dbl) <=  MAX_INT_IN_DBL)
-                return (int64_t)dbl;
-            break;
+            double d = janet_unwrap_number(x);
+            if (!janet_checkint64range(d)) break;
+            return (int64_t) d;
         }
         case JANET_STRING: {
             int64_t value;
@@ -147,12 +146,9 @@ uint64_t janet_unwrap_u64(Janet x) {
         default:
             break;
         case JANET_NUMBER : {
-            double dbl = janet_unwrap_number(x);
-            /* Allow negative values to be cast to "wrap around".
-             * This let's addition and subtraction work as expected. */
-            if (fabs(dbl) <=  MAX_INT_IN_DBL)
-                return (uint64_t)dbl;
-            break;
+            double d = janet_unwrap_number(x);
+            if (!janet_checkuint64range(d)) break;
+            return (uint64_t) d;
         }
         case JANET_STRING: {
             uint64_t value;
@@ -307,8 +303,8 @@ static int compare_double_double(double x, double y) {
 
 static int compare_int64_double(int64_t x, double y) {
     if (isnan(y)) {
-        return 0; // clojure and python do this
-    } else if ((y > (- ((double) MAX_INT_IN_DBL))) && (y < ((double) MAX_INT_IN_DBL))) {
+        return 0;
+    } else if ((y > JANET_INTMIN_DOUBLE) && (y < JANET_INTMAX_DOUBLE)) {
         double dx = (double) x;
         return compare_double_double(dx, y);
     } else if (y > ((double) INT64_MAX)) {
@@ -323,10 +319,10 @@ static int compare_int64_double(int64_t x, double y) {
 
 static int compare_uint64_double(uint64_t x, double y) {
     if (isnan(y)) {
-        return 0; // clojure and python do this
+        return 0;
     } else if (y < 0) {
         return 1;
-    } else if ((y >= 0) && (y < ((double) MAX_INT_IN_DBL))) {
+    } else if ((y >= 0) && (y < JANET_INTMAX_DOUBLE)) {
         double dx = (double) x;
         return compare_double_double(dx, y);
     } else if (y > ((double) UINT64_MAX)) {
@@ -339,8 +335,9 @@ static int compare_uint64_double(uint64_t x, double y) {
 
 static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
     janet_fixarity(argc, 2);
-    if (janet_is_int(argv[0]) != JANET_INT_S64)
+    if (janet_is_int(argv[0]) != JANET_INT_S64) {
         janet_panic("compare method requires int/s64 as first argument");
+    }
     int64_t x = janet_unwrap_s64(argv[0]);
     switch (janet_type(argv[1])) {
         default:
@@ -355,7 +352,6 @@ static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
                 int64_t y = *(int64_t *)abst;
                 return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
             } else if (janet_abstract_type(abst) == &janet_u64_type) {
-                // comparing signed to unsigned -- be careful!
                 uint64_t y = *(uint64_t *)abst;
                 if (x < 0) {
                     return janet_wrap_number(-1);
@@ -374,8 +370,9 @@ static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
 
 static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
     janet_fixarity(argc, 2);
-    if (janet_is_int(argv[0]) != JANET_INT_U64)  // is this needed?
+    if (janet_is_int(argv[0]) != JANET_INT_U64) {
         janet_panic("compare method requires int/u64 as first argument");
+    }
     uint64_t x = janet_unwrap_u64(argv[0]);
     switch (janet_type(argv[1])) {
         default:
@@ -390,7 +387,6 @@ static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
                 uint64_t y = *(uint64_t *)abst;
                 return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
             } else if (janet_abstract_type(abst) == &janet_s64_type) {
-                // comparing unsigned to signed -- be careful!
                 int64_t y = *(int64_t *)abst;
                 if (y < 0) {
                     return janet_wrap_number(1);
@@ -431,7 +427,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
 } \
 
 #define OPMETHODINVERT(T, type, name, oper) \
-static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
+static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
     janet_fixarity(argc, 2); \
     T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
     *box = janet_unwrap_##type(argv[1]); \
@@ -440,6 +436,19 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
     return janet_wrap_abstract(box); \
 } \
 
+#define UNARYMETHOD(T, type, name, oper) \
+static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
+    janet_fixarity(argc, 1); \
+    T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
+    *box = oper(janet_unwrap_##type(argv[0])); \
+    return janet_wrap_abstract(box); \
+} \
+
+#define DIVZERO(name) DIVZERO_##name
+#define DIVZERO_div janet_panic("division by zero")
+#define DIVZERO_rem janet_panic("division by zero")
+#define DIVZERO_mod return janet_wrap_abstract(box)
+
 #define DIVMETHOD(T, type, name, oper) \
 static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
     janet_arity(argc, 2, -1);                       \
@@ -447,19 +456,19 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
     *box = janet_unwrap_##type(argv[0]); \
     for (int32_t i = 1; i < argc; i++) { \
       T value = janet_unwrap_##type(argv[i]); \
-      if (value == 0) janet_panic("division by zero"); \
+      if (value == 0) DIVZERO(name); \
       *box oper##= value; \
     } \
     return janet_wrap_abstract(box); \
 } \
 
 #define DIVMETHODINVERT(T, type, name, oper) \
-static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
+static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
     janet_fixarity(argc, 2);                       \
     T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
     *box = janet_unwrap_##type(argv[1]); \
     T value = janet_unwrap_##type(argv[0]); \
-    if (value == 0) janet_panic("division by zero"); \
+    if (value == 0) DIVZERO(name); \
     *box oper##= value; \
     return janet_wrap_abstract(box); \
 } \
@@ -471,7 +480,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
     *box = janet_unwrap_##type(argv[0]); \
     for (int32_t i = 1; i < argc; i++) { \
       T value = janet_unwrap_##type(argv[i]); \
-      if (value == 0) janet_panic("division by zero"); \
+      if (value == 0) DIVZERO(name); \
       if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
       *box oper##= value; \
     } \
@@ -479,26 +488,50 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
 } \
 
 #define DIVMETHODINVERT_SIGNED(T, type, name, oper) \
-static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
+static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
     janet_fixarity(argc, 2);                       \
     T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
     *box = janet_unwrap_##type(argv[1]); \
     T value = janet_unwrap_##type(argv[0]); \
-    if (value == 0) janet_panic("division by zero"); \
+    if (value == 0) DIVZERO(name); \
     if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
     *box oper##= value; \
     return janet_wrap_abstract(box); \
 } \
 
+static Janet cfun_it_s64_divf(int32_t argc, Janet *argv) {
+    janet_fixarity(argc, 2);
+    int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
+    int64_t op1 = janet_unwrap_s64(argv[0]);
+    int64_t op2 = janet_unwrap_s64(argv[1]);
+    if (op2 == 0) janet_panic("division by zero");
+    int64_t x = op1 / op2;
+    *box = x - (((op1 ^ op2) < 0) && (x * op2 != op1));
+    return janet_wrap_abstract(box);
+}
+
+static Janet cfun_it_s64_divfi(int32_t argc, Janet *argv) {
+    janet_fixarity(argc, 2);
+    int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
+    int64_t op2 = janet_unwrap_s64(argv[0]);
+    int64_t op1 = janet_unwrap_s64(argv[1]);
+    if (op2 == 0) janet_panic("division by zero");
+    int64_t x = op1 / op2;
+    *box = x - (((op1 ^ op2) < 0) && (x * op2 != op1));
+    return janet_wrap_abstract(box);
+}
+
 static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
     janet_fixarity(argc, 2);
     int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
     int64_t op1 = janet_unwrap_s64(argv[0]);
     int64_t op2 = janet_unwrap_s64(argv[1]);
-    int64_t x = op1 % op2;
-    *box = (op1 > 0)
-           ? ((op2 > 0) ? x : (0 == x ? x : x + op2))
-           : ((op2 > 0) ? (0 == x ? x : x + op2) : x);
+    if (op2 == 0) {
+        *box = op1;
+    } else {
+        int64_t x = op1 % op2;
+        *box = (((op1 ^ op2) < 0) && (x != 0)) ? x + op2 : x;
+    }
     return janet_wrap_abstract(box);
 }
 
@@ -507,37 +540,43 @@ static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) {
     int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
     int64_t op2 = janet_unwrap_s64(argv[0]);
     int64_t op1 = janet_unwrap_s64(argv[1]);
-    int64_t x = op1 % op2;
-    *box = (op1 > 0)
-           ? ((op2 > 0) ? x : (0 == x ? x : x + op2))
-           : ((op2 > 0) ? (0 == x ? x : x + op2) : x);
+    if (op2 == 0) {
+        *box = op1;
+    } else {
+        int64_t x = op1 % op2;
+        *box = (((op1 ^ op2) < 0) && (x != 0)) ? x + op2 : x;
+    }
     return janet_wrap_abstract(box);
 }
 
 OPMETHOD(int64_t, s64, add, +)
 OPMETHOD(int64_t, s64, sub, -)
-OPMETHODINVERT(int64_t, s64, subi, -)
+OPMETHODINVERT(int64_t, s64, sub, -)
 OPMETHOD(int64_t, s64, mul, *)
 DIVMETHOD_SIGNED(int64_t, s64, div, /)
 DIVMETHOD_SIGNED(int64_t, s64, rem, %)
-DIVMETHODINVERT_SIGNED(int64_t, s64, divi, /)
-DIVMETHODINVERT_SIGNED(int64_t, s64, remi, %)
+DIVMETHODINVERT_SIGNED(int64_t, s64, div, /)
+DIVMETHODINVERT_SIGNED(int64_t, s64, rem, %)
 OPMETHOD(int64_t, s64, and, &)
 OPMETHOD(int64_t, s64, or, |)
 OPMETHOD(int64_t, s64, xor, ^)
+UNARYMETHOD(int64_t, s64, not, ~)
 OPMETHOD(int64_t, s64, lshift, <<)
 OPMETHOD(int64_t, s64, rshift, >>)
 OPMETHOD(uint64_t, u64, add, +)
 OPMETHOD(uint64_t, u64, sub, -)
-OPMETHODINVERT(uint64_t, u64, subi, -)
+OPMETHODINVERT(uint64_t, u64, sub, -)
 OPMETHOD(uint64_t, u64, mul, *)
 DIVMETHOD(uint64_t, u64, div, /)
+DIVMETHOD(uint64_t, u64, rem, %)
 DIVMETHOD(uint64_t, u64, mod, %)
-DIVMETHODINVERT(uint64_t, u64, divi, /)
-DIVMETHODINVERT(uint64_t, u64, modi, %)
+DIVMETHODINVERT(uint64_t, u64, div, /)
+DIVMETHODINVERT(uint64_t, u64, rem, %)
+DIVMETHODINVERT(uint64_t, u64, mod, %)
 OPMETHOD(uint64_t, u64, and, &)
 OPMETHOD(uint64_t, u64, or, |)
 OPMETHOD(uint64_t, u64, xor, ^)
+UNARYMETHOD(uint64_t, u64, not, ~)
 OPMETHOD(uint64_t, u64, lshift, <<)
 OPMETHOD(uint64_t, u64, rshift, >>)
 
@@ -555,6 +594,8 @@ static JanetMethod it_s64_methods[] = {
     {"r*", cfun_it_s64_mul},
     {"/", cfun_it_s64_div},
     {"r/", cfun_it_s64_divi},
+    {"div", cfun_it_s64_divf},
+    {"rdiv", cfun_it_s64_divfi},
     {"mod", cfun_it_s64_mod},
     {"rmod", cfun_it_s64_modi},
     {"%", cfun_it_s64_rem},
@@ -565,6 +606,7 @@ static JanetMethod it_s64_methods[] = {
     {"r|", cfun_it_s64_or},
     {"^", cfun_it_s64_xor},
     {"r^", cfun_it_s64_xor},
+    {"~", cfun_it_s64_not},
     {"<<", cfun_it_s64_lshift},
     {">>", cfun_it_s64_rshift},
     {"compare", cfun_it_s64_compare},
@@ -580,16 +622,19 @@ static JanetMethod it_u64_methods[] = {
     {"r*", cfun_it_u64_mul},
     {"/", cfun_it_u64_div},
     {"r/", cfun_it_u64_divi},
+    {"div", cfun_it_u64_div},
+    {"rdiv", cfun_it_u64_divi},
     {"mod", cfun_it_u64_mod},
     {"rmod", cfun_it_u64_modi},
-    {"%", cfun_it_u64_mod},
-    {"r%", cfun_it_u64_modi},
+    {"%", cfun_it_u64_rem},
+    {"r%", cfun_it_u64_remi},
     {"&", cfun_it_u64_and},
     {"r&", cfun_it_u64_and},
     {"|", cfun_it_u64_or},
     {"r|", cfun_it_u64_or},
     {"^", cfun_it_u64_xor},
     {"r^", cfun_it_u64_xor},
+    {"~", cfun_it_u64_not},
     {"<<", cfun_it_u64_lshift},
     {">>", cfun_it_u64_rshift},
     {"compare", cfun_it_u64_compare},

src/core/io.c

@@ -143,7 +143,8 @@ JANET_CORE_FN(cfun_io_fopen,
               "Following one of the initial flags, 0 or more of the following flags can be appended:\n\n"
               "* b - open the file in binary mode (rather than text mode)\n\n"
               "* + - append to the file instead of overwriting it\n\n"
-              "* n - error if the file cannot be opened instead of returning nil") {
+              "* n - error if the file cannot be opened instead of returning nil\n\n"
+              "See fopen (<stdio.h>, C99) for further details.") {
     janet_arity(argc, 1, 2);
     const uint8_t *fname = janet_getstring(argv, 0);
     const uint8_t *fmode;
@@ -504,7 +505,6 @@ static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
     return janet_wrap_nil();
 }
 
-
 static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
                                 int newline, const char *name, FILE *dflt_file) {
     Janet x = janet_dyn(name);

src/core/marsh.c

@@ -154,7 +154,7 @@ static void pushbytes(MarshalState *st, const uint8_t *bytes, int32_t len) {
     janet_buffer_push_bytes(st->buf, bytes, len);
 }
 
-static void pushpointer(MarshalState *st, void *ptr) {
+static void pushpointer(MarshalState *st, const void *ptr) {
     janet_buffer_push_bytes(st->buf, (const uint8_t *) &ptr, sizeof(ptr));
 }
 
@@ -246,6 +246,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
     }
     /* Add to lookup */
     janet_v_push(st->seen_defs, def);
+
     pushint(st, def->flags);
     pushint(st, def->slotcount);
     pushint(st, def->arity);
@@ -266,14 +267,14 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
 
     /* marshal constants */
     for (int32_t i = 0; i < def->constants_length; i++)
-        marshal_one(st, def->constants[i], flags);
+        marshal_one(st, def->constants[i], flags + 1);
 
     /* Marshal symbol map, if needed */
     for (int32_t i = 0; i < def->symbolmap_length; i++) {
         pushint(st, (int32_t) def->symbolmap[i].birth_pc);
         pushint(st, (int32_t) def->symbolmap[i].death_pc);
         pushint(st, (int32_t) def->symbolmap[i].slot_index);
-        marshal_one(st, janet_wrap_symbol(def->symbolmap[i].symbol), flags);
+        marshal_one(st, janet_wrap_symbol(def->symbolmap[i].symbol), flags + 1);
     }
 
     /* marshal the bytecode */
@@ -362,6 +363,15 @@ void janet_marshal_int(JanetMarshalContext *ctx, int32_t value) {
     pushint(st, value);
 }
 
+/* Only use in unsafe - don't marshal pointers otherwise */
+void janet_marshal_ptr(JanetMarshalContext *ctx, const void *ptr) {
+    if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
+        janet_panic("can only marshal pointers in unsafe mode");
+    }
+    MarshalState *st = (MarshalState *)(ctx->m_state);
+    pushpointer(st, ptr);
+}
+
 void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value) {
     MarshalState *st = (MarshalState *)(ctx->m_state);
     pushbyte(st, value);
@@ -378,18 +388,27 @@ void janet_marshal_janet(JanetMarshalContext *ctx, Janet x) {
     marshal_one(st, x, ctx->flags + 1);
 }
 
+#ifdef JANET_MARSHAL_DEBUG
+#define MARK_SEEN() \
+    do { if (st->maybe_cycles) { \
+        Janet _check = janet_table_get(&st->seen, x); \
+        if (!janet_checktype(_check, JANET_NIL)) janet_eprintf("double MARK_SEEN on %v\n", x); \
+        janet_eprintf("made reference %d (%t) to %v\n", st->nextid, x, x); \
+        janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); \
+    } } while (0)
+#else
+#define MARK_SEEN() \
+    do { if (st->maybe_cycles) { \
+        janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); \
+    } } while (0)
+#endif
+
 void janet_marshal_abstract(JanetMarshalContext *ctx, void *abstract) {
     MarshalState *st = (MarshalState *)(ctx->m_state);
-    if (st->maybe_cycles) {
-        janet_table_put(&st->seen,
-                        janet_wrap_abstract(abstract),
-                        janet_wrap_integer(st->nextid++));
-    }
+    Janet x = janet_wrap_abstract(abstract);
+    MARK_SEEN();
 }
 
-#define MARK_SEEN() \
-    do { if (st->maybe_cycles) janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); } while (0)
-
 static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
     void *abstract = janet_unwrap_abstract(x);
 #ifdef JANET_EV
@@ -411,7 +430,7 @@ static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
     if (at->marshal) {
         pushbyte(st, LB_ABSTRACT);
         marshal_one(st, janet_csymbolv(at->name), flags + 1);
-        JanetMarshalContext context = {st, NULL, flags, NULL, at};
+        JanetMarshalContext context = {st, NULL, flags + 1, NULL, at};
         at->marshal(abstract, &context);
     } else {
         janet_panicf("cannot marshal %p", x);
@@ -728,9 +747,22 @@ static uint64_t read64(UnmarshalState *st, const uint8_t **atdata) {
     return ret;
 }
 
+#ifdef JANET_MARSHAL_DEBUG
+static void dump_reference_table(UnmarshalState *st) {
+    for (int32_t i = 0; i < janet_v_count(st->lookup); i++) {
+        janet_eprintf("  reference %d (%t) = %v\n", i, st->lookup[i], st->lookup[i]);
+    }
+}
+#endif
+
 /* Assert a janet type */
-static void janet_asserttype(Janet x, JanetType t) {
+static void janet_asserttype(Janet x, JanetType t, UnmarshalState *st) {
     if (!janet_checktype(x, t)) {
+#ifdef JANET_MARSHAL_DEBUG
+        dump_reference_table(st);
+#else
+        (void) st;
+#endif
         janet_panicf("expected type %T, got %v", 1 << t, x);
     }
 }
@@ -782,7 +814,7 @@ static const uint8_t *unmarshal_one_env(
             Janet fiberv;
             /* On stack variant */
             data = unmarshal_one(st, data, &fiberv, flags);
-            janet_asserttype(fiberv, JANET_FIBER);
+            janet_asserttype(fiberv, JANET_FIBER, st);
             env->as.fiber = janet_unwrap_fiber(fiberv);
             /* Negative offset indicates untrusted input */
             env->offset = -offset;
@@ -880,13 +912,13 @@ static const uint8_t *unmarshal_one_def(
         if (def->flags & JANET_FUNCDEF_FLAG_HASNAME) {
             Janet x;
             data = unmarshal_one(st, data, &x, flags + 1);
-            janet_asserttype(x, JANET_STRING);
+            janet_asserttype(x, JANET_STRING, st);
             def->name = janet_unwrap_string(x);
         }
         if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCE) {
             Janet x;
             data = unmarshal_one(st, data, &x, flags + 1);
-            janet_asserttype(x, JANET_STRING);
+            janet_asserttype(x, JANET_STRING, st);
             def->source = janet_unwrap_string(x);
         }
 
@@ -916,8 +948,9 @@ static const uint8_t *unmarshal_one_def(
                 def->symbolmap[i].slot_index = (uint32_t) readint(st, &data);
                 Janet value;
                 data = unmarshal_one(st, data, &value, flags + 1);
-                if (!janet_checktype(value, JANET_SYMBOL))
-                    janet_panic("expected symbol in symbol map");
+                if (!janet_checktype(value, JANET_SYMBOL)) {
+                    janet_panicf("corrupted symbolmap when unmarshalling debug info, got %v", value);
+                }
                 def->symbolmap[i].symbol = janet_unwrap_symbol(value);
             }
             def->symbolmap_length = (uint32_t) symbolmap_length;
@@ -1066,7 +1099,7 @@ static const uint8_t *unmarshal_one_fiber(
         /* Get function */
         Janet funcv;
         data = unmarshal_one(st, data, &funcv, flags + 1);
-        janet_asserttype(funcv, JANET_FUNCTION);
+        janet_asserttype(funcv, JANET_FUNCTION, st);
         func = janet_unwrap_function(funcv);
         def = func->def;
 
@@ -1112,7 +1145,7 @@ static const uint8_t *unmarshal_one_fiber(
         Janet envv;
         fiber_flags &= ~JANET_FIBER_FLAG_HASENV;
         data = unmarshal_one(st, data, &envv, flags + 1);
-        janet_asserttype(envv, JANET_TABLE);
+        janet_asserttype(envv, JANET_TABLE, st);
         fiber_env = janet_unwrap_table(envv);
     }
 
@@ -1121,7 +1154,7 @@ static const uint8_t *unmarshal_one_fiber(
         Janet fiberv;
         fiber_flags &= ~JANET_FIBER_FLAG_HASCHILD;
         data = unmarshal_one(st, data, &fiberv, flags + 1);
-        janet_asserttype(fiberv, JANET_FIBER);
+        janet_asserttype(fiberv, JANET_FIBER, st);
         fiber->child = janet_unwrap_fiber(fiberv);
     }
 
@@ -1165,6 +1198,18 @@ int64_t janet_unmarshal_int64(JanetMarshalContext *ctx) {
     return read64(st, &(ctx->data));
 }
 
+void *janet_unmarshal_ptr(JanetMarshalContext *ctx) {
+    if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
+        janet_panic("can only unmarshal pointers in unsafe mode");
+    }
+    UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
+    void *ptr;
+    MARSH_EOS(st, ctx->data + sizeof(void *) - 1);
+    memcpy((char *) &ptr, ctx->data, sizeof(void *));
+    ctx->data += sizeof(void *);
+    return ptr;
+}
+
 uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx) {
     UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
     MARSH_EOS(st, ctx->data);
@@ -1207,7 +1252,9 @@ static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *
     if (at == NULL) janet_panic("unknown abstract type");
     if (at->unmarshal) {
         JanetMarshalContext context = {NULL, st, flags, data, at};
-        *out = janet_wrap_abstract(at->unmarshal(&context));
+        void *abst = at->unmarshal(&context);
+        janet_assert(abst != NULL, "null pointer abstract");
+        *out = janet_wrap_abstract(abst);
         if (context.at != NULL) {
             janet_panic("janet_unmarshal_abstract not called");
         }
@@ -1308,7 +1355,7 @@ static const uint8_t *unmarshal_one(
         }
         case LB_FIBER: {
             JanetFiber *fiber;
-            data = unmarshal_one_fiber(st, data + 1, &fiber, flags);
+            data = unmarshal_one_fiber(st, data + 1, &fiber, flags + 1);
             *out = janet_wrap_fiber(fiber);
             return data;
         }
@@ -1323,6 +1370,9 @@ static const uint8_t *unmarshal_one(
             func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) +
                                  len * sizeof(JanetFuncEnv));
             func->def = NULL;
+            for (int32_t i = 0; i < len; i++) {
+                func->envs[i] = NULL;
+            }
             *out = janet_wrap_function(func);
             janet_v_push(st->lookup, *out);
             data = unmarshal_one_def(st, data, &def, flags + 1);
@@ -1376,7 +1426,7 @@ static const uint8_t *unmarshal_one(
                 if (lead == LB_STRUCT_PROTO) {
                     Janet proto;
                     data = unmarshal_one(st, data, &proto, flags + 1);
-                    janet_asserttype(proto, JANET_STRUCT);
+                    janet_asserttype(proto, JANET_STRUCT, st);
                     janet_struct_proto(struct_) = janet_unwrap_struct(proto);
                 }
                 for (int32_t i = 0; i < len; i++) {
@@ -1399,7 +1449,7 @@ static const uint8_t *unmarshal_one(
                 if (lead == LB_TABLE_PROTO) {
                     Janet proto;
                     data = unmarshal_one(st, data, &proto, flags + 1);
-                    janet_asserttype(proto, JANET_TABLE);
+                    janet_asserttype(proto, JANET_TABLE, st);
                     t->proto = janet_unwrap_table(proto);
                 }
                 for (int32_t i = 0; i < len; i++) {

src/core/net.c

@@ -256,7 +256,6 @@ JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunctio
     janet_await();
 }
 
-
 #endif
 
 /* Adress info */
@@ -417,7 +416,6 @@ JANET_CORE_FN(cfun_net_connect,
         }
     }
 
-
     /* Create socket */
     JSock sock = JSOCKDEFAULT;
     void *addr = NULL;

src/core/os.c

@@ -289,7 +289,6 @@ JANET_CORE_FN(os_cpu_count,
 #endif
 }
 
-
 #ifndef JANET_NO_PROCESSES
 
 /* Get env for os_execute */
@@ -1076,7 +1075,6 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
         startupInfo.hStdInput = (HANDLE) _get_osfhandle(0);
     }
 
-
     if (pipe_out != JANET_HANDLE_NONE) {
         startupInfo.hStdOutput = pipe_out;
     } else if (new_out != JANET_HANDLE_NONE) {
@@ -1147,14 +1145,16 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
         posix_spawn_file_actions_addclose(&actions, pipe_in);
     } else if (new_in != JANET_HANDLE_NONE && new_in != 0) {
         posix_spawn_file_actions_adddup2(&actions, new_in, 0);
-        posix_spawn_file_actions_addclose(&actions, new_in);
+        if (new_in != new_out && new_in != new_err)
+            posix_spawn_file_actions_addclose(&actions, new_in);
     }
     if (pipe_out != JANET_HANDLE_NONE) {
         posix_spawn_file_actions_adddup2(&actions, pipe_out, 1);
         posix_spawn_file_actions_addclose(&actions, pipe_out);
     } else if (new_out != JANET_HANDLE_NONE && new_out != 1) {
         posix_spawn_file_actions_adddup2(&actions, new_out, 1);
-        posix_spawn_file_actions_addclose(&actions, new_out);
+        if (new_out != new_err)
+            posix_spawn_file_actions_addclose(&actions, new_out);
     }
     if (pipe_err != JANET_HANDLE_NONE) {
         posix_spawn_file_actions_adddup2(&actions, pipe_err, 2);
@@ -1431,6 +1431,23 @@ JANET_CORE_FN(os_sleep,
     return janet_wrap_nil();
 }
 
+JANET_CORE_FN(os_isatty,
+              "(os/isatty &opt file)",
+              "Returns true if `file` is a terminal. If `file` is not specified, "
+              "it will default to standard output.") {
+    janet_arity(argc, 0, 1);
+    FILE *f = (argc == 1) ? janet_getfile(argv, 0, NULL) : stdout;
+#ifdef JANET_WINDOWS
+    int fd = _fileno(f);
+    if (fd == -1) janet_panic("not a valid stream");
+    return janet_wrap_boolean(_isatty(fd));
+#else
+    int fd = fileno(f);
+    if (fd == -1) janet_panic(strerror(errno));
+    return janet_wrap_boolean(isatty(fd));
+#endif
+}
+
 JANET_CORE_FN(os_cwd,
               "(os/cwd)",
               "Returns the current working directory.") {
@@ -2469,6 +2486,7 @@ void janet_lib_os(JanetTable *env) {
         JANET_CORE_REG("os/date", os_date), /* not high resolution */
         JANET_CORE_REG("os/strftime", os_strftime),
         JANET_CORE_REG("os/sleep", os_sleep),
+        JANET_CORE_REG("os/isatty", os_isatty),
 
         /* env functions */
         JANET_CORE_REG("os/environ", os_environ),

src/core/parse.c

@@ -259,6 +259,14 @@ static int checkescape(uint8_t c) {
             return '\f';
         case 'v':
             return '\v';
+        case 'a':
+            return '\a';
+        case 'b':
+            return '\b';
+        case '\'':
+            return '\'';
+        case '?':
+            return '?';
         case 'e':
             return 27;
         case '"':

src/core/peg.c

@@ -1261,6 +1261,13 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
         default:
             peg_panic(b, "unexpected peg source");
             return 0;
+
+        case JANET_BOOLEAN: {
+            int n = janet_unwrap_boolean(peg);
+            Reserve r = reserve(b, 2);
+            emit_1(r, n ? RULE_NCHAR : RULE_NOTNCHAR, 0);
+            break;
+        }
         case JANET_NUMBER: {
             int32_t n = peg_getinteger(b, peg);
             Reserve r = reserve(b, 2);

src/core/pp.c

@@ -152,6 +152,12 @@ static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, in
             case '\v':
                 janet_buffer_push_bytes(buffer, (const uint8_t *)"\\v", 2);
                 break;
+            case '\a':
+                janet_buffer_push_bytes(buffer, (const uint8_t *)"\\a", 2);
+                break;
+            case '\b':
+                janet_buffer_push_bytes(buffer, (const uint8_t *)"\\b", 2);
+                break;
             case 27:
                 janet_buffer_push_bytes(buffer, (const uint8_t *)"\\e", 2);
                 break;
@@ -244,6 +250,10 @@ void janet_to_string_b(JanetBuffer *buffer, Janet x) {
         case JANET_FUNCTION: {
             JanetFunction *fun = janet_unwrap_function(x);
             JanetFuncDef *def = fun->def;
+            if (def == NULL) {
+                janet_buffer_push_cstring(buffer, "<incomplete function>");
+                break;
+            }
             if (def->name) {
                 const uint8_t *n = def->name;
                 janet_buffer_push_cstring(buffer, "<function ");
@@ -775,7 +785,7 @@ static const char *get_fmt_mapping(char c) {
         if (format_mappings[i].c == c)
             return format_mappings[i].mapping;
     }
-    return NULL;
+    janet_assert(0, "bad format mapping");
 }
 
 static const char *scanformat(

src/core/specials.c

@@ -182,7 +182,6 @@ static int destructure(JanetCompiler *c,
                         return 1;
                     }
 
-
                     if (!janet_checktype(values[i + 1], JANET_SYMBOL)) {
                         janetc_error(c, janet_formatc("expected symbol following '& in destructuring pattern, found %q", values[i + 1]));
                         return 1;
@@ -306,12 +305,16 @@ static JanetSlot janetc_varset(JanetFopts opts, int32_t argn, const Janet *argv)
 }
 
 /* Add attributes to a global def or var table */
-static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv) {
+static JanetTable *handleattr(JanetCompiler *c, const char *kind, int32_t argn, const Janet *argv) {
     int32_t i;
     JanetTable *tab = janet_table(2);
     const char *binding_name = janet_type(argv[0]) == JANET_SYMBOL
                                ? ((const char *)janet_unwrap_symbol(argv[0]))
                                : "<multiple bindings>";
+    if (argn < 2) {
+        janetc_error(c, janet_formatc("expected at least 2 arguments to %s", kind));
+        return NULL;
+    }
     for (i = 1; i < argn - 1; i++) {
         Janet attr = argv[i];
         switch (janet_type(attr)) {
@@ -335,18 +338,52 @@ static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv)
     return tab;
 }
 
-static JanetSlot dohead(const char *kind, JanetCompiler *c, JanetFopts opts, Janet *head, int32_t argn, const Janet *argv) {
+typedef struct SlotHeadPair {
+    Janet lhs;
+    JanetSlot rhs;
+} SlotHeadPair;
+
+SlotHeadPair *dohead_destructure(JanetCompiler *c, SlotHeadPair *into, JanetFopts opts, Janet lhs, Janet rhs) {
+
+    /* Detect if we can do an optimization to avoid some allocations */
+    int can_destructure_lhs = janet_checktype(lhs, JANET_TUPLE)
+                              || janet_checktype(lhs, JANET_ARRAY);
+    int rhs_is_indexed = janet_checktype(rhs, JANET_ARRAY)
+                         || (janet_checktype(rhs, JANET_TUPLE) && (janet_tuple_flag(janet_unwrap_tuple(rhs)) & JANET_TUPLE_FLAG_BRACKETCTOR));
+    uint32_t has_drop = opts.flags & JANET_FOPTS_DROP;
+
     JanetFopts subopts = janetc_fopts_default(c);
-    JanetSlot ret;
-    if (argn < 2) {
-        janetc_error(c, janet_formatc("expected at least 2 arguments to %s", kind));
-        return janetc_cslot(janet_wrap_nil());
-    }
-    *head = argv[0];
     subopts.flags = opts.flags & ~(JANET_FOPTS_TAIL | JANET_FOPTS_DROP);
+
+    if (has_drop && can_destructure_lhs && rhs_is_indexed) {
+        /* Code is of the form (def [a b] [1 2]), avoid the allocation of two tuples */
+        JanetView view_lhs = {0};
+        JanetView view_rhs = {0};
+        janet_indexed_view(lhs, &view_lhs.items, &view_lhs.len);
+        janet_indexed_view(rhs, &view_rhs.items, &view_rhs.len);
+        int found_amp = 0;
+        for (int32_t i = 0; i < view_lhs.len; i++) {
+            if (janet_symeq(view_lhs.items[i], "&")) {
+                found_amp = 1;
+                /* Good error will be generated later. */
+                break;
+            }
+        }
+        if (!found_amp) {
+            for (int32_t i = 0; i < view_lhs.len; i++) {
+                Janet sub_rhs = view_rhs.len <= i ? janet_wrap_nil() : view_rhs.items[i];
+                into = dohead_destructure(c, into, subopts, view_lhs.items[i], sub_rhs);
+            }
+            return into;
+        }
+    }
+
+    /* No optimization, do the simple way */
     subopts.hint = opts.hint;
-    ret = janetc_value(subopts, argv[argn - 1]);
-    return ret;
+    JanetSlot ret = janetc_value(subopts, rhs);
+    SlotHeadPair shp = {lhs, ret};
+    janet_v_push(into, shp);
+    return into;
 }
 
 /* Def or var a symbol in a local scope */
@@ -412,12 +449,23 @@ static int varleaf(
 
 static JanetSlot janetc_var(JanetFopts opts, int32_t argn, const Janet *argv) {
     JanetCompiler *c = opts.compiler;
-    Janet head;
-    JanetTable *attr_table = handleattr(c, argn, argv);
-    JanetSlot ret = dohead("var", c, opts, &head, argn, argv);
-    if (c->result.status == JANET_COMPILE_ERROR)
+    JanetTable *attr_table = handleattr(c, "var", argn, argv);
+    if (c->result.status == JANET_COMPILE_ERROR) {
         return janetc_cslot(janet_wrap_nil());
-    destructure(c, argv[0], ret, varleaf, attr_table);
+    }
+    SlotHeadPair *into = NULL;
+    into = dohead_destructure(c, into, opts, argv[0], argv[argn - 1]);
+    if (c->result.status == JANET_COMPILE_ERROR) {
+        janet_v_free(into);
+        return janetc_cslot(janet_wrap_nil());
+    }
+    JanetSlot ret;
+    janet_assert(janet_v_count(into) > 0, "bad destructure");
+    for (int32_t i = 0; i < janet_v_count(into); i++) {
+        destructure(c, into[i].lhs, into[i].rhs, varleaf, attr_table);
+        ret = into[i].rhs;
+    }
+    janet_v_free(into);
     return ret;
 }
 
@@ -461,13 +509,24 @@ static int defleaf(
 
 static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
     JanetCompiler *c = opts.compiler;
-    Janet head;
-    opts.flags &= ~JANET_FOPTS_HINT;
-    JanetTable *attr_table = handleattr(c, argn, argv);
-    JanetSlot ret = dohead("def", c, opts, &head, argn, argv);
-    if (c->result.status == JANET_COMPILE_ERROR)
+    JanetTable *attr_table = handleattr(c, "def", argn, argv);
+    if (c->result.status == JANET_COMPILE_ERROR) {
         return janetc_cslot(janet_wrap_nil());
-    destructure(c, argv[0], ret, defleaf, attr_table);
+    }
+    opts.flags &= ~JANET_FOPTS_HINT;
+    SlotHeadPair *into = NULL;
+    into = dohead_destructure(c, into, opts, argv[0], argv[argn - 1]);
+    if (c->result.status == JANET_COMPILE_ERROR) {
+        janet_v_free(into);
+        return janetc_cslot(janet_wrap_nil());
+    }
+    JanetSlot ret;
+    janet_assert(janet_v_count(into) > 0, "bad destructure");
+    for (int32_t i = 0; i < janet_v_count(into); i++) {
+        destructure(c, into[i].lhs, into[i].rhs, defleaf, attr_table);
+        ret = into[i].rhs;
+    }
+    janet_v_free(into);
     return ret;
 }
 
@@ -592,7 +651,6 @@ static JanetSlot janetc_do(JanetFopts opts, int32_t argn, const Janet *argv) {
     return ret;
 }
 
-
 /* Compile an upscope form. Upscope forms execute their body sequentially and
  * evaluate to the last expression in the body, but without lexical scope. */
 static JanetSlot janetc_upscope(JanetFopts opts, int32_t argn, const Janet *argv) {
@@ -960,6 +1018,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
     for (i = 0; i < paramcount; i++) {
         Janet param = params[i];
         if (!janet_checktype(param, JANET_SYMBOL)) {
+            janet_assert(janet_v_count(destructed_params) > j, "out of bounds");
             JanetSlot reg = destructed_params[j++];
             destructure(c, param, reg, defleaf, NULL);
             janetc_freeslot(c, reg);
@@ -1064,4 +1123,3 @@ const JanetSpecial *janetc_special(const uint8_t *name) {
                sizeof(JanetSpecial),
                name);
 }
-

src/core/string.c

@@ -175,8 +175,9 @@ JANET_CORE_FN(cfun_string_slice,
               "Returns a substring from a byte sequence. The substring is from "
               "index `start` inclusive to index `end`, exclusive. All indexing "
               "is from 0. `start` and `end` can also be negative to indicate indexing "
-              "from the end of the string. Note that index -1 is synonymous with "
-              "index `(length bytes)` to allow a full negative slice range. ") {
+              "from the end of the string. Note that if `start` is negative it is "
+              "exclusive, and if `end` is negative it is inclusive, to allow a full "
+              "negative slice range.") {
     JanetByteView view = janet_getbytes(argv, 0);
     JanetRange range = janet_getslice(argc, argv);
     return janet_stringv(view.bytes + range.start, range.end - range.start);

src/core/symcache.c

@@ -108,6 +108,7 @@ static const uint8_t **janet_symcache_findmem(
         }
 notfound:
     *success = 0;
+    janet_assert(firstEmpty != NULL, "symcache failed to get memory");
     return firstEmpty;
 }
 

src/core/tuple.c

@@ -69,9 +69,9 @@ JANET_CORE_FN(cfun_tuple_slice,
               "inclusive to index `end` exclusive. If `start` or `end` are not provided, "
               "they default to 0 and the length of `arrtup`, respectively. "
               "`start` and `end` can also be negative to indicate indexing "
-              "from the end of the input. Note that index -1 is synonymous with "
-              "index `(length arrtup)` to allow a full negative slice range. "
-              "Returns the new tuple.") {
+              "from the end of the input. Note that if `start` is negative it is "
+              "exclusive, and if `end` is negative it is inclusive, to allow a full "
+              "negative slice range. Returns the new tuple.") {
     JanetView view = janet_getindexed(argv, 0);
     JanetRange range = janet_getslice(argc, argv);
     return janet_wrap_tuple(janet_tuple_n(view.items + range.start, range.end - range.start));

src/core/util.c

@@ -499,7 +499,7 @@ typedef struct {
 static void namebuf_init(NameBuf *namebuf, const char *prefix) {
     size_t plen = strlen(prefix);
     namebuf->plen = plen;
-    namebuf->buf = janet_malloc(namebuf->plen + 256);
+    namebuf->buf = janet_smalloc(namebuf->plen + 256);
     if (NULL == namebuf->buf) {
         JANET_OUT_OF_MEMORY;
     }
@@ -508,12 +508,12 @@ static void namebuf_init(NameBuf *namebuf, const char *prefix) {
 }
 
 static void namebuf_deinit(NameBuf *namebuf) {
-    janet_free(namebuf->buf);
+    janet_sfree(namebuf->buf);
 }
 
 static char *namebuf_name(NameBuf *namebuf, const char *suffix) {
     size_t slen = strlen(suffix);
-    namebuf->buf = janet_realloc(namebuf->buf, namebuf->plen + 2 + slen);
+    namebuf->buf = janet_srealloc(namebuf->buf, namebuf->plen + 2 + slen);
     if (NULL == namebuf->buf) {
         JANET_OUT_OF_MEMORY;
     }
@@ -805,6 +805,13 @@ int janet_checkint(Janet x) {
     return janet_checkintrange(dval);
 }
 
+int janet_checkuint(Janet x) {
+    if (!janet_checktype(x, JANET_NUMBER))
+        return 0;
+    double dval = janet_unwrap_number(x);
+    return janet_checkuintrange(dval);
+}
+
 int janet_checkint64(Janet x) {
     if (!janet_checktype(x, JANET_NUMBER))
         return 0;
@@ -816,7 +823,7 @@ int janet_checkuint64(Janet x) {
     if (!janet_checktype(x, JANET_NUMBER))
         return 0;
     double dval = janet_unwrap_number(x);
-    return dval >= 0 && dval <= JANET_INTMAX_DOUBLE && dval == (uint64_t) dval;
+    return janet_checkuint64range(dval);
 }
 
 int janet_checksize(Janet x) {

src/core/value.c

@@ -698,11 +698,16 @@ Janet janet_lengthv(Janet x) {
             const JanetAbstractType *type = janet_abstract_type(abst);
             if (type->length != NULL) {
                 size_t len = type->length(abst, janet_abstract_size(abst));
-                if ((uint64_t) len <= (uint64_t) JANET_INTMAX_INT64) {
+                /* If len is always less then double, we can never overflow */
+#ifdef JANET_32
+                return janet_wrap_number(len);
+#else
+                if (len < (size_t) JANET_INTMAX_INT64) {
                     return janet_wrap_number((double) len);
                 } else {
                     janet_panicf("integer length %u too large", len);
                 }
+#endif
             }
             Janet argv[1] = { x };
             return janet_mcall("length", 1, argv);

src/core/vector.c

@@ -40,7 +40,7 @@ void *janet_v_grow(void *v, int32_t increment, int32_t itemsize) {
 
 /* Convert a buffer to normal allocated memory (forget capacity) */
 void *janet_v_flattenmem(void *v, int32_t itemsize) {
-    int32_t *p;
+    char *p;
     if (NULL == v) return NULL;
     size_t size = (size_t) itemsize * janet_v__cnt(v);
     p = janet_malloc(size);

src/core/vm.c

@@ -138,7 +138,7 @@
             vm_pcnext();\
         }\
     }
-#define _vm_bitop_immediate(op, type1)\
+#define _vm_bitop_immediate(op, type1, rangecheck, msg)\
     {\
         Janet op1 = stack[B];\
         if (!janet_checktype(op1, JANET_NUMBER)) {\
@@ -147,13 +147,15 @@
             stack[A] = janet_mcall(#op, 2, _argv);\
             vm_checkgc_pcnext();\
         } else {\
-            type1 x1 = (type1) janet_unwrap_integer(op1);\
-            stack[A] = janet_wrap_integer(x1 op CS);\
+            double y1 = janet_unwrap_number(op1);\
+            if (!rangecheck(y1)) { vm_commit(); janet_panicf("value %v out of range for " msg, op1); }\
+            type1 x1 = (type1) y1;\
+            stack[A] = janet_wrap_number((type1) (x1 op CS));\
             vm_pcnext();\
         }\
     }
-#define vm_bitop_immediate(op) _vm_bitop_immediate(op, int32_t);
-#define vm_bitopu_immediate(op) _vm_bitop_immediate(op, uint32_t);
+#define vm_bitop_immediate(op) _vm_bitop_immediate(op, int32_t, janet_checkintrange, "32-bit signed integers");
+#define vm_bitopu_immediate(op) _vm_bitop_immediate(op, uint32_t, janet_checkuintrange, "32-bit unsigned integers");
 #define _vm_binop(op, wrap)\
     {\
         Janet op1 = stack[B];\
@@ -170,14 +172,18 @@
         }\
     }
 #define vm_binop(op) _vm_binop(op, janet_wrap_number)
-#define _vm_bitop(op, type1)\
+#define _vm_bitop(op, type1, rangecheck, msg)\
     {\
         Janet op1 = stack[B];\
         Janet op2 = stack[C];\
         if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\
-            type1 x1 = (type1) janet_unwrap_integer(op1);\
-            int32_t x2 = janet_unwrap_integer(op2);\
-            stack[A] = janet_wrap_integer(x1 op x2);\
+            double y1 = janet_unwrap_number(op1);\
+            double y2 = janet_unwrap_number(op2);\
+            if (!rangecheck(y1)) { vm_commit(); janet_panicf("value %v out of range for " msg, op1); }\
+            if (!janet_checkintrange(y2)) { vm_commit(); janet_panicf("rhs must be valid 32-bit signed integer, got %f", op2); }\
+            type1 x1 = (type1) y1;\
+            int32_t x2 = (int32_t) y2;\
+            stack[A] = janet_wrap_number((type1) (x1 op x2));\
             vm_pcnext();\
         } else {\
             vm_commit();\
@@ -185,8 +191,8 @@
             vm_checkgc_pcnext();\
         }\
     }
-#define vm_bitop(op) _vm_bitop(op, int32_t)
-#define vm_bitopu(op) _vm_bitop(op, uint32_t)
+#define vm_bitop(op) _vm_bitop(op, int32_t, janet_checkintrange, "32-bit signed integers")
+#define vm_bitopu(op) _vm_bitop(op, uint32_t, janet_checkuintrange, "32-bit unsigned integers")
 #define vm_compop(op) \
     {\
         Janet op1 = stack[B];\
@@ -295,6 +301,16 @@ static Janet janet_method_lookup(Janet x, const char *name) {
     return method_to_fun(janet_ckeywordv(name), x);
 }
 
+static Janet janet_unary_call(const char *method, Janet arg) {
+    Janet m = janet_method_lookup(arg, method);
+    if (janet_checktype(m, JANET_NIL)) {
+        janet_panicf("could not find method :%s for %v", method, arg);
+    } else {
+        Janet argv[1] = { arg };
+        return janet_method_invoke(m, 1, argv);
+    }
+}
+
 /* Call a method first on the righthand side, and then on the left hand side with a prefix */
 static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lhs, Janet rhs) {
     Janet lm = janet_method_lookup(lhs, lmethod);
@@ -331,11 +347,13 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
         &&label_JOP_RETURN_NIL,
         &&label_JOP_ADD_IMMEDIATE,
         &&label_JOP_ADD,
+        &&label_JOP_SUBTRACT_IMMEDIATE,
         &&label_JOP_SUBTRACT,
         &&label_JOP_MULTIPLY_IMMEDIATE,
         &&label_JOP_MULTIPLY,
         &&label_JOP_DIVIDE_IMMEDIATE,
         &&label_JOP_DIVIDE,
+        &&label_JOP_DIVIDE_FLOOR,
         &&label_JOP_MODULO,
         &&label_JOP_REMAINDER,
         &&label_JOP_BAND,
@@ -576,8 +594,6 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
         &&label_unknown_op,
         &&label_unknown_op,
         &&label_unknown_op,
-        &&label_unknown_op,
-        &&label_unknown_op,
         &&label_unknown_op
     };
 #endif
@@ -667,6 +683,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
     VM_OP(JOP_ADD)
     vm_binop(+);
 
+    VM_OP(JOP_SUBTRACT_IMMEDIATE)
+    vm_binop_immediate(-);
+
     VM_OP(JOP_SUBTRACT)
     vm_binop(-);
 
@@ -682,14 +701,33 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
     VM_OP(JOP_DIVIDE)
     vm_binop( /);
 
+    VM_OP(JOP_DIVIDE_FLOOR) {
+        Janet op1 = stack[B];
+        Janet op2 = stack[C];
+        if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
+            double x1 = janet_unwrap_number(op1);
+            double x2 = janet_unwrap_number(op2);
+            stack[A] = janet_wrap_number(floor(x1 / x2));
+            vm_pcnext();
+        } else {
+            vm_commit();
+            stack[A] = janet_binop_call("div", "rdiv", op1, op2);
+            vm_checkgc_pcnext();
+        }
+    }
+
     VM_OP(JOP_MODULO) {
         Janet op1 = stack[B];
         Janet op2 = stack[C];
         if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
             double x1 = janet_unwrap_number(op1);
             double x2 = janet_unwrap_number(op2);
-            double intres = x2 * floor(x1 / x2);
-            stack[A] = janet_wrap_number(x1 - intres);
+            if (x2 == 0) {
+                stack[A] = janet_wrap_number(x1);
+            } else {
+                double intres = x2 * floor(x1 / x2);
+                stack[A] = janet_wrap_number(x1 - intres);
+            }
             vm_pcnext();
         } else {
             vm_commit();
@@ -724,9 +762,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
 
     VM_OP(JOP_BNOT) {
         Janet op = stack[E];
-        vm_assert_type(op, JANET_NUMBER);
-        stack[A] = janet_wrap_integer(~janet_unwrap_integer(op));
-        vm_pcnext();
+        if (janet_checktype(op, JANET_NUMBER)) {
+            stack[A] = janet_wrap_integer(~janet_unwrap_integer(op));
+            vm_pcnext();
+        } else {
+            vm_commit();
+            stack[A] = janet_unary_call("~", op);
+            vm_checkgc_pcnext();
+        }
     }
 
     VM_OP(JOP_SHIFT_RIGHT_UNSIGNED)
@@ -980,7 +1023,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
             if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
                 vm_do_trace(func, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart);
             }
-            janet_stack_frame(stack)->pc = pc;
+            vm_commit();
             if (janet_fiber_funcframe(fiber, func)) {
                 int32_t n = fiber->stacktop - fiber->stackstart;
                 janet_panicf("%v called with %d argument%s, expected %d",
@@ -1517,7 +1560,7 @@ JanetSignal janet_pcall(
         fiber = janet_fiber(fun, 64, argc, argv);
     }
     if (f) *f = fiber;
-    if (!fiber) {
+    if (NULL == fiber) {
         *out = janet_cstringv("arity mismatch");
         return JANET_SIGNAL_ERROR;
     }

src/include/janet.h

@@ -354,7 +354,6 @@ typedef struct JanetOSRWLock JanetOSRWLock;
 #include <stddef.h>
 #include <stdio.h>
 
-
 /* What to do when out of memory */
 #ifndef JANET_OUT_OF_MEMORY
 #define JANET_OUT_OF_MEMORY do { fprintf(stderr, "%s:%d - janet out of memory\n", __FILE__, __LINE__); exit(1); } while (0)
@@ -869,12 +868,15 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
 #endif
 
 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_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))
+#define janet_checkuint64range(x) ((x) >= 0 && (x) <= JANET_INTMAX_DOUBLE && (x) == (uint64_t)(x))
 #define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
 #define janet_wrap_integer(x) janet_wrap_number((int32_t)(x))
 
@@ -1260,11 +1262,13 @@ enum JanetOpCode {
     JOP_RETURN_NIL,
     JOP_ADD_IMMEDIATE,
     JOP_ADD,
+    JOP_SUBTRACT_IMMEDIATE,
     JOP_SUBTRACT,
     JOP_MULTIPLY_IMMEDIATE,
     JOP_MULTIPLY,
     JOP_DIVIDE_IMMEDIATE,
     JOP_DIVIDE,
+    JOP_DIVIDE_FLOOR,
     JOP_MODULO,
     JOP_REMAINDER,
     JOP_BAND,
@@ -1809,13 +1813,16 @@ JANET_API void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *pr
 #define JANET_SANDBOX_SUBPROCESS 2
 #define JANET_SANDBOX_NET_CONNECT 4
 #define JANET_SANDBOX_NET_LISTEN 8
-#define JANET_SANDBOX_FFI 16
+#define JANET_SANDBOX_FFI_DEFINE 16
 #define JANET_SANDBOX_FS_WRITE 32
 #define JANET_SANDBOX_FS_READ 64
 #define JANET_SANDBOX_HRTIME 128
 #define JANET_SANDBOX_ENV 256
 #define JANET_SANDBOX_DYNAMIC_MODULES 512
 #define JANET_SANDBOX_FS_TEMP 1024
+#define JANET_SANDBOX_FFI_USE 2048
+#define JANET_SANDBOX_FFI_JIT 4096
+#define JANET_SANDBOX_FFI (JANET_SANDBOX_FFI_DEFINE | JANET_SANDBOX_FFI_USE | JANET_SANDBOX_FFI_JIT)
 #define JANET_SANDBOX_FS (JANET_SANDBOX_FS_WRITE | JANET_SANDBOX_FS_READ | JANET_SANDBOX_FS_TEMP)
 #define JANET_SANDBOX_NET (JANET_SANDBOX_NET_CONNECT | JANET_SANDBOX_NET_LISTEN)
 #define JANET_SANDBOX_ALL (UINT32_MAX)
@@ -1902,7 +1909,6 @@ JANET_API Janet janet_resolve_core(const char *name);
 #define JANET_DEF_SD(ENV, JNAME, VAL, DOC) \
     janet_def_sm(ENV, JNAME, VAL, DOC, __FILE__, __LINE__)
 
-
 /* Choose defaults for source mapping and docstring based on config defs */
 #if defined(JANET_NO_SOURCEMAPS) && defined(JANET_NO_DOCSTRINGS)
 #define JANET_REG JANET_REG_
@@ -1991,6 +1997,8 @@ JANET_API JanetDictView janet_getdictionary(const Janet *argv, int32_t n);
 JANET_API void *janet_getabstract(const Janet *argv, int32_t n, const JanetAbstractType *at);
 JANET_API JanetRange janet_getslice(int32_t argc, const Janet *argv);
 JANET_API int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which);
+JANET_API int32_t janet_getstartrange(const Janet *argv, int32_t argc, int32_t n, int32_t length);
+JANET_API int32_t janet_getendrange(const Janet *argv, int32_t argc, int32_t n, int32_t length);
 JANET_API int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which);
 JANET_API uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags);
 
@@ -2049,6 +2057,7 @@ JANET_API int janet_cryptorand(uint8_t *out, size_t n);
 JANET_API void janet_marshal_size(JanetMarshalContext *ctx, size_t value);
 JANET_API void janet_marshal_int(JanetMarshalContext *ctx, int32_t value);
 JANET_API void janet_marshal_int64(JanetMarshalContext *ctx, int64_t value);
+JANET_API void janet_marshal_ptr(JanetMarshalContext *ctx, const void *value);
 JANET_API void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value);
 JANET_API void janet_marshal_bytes(JanetMarshalContext *ctx, const uint8_t *bytes, size_t len);
 JANET_API void janet_marshal_janet(JanetMarshalContext *ctx, Janet x);
@@ -2058,6 +2067,7 @@ JANET_API void janet_unmarshal_ensure(JanetMarshalContext *ctx, size_t size);
 JANET_API size_t janet_unmarshal_size(JanetMarshalContext *ctx);
 JANET_API int32_t janet_unmarshal_int(JanetMarshalContext *ctx);
 JANET_API int64_t janet_unmarshal_int64(JanetMarshalContext *ctx);
+JANET_API void *janet_unmarshal_ptr(JanetMarshalContext *ctx);
 JANET_API uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx);
 JANET_API void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len);
 JANET_API Janet janet_unmarshal_janet(JanetMarshalContext *ctx);

src/mainclient/shell.c

@@ -548,7 +548,6 @@ static void kdeletew(void) {
     refresh();
 }
 
-
 /* See tools/symchargen.c */
 static int is_symbol_char_gen(uint8_t c) {
     if (c & 0x80) return 1;

test/helper.janet

@@ -2,7 +2,7 @@
 
 (var num-tests-passed 0)
 (var num-tests-run 0)
-(var suite-num 0)
+(var suite-name 0)
 (var start-time 0)
 
 (def is-verbose (os/getenv "VERBOSE"))
@@ -14,9 +14,12 @@
   (++ num-tests-run)
   (when x (++ num-tests-passed))
   (def str (string e))
+  (def frame (last (debug/stack (fiber/current))))
+  (def line-info (string/format "%s:%d"
+                              (frame :source) (frame :source-line)))
   (if x
-    (when is-verbose (eprintf "\e[32m✔\e[0m %s: %v" (describe e) x))
-    (eprintf "\e[31m✘\e[0m %s: %v" (describe e) x))
+    (when is-verbose (eprintf "\e[32m✔\e[0m %s: %s: %v" line-info (describe e) x))
+    (eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x))
   x)
 
 (defmacro assert-error
@@ -34,13 +37,20 @@
   (def errsym (keyword (gensym)))
   ~(assert (not= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
 
-(defn start-suite [x]
-  (set suite-num x)
+(defn start-suite [&opt x]
+  (default x (dyn :current-file))
+  (set suite-name
+       (cond
+         (number? x) (string x)
+         (string? x) (string/slice x
+                                   (length "test/suite-")
+                                   (- (inc (length ".janet"))))
+         (string x)))
   (set start-time (os/clock))
-  (eprint "Starting suite " x "..."))
+  (eprint "Starting suite " suite-name "..."))
 
 (defn end-suite []
   (def delta (- (os/clock) start-time))
-  (eprinf "Finished suite %d in %.3f seconds - " suite-num delta)
+  (eprinf "Finished suite %s in %.3f seconds - " suite-name delta)
   (eprint num-tests-passed " of " num-tests-run " tests passed.")
   (if (not= num-tests-passed num-tests-run) (os/exit 1)))

test/suite-array.janet

@@ -0,0 +1,81 @@
+# Copyright (c) 2023 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)
+
+# Array tests
+# e05022f
+(defn array=
+  "Check if two arrays are equal in an element by element comparison"
+  [a b]
+  (if (and (array? a) (array? b))
+    (= (apply tuple a) (apply tuple b))))
+(assert (= (apply tuple @[1 2 3 4 5]) (tuple 1 2 3 4 5)) "array to tuple")
+(def arr (array))
+(array/push arr :hello)
+(array/push arr :world)
+(assert (array= arr @[:hello :world]) "array comparison")
+(assert (array= @[1 2 3 4 5] @[1 2 3 4 5]) "array comparison 2")
+(assert (array= @[:one :two :three :four :five]
+                @[:one :two :three :four :five]) "array comparison 3")
+(assert (array= (array/slice @[1 2 3] 0 2) @[1 2]) "array/slice 1")
+(assert (array= (array/slice @[0 7 3 9 1 4] 2 -2) @[3 9 1]) "array/slice 2")
+
+# Array remove
+# 687a3c9
+(assert (deep= (array/remove @[1 2 3 4 5] 2) @[1 2 4 5]) "array/remove 1")
+(assert (deep= (array/remove @[1 2 3 4 5] 2 2) @[1 2 5]) "array/remove 2")
+(assert (deep= (array/remove @[1 2 3 4 5] 2 200) @[1 2]) "array/remove 3")
+(assert (deep= (array/remove @[1 2 3 4 5] -2 200) @[1 2 3]) "array/remove 4")
+
+
+# array/peek
+(assert (nil? (array/peek @[])) "array/peek empty")
+
+# array/fill
+(assert (deep= (array/fill @[1 1] 2) @[2 2]) "array/fill 1")
+
+# array/concat
+(assert (deep= (array/concat @[1 2] @[3 4] 5 6) @[1 2 3 4 5 6]) "array/concat 1")
+(def a @[1 2])
+(assert (deep= (array/concat a a) @[1 2 1 2]) "array/concat self")
+
+# array/insert
+(assert (deep= (array/insert @[:a :a :a :a] 2 :b :b) @[:a :a :b :b :a :a]) "array/insert 1")
+(assert (deep= (array/insert @[:a :b] -1 :c :d) @[:a :b :c :d]) "array/insert 2")
+
+# array/remove
+(assert-error "removal index 3 out of range [0,2]" (array/remove @[1 2] 3))
+(assert-error "expected non-negative integer for argument n, got -1" (array/remove @[1 2] 1 -1))
+
+# array/pop
+(assert (= (array/pop @[1]) 1) "array/pop 1")
+(assert (= (array/pop @[]) nil) "array/pop empty")
+
+# Code coverage
+(def a @[1])
+(array/pop a)
+(array/trim a)
+(array/ensure @[1 1] 6 2)
+
+
+(end-suite)
+

test/suite-asm.janet

@@ -0,0 +1,55 @@
+# Copyright (c) 2023 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)
+
+# Assembly test
+# Fibonacci sequence, implemented with naive recursion.
+# a679f60
+(def fibasm (asm '{
+  :arity 1
+  :bytecode [
+    (ltim 1 0 0x2)      # $1 = $0 < 2
+    (jmpif 1 :done)     # if ($1) goto :done
+    (lds 1)             # $1 = self
+    (addim 0 0 -0x1)    # $0 = $0 - 1
+    (push 0)            # push($0), push argument for next function call
+    (call 2 1)          # $2 = call($1)
+    (addim 0 0 -0x1)    # $0 = $0 - 1
+    (push 0)            # push($0)
+    (call 0 1)          # $0 = call($1)
+    (add 0 0 2)        # $0 = $0 + $2 (integers)
+    :done
+    (ret 0)             # return $0
+  ]
+}))
+
+(assert (= 0 (fibasm 0)) "fibasm 1")
+(assert (= 1 (fibasm 1)) "fibasm 2")
+(assert (= 55 (fibasm 10)) "fibasm 3")
+(assert (= 6765 (fibasm 20)) "fibasm 4")
+
+# dacbe29
+(def f (asm (disasm (fn [x] (fn [y] (+ x y))))))
+(assert (= ((f 10) 37) 47) "asm environment tables")
+
+(end-suite)
+

test/suite-boot.janet

@@ -0,0 +1,900 @@
+# Copyright (c) 2023 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)
+
+# Let
+# 807f981
+(assert (= (let [a 1 b 2] (+ a b)) 3) "simple let")
+(assert (= (let [[a b] @[1 2]] (+ a b)) 3) "destructured let")
+(assert (= (let [[a [c d] b] @[1 (tuple 4 3) 2]] (+ a b c d)) 10)
+        "double destructured let")
+
+# Macros
+# b305a7c
+(defn dub [x] (+ x x))
+(assert (= 2 (dub 1)) "defn macro")
+(do
+  (defn trip [x] (+ x x x))
+  (assert (= 3 (trip 1)) "defn macro triple"))
+(do
+  (var i 0)
+  (when true
+    (++ i)
+    (++ i)
+    (++ i)
+    (++ i)
+    (++ i)
+    (++ i))
+  (assert (= i 6) "when macro"))
+
+# Add truthy? to core
+# ded08b6
+(assert (= true ;(map truthy? [0 "" true @{} {} [] '()])) "truthy values")
+(assert (= false ;(map truthy? [nil false])) "non-truthy values")
+
+## Polymorphic comparison -- Issue #272
+# 81d301a42
+
+# confirm polymorphic comparison delegation to primitive comparators:
+(assert (= 0 (cmp 3 3)) "compare-primitive integers (1)")
+(assert (= -1 (cmp 3 5)) "compare-primitive integers (2)")
+(assert (= 1 (cmp "foo" "bar")) "compare-primitive strings")
+(assert (= 0 (compare 1 1)) "compare integers (1)")
+(assert (= -1 (compare 1 2)) "compare integers (2)")
+(assert (= 1 (compare "foo" "bar")) "compare strings (1)")
+
+(assert (compare< 1 2 3 4 5 6) "compare less than integers")
+(assert (not (compare> 1 2 3 4 5 6)) "compare not greater than integers")
+(assert (compare< 1.0 2.0 3.0 4.0 5.0 6.0) "compare less than reals")
+(assert (compare> 6 5 4 3 2 1) "compare greater than integers")
+(assert (compare> 6.0 5.0 4.0 3.0 2.0 1.0) "compare greater than reals")
+(assert (not (compare< 6.0 5.0 4.0 3.0 2.0 1.0)) "compare less than reals")
+(assert (compare<= 1 2 3 3 4 5 6) "compare less than or equal to integers")
+(assert (compare<= 1.0 2.0 3.0 3.0 4.0 5.0 6.0)
+        "compare less than or equal to reals")
+(assert (compare>= 6 5 4 4 3 2 1)
+        "compare greater than or equal to integers")
+(assert (compare>= 6.0 5.0 4.0 4.0 3.0 2.0 1.0)
+        "compare greater than or equal to reals")
+(assert (compare< 1.0 nil false true
+           (fiber/new (fn [] 1))
+           "hi"
+           (quote hello)
+           :hello
+           (array 1 2 3)
+           (tuple 1 2 3)
+           (table "a" "b" "c" "d")
+           (struct 1 2 3 4)
+           (buffer "hi")
+           (fn [x] (+ x x))
+           print) "compare type ordering")
+
+# test polymorphic compare with 'objects' (table/setproto)
+(def mynum
+  @{:type :mynum :v 0 :compare
+    (fn [self other]
+      (case (type other)
+      :number (cmp (self :v) other)
+      :table (when (= (get other :type) :mynum)
+               (cmp (self :v) (other :v)))))})
+
+(let [n3 (table/setproto @{:v 3} mynum)]
+  (assert (= 0 (compare 3 n3)) "compare num to object (1)")
+  (assert (= -1 (compare n3 4)) "compare object to num (2)")
+  (assert (= 1 (compare (table/setproto @{:v 4} mynum) n3))
+          "compare object to object")
+  (assert (compare< 2 n3 4) "compare< poly")
+  (assert (compare> 4 n3 2) "compare> poly")
+  (assert (compare<= 2 3 n3 4) "compare<= poly")
+  (assert (compare= 3 n3 (table/setproto @{:v 3} mynum)) "compare= poly")
+  (assert (deep= (sorted @[4 5 n3 2] compare<) @[2 n3 4 5])
+          "polymorphic sort"))
+
+# Add any? predicate to core
+# 7478ad11
+(assert (= nil (any? [])) "any? 1")
+(assert (= nil (any? [false nil])) "any? 2")
+(assert (= nil (any? [nil false])) "any? 3")
+(assert (= 1 (any? [1])) "any? 4")
+(assert (nan? (any? [nil math/nan nil])) "any? 5")
+(assert (= true
+           (any? [nil nil false nil nil true nil nil nil nil false :a nil]))
+        "any? 6")
+
+# Some higher order functions and macros
+# 5e2de33
+(def my-array @[1 2 3 4 5 6])
+(assert (= (if-let [x (get my-array 5)] x) 6) "if-let 1")
+(assert (= (if-let [y (get @{} :key)] 10 nil) nil) "if-let 2")
+(assert (= (if-let [a my-array k (next a)] :t :f) :t) "if-let 3")
+(assert (= (if-let [a my-array k (next a 5)] :t :f) :f) "if-let 4")
+(assert (= (if-let [[a b] my-array] a) 1) "if-let 5")
+(assert (= (if-let [{:a a :b b} {:a 1 :b 2}] b) 2) "if-let 6")
+(assert (= (if-let [[a b] nil] :t :f) :f) "if-let 7")
+
+# #1191
+(var cnt 0)
+(defmacro upcnt [] (++ cnt))
+(assert (= (if-let [a true b true c true] nil (upcnt)) nil) "issue #1191")
+(assert (= cnt 1) "issue #1191")
+
+(assert (= 14 (sum (map inc @[1 2 3 4]))) "sum map")
+(def myfun (juxt + - * /))
+(assert (= [2 -2 2 0.5] (myfun 2)) "juxt")
+
+# Case statements
+# 5249228
+(assert
+  (= :six (case (+ 1 2 3)
+            1 :one
+            2 :two
+            3 :three
+            4 :four
+            5 :five
+            6 :six
+            7 :seven
+            8 :eight
+            9 :nine)) "case macro")
+
+(assert (= 7 (case :a :b 5 :c 6 :u 10 7)) "case with default")
+
+# Testing the seq, tabseq, catseq, and loop macros
+# 547529e
+(def xs (apply tuple (seq [x :range [0 10] :when (even? x)]
+                       (tuple (/ x 2) x))))
+(assert (= xs '((0 0) (1 2) (2 4) (3 6) (4 8))) "seq macro 1")
+
+# 624be87c9
+(def xs (apply tuple (seq [x :down [8 -2] :when (even? x)]
+                       (tuple (/ x 2) x))))
+(assert (= xs '((4 8) (3 6) (2 4) (1 2) (0 0))) "seq macro 2")
+
+# Looping idea
+# 45f8db0
+(def xs
+  (seq [x :in [-1 0 1] y :in [-1 0 1] :when (not= x y 0)] (tuple x y)))
+(def txs (apply tuple xs))
+
+(assert (= txs [[-1 -1] [-1 0] [-1 1] [0 -1] [0 1] [1 -1] [1 0] [1 1]])
+        "nested seq")
+
+# 515891b03
+(assert (deep= (tabseq [i :in (range 3)] i (* 3 i))
+               @{0 0 1 3 2 6}))
+
+(assert (deep= (tabseq [i :in (range 3)] i)
+               @{}))
+
+# ccd874fe4
+(def xs (catseq [x :range [0 3]] [x x]))
+(assert (deep= xs @[0 0 1 1 2 2]) "catseq")
+
+# :range-to and :down-to
+# e0c9910d8
+(assert (deep= (seq [x :range-to [0 10]] x) (seq [x :range [0 11]] x))
+        "loop :range-to")
+(assert (deep= (seq [x :down-to [10 0]] x) (seq [x :down [10 -1]] x))
+        "loop :down-to")
+
+# 7880d7320
+(def res @{})
+(loop [[k v] :pairs @{1 2 3 4 5 6}]
+  (put res k v))
+(assert (and
+          (= (get res 1) 2)
+          (= (get res 3) 4)
+          (= (get res 5) 6)) "loop :pairs")
+
+# Issue #428
+# 08a3687eb
+(var result nil)
+(defn f [] (yield {:a :ok}))
+(assert-no-error "issue 428 1"
+                 (loop [{:a x} :in (fiber/new f)] (set result x)))
+(assert (= result :ok) "issue 428 2")
+
+# Generators
+# 184fe31e0
+(def gen (generate [x :range [0 100] :when (pos? (% x 4))] x))
+(var gencount 0)
+(loop [x :in gen]
+  (++ gencount)
+  (assert (pos? (% x 4)) "generate in loop"))
+(assert (= gencount 75) "generate loop count")
+
+# Even and odd
+# ff163a5ae
+(assert (odd? 9) "odd? 1")
+(assert (odd? -9) "odd? 2")
+(assert (not (odd? 10)) "odd? 3")
+(assert (not (odd? 0)) "odd? 4")
+(assert (not (odd? -10)) "odd? 5")
+(assert (not (odd? 1.1)) "odd? 6")
+(assert (not (odd? -0.1)) "odd? 7")
+(assert (not (odd? -1.1)) "odd? 8")
+(assert (not (odd? -1.6)) "odd? 9")
+
+(assert (even? 10) "even? 1")
+(assert (even? -10) "even? 2")
+(assert (even? 0) "even? 3")
+(assert (not (even? 9)) "even? 4")
+(assert (not (even? -9)) "even? 5")
+(assert (not (even? 0.1)) "even? 6")
+(assert (not (even? -0.1)) "even? 7")
+(assert (not (even? -10.1)) "even? 8")
+(assert (not (even? -10.6)) "even? 9")
+
+# Map arities
+# 25ded775a
+(assert (deep= (map inc [1 2 3]) @[2 3 4]))
+(assert (deep= (map + [1 2 3] [10 20 30]) @[11 22 33]))
+(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300]) @[111 222 333]))
+(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300] [1000 2000 3000])
+               @[1111 2222 3333]))
+(assert (deep= (map +
+                    [1 2 3] [10 20 30] [100 200 300] [1000 2000 3000]
+                    [10000 20000 30000])
+               @[11111 22222 33333]))
+# 77e62a2
+(assert (deep= (map +
+                    [1 2 3] [10 20 30] [100 200 300] [1000 2000 3000]
+                    [10000 20000 30000] [100000 200000 300000])
+               @[111111 222222 333333]))
+
+# Mapping uses the shortest sequence
+# a69799aa4
+(assert (deep= (map + [1 2 3 4] [10 20 30]) @[11 22 33]))
+(assert (deep= (map + [1 2 3 4] [10 20 30] [100 200]) @[111 222]))
+(assert (deep= (map + [1 2 3 4] [10 20 30] [100 200] [1000]) @[1111]))
+# 77e62a2
+(assert (deep= (map + [1 2 3 4] [10 20 30] [100 200] [1000] []) @[]))
+
+# Variadic arguments to map-like functions
+# 77e62a2
+(assert (deep= (mapcat tuple [1 2 3 4] [5 6 7 8]) @[1 5 2 6 3 7 4 8]))
+(assert (deep= (keep |(if (> $1 0) (/ $0 $1)) [1 2 3 4 5] [1 2 1 0 1])
+               @[1 1 3 5]))
+
+(assert (= (count = [1 3 2 4 3 5 4 2 1] [1 2 3 4 5 4 3 2 1]) 4))
+
+(assert (= (some not= (range 5) (range 5)) nil))
+(assert (= (some = [1 2 3 4 5] [5 4 3 2 1]) true))
+
+(assert (= (all = (range 5) (range 5)) true))
+(assert (= (all not= [1 2 3 4 5] [5 4 3 2 1]) false))
+
+# 4194374
+(assert (= false (deep-not= [1] [1])) "issue #1149")
+
+# Merge sort
+# f5b29b8
+# Imperative (and verbose) merge sort merge
+(defn merge-sort
+  [xs ys]
+  (def ret @[])
+  (def xlen (length xs))
+  (def ylen (length ys))
+  (var i 0)
+  (var j 0)
+  # Main merge
+  (while (if (< i xlen) (< j ylen))
+    (def xi (get xs i))
+    (def yj (get ys j))
+    (if (< xi yj)
+      (do (array/push ret xi) (set i (+ i 1)))
+      (do (array/push ret yj) (set j (+ j 1)))))
+  # Push rest of xs
+  (while (< i xlen)
+    (def xi (get xs i))
+    (array/push ret xi)
+    (set i (+ i 1)))
+  # Push rest of ys
+  (while (< j ylen)
+    (def yj (get ys j))
+    (array/push ret yj)
+    (set j (+ j 1)))
+  ret)
+
+(assert (apply <= (merge-sort @[1 3 5] @[2 4 6])) "merge sort merge 1")
+(assert (apply <= (merge-sort @[1 2 3] @[4 5 6])) "merge sort merge 2")
+(assert (apply <= (merge-sort @[1 3 5] @[2 4 6 6 6 9])) "merge sort merge 3")
+(assert (apply <= (merge-sort '(1 3 5) @[2 4 6 6 6 9])) "merge sort merge 4")
+
+(assert (deep= @[1 2 3 4 5] (sort @[5 3 4 1 2])) "sort 1")
+(assert (deep= @[{:a 1} {:a 4} {:a 7}]
+               (sort-by |($ :a) @[{:a 4} {:a 7} {:a 1}])) "sort 2")
+(assert (deep= @[1 2 3 4 5] (sorted [5 3 4 1 2])) "sort 3")
+(assert (deep= @[{:a 1} {:a 4} {:a 7}]
+               (sorted-by |($ :a) [{:a 4} {:a 7} {:a 1}])) "sort 4")
+
+# Sort function
+# 2ca9300bf
+(assert (deep=
+          (range 99)
+          (sort (mapcat (fn [[x y z]] [z y x]) (partition 3 (range 99)))))
+        "sort 5")
+(assert (<= ;(sort (map (fn [x] (math/random)) (range 1000)))) "sort 6")
+
+# And and or
+# c16a9d846
+(assert (= (and true true) true) "and true true")
+(assert (= (and true false) false) "and true false")
+(assert (= (and false true) false) "and false true")
+(assert (= (and true true true) true) "and true true true")
+(assert (= (and 0 1 2) 2) "and 0 1 2")
+(assert (= (and 0 1 nil) nil) "and 0 1 nil")
+(assert (= (and 1) 1) "and 1")
+(assert (= (and) true) "and with no arguments")
+(assert (= (and 1 true) true) "and with trailing true")
+(assert (= (and 1 true 2) 2) "and with internal true")
+
+(assert (= (or true true) true) "or true true")
+(assert (= (or true false) true) "or true false")
+(assert (= (or false true) true) "or false true")
+(assert (= (or false false) false) "or false true")
+(assert (= (or true true false) true) "or true true false")
+(assert (= (or 0 1 2) 0) "or 0 1 2")
+(assert (= (or nil 1 2) 1) "or nil 1 2")
+(assert (= (or 1) 1) "or 1")
+(assert (= (or) nil) "or with no arguments")
+
+# And/or checks
+# 6123c41f1
+(assert (= false (and false false)) "and 1")
+(assert (= false (or false false)) "or 1")
+
+# 11cd1279d
+(assert (deep= @{:a 1 :b 2 :c 3} (zipcoll '[:a :b :c] '[1 2 3])) "zipcoll")
+
+# bc8be266f
+(def- a 100)
+(assert (= a 100) "def-")
+
+# bc8be266f
+(assert (= :first
+          (match @[1 3 5]
+                 @[x y z] :first
+                 :second)) "match 1")
+
+(def val1 :avalue)
+(assert (= :second
+          (match val1
+                 @[x y z] :first
+                 :avalue :second
+                 :third)) "match 2")
+
+(assert (= 100
+           (match @[50 40]
+                  @[x x] (* x 3)
+                  @[x y] (+ x y 10)
+                  0)) "match 3")
+
+# Match checks
+# 47e8f669f
+(assert (= :hi (match nil nil :hi)) "match 1")
+(assert (= :hi (match {:a :hi} {:a a} a)) "match 2")
+(assert (= nil (match {:a :hi} {:a a :b b} a)) "match 3")
+(assert (= nil (match [1 2] [a b c] a)) "match 4")
+(assert (= 2 (match [1 2] [a b] b)) "match 5")
+# db631097b
+(assert (= [2 :a :b] (match [1 2 :a :b] [o & rest] rest)) "match 6")
+(assert (= [] (match @[:a] @[x & r] r :fallback)) "match 7")
+(assert (= :fallback (match @[1] @[x y & r] r :fallback)) "match 8")
+(assert (= [1 2 3 4] (match @[1 2 3 4] @[x y z & r] [x y z ;r] :fallback))
+        "match 9")
+
+# Test cases for #293
+# d3b9b8d45
+(assert (= :yes (match [1 2 3] [_ a _] :yes :no)) "match wildcard 1")
+(assert (= :no (match [1 2 3] [__ a __] :yes :no)) "match wildcard 2")
+(assert (= :yes (match [1 2 [1 2 3]] [_ a [_ _ _]] :yes :no))
+        "match wildcard 3")
+(assert (= :yes (match [1 2 3] (_ (even? 2)) :yes :no)) "match wildcard 4")
+(assert (= :yes (match {:a 1} {:a _} :yes :no)) "match wildcard 5")
+(assert (= false (match {:a 1 :b 2 :c 3}
+                   {:a a :b _ :c _ :d _} :no
+                   {:a _ :b _ :c _} false
+                   :no)) "match wildcard 6")
+(assert (= nil (match {:a 1 :b 2 :c 3}
+                 {:a a :b _ :c _ :d _} :no
+                 {:a _ :b _ :c _} nil
+                 :no)) "match wildcard 7")
+# issue #529 - 602010600
+(assert (= "t" (match [true nil] [true _] "t")) "match wildcard 8")
+
+# quoted match test
+# 425a0fcf0
+(assert (= :yes (match 'john 'john :yes _ :nope)) "quoted literal match 1")
+(assert (= :nope (match 'john ''john :yes _ :nope)) "quoted literal match 2")
+
+# Some macros
+# 7880d7320
+(assert (= 2 (if-not 1 3 2)) "if-not 1")
+(assert (= 3 (if-not false 3)) "if-not 2")
+(assert (= 3 (if-not nil 3 2)) "if-not 3")
+(assert (= nil (if-not true 3)) "if-not 4")
+
+(assert (= 4 (unless false (+ 1 2 3) 4)) "unless")
+
+# take
+# 18da183ef
+(assert (deep= (take 0 []) []) "take 1")
+(assert (deep= (take 10 []) []) "take 2")
+(assert (deep= (take 0 [1 2 3 4 5]) []) "take 3")
+(assert (deep= (take 10 [1 2 3]) [1 2 3]) "take 4")
+(assert (deep= (take -1 [:a :b :c]) [:c]) "take 5")
+# 34019222c
+(assert (deep= (take 3 (generate [x :in [1 2 3 4 5]] x)) @[1 2 3])
+        "take from fiber")
+# NB: repeatedly resuming a fiber created with `generate` includes a `nil`
+# as the final element. Thus a generate of 2 elements will create an array
+# of 3.
+(assert (= (length (take 4 (generate [x :in [1 2]] x))) 2)
+        "take from short fiber")
+
+# take-until
+# 18da183ef
+(assert (deep= (take-until pos? @[]) []) "take-until 1")
+(assert (deep= (take-until pos? @[1 2 3]) []) "take-until 2")
+(assert (deep= (take-until pos? @[-1 -2 -3]) [-1 -2 -3]) "take-until 3")
+(assert (deep= (take-until pos? @[-1 -2 3]) [-1 -2]) "take-until 4")
+(assert (deep= (take-until pos? @[-1 1 -2]) [-1]) "take-until 5")
+(assert (deep= (take-until |(= $ 115) "books") "book") "take-until 6")
+(assert (deep= (take-until |(= $ 115) (generate [x :in "books"] x))
+               @[98 111 111 107]) "take-until from fiber")
+
+# take-while
+# 18da183ef
+(assert (deep= (take-while neg? @[]) []) "take-while 1")
+(assert (deep= (take-while neg? @[1 2 3]) []) "take-while 2")
+(assert (deep= (take-while neg? @[-1 -2 -3]) [-1 -2 -3]) "take-while 3")
+(assert (deep= (take-while neg? @[-1 -2 3]) [-1 -2]) "take-while 4")
+(assert (deep= (take-while neg? @[-1 1 -2]) [-1]) "take-while 5")
+(assert (deep= (take-while neg? (generate [x :in  @[-1 1 -2]] x))
+               @[-1]) "take-while from fiber")
+
+# drop
+# 18da183ef
+(assert (deep= (drop 0 []) []) "drop 1")
+(assert (deep= (drop 10 []) []) "drop 2")
+(assert (deep= (drop 0 [1 2 3 4 5]) [1 2 3 4 5]) "drop 3")
+(assert (deep= (drop 10 [1 2 3]) []) "drop 4")
+(assert (deep= (drop -1 [1 2 3]) [1 2]) "drop 5")
+(assert (deep= (drop -10 [1 2 3]) []) "drop 6")
+(assert (deep= (drop 1 "abc") "bc") "drop 7")
+(assert (deep= (drop 10 "abc") "") "drop 8")
+(assert (deep= (drop -1 "abc") "ab") "drop 9")
+(assert (deep= (drop -10 "abc") "") "drop 10")
+
+# drop-until
+# 75dc08f
+(assert (deep= (drop-until pos? @[]) []) "drop-until 1")
+(assert (deep= (drop-until pos? @[1 2 3]) [1 2 3]) "drop-until 2")
+(assert (deep= (drop-until pos? @[-1 -2 -3]) []) "drop-until 3")
+(assert (deep= (drop-until pos? @[-1 -2 3]) [3]) "drop-until 4")
+(assert (deep= (drop-until pos? @[-1 1 -2]) [1 -2]) "drop-until 5")
+(assert (deep= (drop-until |(= $ 115) "books") "s") "drop-until 6")
+
+# take-drop symmetry #1178
+(def items-list ['abcde :abcde "abcde" @"abcde" [1 2 3 4 5] @[1 2 3 4 5]])
+
+(each items items-list
+  (def len (length items))
+  (for i 0 (+ len 1)
+    (assert (deep= (take i items) (drop (- i len) items)) (string/format "take-drop symmetry %q %d" items i))
+    (assert (deep= (take (- i) items) (drop (- len i) items)) (string/format "take-drop symmetry %q %d" items i))))
+
+(defn squares []
+  (coro
+    (var [a b] [0 1])
+    (forever (yield a) (+= a b) (+= b 2))))
+
+(def sqr1 (squares))
+(assert (deep= (take 10 sqr1) @[0 1 4 9 16 25 36 49 64 81]))
+(assert (deep= (take 1 sqr1) @[100]) "take fiber next value")
+
+(def sqr2 (drop 10 (squares)))
+(assert (deep= (take 1 sqr2) @[100]) "drop fiber next value")
+
+(def dict @{:a 1 :b 2 :c 3 :d 4 :e 5})
+(def dict1 (take 2 dict))
+(def dict2 (drop 2 dict))
+
+(assert (= (length dict1) 2) "take dictionary")
+(assert (= (length dict2) 3) "drop dictionary")
+(assert (deep= (merge dict1 dict2) dict) "take-drop symmetry for dictionary")
+
+# Comment macro
+# issue #110 - 698e89aba
+(comment 1)
+(comment 1 2)
+(comment 1 2 3)
+(comment 1 2 3 4)
+
+# comp should be variadic
+# 5c83ebd75, 02ce3031
+(assert (= 10 ((comp +) 1 2 3 4)) "variadic comp 1")
+(assert (= 11 ((comp inc +) 1 2 3 4)) "variadic comp 2")
+(assert (= 12 ((comp inc inc +) 1 2 3 4)) "variadic comp 3")
+(assert (= 13 ((comp inc inc inc +) 1 2 3 4)) "variadic comp 4")
+(assert (= 14 ((comp inc inc inc inc +) 1 2 3 4)) "variadic comp 5")
+(assert (= 15 ((comp inc inc inc inc inc +) 1 2 3 4)) "variadic comp 6")
+(assert (= 16 ((comp inc inc inc inc inc inc +) 1 2 3 4))
+        "variadic comp 7")
+
+# Function shorthand
+# 44e752d73
+(assert (= (|(+ 1 2 3)) 6) "function shorthand 1")
+(assert (= (|(+ 1 2 3 $) 4) 10) "function shorthand 2")
+(assert (= (|(+ 1 2 3 $0) 4) 10) "function shorthand 3")
+(assert (= (|(+ $0 $0 $0 $0) 4) 16) "function shorthand 4")
+(assert (= (|(+ $ $ $ $) 4) 16) "function shorthand 5")
+(assert (= (|4) 4) "function shorthand 6")
+(assert (= (((|||4))) 4) "function shorthand 7")
+(assert (= (|(+ $1 $1 $1 $1) 2 4) 16) "function shorthand 8")
+(assert (= (|(+ $0 $1 $3 $2 $6) 0 1 2 3 4 5 6) 12) "function shorthand 9")
+# 5f5147652
+(assert (= (|(+ $0 $99) ;(range 100)) 99) "function shorthand 10")
+
+# 655d4b3aa
+(defn idx= [x y] (= (tuple/slice x) (tuple/slice y)))
+
+# Simple take, drop, etc. tests.
+(assert (idx= (take 10 (range 100)) (range 10)) "take 10")
+(assert (idx= (drop 10 (range 100)) (range 10 100)) "drop 10")
+
+# with-vars
+# 6ceaf9d28
+(var abc 123)
+(assert (= 356 (with-vars [abc 456] (- abc 100))) "with-vars 1")
+(assert-error "with-vars 2" (with-vars [abc 456] (error :oops)))
+(assert (= abc 123) "with-vars 3")
+
+# Top level unquote
+# 2487162cc
+(defn constantly
+  []
+  (comptime (math/random)))
+
+(assert (= (constantly) (constantly)) "comptime 1")
+
+# issue #232 - b872ee024
+(assert-error "arity issue in macro" (eval '(each [])))
+# c6b639b93
+(assert-error "comptime issue" (eval '(comptime (error "oops"))))
+
+# 962cd7e5f
+(var counter 0)
+(when-with [x nil |$]
+           (++ counter))
+(when-with [x 10 |$]
+           (+= counter 10))
+
+(assert (= 10 counter) "when-with 1")
+
+(if-with [x nil |$] (++ counter) (+= counter 10))
+(if-with [x true |$] (+= counter 20) (+= counter 30))
+
+(assert (= 40 counter) "if-with 1")
+
+# a45509d28
+(def a @[])
+(eachk x [:a :b :c :d]
+  (array/push a x))
+(assert (deep= (range 4) a) "eachk 1")
+
+# issue 609 - 1fcaffe
+(with-dyns [:err @""]
+  (tracev (def my-unique-var-name true))
+  (assert my-unique-var-name "tracev upscopes"))
+
+# Prompts and Labels
+# 59d288c
+(assert (= 10 (label a (for i 0 10 (if (= i 5) (return a 10))))) "label 1")
+
+(defn recur
+  [lab x y]
+  (when (= x y) (return lab :done))
+  (def res (label newlab (recur (or lab newlab) (+ x 1) y)))
+  (if lab :oops res))
+(assert (= :done (recur nil 0 10)) "label 2")
+
+(assert (= 10 (prompt :a (for i 0 10 (if (= i 5) (return :a 10)))))
+        "prompt 1")
+
+(defn- inner-loop
+  [i]
+  (if (= i 5)
+    (return :a 10)))
+
+(assert (= 10 (prompt :a (for i 0 10 (inner-loop i)))) "prompt 2")
+
+(defn- inner-loop2
+  [i]
+  (try
+    (if (= i 5)
+      (error 10))
+    ([err] (return :a err))))
+
+(assert (= 10 (prompt :a (for i 0 10 (inner-loop2 i)))) "prompt 3")
+
+# chr
+# issue 304 - 77343e02e
+(assert (= (chr "a") 97) "chr 1")
+
+# Reduce2
+# 3eb0927a2
+(assert (= (reduce + 0 (range 1 10)) (reduce2 + (range 10))) "reduce2 1")
+# 65379741f
+(assert (= (reduce * 1 (range 2 10)) (reduce2 * (range 1 10))) "reduce2 2")
+(assert (= nil (reduce2 * [])) "reduce2 3")
+
+# Accumulate
+# 3eb0927a2
+(assert (deep= (accumulate + 0 (range 5)) @[0 1 3 6 10]) "accumulate 1")
+(assert (deep= (accumulate2 + (range 5)) @[0 1 3 6 10]) "accumulate2 1")
+# 65379741f
+(assert (deep= @[] (accumulate2 + [])) "accumulate2 2")
+(assert (deep= @[] (accumulate 0 + [])) "accumulate 2")
+
+# in vs get regression
+# issue #340 - b63a0796f
+(assert (nil? (first @"")) "in vs get 1")
+(assert (nil? (last @"")) "in vs get 1")
+
+# index-of
+# 259812314
+(assert (= nil (index-of 10 [])) "index-of 1")
+(assert (= nil (index-of 10 [1 2 3])) "index-of 2")
+(assert (= 1 (index-of 2 [1 2 3])) "index-of 3")
+(assert (= 0 (index-of :a [:a :b :c])) "index-of 4")
+(assert (= nil (index-of :a {})) "index-of 5")
+(assert (= :a (index-of :A {:a :A :b :B})) "index-of 6")
+(assert (= :a (index-of :A @{:a :A :b :B})) "index-of 7")
+(assert (= 0 (index-of (chr "a") "abc")) "index-of 8")
+(assert (= nil (index-of (chr "a") "")) "index-of 9")
+(assert (= nil (index-of 10 @[])) "index-of 10")
+(assert (= nil (index-of 10 @[1 2 3])) "index-of 11")
+
+# e78a3d1
+# NOTE: These is a motivation for the has-value? and has-key? functions below
+
+# returns false despite key present
+(assert (= false (index-of 8 {true 7 false 8}))
+        "index-of corner key (false) 1")
+(assert (= false (index-of 8 @{false 8}))
+        "index-of corner key (false) 2")
+# still returns null
+(assert (= nil (index-of 7 {false 8})) "index-of corner key (false) 3")
+
+# has-value?
+(assert (= false (has-value? [] "foo")) "has-value? 1")
+(assert (= true (has-value? [4 7 1 3] 4)) "has-value? 2")
+(assert (= false (has-value? [4 7 1 3] 22)) "has-value? 3")
+(assert (= false (has-value? @[1 2 3] 4)) "has-value? 4")
+(assert (= true (has-value? @[:a :b :c] :a)) "has-value? 5")
+(assert (= false (has-value? {} :foo)) "has-value? 6")
+(assert (= true (has-value? {:a :A :b :B} :A)) "has-value? 7")
+(assert (= true (has-value? {:a :A :b :B} :A)) "has-value? 7")
+(assert (= true (has-value? @{:a :A :b :B} :A)) "has-value? 8")
+(assert (= true (has-value? "abc" (chr "a"))) "has-value? 9")
+(assert (= false (has-value? "abc" "1")) "has-value? 10")
+# weird true/false corner cases, should align with "index-of corner
+# key {k}" cases
+(assert (= true (has-value? {true 7 false 8} 8))
+        "has-value? corner key (false) 1")
+(assert (= true (has-value? @{false 8} 8))
+        "has-value? corner key (false) 2")
+(assert (= false (has-value? {false 8} 7))
+        "has-value? corner key (false) 3")
+
+# has-key?
+(do
+  (var test-has-key-auto 0)
+  (defn test-has-key [col key expected &keys {:name name}]
+    ``Test that has-key has the outcome `expected`, and that if
+    the result is true, then ensure (in key) does not fail either``
+    (assert (boolean? expected))
+    (default name (string "has-key? " (++ test-has-key-auto)))
+    (assert (= expected (has-key? col key)) name)
+    (if
+      # guarenteed by `has-key?` to never fail
+      expected (in col key)
+      # if `has-key?` is false, then `in` should fail (for indexed types)
+      #
+      # For dictionary types, it should return nil
+      (let [[success retval] (protect (in col key))]
+        (def should-succeed (dictionary? col))
+        (assert
+          (= success should-succeed)
+          (string/format
+            "%s: expected (in col key) to %s, but got %q"
+            name (if expected "succeed" "fail") retval)))))
+
+  (test-has-key [] 0 false) # 1
+  (test-has-key [4 7 1 3] 2 true) # 2
+  (test-has-key [4 7 1 3] 22 false) # 3
+  (test-has-key @[1 2 3] 4 false) # 4
+  (test-has-key @[:a :b :c] 2 true) # 5
+  (test-has-key {} :foo false) # 6
+  (test-has-key {:a :A :b :B} :a true) # 7
+  (test-has-key {:a :A :b :B} :A false) # 8
+  (test-has-key @{:a :A :b :B} :a true) # 9
+  (test-has-key "abc" 1 true) # 10
+  (test-has-key "abc" 4 false) # 11
+  # weird true/false corner cases
+  #
+  # Tries to mimic the corresponding corner cases in has-value? and
+  # index-of, but with keys/values inverted
+  #
+  # in the first two cases (truthy? (get val col)) would have given false
+  # negatives
+  (test-has-key {7 true 8 false} 8 true :name
+                "has-key? corner value (false) 1")
+  (test-has-key @{8 false} 8 true :name
+                "has-key? corner value (false) 2")
+  (test-has-key @{8 false} 7 false :name
+                "has-key? corner value (false) 3"))
+
+# Regression
+# issue #463 - 7e7498350
+(assert (= {:x 10} (|(let [x $] ~{:x ,x}) 10)) "issue 463")
+
+# macex testing
+# 7e7498350
+(assert (deep= (macex1 '~{1 2 3 4}) '~{1 2 3 4}) "macex1 qq struct")
+(assert (deep= (macex1 '~@{1 2 3 4}) '~@{1 2 3 4}) "macex1 qq table")
+(assert (deep= (macex1 '~(1 2 3 4)) '~[1 2 3 4]) "macex1 qq tuple")
+(assert (= :brackets (tuple/type (1 (macex1 '~[1 2 3 4]))))
+        "macex1 qq bracket tuple")
+(assert (deep= (macex1 '~@[1 2 3 4 ,blah]) '~@[1 2 3 4 ,blah])
+        "macex1 qq array")
+
+# Sourcemaps in threading macros
+# b6175e429
+(defn check-threading [macro expansion]
+  (def expanded (macex1 (tuple macro 0 '(x) '(y))))
+  (assert (= expanded expansion) (string macro " expansion value"))
+  (def smap-x (tuple/sourcemap (get expanded 1)))
+  (def smap-y (tuple/sourcemap expanded))
+  (def line first)
+  (defn column [t] (t 1))
+  (assert (not= smap-x [-1 -1]) (string macro " x sourcemap existence"))
+  (assert (not= smap-y [-1 -1]) (string macro " y sourcemap existence"))
+  (assert (or (< (line smap-x) (line smap-y))
+              (and (= (line smap-x) (line smap-y))
+                   (< (column smap-x) (column smap-y))))
+          (string macro " relation between x and y sourcemap")))
+
+(check-threading '-> '(y (x 0)))
+(check-threading '->> '(y (x 0)))
+
+# keep-syntax
+# b6175e429
+(let [brak '[1 2 3]
+      par '(1 2 3)]
+
+  (tuple/setmap brak 2 1)
+
+  (assert (deep= (keep-syntax brak @[1 2 3]) @[1 2 3])
+          "keep-syntax brackets ignore array")
+  (assert (= (keep-syntax! brak @[1 2 3]) '[1 2 3])
+          "keep-syntax! brackets replace array")
+
+  (assert (= (keep-syntax! par (map inc @[1 2 3])) '(2 3 4))
+          "keep-syntax! parens coerce array")
+  (assert (not= (keep-syntax! brak @[1 2 3]) '(1 2 3))
+          "keep-syntax! brackets not parens")
+  (assert (not= (keep-syntax! par @[1 2 3]) '[1 2 3])
+          "keep-syntax! parens not brackets")
+  (assert (= (tuple/sourcemap brak)
+             (tuple/sourcemap (keep-syntax! brak @[1 2 3])))
+          "keep-syntax! brackets source map")
+
+  (keep-syntax par brak)
+  (assert (not= (tuple/sourcemap brak) (tuple/sourcemap par))
+          "keep-syntax no mutate")
+  (assert (= (keep-syntax 1 brak) brak) "keep-syntax brackets ignore type"))
+
+# Curenv
+# 28439d822, f7c556e
+(assert (= (curenv) (curenv 0)) "curenv 1")
+(assert (= (table/getproto (curenv)) (curenv 1)) "curenv 2")
+(assert (= nil (curenv 1000000)) "curenv 3")
+(assert (= root-env (curenv 1)) "curenv 4")
+
+# Import macro test
+# a31e079f9
+(assert-no-error "import macro 1" (macex '(import a :as b :fresh maybe)))
+(assert (deep= ~(,import* "a" :as "b" :fresh maybe)
+               (macex '(import a :as b :fresh maybe))) "import macro 2")
+
+# #477 walk preserving bracket type
+# 0a1d902f4
+(assert (= :brackets (tuple/type (postwalk identity '[])))
+        "walk square brackets 1")
+(assert (= :brackets (tuple/type (walk identity '[])))
+        "walk square brackets 2")
+
+# Issue #751
+# 547fda6a4
+(def t {:side false})
+(assert (nil? (get-in t [:side :note])) "get-in with false value")
+(assert (= (get-in t [:side :note] "dflt") "dflt")
+        "get-in with false value and default")
+
+# Evaluate stream with `dofile`
+# 9cc4e4812
+(def [r w] (os/pipe))
+(:write w "(setdyn :x 10)")
+(:close w)
+(def stream-env (dofile r))
+(assert (= (stream-env :x) 10) "dofile stream 1")
+
+# Test thaw and freeze
+# 9cc0645a1
+(def table-to-freeze @{:c 22 :b [1 2 3 4] :d @"test" :e "test2"})
+(def table-to-freeze-with-inline-proto
+  @{:a @[1 2 3] :b @[1 2 3 4] :c 22 :d @"test" :e @"test2"})
+(def struct-to-thaw
+  (struct/with-proto {:a [1 2 3]} :c 22 :b [1 2 3 4] :d "test" :e "test2"))
+(table/setproto table-to-freeze @{:a @[1 2 3]})
+
+(assert (deep= {:a [1 2 3] :b [1 2 3 4] :c 22 :d "test" :e "test2"}
+               (freeze table-to-freeze)))
+(assert (deep= table-to-freeze-with-inline-proto (thaw table-to-freeze)))
+(assert (deep= table-to-freeze-with-inline-proto (thaw struct-to-thaw)))
+
+# Make sure Carriage Returns don't end up in doc strings
+# e528b86
+(assert (not (string/find "\r"
+                          (get ((fiber/getenv (fiber/current)) 'cond)
+                               :doc "")))
+        "no \\r in doc strings")
+
+# cff718f37
+(var counter 0)
+(def thunk (delay (++ counter)))
+(assert (= (thunk) 1) "delay 1")
+(assert (= counter 1) "delay 2")
+(assert (= (thunk) 1) "delay 3")
+(assert (= counter 1) "delay 4")
+
+# maclintf
+(def env (table/clone (curenv)))
+((compile '(defmacro foo [] (maclintf :strict "oops")) env :anonymous))
+(def lints @[])
+(compile (tuple/setmap '(foo) 1 2) env :anonymous lints)
+(assert (deep= lints @[[:strict 1 2 "oops"]]) "maclintf 1")
+
+(def env (table/clone (curenv)))
+((compile '(defmacro foo [& body] (maclintf :strict "foo-oops") ~(do ,;body)) env :anonymous))
+((compile '(defmacro bar [] (maclintf :strict "bar-oops")) env :anonymous))
+(def lints @[])
+# Compile (foo (bar)), but with explicit source map values
+(def bar-invoke (tuple/setmap '(bar) 3 4))
+(compile (tuple/setmap ~(foo ,bar-invoke) 1 2) env :anonymous lints)
+(assert (deep= lints @[[:strict 1 2 "foo-oops"]
+                       [:strict 3 4 "bar-oops"]])
+        "maclintf 2")
+
+(end-suite)

test/suite-buffer.janet

@@ -0,0 +1,121 @@
+# Copyright (c) 2023 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)
+
+# Buffer blitting
+# 16ebb1118
+(def b (buffer/new-filled 100))
+(buffer/bit-set b 100)
+(buffer/bit-clear b 100)
+(assert (zero? (sum b)) "buffer bit set and clear")
+(assert (= false (buffer/bit b 101)) "bit get false")
+(buffer/bit-toggle b 101)
+(assert (= true (buffer/bit b 101)) "bit get true")
+(assert (= 32 (sum b)) "buffer bit set and clear")
+(assert-error "invalid bit index 1000" (buffer/bit-toggle b 1000))
+
+(def b2 @"hello world")
+
+(buffer/blit b2 "joyto ")
+(assert (= (string b2) "joyto world") "buffer/blit 1")
+
+(buffer/blit b2 "joyto" 6)
+(assert (= (string b2) "joyto joyto") "buffer/blit 2")
+
+(buffer/blit b2 "abcdefg" 5 6)
+(assert (= (string b2) "joytogjoyto") "buffer/blit 3")
+
+# buffer/push
+
+(assert (deep= (buffer/push @"AA" @"BB") @"AABB") "buffer/push buffer")
+(assert (deep= (buffer/push @"AA" 66 66) @"AABB") "buffer/push int")
+(def b @"AA")
+(assert (deep= (buffer/push b b) @"AAAA") "buffer/push buffer self")
+
+# buffer/push-byte
+(assert (deep= (buffer/push-byte @"AA" 66) @"AAB") "buffer/push-byte")
+(assert-error "bad slot #1, expected 32 bit signed integer" (buffer/push-byte @"AA" :flap))
+
+# Buffer push word
+# e755f9830
+(def b3 @"")
+(buffer/push-word b3 0xFF 0x11)
+(assert (= 8 (length b3)) "buffer/push-word 1")
+(assert (= "\xFF\0\0\0\x11\0\0\0" (string b3)) "buffer/push-word 2")
+(buffer/clear b3)
+(buffer/push-word b3 0xFFFFFFFF 0x1100)
+(assert (= 8 (length b3)) "buffer/push-word 3")
+(assert (= "\xFF\xFF\xFF\xFF\0\x11\0\0" (string b3)) "buffer/push-word 4")
+(assert-error "cannot convert 0.5 to machine word" (buffer/push-word @"" 0.5))
+
+# Buffer push string
+# 175925207
+(def b4 (buffer/new-filled 10 0))
+(buffer/push-string b4 b4)
+(assert (= "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" (string b4))
+        "buffer/push-buffer 1")
+(def b5 @"123")
+(buffer/push-string b5 "456" @"789")
+(assert (= "123456789" (string b5)) "buffer/push-buffer 2")
+
+# some tests for buffer/format
+# 029394d
+(assert (= (string (buffer/format @"" "pi = %6.3f" math/pi)) "pi =  3.142")
+        "%6.3f")
+(assert (= (string (buffer/format @"" "pi = %+6.3f" math/pi)) "pi = +3.142")
+        "%6.3f")
+(assert (= (string (buffer/format @"" "pi = %40.20g" math/pi))
+           "pi =                     3.141592653589793116") "%6.3f")
+
+(assert (= (string (buffer/format @"" "🐼 = %6.3f" math/pi)) "🐼 =  3.142")
+        "UTF-8")
+(assert (= (string (buffer/format @"" "π = %.8g" math/pi)) "π = 3.1415927")
+        "π")
+(assert (= (string (buffer/format @"" "\xCF\x80 = %.8g" math/pi))
+           "\xCF\x80 = 3.1415927") "\xCF\x80")
+
+# Regression #301
+# a3d4ecddb
+(def b (buffer/new-filled 128 0x78))
+(assert (= 38 (length (buffer/blit @"" b -1 90))) "buffer/blit 1")
+
+(def a @"abcdefghijklm")
+(assert (deep= @"abcde" (buffer/blit @"" a -1 0 5)) "buffer/blit 2")
+(assert (deep= @"bcde" (buffer/blit @"" a -1 1 5)) "buffer/blit 3")
+(assert (deep= @"cde" (buffer/blit @"" a -1 2 5)) "buffer/blit 4")
+(assert (deep= @"de" (buffer/blit @"" a -1 3 5)) "buffer/blit 5")
+(assert (deep= @"de" (buffer/blit @"" a nil 3 5)) "buffer/blit 6")
+
+# buffer/push-at
+# c55d93512
+(assert (deep= @"abc456" (buffer/push-at @"abc123" 3 "456"))
+        "buffer/push-at 1")
+(assert (deep= @"abc456789" (buffer/push-at @"abc123" 3 "456789"))
+        "buffer/push-at 2")
+(assert (deep= @"abc423" (buffer/push-at @"abc123" 3 "4"))
+        "buffer/push-at 3")
+
+# 4782a76
+(assert (= 10 (do (var x 10) (def y x) (++ x) y)) "no invalid aliasing")
+
+(end-suite)
+

test/suite-capi.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2023 Calvin Rose & contributors
+# Copyright (c) 2023 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
@@ -19,25 +19,26 @@
 # IN THE SOFTWARE.
 
 (import ./helper :prefix "" :exit true)
-(start-suite 13)
+(start-suite)
 
-(assert (deep= (tabseq [i :in (range 3)] i (* 3 i))
-               @{0 0 1 3 2 6}))
+# Tuple types
+# c6edf03ae
+(assert (= (tuple/type '(1 2 3)) :parens) "normal tuple")
+(assert (= (tuple/type [1 2 3]) :parens) "normal tuple 1")
+(assert (= (tuple/type '[1 2 3]) :brackets) "bracketed tuple 2")
+(assert (= (tuple/type (-> '(1 2 3) marshal unmarshal)) :parens)
+        "normal tuple marshalled/unmarshalled")
+(assert (= (tuple/type (-> '[1 2 3] marshal unmarshal)) :brackets)
+        "normal tuple marshalled/unmarshalled")
 
-(assert (deep= (tabseq [i :in (range 3)] i)
-               @{}))
-
-(def- sym-prefix-peg
-  (peg/compile
-    ~{:symchar (+ (range "\x80\xff" "AZ" "az" "09") (set "!$%&*+-./:<?=>@^_"))
-      :anchor (drop (cmt ($) ,|(= $ 0)))
-      :cap (* (+ (> -1 (not :symchar)) :anchor) (* ($) '(some :symchar)))
-      :recur (+ :cap (> -1 :recur))
-      :main (> -1 :recur)}))
-
-(assert (deep= (peg/match sym-prefix-peg @"123" 3) @[0 "123"]) "peg lookback")
-(assert (deep= (peg/match sym-prefix-peg @"1234" 4) @[0 "1234"]) "peg lookback 2")
-
-(assert (deep= (peg/replace-all '(* (<- 1) 1 (backmatch)) "xxx" "aba cdc efa") @"xxx xxx efa") "peg replace-all 1")
+# Dynamic bindings
+# 7918add47, 513d551d
+(setdyn :a 10)
+(assert (= 40 (with-dyns [:a 25 :b 15] (+ (dyn :a) (dyn :b)))) "dyn usage 1")
+(assert (= 10 (dyn :a)) "dyn usage 2")
+(assert (= nil (dyn :b)) "dyn usage 3")
+(setdyn :a 100)
+(assert (= 100 (dyn :a)) "dyn usage 4")
 
 (end-suite)
+

test/suite-cfuns.janet

@@ -0,0 +1,34 @@
+# Copyright (c) 2023 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)
+
+# Inline 3 argument get
+# a1ea62a
+(assert (= 10 (do (var a 10) (set a (get '{} :a a)))) "inline get 1")
+
+# Regression #24
+# f28477649
+(def t (put @{} :hi 1))
+(assert (deep= t @{:hi 1}) "regression #24")
+
+(end-suite)
+

test/suite-compile.janet

@@ -0,0 +1,77 @@
+# Copyright (c) 2023 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)
+
+# Regression Test
+# 0378ba78
+(assert (= 1 (((compile '(fn [] 1) @{})))) "regression test")
+
+# Fix a compiler bug in the do special form
+# 3e1e2585
+(defn myfun [x]
+  (var a 10)
+  (set a (do
+         (def y x)
+         (if x 8 9))))
+
+(assert (= (myfun true) 8) "check do form regression")
+(assert (= (myfun false) 9) "check do form regression")
+
+# Check x:digits: works as symbol and not a hex number
+# 5baf70f4
+(def x1 100)
+(assert (= x1 100) "x1 as symbol")
+(def X1 100)
+(assert (= X1 100) "X1 as symbol")
+
+# Edge case should cause old compilers to fail due to
+# if statement optimization
+# 17283241
+(var var-a 1)
+(var var-b (if false 2 (string "hello")))
+
+(assert (= var-b "hello") "regression 1")
+
+# d28925fda
+(assert (= (string '()) (string [])) "empty bracket tuple literal")
+
+# Bracket tuple issue
+# 340a6c4
+(let [do 3]
+  (assert (= [3 1 2 3] [do 1 2 3]) "bracket tuples are never special forms"))
+(assert (= ~(,defn 1 2 3) [defn 1 2 3]) "bracket tuples are never macros")
+(assert (= ~(,+ 1 2 3) [+ 1 2 3]) "bracket tuples are never function calls")
+
+# Crash issue #1174 - bad debug info
+# e97299f
+(defn crash []
+  (debug/stack (fiber/current)))
+(do
+  (math/random)
+  (defn foo [_]
+    (crash)
+    1)
+  (foo 0)
+  10)
+
+(end-suite)
+

test/suite-corelib.janet

@@ -0,0 +1,176 @@
+# Copyright (c) 2023 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)
+
+# ac50f62
+(assert (= 10 (+ 1 2 3 4)) "addition")
+(assert (= -8 (- 1 2 3 4)) "subtraction")
+(assert (= 24 (* 1 2 3 4)) "multiplication")
+# d6967a5
+(assert (= 4 (blshift 1 2)) "left shift")
+(assert (= 1 (brshift 4 2)) "right shift")
+# unsigned shift
+(assert (= 32768 (brushift 0x80000000 16)) "right shift unsigned 1")
+(assert-error "right shift unsigned 2" (= -32768 (brshift 0x80000000 16)))
+(assert (= -1 (brshift -1 16)) "right shift unsigned 3")
+# non-immediate forms
+(assert (= 32768 (brushift 0x80000000 (+ 0 16))) "right shift unsigned non-immediate")
+(assert-error "right shift non-immediate" (= -32768 (brshift 0x80000000 (+ 0 16))))
+(assert (= -1 (brshift -1 (+ 0 16))) "right shift non-immediate 2")
+(assert (= 32768 (blshift 1 (+ 0 15))) "left shift non-immediate")
+# 7e46ead
+(assert (< 1 2 3 4 5 6) "less than integers")
+(assert (< 1.0 2.0 3.0 4.0 5.0 6.0) "less than reals")
+(assert (> 6 5 4 3 2 1) "greater than integers")
+(assert (> 6.0 5.0 4.0 3.0 2.0 1.0) "greater than reals")
+(assert (<= 1 2 3 3 4 5 6) "less than or equal to integers")
+(assert (<= 1.0 2.0 3.0 3.0 4.0 5.0 6.0) "less than or equal to reals")
+(assert (>= 6 5 4 4 3 2 1) "greater than or equal to integers")
+(assert (>= 6.0 5.0 4.0 4.0 3.0 2.0 1.0) "greater than or equal to reals")
+
+(assert (= 7 (% 20 13)) "rem 1")
+(assert (= -7 (% -20 13)) "rem 2")
+(assert (= 7 (% 20 -13)) "rem 3")
+(assert (= -7 (% -20 -13)) "rem 4")
+(assert (nan? (% 20 0)) "rem 5")
+
+(assert (= 7 (mod 20 13)) "mod 1")
+(assert (= 6 (mod -20 13)) "mod 2")
+(assert (= -6 (mod 20 -13)) "mod 3")
+(assert (= -7 (mod -20 -13)) "mod 4")
+(assert (= 20 (mod 20 0)) "mod 5")
+
+(assert (= 1 (div 20 13)) "div 1")
+(assert (= -2 (div -20 13)) "div 2")
+(assert (= -2 (div 20 -13)) "div 3")
+(assert (= 1 (div -20 -13)) "div 4")
+(assert (= math/inf (div 20 0)) "div 5")
+
+(assert (all = (seq [n :range [0 10]] (mod n 5 3))
+               (seq [n :range [0 10]] (% n 5 3))
+               [0 1 2 0 1 0 1 2 0 1]) "variadic mod")
+
+(assert (< 1.0 nil false true
+           (fiber/new (fn [] 1))
+           "hi"
+           (quote hello)
+           :hello
+           (array 1 2 3)
+           (tuple 1 2 3)
+           (table "a" "b" "c" "d")
+           (struct 1 2 3 4)
+           (buffer "hi")
+           (fn [x] (+ x x))
+           print) "type ordering")
+
+# b305a7c9b
+(assert (= (string (buffer "123" "456")) (string @"123456")) "buffer literal")
+# 277117165
+(assert (= (get {} 1) nil) "get nil from empty struct")
+(assert (= (get @{} 1) nil) "get nil from empty table")
+(assert (= (get {:boop :bap} :boop) :bap) "get non nil from struct")
+(assert (= (get @{:boop :bap} :boop) :bap) "get non nil from table")
+(assert (= (get @"\0" 0) 0) "get non nil from buffer")
+(assert (= (get @"\0" 1) nil) "get nil from buffer oob")
+(assert (put @{} :boop :bap) "can add to empty table")
+(assert (put @{1 3} :boop :bap) "can add to non-empty table")
+# 7e46ead
+(assert (= 7 (bor 3 4)) "bit or")
+(assert (= 0 (band 3 4)) "bit and")
+# f41dab8
+(assert (= 0xFF (bxor 0x0F 0xF0)) "bit xor")
+(assert (= 0xF0 (bxor 0xFF 0x0F)) "bit xor 2")
+
+# Some testing for not=
+# 08f6c642d
+(assert (not= 1 1 0) "not= 1")
+(assert (not= 0 1 1) "not= 2")
+
+# Check if abstract test works
+# d791077e2
+(assert (abstract? stdout) "abstract? stdout")
+(assert (abstract? stdin) "abstract? stdin")
+(assert (abstract? stderr) "abstract? stderr")
+(assert (not (abstract? nil)) "not abstract? nil")
+(assert (not (abstract? 1)) "not abstract? 1")
+(assert (not (abstract? 3)) "not abstract? 3")
+(assert (not (abstract? 5)) "not abstract? 5")
+
+# Module path expansion
+# ff3bb6627
+(setdyn :current-file "some-dir/some-file")
+(defn test-expand [path temp]
+  (string (module/expand-path path temp)))
+
+(assert (= (test-expand "abc" ":cur:/:all:") "some-dir/abc")
+        "module/expand-path 1")
+(assert (= (test-expand "./abc" ":cur:/:all:") "some-dir/abc")
+        "module/expand-path 2")
+(assert (= (test-expand "abc/def.txt" ":cur:/:name:") "some-dir/def.txt")
+        "module/expand-path 3")
+(assert (= (test-expand "abc/def.txt" ":cur:/:dir:/sub/:name:")
+           "some-dir/abc/sub/def.txt") "module/expand-path 4")
+# fc46030e7
+(assert (= (test-expand "/abc/../def.txt" ":all:") "/def.txt")
+        "module/expand-path 5")
+(assert (= (test-expand "abc/../def.txt" ":all:") "def.txt")
+        "module/expand-path 6")
+(assert (= (test-expand "../def.txt" ":all:") "../def.txt")
+        "module/expand-path 7")
+(assert (= (test-expand "../././././abcd/../def.txt" ":all:") "../def.txt")
+        "module/expand-path 8")
+
+# module/expand-path regression
+# issue #143 - e0fe8476a
+(with-dyns [:syspath ".janet/.janet"]
+  (assert (= (string (module/expand-path "hello" ":sys:/:all:.janet"))
+             ".janet/.janet/hello.janet") "module/expand-path 1"))
+
+# int?
+(assert (int? 1) "int? 1")
+(assert (int? -1) "int? -1")
+(assert (not (int? true)) "int? true")
+(assert (not (int? 3.14)) "int? 3.14")
+(assert (not (int? 8589934592)) "int? 8589934592")
+
+# memcmp
+(assert (= (memcmp "123helloabcd" "1234helloabc" 5 3 4) 0) "memcmp 1")
+(assert (< (memcmp "123hellaabcd" "1234helloabc" 5 3 4) 0) "memcmp 2")
+(assert (> (memcmp "123helloabcd" "1234hellaabc" 5 3 4) 0) "memcmp 3")
+(assert-error "invalid offset-a: 1" (memcmp "a" "b" 1 1 0))
+(assert-error "invalid offset-b: 1" (memcmp "a" "b" 1 0 1))
+
+# Range
+# a982f351d
+(assert (deep= (range 10) @[0 1 2 3 4 5 6 7 8 9]) "(range 10)")
+(assert (deep= (range 5 10) @[5 6 7 8 9]) "(range 5 10)")
+(assert (deep= (range 0 16 4) @[0 4 8 12]) "(range 0 16 4)")
+(assert (deep= (range 0 17 4) @[0 4 8 12 16]) "(range 0 17 4)")
+(assert (deep= (range 16 0 -4) @[16 12 8 4]) "(range 16 0 -4)")
+(assert (deep= (range 17 0 -4) @[17 13 9 5 1]) "(range 17 0 -4)")
+
+(assert (= (length (range 10)) 10) "(range 10)")
+(assert (= (length (range -10)) 0) "(range -10)")
+(assert (= (length (range 1 10)) 9) "(range 1 10)")
+
+(end-suite)
+

test/suite-debug.janet

@@ -0,0 +1,34 @@
+# Copyright (c) 2023 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)
+
+# Simple function break
+# a8afc5b81
+(debug/fbreak map 1)
+(def f (fiber/new (fn [] (map inc [1 2 3])) :a))
+(resume f)
+(assert (= :debug (fiber/status f)) "debug/fbreak")
+(debug/unfbreak map 1)
+(map inc [1 2 3])
+
+(end-suite)
+

test/suite-ev.janet

@@ -19,50 +19,58 @@
 # IN THE SOFTWARE.
 
 (import ./helper :prefix "" :exit true)
-(start-suite 9)
+(start-suite)
 
 # Subprocess
-
+# 5e1a8c86f
 (def janet (dyn :executable))
 
+# Subprocess should inherit the "RUN" parameter for fancy testing
+(def run (filter next (string/split " " (os/getenv "SUBRUN" ""))))
+
 (repeat 10
 
-  (let [p (os/spawn [janet "-e" `(print "hello")`] :p {:out :pipe})]
+  (let [p (os/spawn [;run janet "-e" `(print "hello")`] :p {:out :pipe})]
     (os/proc-wait p)
     (def x (:read (p :out) :all))
-    (assert (deep= "hello" (string/trim x)) "capture stdout from os/spawn pre close."))
+    (assert (deep= "hello" (string/trim x))
+            "capture stdout from os/spawn pre close."))
 
-  (let [p (os/spawn [janet "-e" `(print "hello")`] :p {:out :pipe})]
+  (let [p (os/spawn [;run janet "-e" `(print "hello")`] :p {:out :pipe})]
     (def x (:read (p :out) 1024))
     (os/proc-wait p)
-    (assert (deep= "hello" (string/trim x)) "capture stdout from os/spawn post close."))
+    (assert (deep= "hello" (string/trim x))
+            "capture stdout from os/spawn post close."))
 
-  (let [p (os/spawn [janet "-e" `(file/read stdin :line)`] :px {:in :pipe})]
+  (let [p (os/spawn [;run janet "-e" `(file/read stdin :line)`] :px
+                    {:in :pipe})]
     (:write (p :in) "hello!\n")
     (assert-no-error "pipe stdin to process" (os/proc-wait p))))
 
-(let [p (os/spawn [janet "-e" `(print (file/read stdin :line))`] :px {:in :pipe :out :pipe})]
+(let [p (os/spawn [;run janet "-e" `(print (file/read stdin :line))`] :px
+                  {:in :pipe :out :pipe})]
   (:write (p :in) "hello!\n")
   (def x (:read (p :out) 1024))
   (assert-no-error "pipe stdin to process 2" (os/proc-wait p))
   (assert (= "hello!" (string/trim x)) "round trip pipeline in process"))
 
-(let [p (os/spawn [janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
+(let [p (os/spawn [;run janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
   (os/proc-kill p)
   (def retval (os/proc-wait p))
   (assert (not= retval 24) "Process was *not* terminated by parent"))
 
-(let [p (os/spawn [janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
+(let [p (os/spawn [;run janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
   (os/proc-kill p false :term)
   (def retval (os/proc-wait p))
   (assert (not= retval 24) "Process was *not* terminated by parent"))
 
 # Parallel subprocesses
-
+# 5e1a8c86f
 (defn calc-1
   "Run subprocess, read from stdout, then wait on subprocess."
   [code]
-  (let [p (os/spawn [janet "-e" (string `(printf "%j" ` code `)`)] :px {:out :pipe})]
+  (let [p (os/spawn [;run janet "-e" (string `(printf "%j" ` code `)`)] :px
+                    {:out :pipe})]
     (os/proc-wait p)
     (def output (:read (p :out) :all))
     (parse output)))
@@ -76,9 +84,13 @@
     @[10 26 42]) "parallel subprocesses 1")
 
 (defn calc-2
-  "Run subprocess, wait on subprocess, then read from stdout. Read only up to 10 bytes instead of :all"
+  ``
+  Run subprocess, wait on subprocess, then read from stdout. Read only up
+  to 10 bytes instead of :all
+  ``
   [code]
-  (let [p (os/spawn [janet "-e" (string `(printf "%j" ` code `)`)] :px {:out :pipe})]
+  (let [p (os/spawn [;run janet "-e" (string `(printf "%j" ` code `)`)] :px
+                    {:out :pipe})]
     (def output (:read (p :out) 10))
     (os/proc-wait p)
     (parse output)))
@@ -92,18 +104,28 @@
     @[10 26 42]) "parallel subprocesses 2")
 
 # File piping
-
+# a1cc5ca04
 (assert-no-error "file writing 1"
   (with [f (file/temp)]
-    (os/execute [janet "-e" `(repeat 20 (print :hello))`] :p {:out f})))
+    (os/execute [;run janet "-e" `(repeat 20 (print :hello))`] :p {:out f})))
 
 (assert-no-error "file writing 2"
   (with [f (file/open "unique.txt" :w)]
-    (os/execute [janet "-e" `(repeat 20 (print :hello))`] :p {:out f})
+    (os/execute [;run janet "-e" `(repeat 20 (print :hello))`] :p {:out f})
     (file/flush f)))
 
-# each-line iterator
+# Issue #593
+# a1cc5ca04
+(assert-no-error "file writing 3"
+  (def outfile (file/open "unique.txt" :w))
+  (os/execute [;run janet "-e" "(pp (seq [i :range (1 10)] i))"] :p
+              {:out outfile})
+  (file/flush outfile)
+  (file/close outfile)
+  (os/rm "unique.txt"))
 
+# each-line iterator
+# 70f13f1
 (assert-no-error "file/lines iterator"
    (def outstream (os/open "unique.txt" :wct))
    (def buf1 "123\n456\n")
@@ -116,26 +138,20 @@
    (assert (= buf1 buf2) "file/lines iterator")
    (os/rm "unique.txt"))
 
-# Issue #593
-(assert-no-error "file writing 3"
-  (def outfile (file/open "unique.txt" :w))
-  (os/execute [janet "-e" "(pp (seq [i :range (1 10)] i))"] :p {:out outfile})
-  (file/flush outfile)
-  (file/close outfile)
-  (os/rm "unique.txt"))
-
 # Ensure that the stream created by os/open works
-
+# e8a86013d
 (assert-no-error "File writing 4.1"
    (def outstream (os/open "unique.txt" :wct))
    (defer (:close outstream)
      (:write outstream "123\n")
      (:write outstream "456\n"))
    # Cast to string to enable comparison
-   (assert (= "123\n456\n" (string (slurp "unique.txt"))) "File writing 4.2")
+   (assert (= "123\n456\n" (string (slurp "unique.txt")))
+           "File writing 4.2")
    (os/rm "unique.txt"))
 
 # Test that the stream created by os/open can be read from
+# 8d8a6534e
 (comment
   (assert-no-error "File reading 1.1"
     (def outstream (os/open "unique.txt" :wct))
@@ -145,17 +161,25 @@
 
     (def outstream (os/open "unique.txt" :r))
     (defer (:close outstream)
-      (assert (= "123\n456\n" (string (:read outstream :all))) "File reading 1.2"))
+      (assert (= "123\n456\n" (string (:read outstream :all)))
+              "File reading 1.2"))
     (os/rm "unique.txt")))
 
-  # ev/gather
-
+# ev/gather
+# 4f2d1cdc0
 (assert (deep= @[1 2 3] (ev/gather 1 2 3)) "ev/gather 1")
 (assert (deep= @[] (ev/gather)) "ev/gather 2")
 (assert-error "ev/gather 3" (ev/gather 1 2 (error 3)))
 
-# Net testing
+(var cancel-counter 0)
+(assert-error "ev/gather 4.1" (ev/gather
+                               (defer (++ cancel-counter) (ev/take (ev/chan)))
+                               (defer (++ cancel-counter) (ev/take (ev/chan)))
+                               (error :oops)))
+(assert (= cancel-counter 2) "ev/gather 4.2")
 
+# Net testing
+# 2904c19ed
 (repeat 10
 
   (defn handler
@@ -184,6 +208,7 @@
   (:close s))
 
 # Test on both server and client
+# 504411e
 (defn names-handler
   [stream]
   (defer (:close stream)
@@ -194,6 +219,7 @@
     (assert (= port 8000) "localname port server")))
 
 # Test localname and peername
+# 077bf5eba
 (repeat 10
   (with [s (net/server "127.0.0.1" "8000" names-handler)]
     (repeat 10
@@ -206,7 +232,7 @@
   (gccollect))
 
 # Create pipe
-
+# 12f09ad2d
 (var pipe-counter 0)
 (def chan (ev/chan 10))
 (let [[reader writer] (os/pipe)]
@@ -222,6 +248,7 @@
   (ev/close writer)
   (ev/take chan))
 
+# cff52ded5
 (var result nil)
 (var fiber nil)
 (set fiber
@@ -231,10 +258,11 @@
 (ev/sleep 0)
 (ev/cancel fiber "boop")
 
-(assert (os/execute [janet "-e" `(+ 1 2 3)`] :xp) "os/execute self")
+# f0dbc2e
+(assert (os/execute [;run janet "-e" `(+ 1 2 3)`] :xp) "os/execute self")
 
 # Test some channel
-
+# e76b8da26
 (def c1 (ev/chan))
 (def c2 (ev/chan))
 (def arr @[])
@@ -276,16 +304,17 @@
 (assert (= (slice arr) (slice (range 100))) "ev/chan-close 3")
 
 # threaded channels
-
+# 868cdb9
 (def ch (ev/thread-chan 2))
 (def att (ev/thread-chan 109))
 (assert att "`att` was nil after creation")
 (ev/give ch att)
 (ev/do-thread
-  (assert (ev/take ch) "channel packing bug for threaded abstracts on threaded channels."))
+  (assert (ev/take ch)
+          "channel packing bug for threaded abstracts on threaded channels."))
 
 # marshal channels
-
+# 76be8006a
 (def ch (ev/chan 10))
 (ev/give ch "hello")
 (ev/give ch "world")
@@ -295,4 +324,25 @@
 (assert (= item1 "hello"))
 (assert (= item2 "world"))
 
+# ev/take, suspended, channel closed
+(def ch (ev/chan))
+(ev/go |(ev/chan-close ch))
+(assert (= (ev/take ch) nil))
+
+# ev/give, suspended, channel closed
+(def ch (ev/chan))
+(ev/go |(ev/chan-close ch))
+(assert (= (ev/give ch 1) nil))
+
+# ev/select, suspended take operation, channel closed
+(def ch (ev/chan))
+(ev/go |(ev/chan-close ch))
+(assert (= (ev/select ch) [:close ch]))
+
+# ev/select, suspended give operation, channel closed
+(def ch (ev/chan))
+(ev/go |(ev/chan-close ch))
+(assert (= (ev/select [ch 1]) [:close ch]))
+
 (end-suite)
+

test/suite-ffi.janet

@@ -19,30 +19,30 @@
 # IN THE SOFTWARE.
 
 (import ./helper :prefix "" :exit true)
-(start-suite 12)
-
-(var counter 0)
-(def thunk (delay (++ counter)))
-(assert (= (thunk) 1) "delay 1")
-(assert (= counter 1) "delay 2")
-(assert (= (thunk) 1) "delay 3")
-(assert (= counter 1) "delay 4")
+(start-suite)
 
 # We should get ARM support...
-(def has-ffi (and (dyn 'ffi/native) (= (os/arch) :x64)))
+(def has-ffi (dyn 'ffi/native))
+(def has-full-ffi
+  (and has-ffi
+       (when-let [entry (dyn 'ffi/calling-conventions)]
+         (def fficc (entry :value))
+         (> (length (fficc)) 1)))) # all arches support :none
 
 # FFI check
+# d80356158
 (compwhen has-ffi
   (ffi/context))
 
 (compwhen has-ffi
   (ffi/defbind memcpy :ptr [dest :ptr src :ptr n :size]))
-(compwhen has-ffi
+(compwhen has-full-ffi
   (def buffer1 @"aaaa")
   (def buffer2 @"bbbb")
   (memcpy buffer1 buffer2 4)
   (assert (= (string buffer1) "bbbb") "ffi 1 - memcpy"))
 
+# cfaae47ce
 (compwhen has-ffi
   (assert (= 8 (ffi/size [:int :char])) "size unpacked struct 1")
   (assert (= 5 (ffi/size [:pack :int :char])) "size packed struct 1")
@@ -50,7 +50,8 @@
   (assert (= 4 (ffi/align [:int :char])) "align 1")
   (assert (= 1 (ffi/align [:pack :int :char])) "align 2")
   (assert (= 1 (ffi/align [:int :char :pack-all])) "align 3")
-  (assert (= 26 (ffi/size [:char :pack :int @[:char 21]])) "array struct size"))
+  (assert (= 26 (ffi/size [:char :pack :int @[:char 21]]))
+          "array struct size"))
 
 (end-suite)
 

test/suite-inttypes.janet

@@ -0,0 +1,288 @@
+# Copyright (c) 2023 Calvin Rose & contributors
+#
+# 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)
+
+# some tests for bigint
+# 319575c
+(def i64 int/s64)
+(def u64 int/u64)
+
+(assert-no-error
+  "create some uint64 bigints"
+  (do
+    # from number
+    (def a (u64 10))
+    # max double we can convert to int (2^53)
+    (def b (u64 0x1fffffffffffff))
+    (def b (u64 (math/pow 2 53)))
+    # from string
+    (def c (u64 "0xffff_ffff_ffff_ffff"))
+    (def c (u64 "32rvv_vv_vv_vv"))
+    (def d (u64 "123456789"))))
+
+# Conversion back to an int32
+# 88db9751d
+(assert (= (int/to-number (u64 0xFaFa)) 0xFaFa))
+(assert (= (int/to-number (i64 0xFaFa)) 0xFaFa))
+(assert (= (int/to-number (u64 9007199254740991)) 9007199254740991))
+(assert (= (int/to-number (i64 9007199254740991)) 9007199254740991))
+(assert (= (int/to-number (i64 -9007199254740991)) -9007199254740991))
+
+(assert-error
+  "u64 out of bounds for safe integer"
+  (int/to-number (u64 "9007199254740993"))
+
+  (assert-error
+    "s64 out of bounds for safe integer"
+    (int/to-number (i64 "-9007199254740993"))))
+
+(assert-error
+  "int/to-number fails on non-abstract types"
+  (int/to-number 1))
+
+(assert-no-error
+  "create some int64 bigints"
+  (do
+    # from number
+    (def a (i64 -10))
+    # max double we can convert to int (2^53)
+    (def b (i64 0x1fffffffffffff))
+    (def b (i64 (math/pow 2 53)))
+    # from string
+    (def c (i64 "0x7fff_ffff_ffff_ffff"))
+    (def d (i64 "123456789"))))
+
+(assert-error
+  "bad initializers"
+  (do
+    # double to big to be converted to uint64 without truncation (2^53 + 1)
+    (def b (u64 (+ 0xffff_ffff_ffff_ff 1)))
+    (def b (u64 (+ (math/pow 2 53) 1)))
+    # out of range 65 bits
+    (def c (u64 "0x1ffffffffffffffff"))
+    # just to big
+    (def d (u64 "123456789123456789123456789"))))
+
+(assert (= (:/ (u64 "0xffff_ffff_ffff_ffff") 8 2) (u64 "0xfffffffffffffff"))
+        "bigint operations 1")
+(assert (let [a (u64 0xff)] (= (:+ a a a a) (:* a 2 2)))
+        "bigint operations 2")
+
+# 5ae520a2c
+(assert (= (string (i64 -123)) "-123") "i64 prints reasonably")
+(assert (= (string (u64 123)) "123") "u64 prints reasonably")
+
+# 1db6d0e0b
+(assert-error
+  "trap INT64_MIN / -1"
+  (:/ (int/s64 "-0x8000_0000_0000_0000") -1))
+
+# int/s64 and int/u64 serialization
+# 6aea7c7f7
+(assert (deep= (int/to-bytes (u64 0)) @"\x00\x00\x00\x00\x00\x00\x00\x00"))
+
+(assert (deep= (int/to-bytes (i64 1) :le)
+               @"\x01\x00\x00\x00\x00\x00\x00\x00"))
+(assert (deep= (int/to-bytes (i64 1) :be)
+               @"\x00\x00\x00\x00\x00\x00\x00\x01"))
+(assert (deep= (int/to-bytes (i64 -1))
+               @"\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF"))
+(assert (deep= (int/to-bytes (i64 -5) :be)
+               @"\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFB"))
+
+(assert (deep= (int/to-bytes (u64 1) :le)
+               @"\x01\x00\x00\x00\x00\x00\x00\x00"))
+(assert (deep= (int/to-bytes (u64 1) :be)
+               @"\x00\x00\x00\x00\x00\x00\x00\x01"))
+(assert (deep= (int/to-bytes (u64 300) :be)
+               @"\x00\x00\x00\x00\x00\x00\x01\x2C"))
+
+# int/s64 int/u64 to existing buffer
+# bbb3e16fd
+(let [buf1 @""
+      buf2 @"abcd"]
+  (assert (deep= (int/to-bytes (i64 1) :le buf1)
+                 @"\x01\x00\x00\x00\x00\x00\x00\x00"))
+  (assert (deep= buf1 @"\x01\x00\x00\x00\x00\x00\x00\x00"))
+  (assert (deep= (int/to-bytes (u64 300) :be buf2)
+                 @"abcd\x00\x00\x00\x00\x00\x00\x01\x2C")))
+
+# int/s64 and int/u64 paramater type checking
+# 6aea7c7f7
+(assert-error
+  "bad value passed to int/to-bytes"
+  (int/to-bytes 1))
+
+# 6aea7c7f7
+(assert-error
+  "invalid endianness passed to int/to-bytes"
+  (int/to-bytes (u64 0) :little))
+
+# bbb3e16fd
+(assert-error
+  "invalid buffer passed to int/to-bytes"
+  (int/to-bytes (u64 0) :little :buffer))
+
+# Right hand operators
+# 4fe005e3c
+(assert (= (int/s64 (sum (range 10))) (sum (map int/s64 (range 10))))
+        "right hand operators 1")
+(assert (= (int/s64
+             (product (range 1 10))) (product (map int/s64 (range 1 10))))
+        "right hand operators 2")
+(assert (= (int/s64 15) (bor 10 (int/s64 5)) (bor (int/s64 10) 5))
+        "right hand operators 3")
+
+# Integer type checks
+# 11067d7a5
+(assert (compare= 0 (- (int/u64 "1000") 1000)) "subtract from int/u64")
+
+(assert (odd? (int/u64 "1001")) "odd? 1")
+(assert (not (odd? (int/u64 "1000"))) "odd? 2")
+(assert (odd? (int/s64 "1001")) "odd? 3")
+(assert (not (odd? (int/s64 "1000"))) "odd? 4")
+(assert (odd? (int/s64 "-1001")) "odd? 5")
+(assert (not (odd? (int/s64 "-1000"))) "odd? 6")
+
+(assert (even? (int/u64 "1000")) "even? 1")
+(assert (not (even? (int/u64 "1001"))) "even? 2")
+(assert (even? (int/s64 "1000")) "even? 3")
+(assert (not (even? (int/s64 "1001"))) "even? 4")
+(assert (even? (int/s64 "-1000")) "even? 5")
+(assert (not (even? (int/s64 "-1001"))) "even? 6")
+
+# integer type operations
+(defn opcheck [int x y]
+  (each op [mod % div]
+    (assert (compare= (op x y) (op (int x) y))
+            (string int " (" op " " x " " y ") expected " (op x y)
+                    ", got " (op (int x) y)))
+    (assert (compare= (op x y) (op x (int y)))
+            (string int " (" op " " x " " y ") expected " (op x y)
+                    ", got " (op x (int y))))
+    (assert (compare= (op x y) (op (int x) (int y)))
+            (string int " (" op " " x " " y ") expected " (op x y)
+                    ", got " (op (int x) (int y))))))
+
+(loop [x :in [-5 -3 0 3 5]
+       y :in [-4 -3 3 4]]
+  (opcheck int/s64 x y)
+  (if (and (>= x 0) (>= y 0))
+    (opcheck int/u64 x y)))
+
+(each int [int/s64 int/u64]
+  (each op [% / div]
+    (assert-error "division by zero" (op (int 7) 0))
+    (assert-error "division by zero" (op 7 (int 0)))
+    (assert-error "division by zero" (op (int 7) (int 0)))))
+
+(each int [int/s64 int/u64]
+  (loop [x :in [-5 -3 0 3 5] :when (or (pos? x) (= int int/s64))]
+    # skip check when comparing negative values with unsigned integers.
+    (assert (= (int x) (mod (int x) 0)) (string int " mod 0"))
+    (assert (= (int x) (mod x (int 0))) (string int " mod 0"))
+    (assert (= (int x) (mod (int x) (int 0))) (string int " mod 0"))))
+
+(loop [x :in [-5 -3 0 3 5]]
+  (assert (compare= (bnot x) (bnot (int/s64 x))) "int/s64 bnot"))
+
+(loop [x :range [0 10]]
+  (assert (= (int/u64 "0xFFFF_FFFF_FFFF_FFFF")
+          (bxor (int/u64 x) (bnot (int/u64 x))))
+          "int/u64 bnot"))
+
+# Check for issue #1130
+# 7e65c2bda
+(var d (int/s64 7))
+(mod 0 d)
+
+(var d (int/s64 7))
+(def result (seq [n :in (range -21 0)] (mod n d)))
+(assert (deep= result
+               (map int/s64 @[0 1 2 3 4 5 6 0 1 2 3 4 5 6 0 1 2 3 4 5 6]))
+        "issue #1130")
+
+# issue #272 - 81d301a42
+(let [MAX_INT_64_STRING "9223372036854775807"
+      MAX_UINT_64_STRING "18446744073709551615"
+      MAX_INT_IN_DBL_STRING "9007199254740991"
+      NAN (math/log -1)
+      INF (/ 1 0)
+      MINUS_INF (/ -1 0)
+      compare-poly-tests
+      [[(int/s64 3) (int/u64 3) 0]
+       [(int/s64 -3) (int/u64 3) -1]
+       [(int/s64 3) (int/u64 2) 1]
+       [(int/s64 3) 3 0] [(int/s64 3) 4 -1] [(int/s64 3) -9 1]
+       [(int/u64 3) 3 0] [(int/u64 3) 4 -1] [(int/u64 3) -9 1]
+       [3 (int/s64 3) 0] [3 (int/s64 4) -1] [3 (int/s64 -5) 1]
+       [3 (int/u64 3) 0] [3 (int/u64 4) -1] [3 (int/u64 2) 1]
+       [(int/s64 MAX_INT_64_STRING) (int/u64 MAX_UINT_64_STRING) -1]
+       [(int/s64 MAX_INT_IN_DBL_STRING)
+        (scan-number MAX_INT_IN_DBL_STRING) 0]
+       [(int/u64 MAX_INT_IN_DBL_STRING)
+        (scan-number MAX_INT_IN_DBL_STRING) 0]
+       [(+ 1 (int/u64 MAX_INT_IN_DBL_STRING))
+        (scan-number MAX_INT_IN_DBL_STRING) 1]
+       [(int/s64 0) INF -1] [(int/u64 0) INF -1]
+       [MINUS_INF (int/u64 0) -1] [MINUS_INF (int/s64 0) -1]
+       [(int/s64 1) NAN 0] [NAN (int/u64 1) 0]]]
+  (each [x y c] compare-poly-tests
+    (assert (= c (compare x y))
+            (string/format "compare polymorphic %q %q %d" x y c))))
+
+# marshal
+(def m1 (u64 3141592654))
+(def m2 (unmarshal (marshal m1)))
+(assert (= m1 m2) "marshal/unmarshal")
+
+# compare u64/u64
+(assert (= (compare (u64 1) (u64 2)) -1) "compare 1")
+(assert (= (compare (u64 1) (u64 1))  0) "compare 2")
+(assert (= (compare (u64 2) (u64 1)) +1) "compare 3")
+
+# compare i64/i64
+(assert (= (compare (i64 -1) (i64 +1)) -1) "compare 4")
+(assert (= (compare (i64 +1) (i64 +1))  0) "compare 5")
+(assert (= (compare (i64 +1) (i64 -1)) +1) "compare 6")
+
+# compare u64/i64
+(assert (= (compare (u64 1) (i64 2)) -1) "compare 7")
+(assert (= (compare (u64 1) (i64 -1)) +1) "compare 8")
+(assert (= (compare (u64 0) (i64 -1)) +1) "compare 9")
+
+# compare i64/u64
+(assert (= (compare (i64 1) (u64 2)) -1) "compare 10")
+(assert (= (compare (i64 -1) (u64 1)) -1) "compare 11")
+(assert (= (compare (i64 -1) (u64 0)) -1) "compare 12")
+
+# off by 1 error in inttypes
+# a3e812b86
+(assert (= (int/s64 "-0x8000_0000_0000_0000")
+           (+ (int/s64 "0x7FFF_FFFF_FFFF_FFFF") 1)) "int types wrap around")
+(assert (= (int/s64 "0x7FFF_FFFF_FFFF_FFFF")
+           (- (int/s64 "-0x8000_0000_0000_0000") 1)) "int types wrap around")
+
+# Issue #1217
+(assert (= (- (int/u64 "0xFFFFFFFF") 1) (int/u64 "0xFFFFFFFE")) "u64 subtract")
+
+(end-suite)

test/suite-io.janet

@@ -0,0 +1,82 @@
+# Copyright (c) 2023 Calvin Rose & contributors
+#
+# 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)
+
+# Printing to buffers
+# d47804d22
+(def out-buf @"")
+(def err-buf @"")
+(with-dyns [:out out-buf :err err-buf]
+  (print "Hello")
+  (prin "hi")
+  (eprint "Sup")
+  (eprin "not much."))
+
+(assert (= (string out-buf) "Hello\nhi") "print and prin to buffer 1")
+(assert (= (string err-buf) "Sup\nnot much.")
+        "eprint and eprin to buffer 1")
+
+# Printing to functions
+# 4e263b8c3
+(def out-buf @"")
+(defn prepend [x]
+  (with-dyns [:out out-buf]
+    (prin "> " x)))
+(with-dyns [:out prepend]
+  (print "Hello world"))
+
+(assert (= (string out-buf) "> Hello world\n")
+        "print to buffer via function")
+
+# c2f844157, 3c523d66e
+(with [f (file/temp)]
+  (assert (= 0 (file/tell f)) "start of file")
+  (file/write f "foo\n")
+  (assert (= 4 (file/tell f)) "after written string")
+  (file/flush f)
+  (file/seek f :set 0)
+  (assert (= 0 (file/tell f)) "start of file again")
+  (assert (= (string (file/read f :all)) "foo\n") "temp files work"))
+
+# issue #1055 - 2c927ea76
+(let [b @""]
+  (defn dummy [a b c]
+    (+ a b c))
+  (trace dummy)
+  (defn errout [arg]
+    (buffer/push b arg))
+  (assert (= 6 (with-dyns [*err* errout] (dummy 1 2 3)))
+          "trace to custom err function")
+  (assert (deep= @"trace (dummy 1 2 3)\n" b) "trace buffer correct"))
+
+
+# xprintf
+(def b @"")
+(defn to-b [a] (buffer/push b a))
+(xprintf to-b "123")
+(assert (deep= b @"123\n") "xprintf to buffer")
+
+
+(assert-error "cannot print to 3" (xprintf 3 "123"))
+
+(end-suite)
+

test/suite-marsh.janet

@@ -0,0 +1,150 @@
+# Copyright (c) 2023 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)
+
+# Marshal
+
+# 98f2c6f
+(def um-lookup (env-lookup (fiber/getenv (fiber/current))))
+(def m-lookup (invert um-lookup))
+
+# 0cf10946b
+(defn testmarsh [x msg]
+  (def marshx (marshal x m-lookup))
+  (def out (marshal (unmarshal marshx um-lookup) m-lookup))
+  (assert (= (string marshx) (string out)) msg))
+
+(testmarsh nil "marshal nil")
+(testmarsh false "marshal false")
+(testmarsh true "marshal true")
+(testmarsh 1 "marshal small integers")
+(testmarsh -1 "marshal integers (-1)")
+(testmarsh 199 "marshal small integers (199)")
+(testmarsh 5000 "marshal medium integers (5000)")
+(testmarsh -5000 "marshal small integers (-5000)")
+(testmarsh 10000 "marshal large integers (10000)")
+(testmarsh -10000 "marshal large integers (-10000)")
+(testmarsh 1.0 "marshal double")
+(testmarsh "doctordolittle" "marshal string")
+(testmarsh :chickenshwarma "marshal symbol")
+(testmarsh @"oldmcdonald" "marshal buffer")
+(testmarsh @[1 2 3 4 5] "marshal array")
+(testmarsh [tuple 1 2 3 4 5] "marshal tuple")
+(testmarsh @{1 2 3 4}  "marshal table")
+(testmarsh {1 2 3 4}  "marshal struct")
+(testmarsh (fn [x] x) "marshal function 0")
+(testmarsh (fn name [x] x) "marshal function 1")
+(testmarsh (fn [x] (+ 10 x 2)) "marshal function 2")
+(testmarsh (fn thing [x] (+ 11 x x 30)) "marshal function 3")
+(testmarsh map "marshal function 4")
+(testmarsh reduce "marshal function 5")
+(testmarsh (fiber/new (fn [] (yield 1) 2)) "marshal simple fiber 1")
+(testmarsh (fiber/new (fn [&] (yield 1) 2)) "marshal simple fiber 2")
+
+# issue #53 - 1147482e6
+(def strct {:a @[nil]})
+(put (strct :a) 0 strct)
+(testmarsh strct "cyclic struct")
+
+# More marshalling code
+# issue #53 - 1147482e6
+(defn check-image
+  "Run a marshaling test using the make-image and load-image functions."
+  [x msg]
+  (def im (make-image x))
+  # (printf "\nimage-hash: %d" (-> im string hash))
+  (assert-no-error msg (load-image im)))
+
+(check-image (fn [] (fn [] 1)) "marshal nested functions")
+(check-image (fiber/new (fn [] (fn [] 1)))
+             "marshal nested functions in fiber")
+(check-image (fiber/new (fn [] (fiber/new (fn [] 1))))
+             "marshal nested fibers")
+
+# issue #53 - f4908ebc4
+(def issue-53-x
+  (fiber/new
+    (fn []
+      (var y (fiber/new (fn [] (print "1") (yield) (print "2")))))))
+
+(check-image issue-53-x "issue 53 regression")
+
+# Marshal closure over non resumable fiber
+# issue #317 - 7c4ffe9b9
+(do
+  (defn f1
+    [a]
+    (defn f1 [] (++ (a 0)))
+    (defn f2 [] (++ (a 0)))
+    (error [f1 f2]))
+  (def [_ tup] (protect (f1 @[0])))
+  (def [f1 f2] (unmarshal (marshal tup make-image-dict) load-image-dict))
+  (assert (= 1 (f1)) "marshal-non-resumable-closure 1")
+  (assert (= 2 (f2)) "marshal-non-resumable-closure 2"))
+
+# Marshal closure over currently alive fiber
+# issue #317 - 7c4ffe9b9
+(do
+  (defn f1
+    [a]
+    (defn f1 [] (++ (a 0)))
+    (defn f2 [] (++ (a 0)))
+    (marshal [f1 f2] make-image-dict))
+  (def [f1 f2] (unmarshal (f1 @[0]) load-image-dict))
+  (assert (= 1 (f1)) "marshal-live-closure 1")
+  (assert (= 2 (f2)) "marshal-live-closure 2"))
+
+(do
+  (var a 1)
+  (defn b [x] (+ a x))
+  (def c (unmarshal (marshal b)))
+  (assert (= 2 (c 1)) "marshal-on-stack-closure 1"))
+
+# Issue #336 cases - don't segfault
+# b145d4786
+(assert-error "unmarshal errors 1" (unmarshal @"\xd6\xb9\xb9"))
+(assert-error "unmarshal errors 2" (unmarshal @"\xd7bc"))
+# 5bbd50785
+(assert-error "unmarshal errors 3"
+              (unmarshal "\xd3\x01\xd9\x01\x62\xcf\x03\x78\x79\x7a"
+                         load-image-dict))
+# fcc610f53
+(assert-error "unmarshal errors 4"
+              (unmarshal
+                @"\xD7\xCD\0e/p\x98\0\0\x03\x01\x01\x01\x02\0\0\x04\0\xCEe/p../tools
+\0\0\0/afl\0\0\x01\0erate\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE
+\xA8\xDE\xDE\xDE\xDE\xDE\xDE\0\0\0\xDE\xDE_unmarshal_testcase3.ja
+neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
+\0\0\0\0\0*\xFE\x01\04\x02\0\0'\x03\0\r\0\r\0\r\0\r" load-image-dict))
+# XXX: still needed? see 72beeeea
+(gccollect)
+
+# ev/chan marshalling
+(compwhen (dyn 'ev/chan)
+  (def chan (ev/chan 10))
+  (ev/give chan chan)
+  (def newchan (unmarshal (marshal chan)))
+  (def item (ev/take newchan))
+  (assert (= item newchan) "ev/chan marshalling"))
+
+(end-suite)
+

test/suite-math.janet

@@ -0,0 +1,69 @@
+# Copyright (c) 2023 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)
+
+# First commit removing the integer number type
+# 6b95326d7
+(assert (= 400 (math/sqrt 160000)) "sqrt(160000)=400")
+
+# RNGs
+# aee168721
+(defn test-rng
+  [rng]
+  (assert (all identity (seq [i :range [0 1000]]
+                             (<= (math/rng-int rng i) i))) "math/rng-int test")
+  (assert (all identity (seq [i :range [0 1000]]
+    (def x (math/rng-uniform rng))
+    (and (>= x 0) (< x 1))))
+          "math/rng-uniform test"))
+
+(def seedrng (math/rng 123))
+(for i 0 75
+  (test-rng (math/rng (:int seedrng))))
+
+# 70328437f
+(assert (deep-not= (-> 123 math/rng (:buffer 16))
+                   (-> 456 math/rng (:buffer 16))) "math/rng-buffer 1")
+
+(assert-no-error "math/rng-buffer 2" (math/seedrandom "abcdefg"))
+
+# 027b2a8
+(defn assert-many [f n e]
+ (var good true)
+ (loop [i :range [0 n]]
+  (if (not (f))
+   (set good false)))
+ (assert good e))
+
+(assert-many (fn [] (>= 1 (math/random) 0)) 200 "(random) between 0 and 1")
+
+# 06aa0a124
+(assert (= (math/gcd 462 1071) 21) "math/gcd 1")
+(assert (= (math/lcm 462 1071) 23562) "math/lcm 1")
+
+# math gamma
+# e6babd8
+(assert (< 11899423.08 (math/gamma 11.5) 11899423.085) "math/gamma")
+(assert (< 2605.1158 (math/log-gamma 500) 2605.1159) "math/log-gamma")
+
+(end-suite)
+

test/suite-os.janet

@@ -0,0 +1,151 @@
+# Copyright (c) 2023 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)
+
+(def janet (dyn :executable))
+(def run (filter next (string/split " " (os/getenv "SUBRUN" ""))))
+
+# OS Date test
+# 719f7ba0c
+(assert (deep= {:year-day 0
+                :minutes 30
+                :month 0
+                :dst false
+                :seconds 0
+                :year 2014
+                :month-day 0
+                :hours 20
+                :week-day 3}
+               (os/date 1388608200)) "os/date")
+
+# OS mktime test
+# 3ee43c3ab
+(assert (= 1388608200 (os/mktime {:year-day 0
+                                  :minutes 30
+                                  :month 0
+                                  :dst false
+                                  :seconds 0
+                                  :year 2014
+                                  :month-day 0
+                                  :hours 20
+                                  :week-day 3})) "os/mktime")
+
+(def now (os/time))
+(assert (= (os/mktime (os/date now)) now) "UTC os/mktime")
+(assert (= (os/mktime (os/date now true) true) now) "local os/mktime")
+(assert (= (os/mktime {:year 1970}) 0) "os/mktime default values")
+
+# OS strftime test
+# 5cd729c4c
+(assert (= (os/strftime "%Y-%m-%d %H:%M:%S" 0) "1970-01-01 00:00:00")
+        "strftime UTC epoch")
+(assert (= (os/strftime "%Y-%m-%d %H:%M:%S" 1388608200)
+           "2014-01-01 20:30:00")
+        "strftime january 2014")
+(assert (= (try (os/strftime "%%%d%t") ([err] err))
+           "invalid conversion specifier '%t'")
+        "invalid conversion specifier")
+
+# 07db4c530
+(os/setenv "TESTENV1" "v1")
+(os/setenv "TESTENV2" "v2")
+(assert (= (os/getenv "TESTENV1") "v1") "getenv works")
+(def environ (os/environ))
+(assert (= [(environ "TESTENV1") (environ "TESTENV2")] ["v1" "v2"])
+        "environ works")
+
+# Ensure randomness puts n of pred into our buffer eventually
+# 0ac5b243c
+(defn cryptorand-check
+  [n pred]
+  (def max-attempts 10000)
+  (var attempts 0)
+  (while (not= attempts max-attempts)
+    (def cryptobuf (os/cryptorand 10))
+    (when (= n (count pred cryptobuf))
+      (break))
+    (++ attempts))
+  (not= attempts max-attempts))
+
+(def v (math/rng-int (math/rng (os/time)) 100))
+(assert (cryptorand-check 0 |(= $ v)) "cryptorand skips value sometimes")
+(assert (cryptorand-check 1 |(= $ v)) "cryptorand has value sometimes")
+
+(do
+  (def buf (buffer/new-filled 1))
+  (os/cryptorand 1 buf)
+  (assert (= (in buf 0) 0) "cryptorand doesn't overwrite buffer")
+  (assert (= (length buf) 2) "cryptorand appends to buffer"))
+
+# 80db68210
+(assert-no-error "realtime clock" (os/clock :realtime))
+(assert-no-error "cputime clock" (os/clock :cputime))
+(assert-no-error "monotonic clock" (os/clock :monotonic))
+
+(def before (os/clock :monotonic))
+(def after (os/clock :monotonic))
+(assert (>= after before) "monotonic clock is monotonic")
+
+# Perm strings
+# a0d61e45d
+(assert (= (os/perm-int "rwxrwxrwx") 8r777) "perm 1")
+(assert (= (os/perm-int "rwxr-xr-x") 8r755) "perm 2")
+(assert (= (os/perm-int "rw-r--r--") 8r644) "perm 3")
+
+(assert (= (band (os/perm-int "rwxrwxrwx") 8r077) 8r077) "perm 4")
+(assert (= (band (os/perm-int "rwxr-xr-x") 8r077) 8r055) "perm 5")
+(assert (= (band (os/perm-int "rw-r--r--") 8r077) 8r044) "perm 6")
+
+(assert (= (os/perm-string 8r777) "rwxrwxrwx") "perm 7")
+(assert (= (os/perm-string 8r755) "rwxr-xr-x") "perm 8")
+(assert (= (os/perm-string 8r644) "rw-r--r--") "perm 9")
+
+# os/execute with environment variables
+# issue #636 - 7e2c433ab
+(assert (= 0 (os/execute [;run janet "-e" "(+ 1 2 3)"] :pe
+                         (merge (os/environ) {"HELLO" "WORLD"})))
+        "os/execute with env")
+
+# os/execute regressions
+# 427f7c362
+(for i 0 10
+  (assert (= i (os/execute [;run janet "-e"
+                            (string/format "(os/exit %d)" i)] :p))
+          (string "os/execute " i)))
+
+# os/execute IO redirection
+(assert-no-error "IO redirection"
+                 (defn devnull []
+                   (def os (os/which))
+                   (def path (if (or (= os :mingw) (= os :windows))
+                               "NUL"
+                               "/dev/null"))
+                   (os/open path :w))
+                 (with [dn (devnull)]
+                   (os/execute [;run janet
+                                "-e"
+                                "(print :foo) (eprint :bar)"]
+                               :px
+                               {:out dn :err dn})))
+
+(end-suite)
+

test/suite-parse.janet

@@ -0,0 +1,192 @@
+# Copyright (c) 2023 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)
+
+# 7e46ead2f
+(assert (not false) "false literal")
+(assert true "true literal")
+(assert (not nil) "nil literal")
+
+(assert (= '(1 2 3) (quote (1 2 3)) (tuple 1 2 3)) "quote shorthand")
+
+# String literals
+# 45f8db0
+(assert (= "abcd" "\x61\x62\x63\x64") "hex escapes")
+(assert (= "\e" "\x1B") "escape character")
+(assert (= "\x09" "\t") "tab character")
+
+# Long strings
+# 7e6342720
+(assert (= "hello, world" `hello, world`) "simple long string")
+(assert (= "hello, \"world\"" `hello, "world"`)
+        "long string with embedded quotes")
+(assert (= "hello, \\\\\\ \"world\"" `hello, \\\ "world"`)
+        "long string with embedded quotes and backslashes")
+
+#
+# Longstring indentation
+#
+# 7aa4241
+(defn reindent
+  "Reindent the contents of a longstring as the Janet parser would.
+  This include removing leading and trailing newlines."
+  [text indent]
+
+  # Detect minimum indent
+  (var rewrite true)
+  (each index (string/find-all "\n" text)
+    (for i (+ index 1) (+ index indent 1)
+      (case (get text i)
+        nil (break)
+        (chr "\n") (break)
+        (chr " ") nil
+        (set rewrite false))))
+
+  # Only re-indent if no dedented characters.
+  (def str
+    (if rewrite
+      (peg/replace-all ~(* "\n" (between 0 ,indent " ")) "\n" text)
+      text))
+
+  (def first-nl (= (chr "\n") (first str)))
+  (def last-nl (= (chr "\n") (last str)))
+  (string/slice str (if first-nl 1 0) (if last-nl -2)))
+
+(defn reindent-reference
+  "Same as reindent but use parser functionality. Useful for
+  validating conformance."
+  [text indent]
+  (if (empty? text) (break text))
+  (def source-code
+    (string (string/repeat " " indent) "``````"
+            text
+            "``````"))
+  (parse source-code))
+
+(var indent-counter 0)
+(defn check-indent
+  [text indent]
+  (++ indent-counter)
+  (let [a (reindent text indent)
+        b (reindent-reference text indent)]
+    (assert (= a b)
+            (string "indent " indent-counter " (indent=" indent ")"))))
+
+(check-indent "" 0)
+(check-indent "\n" 0)
+(check-indent "\n" 1)
+(check-indent "\n\n" 0)
+(check-indent "\n\n" 1)
+(check-indent "\nHello, world!" 0)
+(check-indent "\nHello, world!" 1)
+(check-indent "Hello, world!" 0)
+(check-indent "Hello, world!" 1)
+(check-indent "\n    Hello, world!" 4)
+(check-indent "\n    Hello, world!\n" 4)
+(check-indent "\n    Hello, world!\n   " 4)
+(check-indent "\n    Hello, world!\n    " 4)
+(check-indent "\n    Hello, world!\n   dedented text\n    " 4)
+(check-indent "\n    Hello, world!\n    indented text\n    " 4)
+
+# Symbols with @ character
+# d68eae9
+(def @ 1)
+(assert (= @ 1) "@ symbol")
+(def @-- 2)
+(assert (= @-- 2) "@-- symbol")
+(def @hey 3)
+(assert (= @hey 3) "@hey symbol")
+
+# Parser clone
+# 43520ac67
+(def p (parser/new))
+(assert (= 7 (parser/consume p "(1 2 3 ")) "parser 1")
+(def p2 (parser/clone p))
+(parser/consume p2 ") 1 ")
+(parser/consume p ") 1 ")
+(assert (deep= (parser/status p) (parser/status p2)) "parser 2")
+(assert (deep= (parser/state p) (parser/state p2)) "parser 3")
+
+# Parser errors
+# 976dfc719
+(defn parse-error [input]
+  (def p (parser/new))
+  (parser/consume p input)
+  (parser/error p))
+
+# Invalid utf-8 sequences
+(assert (not= nil (parse-error @"\xc3\x28")) "reject invalid utf-8 symbol")
+(assert (not= nil (parse-error @":\xc3\x28")) "reject invalid utf-8 keyword")
+
+# Parser line and column numbers
+# 77b79e989
+(defn parser-location [input &opt location]
+  (def p (parser/new))
+  (parser/consume p input)
+  (if location
+    (parser/where p ;location)
+    (parser/where p)))
+
+(assert (= [1 7] (parser-location @"(+ 1 2)")) "parser location 1")
+(assert (= [5 7] (parser-location @"(+ 1 2)" [5])) "parser location 2")
+(assert (= [10 10] (parser-location @"(+ 1 2)" [10 10])) "parser location 3")
+
+# Issue #861 - should be valgrind clean
+# 39c6be7cb
+(def step1 "(a b c d)\n")
+(def step2 "(a b)\n")
+(def p1 (parser/new))
+(parser/state p1)
+(parser/consume p1 step1)
+(loop [v :iterate (parser/produce p1)])
+(parser/state p1)
+(def p2 (parser/clone p1))
+(parser/state p2)
+(parser/consume p2 step2)
+(loop [v :iterate (parser/produce p2)])
+(parser/state p2)
+
+# parser delimiter errors
+(defn test-error [delim fmt]
+  (def p (parser/new))
+  (parser/consume p delim)
+  (parser/eof p)
+  (def msg (string/format fmt delim))
+  (assert (= (parser/error p) msg) "delimiter error"))
+(each c [ "(" "{" "[" "\"" "``" ]
+  (test-error c "unexpected end of source, %s opened at line 1, column 1"))
+
+# parser/insert
+(def p (parser/new))
+(parser/consume p "(")
+(parser/insert p "hello")
+(parser/consume p ")")
+(assert (= (parser/produce p) ["hello"]))
+
+(def p (parser/new))
+(parser/consume p `("hel`)
+(parser/insert p `lo`)
+(parser/consume p `")`)
+(assert (= (parser/produce p) ["hello"]))
+
+(end-suite)
+

test/suite-peg.janet

@@ -0,0 +1,664 @@
+# Copyright (c) 2023 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)
+
+# Peg
+
+# 83f4a11bf
+(defn check-match
+  [pat text should-match]
+  (def result (peg/match pat text))
+  (assert (= (not should-match) (not result))
+          (string "check-match " text)))
+
+# 798c88b4c
+(defn check-deep
+  [pat text what]
+  (def result (peg/match pat text))
+  (assert (deep= result what) (string "check-deep " text)))
+
+# Just numbers
+# 83f4a11bf
+(check-match '(* 4 -1) "abcd" true)
+(check-match '(* 4 -1) "abc" false)
+(check-match '(* 4 -1) "abcde" false)
+
+# Simple pattern
+# 83f4a11bf
+(check-match '(* (some (range "az" "AZ")) -1) "hello" true)
+(check-match '(* (some (range "az" "AZ")) -1) "hello world" false)
+(check-match '(* (some (range "az" "AZ")) -1) "1he11o" false)
+(check-match '(* (some (range "az" "AZ")) -1) "" false)
+
+# Pre compile
+# ff0d3a008
+(def pegleg (peg/compile '{:item "abc" :main (* :item "," :item -1)}))
+
+(peg/match pegleg "abc,abc")
+
+# Bad Grammars
+# 192705113
+(assert-error "peg/compile error 1" (peg/compile nil))
+(assert-error "peg/compile error 2" (peg/compile @{}))
+(assert-error "peg/compile error 3" (peg/compile '{:a "abc" :b "def"}))
+(assert-error "peg/compile error 4" (peg/compile '(blarg "abc")))
+(assert-error "peg/compile error 5" (peg/compile '(1 2 3)))
+
+# IP address
+# 40845b5c1
+(def ip-address
+  '{:d (range "09")
+    :0-4 (range "04")
+    :0-5 (range "05")
+    :byte (+
+            (* "25" :0-5)
+            (* "2" :0-4 :d)
+            (* "1" :d :d)
+            (between 1 2 :d))
+    :main (* :byte "." :byte "." :byte "." :byte)})
+
+(check-match ip-address "10.240.250.250" true)
+(check-match ip-address "0.0.0.0" true)
+(check-match ip-address "1.2.3.4" true)
+(check-match ip-address "256.2.3.4" false)
+(check-match ip-address "256.2.3.2514" false)
+
+# Substitution test with peg
+# d7626f8c5
+(def grammar '(accumulate (any (+ (/ "dog" "purple panda") (<- 1)))))
+(defn try-grammar [text]
+  (assert (= (string/replace-all "dog" "purple panda" text)
+             (0 (peg/match grammar text))) text))
+
+(try-grammar "i have a dog called doug the dog. he is good.")
+(try-grammar "i have a dog called doug the dog. he is a good boy.")
+(try-grammar "i have a dog called doug the do")
+(try-grammar "i have a dog called doug the dog")
+(try-grammar "i have a dog called doug the dogg")
+(try-grammar "i have a dog called doug the doggg")
+(try-grammar "i have a dog called doug the dogggg")
+
+# Peg CSV test
+# 798c88b4c
+(def csv
+  '{:field (+
+            (* `"` (% (any (+ (<- (if-not `"` 1))
+                              (* (constant `"`) `""`)))) `"`)
+            (<- (any (if-not (set ",\n") 1))))
+    :main (* :field (any (* "," :field)) (+ "\n" -1))})
+
+(defn check-csv
+  [str res]
+  (check-deep csv str res))
+
+(check-csv "1,2,3" @["1" "2" "3"])
+(check-csv "1,\"2\",3" @["1" "2" "3"])
+(check-csv ``1,"1""",3`` @["1" "1\"" "3"])
+
+# Nested Captures
+# 798c88b4c
+(def grmr '(capture (* (capture "a") (capture 1) (capture "c"))))
+(check-deep grmr "abc" @["a" "b" "c" "abc"])
+(check-deep grmr "acc" @["a" "c" "c" "acc"])
+
+# Functions in grammar
+# 798c88b4c
+(def grmr-triple ~(% (any (/ (<- 1) ,(fn [x] (string x x x))))))
+(check-deep grmr-triple "abc" @["aaabbbccc"])
+(check-deep grmr-triple "" @[""])
+(check-deep grmr-triple " " @["   "])
+
+(def counter ~(/ (group (any (<- 1))) ,length))
+(check-deep counter "abcdefg" @[7])
+
+# Capture Backtracking
+# ff0d3a008
+(check-deep '(+ (* (capture "c") "d") "ce") "ce" @[])
+
+# Matchtime capture
+# 192705113
+(def scanner (peg/compile ~(cmt (capture (some 1)) ,scan-number)))
+
+(check-deep scanner "123" @[123])
+(check-deep scanner "0x86" @[0x86])
+(check-deep scanner "-1.3e-7" @[-1.3e-7])
+(check-deep scanner "123A" nil)
+
+# Recursive grammars
+# 170e785b7
+(def g '{:main (+ (* "a" :main "b") "c")})
+
+(check-match g "c" true)
+(check-match g "acb" true)
+(check-match g "aacbb" true)
+(check-match g "aadbb" false)
+
+# Back reference
+# d0ec89c7c
+(def wrapped-string
+  ~{:pad (any "=")
+    :open (* "[" (<- :pad :n) "[")
+    :close (* "]" (cmt (* (-> :n) (<- :pad)) ,=) "]")
+    :main (* :open (any (if-not :close 1)) :close -1)})
+
+(check-match wrapped-string "[[]]" true)
+(check-match wrapped-string "[==[a]==]" true)
+(check-match wrapped-string "[==[]===]" false)
+(check-match wrapped-string "[[blark]]" true)
+(check-match wrapped-string "[[bl[ark]]" true)
+(check-match wrapped-string "[[bl]rk]]" true)
+(check-match wrapped-string "[[bl]rk]] " false)
+(check-match wrapped-string "[=[bl]]rk]=] " false)
+(check-match wrapped-string "[=[bl]==]rk]=] " false)
+(check-match wrapped-string "[===[]==]===]" true)
+
+(def janet-longstring
+  ~{:delim (some "`")
+    :open (capture :delim :n)
+    :close (cmt (* (not (> -1 "`")) (-> :n) (<- (backmatch :n))) ,=)
+    :main (* :open (any (if-not :close 1)) :close -1)})
+
+(check-match janet-longstring "`john" false)
+(check-match janet-longstring "abc" false)
+(check-match janet-longstring "` `" true)
+(check-match janet-longstring "`  `" true)
+(check-match janet-longstring "``  ``" true)
+(check-match janet-longstring "``` `` ```" true)
+(check-match janet-longstring "``  ```" false)
+(check-match janet-longstring "`a``b`" false)
+
+# Line and column capture
+# 776ce586b
+(def line-col (peg/compile '(any (* (line) (column) 1))))
+(check-deep line-col "abcd" @[1 1 1 2 1 3 1 4])
+(check-deep line-col "" @[])
+(check-deep line-col "abcd\n" @[1 1 1 2 1 3 1 4 1 5])
+(check-deep line-col "abcd\nz" @[1 1 1 2 1 3 1 4 1 5 2 1])
+
+# Backmatch
+# 711fe64a5
+(def backmatcher-1 '(* (capture (any "x") :1) "y" (backmatch :1) -1))
+
+(check-match backmatcher-1 "y" true)
+(check-match backmatcher-1 "xyx" true)
+(check-match backmatcher-1 "xxxxxxxyxxxxxxx" true)
+(check-match backmatcher-1 "xyxx" false)
+(check-match backmatcher-1 (string (string/repeat "x" 73) "y") false)
+(check-match backmatcher-1 (string (string/repeat "x" 10000) "y") false)
+(check-match backmatcher-1 (string (string/repeat "x" 10000) "y"
+                                   (string/repeat "x" 10000)) true)
+
+(def backmatcher-2 '(* '(any "x") "y" (backmatch) -1))
+
+(check-match backmatcher-2 "y" true)
+(check-match backmatcher-2 "xyx" true)
+(check-match backmatcher-2 "xxxxxxxyxxxxxxx" true)
+(check-match backmatcher-2 "xyxx" false)
+(check-match backmatcher-2 (string (string/repeat "x" 73) "y") false)
+(check-match backmatcher-2 (string (string/repeat "x" 10000) "y") false)
+(check-match backmatcher-2 (string (string/repeat "x" 10000) "y"
+                                   (string/repeat "x" 10000)) true)
+
+(def longstring-2 '(* '(some "`")
+                      (some (if-not (backmatch) 1))
+                      (backmatch) -1))
+
+(check-match longstring-2 "`john" false)
+(check-match longstring-2 "abc" false)
+(check-match longstring-2 "` `" true)
+(check-match longstring-2 "`  `" true)
+(check-match longstring-2 "``  ``" true)
+(check-match longstring-2 "``` `` ```" true)
+(check-match longstring-2 "``  ```" false)
+
+# Optional
+# 4eeadd746
+(check-match '(* (opt "hi") -1) "" true)
+(check-match '(* (opt "hi") -1) "hi" true)
+(check-match '(* (opt "hi") -1) "no" false)
+(check-match '(* (? "hi") -1) "" true)
+(check-match '(* (? "hi") -1) "hi" true)
+(check-match '(* (? "hi") -1) "no" false)
+
+# Drop
+# b4934cedd
+(check-deep '(drop '"hello") "hello" @[])
+(check-deep '(drop "hello") "hello" @[])
+
+# Add bytecode verification for peg unmarshaling
+# e88a9af2f
+# This should be valgrind clean.
+(var pegi 3)
+(defn marshpeg [p]
+  (assert (-> p peg/compile marshal unmarshal)
+          (string "peg marshal " (++ pegi))))
+(marshpeg '(* 1 2 (set "abcd") "asdasd" (+ "." 3)))
+(marshpeg '(% (* (+ 1 2 3) (* "drop" "bear") '"hi")))
+(marshpeg '(> 123 "abcd"))
+(marshpeg '{:main (* 1 "hello" :main)})
+(marshpeg '(range "AZ"))
+(marshpeg '(if-not "abcdf" 123))
+(marshpeg '(error ($)))
+(marshpeg '(* "abcd" (constant :hi)))
+(marshpeg ~(/ "abc" ,identity))
+(marshpeg '(if-not "abcdf" 123))
+(marshpeg ~(cmt "abcdf" ,identity))
+(marshpeg '(group "abc"))
+
+# Peg swallowing errors
+# 159651117
+(assert (try (peg/match ~(/ '1 ,(fn [x] (nil x))) "x") ([err] err))
+        "errors should not be swallowed")
+(assert (try ((fn [x] (nil x))) ([err] err))
+        "errors should not be swallowed 2")
+
+# Check for bad memoization (+ :a) should mean different things in
+# different contexts
+# 8bc8709d0
+(def redef-a
+  ~{:a "abc"
+    :c (+ :a)
+    :main (* :c {:a "def" :main (+ :a)} -1)})
+
+(check-match redef-a "abcdef" true)
+(check-match redef-a "abcabc" false)
+(check-match redef-a "defdef" false)
+
+# 54a04b589
+(def redef-b
+  ~{:pork {:pork "beef" :main (+ -1 (* 1 :pork))}
+    :main :pork})
+
+(check-match redef-b "abeef" true)
+(check-match redef-b "aabeef" false)
+(check-match redef-b "aaaaaa" false)
+
+# Integer parsing
+# 45feb5548
+(check-deep '(int 1) "a" @[(chr "a")])
+(check-deep '(uint 1) "a" @[(chr "a")])
+(check-deep '(int-be 1) "a" @[(chr "a")])
+(check-deep '(uint-be 1) "a" @[(chr "a")])
+(check-deep '(int 1) "\xFF" @[-1])
+(check-deep '(uint 1) "\xFF" @[255])
+(check-deep '(int-be 1) "\xFF" @[-1])
+(check-deep '(uint-be 1) "\xFF" @[255])
+(check-deep '(int 2) "\xFF\x7f" @[0x7fff])
+(check-deep '(int-be 2) "\x7f\xff" @[0x7fff])
+(check-deep '(uint 2) "\xff\x7f" @[0x7fff])
+(check-deep '(uint-be 2) "\x7f\xff" @[0x7fff])
+(check-deep '(uint-be 2) "\x7f\xff" @[0x7fff])
+(when-let [u64 int/u64
+           i64 int/s64]
+  (check-deep '(uint 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" @[(u64 0x7fff)])
+  (check-deep '(int 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" @[(i64 0x7fff)])
+  (check-deep '(uint 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(u64 0x7fff)])
+  (check-deep '(int 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(i64 0x7fff)]))
+
+(check-deep '(* (int 2) -1) "123" nil)
+
+# to/thru bug
+# issue #640 - 742469a8b
+(check-deep '(to -1) "aaaa" @[])
+(check-deep '(thru -1) "aaaa" @[])
+(check-deep ''(to -1) "aaaa" @["aaaa"])
+(check-deep ''(thru -1) "aaaa" @["aaaa"])
+(check-deep '(to "b") "aaaa" nil)
+(check-deep '(thru "b") "aaaa" nil)
+
+# unref
+# 96513665d
+(def grammar
+  (peg/compile
+    ~{:main (* :tagged -1)
+      :tagged (unref (replace (* :open-tag :value :close-tag) ,struct))
+      :open-tag (* (constant :tag) "<" (capture :w+ :tag-name) ">")
+      :value (* (constant :value) (group (any (+ :tagged :untagged))))
+      :close-tag (* "</" (backmatch :tag-name) ">")
+      :untagged (capture (any (if-not "<" 1)))}))
+(check-deep grammar "<p><em>foobar</em></p>"
+            @[{:tag "p" :value @[{:tag "em" :value @["foobar"]}]}])
+(check-deep grammar "<p>foobar</p>" @[{:tag "p" :value @["foobar"]}])
+
+# Using a large test grammar
+# cf05ff610
+(def- specials {'fn true
+               'var true
+               'do true
+               'while true
+               'def true
+               'splice true
+               'set true
+               'unquote true
+               'quasiquote true
+               'quote true
+               'if true})
+
+(defn- check-number [text] (and (scan-number text) text))
+
+(defn capture-sym
+  [text]
+  (def sym (symbol text))
+  [(if (or (root-env sym) (specials sym)) :coresym :symbol) text])
+
+(def grammar
+  ~{:ws (set " \v\t\r\f\n\0")
+    :readermac (set "';~,")
+    :symchars (+ (range "09" "AZ" "az" "\x80\xFF")
+                 (set "!$%&*+-./:<?=>@^_|"))
+    :token (some :symchars)
+    :hex (range "09" "af" "AF")
+    :escape (* "\\" (+ (set `"'0?\abefnrtvz`)
+                       (* "x" :hex :hex)
+                       (error (constant "bad hex escape"))))
+    :comment (/ '(* "#" (any (if-not (+ "\n" -1) 1))) (constant :comment))
+    :symbol (/ ':token ,capture-sym)
+    :keyword (/ '(* ":" (any :symchars)) (constant :keyword))
+    :constant (/ '(+ "true" "false" "nil") (constant :constant))
+    :bytes (* "\"" (any (+ :escape (if-not "\"" 1))) "\"")
+    :string (/ ':bytes (constant :string))
+    :buffer (/ '(* "@" :bytes) (constant :string))
+    :long-bytes {:delim (some "`")
+                 :open (capture :delim :n)
+                 :close (cmt (* (not (> -1 "`")) (-> :n) '(backmatch :n))
+                             ,=)
+                 :main (drop (* :open (any (if-not :close 1)) :close))}
+    :long-string (/ ':long-bytes (constant :string))
+    :long-buffer (/ '(* "@" :long-bytes) (constant :string))
+    :number (/ (cmt ':token ,check-number) (constant :number))
+    :raw-value (+ :comment :constant :number :keyword
+                  :string :buffer :long-string :long-buffer
+                  :parray :barray :ptuple :btuple :struct :dict :symbol)
+    :value (* (? '(some (+ :ws :readermac))) :raw-value '(any :ws))
+    :root (any :value)
+    :root2 (any (* :value :value))
+    :ptuple (* '"(" :root (+ '")" (error "")))
+    :btuple (* '"[" :root (+ '"]" (error "")))
+    :struct (* '"{" :root2 (+ '"}" (error "")))
+    :parray (* '"@" :ptuple)
+    :barray (* '"@" :btuple)
+    :dict (* '"@"  :struct)
+    :main (+ :root (error ""))})
+
+(def p (peg/compile grammar))
+
+# Just make sure is valgrind clean.
+(def p (-> p make-image load-image))
+
+(assert (peg/match p "abc") "complex peg grammar 1")
+(assert (peg/match p "[1 2 3 4]") "complex peg grammar 2")
+
+###
+### Compiling brainfuck to Janet.
+###
+# 20d5d560f
+(def- bf-peg
+  "Peg for compiling brainfuck into a Janet source ast."
+  (peg/compile
+    ~{:+ (/ '(some "+") ,(fn [x] ~(+= (DATA POS) ,(length x))))
+      :- (/ '(some "-") ,(fn [x] ~(-= (DATA POS) ,(length x))))
+      :> (/ '(some ">") ,(fn [x] ~(+= POS ,(length x))))
+      :< (/ '(some "<") ,(fn [x] ~(-= POS ,(length x))))
+      :. (* "." (constant (prinf "%c" (get DATA POS))))
+      :loop (/ (* "[" :main "]") ,(fn [& captures]
+                                    ~(while (not= (get DATA POS) 0)
+                                       ,;captures)))
+      :main (any (+ :s :loop :+ :- :> :< :.))}))
+
+(defn bf
+  "Run brainfuck."
+  [text]
+  (eval
+    ~(let [DATA (array/new-filled 100 0)]
+       (var POS 50)
+       ,;(peg/match bf-peg text))))
+
+(defn test-bf
+  "Test some bf for expected output."
+  [input output]
+  (def b @"")
+  (with-dyns [:out b]
+    (bf input))
+  (assert (= (string output) (string b))
+          (string "bf input '"
+                  input
+                  "' failed, expected "
+                  (describe output)
+                  ", got "
+                  (describe (string b))
+                  ".")))
+
+(test-bf (string "++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]"
+                 ">>.>---.+++++++..+++.>>.<-.<.+++.------.--------"
+                 ".>>+.>++.") "Hello World!\n")
+
+(test-bf (string ">++++++++"
+                 "[-<+++++++++>]<.>>+>-[+]++>++>+++[>[->+++<<+++>]<<]"
+                 ">-----.>->+++..+++.>-.<<+[>[+>+]>>]<--------------"
+                 ".>>.+++.------.--------.>+.>+.")
+         "Hello World!\n")
+
+(test-bf (string "+[+[<<<+>>>>]+<-<-<<<+<++]<<.<++.<++..+++.<<++.<---"
+                 ".>>.>.+++.------.>-.>>--.")
+         "Hello, World!")
+
+# Regression test
+# issue #300 - 714bd61d5
+# Just don't segfault
+(assert (peg/match '{:main (replace "S" {"S" :spade})} "S7")
+        "regression #300")
+
+# Lenprefix rule
+# 8b5bcaee3
+(def peg (peg/compile ~(* (lenprefix (/ (* '(any (if-not ":" 1)) ":")
+                                        ,scan-number) 1) -1)))
+
+(assert (peg/match peg "5:abcde") "lenprefix 1")
+(assert (not (peg/match peg "5:abcdef")) "lenprefix 2")
+(assert (not (peg/match peg "5:abcd")) "lenprefix 3")
+
+# Packet capture
+# 8b5bcaee3
+(def peg2
+  (peg/compile
+    ~{# capture packet length in tag :header-len
+      :packet-header (* (/ ':d+ ,scan-number :header-len) ":")
+
+      # capture n bytes from a backref :header-len
+      :packet-body '(lenprefix (-> :header-len) 1)
+
+      # header, followed by body, and drop the :header-len capture
+      :packet (/ (* :packet-header :packet-body) ,|$1)
+
+      # any exact seqence of packets (no extra characters)
+      :main (* (any :packet) -1)}))
+
+(assert (deep= @["a" "bb" "ccc"] (peg/match peg2 "1:a2:bb3:ccc"))
+        "lenprefix 4")
+(assert (deep= @["a" "bb" "cccccc"] (peg/match peg2 "1:a2:bb6:cccccc"))
+        "lenprefix 5")
+(assert (= nil (peg/match peg2 "1:a2:bb:5:cccccc")) "lenprefix 6")
+(assert (= nil (peg/match peg2 "1:a2:bb:7:cccccc")) "lenprefix 7")
+
+# Issue #412
+# 677737d34
+(assert (peg/match '(* "a" (> -1 "a") "b") "abc")
+        "lookhead does not move cursor")
+
+# 6d096551f
+(def peg3
+  ~{:main (* "(" (thru ")"))})
+
+(def peg4 (peg/compile ~(* (thru "(") '(to ")"))))
+
+(assert (peg/match peg3 "(12345)") "peg thru 1")
+(assert (not (peg/match peg3 " (12345)")) "peg thru 2")
+(assert (not (peg/match peg3 "(12345")) "peg thru 3")
+
+(assert (= "abc" (0 (peg/match peg4 "123(abc)"))) "peg thru/to 1")
+(assert (= "abc" (0 (peg/match peg4 "(abc)"))) "peg thru/to 2")
+(assert (not (peg/match peg4 "123(abc")) "peg thru/to 3")
+
+# 86e12369b
+(def peg5 (peg/compile [3 "abc"]))
+
+(assert (:match peg5 "abcabcabc") "repeat alias 1")
+(assert (:match peg5 "abcabcabcac") "repeat alias 2")
+(assert (not (:match peg5 "abcabc")) "repeat alias 3")
+
+# Peg find and find-all
+# c26f57362
+(def p "/usr/local/bin/janet")
+(assert (= (peg/find '"n/" p) 13) "peg find 1")
+(assert (not (peg/find '"t/" p)) "peg find 2")
+(assert (deep= (peg/find-all '"/" p) @[0 4 10 14]) "peg find-all")
+
+# Peg replace and replace-all
+# e548e1f6e
+(defn check-replacer
+  [x y z]
+  (assert (= (string/replace x y z) (string (peg/replace x y z)))
+          "replacer test replace")
+  (assert (= (string/replace-all x y z) (string (peg/replace-all x y z)))
+          "replacer test replace-all"))
+(check-replacer "abc" "Z" "abcabcabcabasciabsabc")
+(check-replacer "abc" "Z" "")
+(check-replacer "aba" "ZZZZZZ" "ababababababa")
+(check-replacer "aba" "" "ababababababa")
+
+# 485099fd6
+(check-replacer "aba" string/ascii-upper "ababababababa")
+(check-replacer "aba" 123 "ababababababa")
+(assert (= (string (peg/replace-all ~(set "ab") string/ascii-upper "abcaa"))
+           "ABcAA")
+        "peg/replace-all cfunction")
+(assert (= (string (peg/replace-all ~(set "ab") |$ "abcaa"))
+           "abcaa")
+        "peg/replace-all function")
+
+# 9dc7e8ed3
+(defn peg-test [name f peg subst text expected]
+  (assert (= (string (f peg subst text)) expected) name))
+
+(peg-test "peg/replace has access to captures"
+  peg/replace
+  ~(sequence "." (capture (set "ab")))
+  (fn [str char] (string/format "%s -> %s, " str (string/ascii-upper char)))
+  ".a.b.c"
+  ".a -> A, .b.c")
+
+(peg-test "peg/replace-all has access to captures"
+  peg/replace-all
+  ~(sequence "." (capture (set "ab")))
+  (fn [str char] (string/format "%s -> %s, " str (string/ascii-upper char)))
+  ".a.b.c"
+  ".a -> A, .b -> B, .c")
+
+# Peg bug
+# eab5f67c5
+(assert (deep= @[] (peg/match '(any 1) @"")) "peg empty pattern 1")
+(assert (deep= @[] (peg/match '(any 1) (buffer))) "peg empty pattern 2")
+(assert (deep= @[] (peg/match '(any 1) "")) "peg empty pattern 3")
+(assert (deep= @[] (peg/match '(any 1) (string))) "peg empty pattern 4")
+(assert (deep= @[] (peg/match '(* "test" (any 1)) @"test"))
+        "peg empty pattern 5")
+(assert (deep= @[] (peg/match '(* "test" (any 1)) (buffer "test")))
+        "peg empty pattern 6")
+
+# number pattern
+# cccbdc164
+(assert (deep= @[111] (peg/match '(number :d+) "111"))
+        "simple number capture 1")
+(assert (deep= @[255] (peg/match '(number :w+) "0xff"))
+        "simple number capture 2")
+
+# Marshal and unmarshal pegs
+# 446ab037b
+(def p (-> "abcd" peg/compile marshal unmarshal))
+(assert (peg/match p "abcd") "peg marshal 1")
+(assert (peg/match p "abcdefg") "peg marshal 2")
+(assert (not (peg/match p "zabcdefg")) "peg marshal 3")
+
+# to/thru bug
+# issue #971 - a895219d2
+(def pattern
+  (peg/compile
+    '{:dd (sequence :d :d)
+      :sep (set "/-")
+      :date (sequence :dd :sep :dd)
+      :wsep (some (set " \t"))
+      :entry (group (sequence (capture :date) :wsep (capture :date)))
+      :main (some (thru :entry))}))
+
+(def alt-pattern
+  (peg/compile
+    '{:dd (sequence :d :d)
+      :sep (set "/-")
+      :date (sequence :dd :sep :dd)
+      :wsep (some (set " \t"))
+      :entry (group (sequence (capture :date) :wsep (capture :date)))
+      :main (some (choice :entry 1))}))
+
+(def text "1800-10-818-9-818 16/12\n17/12 19/12\n20/12 11/01")
+(assert (deep= (peg/match pattern text) (peg/match alt-pattern text))
+        "to/thru bug #971")
+
+# 14657a7
+(def- sym-prefix-peg
+  (peg/compile
+    ~{:symchar (+ (range "\x80\xff" "AZ" "az" "09")
+                  (set "!$%&*+-./:<?=>@^_"))
+      :anchor (drop (cmt ($) ,|(= $ 0)))
+      :cap (* (+ (> -1 (not :symchar)) :anchor) (* ($) '(some :symchar)))
+      :recur (+ :cap (> -1 :recur))
+      :main (> -1 :recur)}))
+
+(assert (deep= (peg/match sym-prefix-peg @"123" 3) @[0 "123"])
+        "peg lookback")
+(assert (deep= (peg/match sym-prefix-peg @"1234" 4) @[0 "1234"])
+        "peg lookback 2")
+
+# issue #1027 - 356b39c6f
+(assert (deep= (peg/replace-all '(* (<- 1) 1 (backmatch))
+                                "xxx" "aba cdc efa")
+               @"xxx xxx efa")
+        "peg replace-all 1")
+
+# issue #1026 - 9341081a4
+(assert (deep=
+  (peg/match '(not (* (constant 7) "a")) "hello")
+  @[]) "peg not")
+
+(assert (deep=
+  (peg/match '(if-not (* (constant 7) "a") "hello") "hello")
+  @[]) "peg if-not")
+
+(assert (deep=
+  (peg/match '(if-not (drop (* (constant 7) "a")) "hello") "hello")
+  @[]) "peg if-not drop")
+
+(assert (deep=
+  (peg/match '(if (not (* (constant 7) "a")) "hello") "hello")
+  @[]) "peg if not")
+
+(end-suite)
+

test/suite-pp.janet

@@ -0,0 +1,65 @@
+# Copyright (c) 2023 Calvin Rose & contributors
+#
+# 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)
+
+# Appending buffer to self
+# 6b76ac3d1
+(with-dyns [:out @""]
+  (prin "abcd")
+  (prin (dyn :out))
+  (prin (dyn :out))
+  (assert (deep= (dyn :out) @"abcdabcdabcdabcd") "print buffer to self"))
+
+# Buffer self blitting, check for use after free
+# bbcfaf128
+(def buf1 @"1234567890")
+(buffer/blit buf1 buf1 -1)
+(buffer/blit buf1 buf1 -1)
+(buffer/blit buf1 buf1 -1)
+(buffer/blit buf1 buf1 -1)
+(assert (= (string buf1) (string/repeat "1234567890" 16))
+        "buffer blit against self")
+
+# Check for bugs with printing self with buffer/format
+# bbcfaf128
+(def buftemp @"abcd")
+(assert (= (string (buffer/format buftemp "---%p---" buftemp))
+           `abcd---@"abcd"---`) "buffer/format on self 1")
+(def buftemp @"abcd")
+(assert (= (string (buffer/format buftemp "---%p %p---" buftemp buftemp))
+           `abcd---@"abcd" @"abcd"---`) "buffer/format on self 2")
+
+# 5c364e0
+(defn check-jdn [x]
+  (assert (deep= (parse (string/format "%j" x)) x) "round trip jdn"))
+
+(check-jdn 0)
+(check-jdn nil)
+(check-jdn [])
+(check-jdn @[[] [] 1231 9.123123 -123123 0.1231231230001])
+(check-jdn -0.123123123123)
+(check-jdn 12837192371923)
+(check-jdn "a string")
+(check-jdn @"a buffer")
+
+(end-suite)
+

test/suite-specials.janet

@@ -0,0 +1,202 @@
+# Copyright (c) 2023 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)
+
+# Regression Test #137
+# affcb5b45
+(def [a b c] (range 10))
+(assert (= a 0) "regression #137 (1)")
+(assert (= b 1) "regression #137 (2)")
+(assert (= c 2) "regression #137 (3)")
+
+(var [x y z] (range 10))
+(assert (= x 0) "regression #137 (4)")
+(assert (= y 1) "regression #137 (5)")
+(assert (= z 2) "regression #137 (6)")
+
+# Test destructuring
+# 23dcfb986
+(do
+  (def test-tab @{:a 1 :b 2})
+  (def {:a a :b b} test-tab)
+  (assert (= a 1) "dictionary destructuring 1")
+  (assert (= b 2) "dictionary destructuring 2"))
+(do
+  (def test-tab @{'a 1 'b 2 3 4})
+  (def {'a a 'b b (+ 1 2) c} test-tab)
+  (assert (= a 1) "dictionary destructuring 3")
+  (assert (= b 2) "dictionary destructuring 4")
+  (assert (= c 4) "dictionary destructuring 5 - expression as key"))
+
+# cb5af974a
+(let [test-tuple [:a :b 1 2]]
+  (def [a b one two] test-tuple)
+  (assert (= a :a) "tuple destructuring 1")
+  (assert (= b :b) "tuple destructuring 2")
+  (assert (= two 2) "tuple destructuring 3"))
+(let [test-tuple [:a :b 1 2]]
+  (def [a & rest] test-tuple)
+  (assert (= a :a) "tuple destructuring 4 - rest")
+  (assert (= rest [:b 1 2]) "tuple destructuring 5 - rest"))
+(do
+  (def [a b & rest] [:a :b nil :d])
+  (assert (= a :a) "tuple destructuring 6 - rest")
+  (assert (= b :b) "tuple destructuring 7 - rest")
+  (assert (= rest [nil :d]) "tuple destructuring 8 - rest"))
+
+# 71cffc973
+(do
+  (def [[a b] x & rest] [[1 2] :a :c :b :a])
+  (assert (= a 1) "tuple destructuring 9 - rest")
+  (assert (= b 2) "tuple destructuring 10 - rest")
+  (assert (= x :a) "tuple destructuring 11 - rest")
+  (assert (= rest [:c :b :a]) "tuple destructuring 12 - rest"))
+
+# 651e12cfe
+(do
+  (def [a b & rest] [:a :b])
+  (assert (= a :a) "tuple destructuring 13 - rest")
+  (assert (= b :b) "tuple destructuring 14 - rest")
+  (assert (= rest []) "tuple destructuring 15 - rest"))
+
+(do
+  (def [[a b & r1] c & r2] [[:a :b 1 2] :c 3 4])
+  (assert (= a :a) "tuple destructuring 16 - rest")
+  (assert (= b :b) "tuple destructuring 17 - rest")
+  (assert (= c :c) "tuple destructuring 18 - rest")
+  (assert (= r1 [1 2]) "tuple destructuring 19 - rest")
+  (assert (= r2 [3 4]) "tuple destructuring 20 - rest"))
+
+# Metadata
+# ec2d7bf34
+(def foo-with-tags :a-tag :bar)
+(assert (get (dyn 'foo-with-tags) :a-tag)
+        "extra keywords in def are metadata tags")
+
+(def foo-with-meta {:baz :quux} :bar)
+(assert (= :quux (get (dyn 'foo-with-meta) :baz))
+        "extra struct in def is metadata")
+
+(defn foo-fn-with-meta {:baz :quux}
+  "This is a function"
+  [x]
+  (identity x))
+(assert (= :quux (get (dyn 'foo-fn-with-meta) :baz))
+        "extra struct in defn is metadata")
+(assert (= "(foo-fn-with-meta x)\n\nThis is a function"
+           (get (dyn 'foo-fn-with-meta) :doc))
+        "extra string in defn is docstring")
+
+# Break
+# 4a111b38b
+(var summation 0)
+(for i 0 10
+  (+= summation i)
+  (if (= i 7) (break)))
+(assert (= summation 28) "break 1")
+
+(assert (= nil ((fn [] (break) 4))) "break 2")
+
+# Break with value
+# 8ba112116
+# Shouldn't error out
+(assert-no-error "break 3" (for i 0 10 (if (> i 8) (break i))))
+(assert-no-error "break 4" ((fn [i] (if (> i 8) (break i))) 100))
+
+# No useless splices
+# 7d57f8700
+(check-compile-error '((splice [1 2 3]) 0))
+(check-compile-error '(if ;[1 2] 5))
+(check-compile-error '(while ;[1 2 3] (print :hi)))
+(check-compile-error '(def x ;[1 2 3]))
+(check-compile-error '(fn [x] ;[x 1 2 3]))
+
+# No splice propagation
+(check-compile-error '(+ 1 (do ;[2 3 4]) 5))
+(check-compile-error '(+ 1 (upscope ;[2 3 4]) 5))
+# compiler inlines when condition is constant, ensure that optimization
+# doesn't break
+(check-compile-error '(+ 1 (if true ;[3 4])))
+(check-compile-error '(+ 1 (if false nil ;[3 4])))
+
+# Keyword arguments
+# 3f137ed0b
+(defn myfn [x y z &keys {:a a :b b :c c}]
+  (+ x y z a b c))
+
+(assert (= (+ ;(range 6)) (myfn 0 1 2 :a 3 :b 4 :c 5)) "keyword args 1")
+(assert (= (+ ;(range 6)) (myfn 0 1 2 :a 1 :b 6 :c 5 :d 11))
+        "keyword args 2")
+
+# Named arguments
+# 87fc339
+(defn named-arguments
+  [&named bob sally joe]
+  (+ bob sally joe))
+
+(assert (= 15 (named-arguments :bob 3 :sally 5 :joe 7)) "named arguments 1")
+
+# a117252
+(defn named-opt-arguments
+  [&opt x &named a b c]
+  (+ x a b c))
+
+(assert (= 10 (named-opt-arguments 1 :a 2 :b 3 :c 4)) "named arguments 2")
+
+#
+# fn compilation special
+#
+# b8032ec61
+(defn myfn1 [[x y z] & more]
+  more)
+(defn myfn2 [head & more]
+  more)
+(assert (= (myfn1 [1 2 3] 4 5 6) (myfn2 [:a :b :c] 4 5 6))
+        "destructuring and varargs")
+
+# Nested quasiquotation
+# 4199c42fe
+(def nested ~(a ~(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f))
+(assert (deep= nested '(a ~(b ,(+ 1 2) ,(foo 4 d) e) f))
+        "nested quasiquote")
+
+# Regression #400
+# 7a84fc474
+(assert (= nil (while (and false false)
+                 (fn [])
+                 (error "should not happen"))) "strangeloop 1")
+(assert (= nil (while (not= nil nil)
+                 (fn [])
+                 (error "should not happen"))) "strangeloop 2")
+
+# 919
+# a097537a0
+(defn test
+  []
+  (var x 1)
+  (set x ~(,x ()))
+  x)
+
+(assert (= (test) '(1 ())) "issue #919")
+
+(end-suite)
+

test/suite-string.janet

@@ -19,48 +19,20 @@
 # IN THE SOFTWARE.
 
 (import ./helper :prefix "" :exit true)
-(start-suite 2)
+(start-suite)
 
-# Buffer stuff
-(defn buffer=
-  [a b]
-  (= (string a) (string b)))
+# 8a346ec
+(assert (= (string/join @["one" "two" "three"]) "onetwothree")
+        "string/join 1 argument")
+(assert (= (string/join @["one" "two" "three"] ", ") "one, two, three")
+        "string/join 2 arguments")
+(assert (= (string/join @[] ", ") "") "string/join empty array")
 
-(assert (buffer= @"abcd" @"abcd") "buffer equal 1")
-(assert (buffer= @"abcd" (buffer "ab" "cd")) "buffer equal 2")
-(assert (not= @"" @"") "buffer not equal 1")
-(assert (not= @"abcd" @"abcd") "buffer not equal 2")
-
-(defn buffer-factory
-  []
-  @"im am a buffer")
-
-(assert (not= (buffer-factory) (buffer-factory)) "buffer instantiation")
-
-(assert (= (length @"abcdef") 6) "buffer length")
-
-# Looping idea
-(def xs
-  (seq [x :in [-1 0 1] y :in [-1 0 1] :when (not= x y 0)] (tuple x y)))
-(def txs (apply tuple xs))
-
-(assert (= txs [[-1 -1] [-1 0] [-1 1] [0 -1] [0 1] [1 -1] [1 0] [1 1]]) "nested seq")
-
-# Generators
-(def gen (generate [x :range [0 100] :when (pos? (% x 4))] x))
-(var gencount 0)
-(loop [x :in gen]
-  (++ gencount)
-  (assert (pos? (% x 4)) "generate in loop"))
-(assert (= gencount 75) "generate loop count")
-
-# Check x:digits: works as symbol and not a hex number
-(def x1 100)
-(assert (= x1 100) "x1 as symbol")
-(def X1 100)
-(assert (= X1 100) "X1 as symbol")
+(assert (= (string/find "123" "abc123def") 3) "string/find positive")
+(assert (= (string/find "1234" "abc123def") nil) "string/find negative")
 
 # String functions
+# f41dab8f6
 (assert (= 3 (string/find "abc" "   abcdefghijklmnop")) "string/find 1")
 (assert (= 0 (string/find "A" "A")) "string/find 2")
 (assert (string/has-prefix? "" "foo") "string/has-prefix? 1")
@@ -69,52 +41,100 @@
 (assert (string/has-suffix? "" "foo") "string/has-suffix? 1")
 (assert (string/has-suffix? "oo" "foo") "string/has-suffix? 2")
 (assert (not (string/has-suffix? "f" "foo")) "string/has-suffix? 3")
-(assert (= (string/replace "X" "." "XXX...XXX...XXX")  ".XX...XXX...XXX") "string/replace 1")
-(assert (= (string/replace-all "X" "." "XXX...XXX...XXX") "...............") "string/replace-all 1")
-(assert (= (string/replace-all "XX" "." "XXX...XXX...XXX") ".X....X....X") "string/replace-all 2")
-(assert (= (string/replace "xx" string/ascii-upper "xxyxyxyxxxy") "XXyxyxyxxxy") "string/replace function")
-(assert (= (string/replace-all "xx" string/ascii-upper "xxyxyxyxxxy") "XXyxyxyXXxy") "string/replace-all function")
-(assert (= (string/replace "x" 12 "xyx") "12yx") "string/replace stringable")
-(assert (= (string/replace-all "x" 12 "xyx") "12y12") "string/replace-all stringable")
-(assert (= (string/ascii-lower "ABCabc&^%!@:;.") "abcabc&^%!@:;.") "string/ascii-lower")
-(assert (= (string/ascii-upper "ABCabc&^%!@:;.") "ABCABC&^%!@:;.") "string/ascii-lower")
+(assert (= (string/replace "X" "." "XXX...XXX...XXX")  ".XX...XXX...XXX")
+        "string/replace 1")
+(assert (= (string/replace-all "X" "." "XXX...XXX...XXX") "...............")
+        "string/replace-all 1")
+(assert (= (string/replace-all "XX" "." "XXX...XXX...XXX") ".X....X....X")
+        "string/replace-all 2")
+(assert (= (string/replace "xx" string/ascii-upper "xxyxyxyxxxy")
+           "XXyxyxyxxxy") "string/replace function")
+(assert (= (string/replace-all "xx" string/ascii-upper "xxyxyxyxxxy")
+           "XXyxyxyXXxy") "string/replace-all function")
+(assert (= (string/replace "x" 12 "xyx") "12yx")
+        "string/replace stringable")
+(assert (= (string/replace-all "x" 12 "xyx") "12y12")
+        "string/replace-all stringable")
+(assert (= (string/ascii-lower "ABCabc&^%!@:;.") "abcabc&^%!@:;.")
+        "string/ascii-lower")
+(assert (= (string/ascii-upper "ABCabc&^%!@:;.") "ABCABC&^%!@:;.")
+        "string/ascii-lower")
 (assert (= (string/reverse "") "") "string/reverse 1")
 (assert (= (string/reverse "a") "a") "string/reverse 2")
 (assert (= (string/reverse "abc") "cba") "string/reverse 3")
 (assert (= (string/reverse "abcd") "dcba") "string/reverse 4")
-(assert (= (string/join @["one" "two" "three"] ",") "one,two,three") "string/join 1")
-(assert (= (string/join @["one" "two" "three"] ", ") "one, two, three") "string/join 2")
-(assert (= (string/join @["one" "two" "three"]) "onetwothree") "string/join 3")
+(assert (= (string/join @["one" "two" "three"] ",") "one,two,three")
+        "string/join 1")
+(assert (= (string/join @["one" "two" "three"] ", ") "one, two, three")
+        "string/join 2")
+(assert (= (string/join @["one" "two" "three"]) "onetwothree")
+        "string/join 3")
 (assert (= (string/join @[] "hi") "") "string/join 4")
 (assert (= (string/trim " abcd ") "abcd") "string/trim 1")
 (assert (= (string/trim "abcd \t\t\r\f") "abcd") "string/trim 2")
 (assert (= (string/trim "\n\n\t abcd") "abcd") "string/trim 3")
 (assert (= (string/trim "") "") "string/trim 4")
 (assert (= (string/triml " abcd ") "abcd ") "string/triml 1")
-(assert (= (string/triml "\tabcd \t\t\r\f") "abcd \t\t\r\f") "string/triml 2")
+(assert (= (string/triml "\tabcd \t\t\r\f") "abcd \t\t\r\f")
+        "string/triml 2")
 (assert (= (string/triml "abcd ") "abcd ") "string/triml 3")
 (assert (= (string/trimr " abcd ") " abcd") "string/trimr 1")
 (assert (= (string/trimr "\tabcd \t\t\r\f") "\tabcd") "string/trimr 2")
 (assert (= (string/trimr " abcd") " abcd") "string/trimr 3")
-(assert (deep= (string/split "," "one,two,three") @["one" "two" "three"]) "string/split 1")
-(assert (deep= (string/split "," "onetwothree") @["onetwothree"]) "string/split 2")
-(assert (deep= (string/find-all "e" "onetwothree") @[2 9 10]) "string/find-all 1")
-(assert (deep= (string/find-all "," "onetwothree") @[]) "string/find-all 2")
+(assert (deep= (string/split "," "one,two,three") @["one" "two" "three"])
+        "string/split 1")
+(assert (deep= (string/split "," "onetwothree") @["onetwothree"])
+        "string/split 2")
+(assert (deep= (string/find-all "e" "onetwothree") @[2 9 10])
+        "string/find-all 1")
+(assert (deep= (string/find-all "," "onetwothree") @[])
+        "string/find-all 2")
 
+# b26a7bb22
 (assert-error "string/find error 1" (string/find "" "abcd"))
 (assert-error "string/split error 1" (string/split "" "abcd"))
 (assert-error "string/replace error 1" (string/replace "" "." "abcd"))
-(assert-error "string/replace-all error 1" (string/replace-all "" "." "abcdabcd"))
+(assert-error "string/replace-all error 1"
+              (string/replace-all "" "." "abcdabcd"))
 (assert-error "string/find-all error 1" (string/find-all "" "abcd"))
 
-# Check if abstract test works
-(assert (abstract? stdout) "abstract? stdout")
-(assert (abstract? stdin) "abstract? stdin")
-(assert (abstract? stderr) "abstract? stderr")
-(assert (not (abstract? nil)) "not abstract? nil")
-(assert (not (abstract? 1)) "not abstract? 1")
-(assert (not (abstract? 3)) "not abstract? 3")
-(assert (not (abstract? 5)) "not abstract? 5")
+# String bugs
+# bcba0c027
+(assert (deep= (string/find-all "qq" "qqq") @[0 1]) "string/find-all 1")
+(assert (deep= (string/find-all "q" "qqq") @[0 1 2]) "string/find-all 2")
+(assert (deep= (string/split "qq" "1qqqqz") @["1" "" "z"]) "string/split 1")
+(assert (deep= (string/split "aa" "aaa") @["" "a"]) "string/split 2")
+
+# some tests for string/format
+# 0f0c415
+(assert (= (string/format "pi = %6.3f" math/pi) "pi =  3.142") "%6.3f")
+(assert (= (string/format "pi = %+6.3f" math/pi) "pi = +3.142") "%6.3f")
+(assert (= (string/format "pi = %40.20g" math/pi)
+           "pi =                     3.141592653589793116") "%6.3f")
+
+(assert (= (string/format "🐼 = %6.3f" math/pi) "🐼 =  3.142") "UTF-8")
+(assert (= (string/format "π = %.8g" math/pi) "π = 3.1415927") "π")
+(assert (= (string/format "\xCF\x80 = %.8g" math/pi) "\xCF\x80 = 3.1415927")
+        "\xCF\x80")
+
+# String check-set
+# b4e25e559
+(assert (string/check-set "abc" "a") "string/check-set 1")
+(assert (not (string/check-set "abc" "z")) "string/check-set 2")
+(assert (string/check-set "abc" "abc") "string/check-set 3")
+(assert (string/check-set "abc" "") "string/check-set 4")
+(assert (not (string/check-set "" "aabc")) "string/check-set 5")
+(assert (not (string/check-set "abc" "abcdefg")) "string/check-set 6")
+
+# Trim empty string
+# issue #174 - 9b605b27b
+(assert (= "" (string/trim " ")) "string/trim regression")
+
+# Keyword and Symbol slice
+# e9911fee4
+(assert (= :keyword (keyword/slice "some_keyword_slice" 5 12))
+        "keyword slice")
+(assert (= 'symbol (symbol/slice "some_symbol_slice" 5 11)) "symbol slice")
 
 (end-suite)
 

test/suite-strtod.janet

@@ -0,0 +1,39 @@
+# Copyright (c) 2023 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)
+
+# Scan number
+# 798c88b4c
+(assert (= 1 (scan-number "1")) "scan-number 1")
+(assert (= -1 (scan-number "-1")) "scan-number -1")
+(assert (= 1.3e4 (scan-number "1.3e4")) "scan-number 1.3e4")
+
+# Issue #183 - just parse it :)
+# 688d297a1
+1e-4000000000000000000000
+
+# For undefined behavior sanitizer
+# c876e63
+0xf&1fffFFFF
+
+(end-suite)
+

test/suite-struct.janet

@@ -0,0 +1,94 @@
+# Copyright (c) 2023 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)
+
+# 21bd960
+(assert (= (struct 1 2 3 4 5 6 7 8) (struct 7 8 5 6 3 4 1 2))
+        "struct order does not matter 1")
+# 42a88de
+(assert (= (struct
+             :apple 1
+             6 :bork
+             '(1 2 3) 5)
+           (struct
+             6 :bork
+             '(1 2 3) 5
+             :apple 1)) "struct order does not matter 2")
+
+# Denormal structs
+# 38a7e4faf
+(assert (= (length {1 2 nil 3}) 1) "nil key struct literal")
+(assert (= (length (struct 1 2 nil 3)) 1) "nil key struct ctor")
+
+(assert (= (length (struct (/ 0 0) 2 1 3)) 1) "nan key struct ctor")
+(assert (= (length {1 2 (/ 0 0) 3}) 1) "nan key struct literal")
+
+(assert (= (length (struct 2 1 3 nil)) 1) "nil value struct ctor")
+(assert (= (length {1 2 3 nil}) 1) "nil value struct literal")
+
+# Struct duplicate elements
+# 8bc2987a7
+(assert (= {:a 3 :b 2} {:a 1 :b 2 :a 3}) "struct literal duplicate keys")
+(assert (= {:a 3 :b 2} (struct :a 1 :b 2 :a 3))
+        "struct constructor duplicate keys")
+
+# Struct prototypes
+# 4d983e5
+(def x (struct/with-proto {1 2 3 4} 5 6))
+(def y (-> x marshal unmarshal))
+(def z {1 2 3 4})
+(assert (= 2 (get x 1)) "struct get proto value 1")
+(assert (= 4 (get x 3)) "struct get proto value 2")
+(assert (= 6 (get x 5)) "struct get proto value 3")
+(assert (= x y) "struct proto marshal equality 1")
+(assert (= (getproto x) (getproto y)) "struct proto marshal equality 2")
+(assert (= 0 (cmp x y)) "struct proto comparison 1")
+(assert (= 0 (cmp (getproto x) (getproto y))) "struct proto comparison 2")
+(assert (not= (cmp x z) 0) "struct proto comparison 3")
+(assert (not= (cmp y z) 0) "struct proto comparison 4")
+(assert (not= x z) "struct proto comparison 5")
+(assert (not= y z) "struct proto comparison 6")
+(assert (= (x 5) 6) "struct proto get 1")
+(assert (= (y 5) 6) "struct proto get 1")
+(assert (deep= x y) "struct proto deep= 1")
+(assert (deep-not= x z) "struct proto deep= 2")
+(assert (deep-not= y z) "struct proto deep= 3")
+
+# Check missing struct proto bug
+# 868ec1a7e, e08394c8
+(assert (struct/getproto (struct/with-proto {:a 1} :b 2 :c nil))
+        "missing struct proto")
+
+# struct/with-proto
+(assert-error "expected odd number of arguments" (struct/with-proto {} :a))
+
+# struct/to-table
+(def s (struct/with-proto {:a 1 :b 2} :name "john" ))
+(def t1 (struct/to-table s true))
+(def t2 (struct/to-table s false))
+(assert (deep= t1 @{:name "john"}) "struct/to-table 1")
+(assert (deep= t2 @{:name "john"}) "struct/to-table 2")
+(assert (deep= (getproto t1) @{:a 1 :b 2}) "struct/to-table 3")
+(assert (deep= (getproto t2) nil) "struct/to-table 4")
+
+(end-suite)
+

test/suite-symcache.janet

@@ -0,0 +1,42 @@
+# Copyright (c) 2023 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)
+
+# Symbol function
+# 5460ff1
+(assert (= (symbol "abc" 1 2 3) 'abc123) "symbol function")
+
+# Gensym tests
+# 3ccd68843
+(assert (not= (gensym) (gensym)) "two gensyms not equal")
+((fn []
+   (def syms (table))
+   (var counter 0)
+   (while (< counter 128)
+     (put syms (gensym) true)
+     (set counter (+ 1 counter)))
+   (assert (= (length syms) 128) "many symbols")))
+
+# issue #753 - a78cbd91d
+(assert (pos? (length (gensym))) "gensym not empty, regression #753")
+
+(end-suite)

test/suite-table.janet

@@ -0,0 +1,72 @@
+# Copyright (c) 2023 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)
+
+# Denormal tables
+# 38a7e4faf
+(assert (= (length @{1 2 nil 3}) 1) "nil key table literal")
+(assert (= (length (table 1 2 nil 3)) 1) "nil key table ctor")
+
+(assert (= (length (table (/ 0 0) 2 1 3)) 1) "nan key table ctor")
+(assert (= (length @{1 2 (/ 0 0) 3}) 1) "nan key table literal")
+
+(assert (= (length (table 2 1 3 nil)) 1) "nil value table ctor")
+(assert (= (length @{1 2 3 nil}) 1) "nil value table literal")
+
+# Table duplicate elements
+(assert (deep= @{:a 3 :b 2} @{:a 1 :b 2 :a 3}) "table literal duplicate keys")
+(assert (deep= @{:a 3 :b 2} (table :a 1 :b 2 :a 3))
+        "table constructor duplicate keys")
+
+## Table prototypes
+# 027b2a81c
+(def roottab @{
+ :parentprop 123
+})
+
+(def childtab @{
+ :childprop 456
+})
+
+(table/setproto childtab roottab)
+
+(assert (= 123 (get roottab :parentprop)) "table get 1")
+(assert (= 123 (get childtab :parentprop)) "table get proto")
+(assert (= nil (get roottab :childprop)) "table get 2")
+(assert (= 456 (get childtab :childprop)) "proto no effect")
+
+# b3aed1356
+(assert-error
+  "table rawget regression"
+  (table/new -1))
+
+# table/clone
+# 392813667
+(defn check-table-clone [x msg]
+  (assert (= (table/to-struct x) (table/to-struct (table/clone x))) msg))
+
+(check-table-clone @{:a 123 :b 34 :c :hello : 945 0 1 2 3 4 5}
+                   "table/clone 1")
+(check-table-clone @{} "table/clone 2")
+
+(end-suite)
+

test/suite-unknown.janet

@@ -0,0 +1,296 @@
+# Copyright (c) 2023 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)
+
+# Set global variables to prevent some possible compiler optimizations
+# that defeat point of the test
+# 2771171
+(var zero 0)
+(var one 1)
+(var two 2)
+(var three 3)
+(var plus +)
+(assert (= 22 (plus one (plus 1 2 two) (plus 8 (plus zero 1) 4 three)))
+        "nested function calls")
+
+# McCarthy's 91 function
+# 2771171
+(var f91 nil)
+(set f91 (fn [n]
+           (if (> n 100)
+             (- n 10)
+             (f91 (f91 (+ n 11))))))
+(assert (= 91 (f91 10)) "f91(10) = 91")
+(assert (= 91 (f91 11)) "f91(11) = 91")
+(assert (= 91 (f91 20)) "f91(20) = 91")
+(assert (= 91 (f91 31)) "f91(31) = 91")
+(assert (= 91 (f91 100)) "f91(100) = 91")
+(assert (= 91 (f91 101)) "f91(101) = 91")
+(assert (= 92 (f91 102)) "f91(102) = 92")
+(assert (= 93 (f91 103)) "f91(103) = 93")
+(assert (= 94 (f91 104)) "f91(104) = 94")
+
+# Fibonacci
+# 23196ff
+(def fib
+  (do
+    (var fib nil)
+    (set fib (fn [n]
+               (if (< n 2)
+                 n
+                 (+ (fib (- n 1)) (fib (- n 2))))))))
+(def fib2
+  (fn fib2 [n]
+    (if (< n 2)
+      n
+      (+ (fib2 (- n 1)) (fib2 (- n 2))))))
+
+(assert (= (fib 0) (fib2 0) 0) "fib(0)")
+(assert (= (fib 1) (fib2 1) 1) "fib(1)")
+(assert (= (fib 2) (fib2 2) 1) "fib(2)")
+(assert (= (fib 3) (fib2 3) 2) "fib(3)")
+(assert (= (fib 4) (fib2 4) 3) "fib(4)")
+(assert (= (fib 5) (fib2 5) 5) "fib(5)")
+(assert (= (fib 6) (fib2 6) 8) "fib(6)")
+(assert (= (fib 7) (fib2 7) 13) "fib(7)")
+(assert (= (fib 8) (fib2 8) 21) "fib(8)")
+(assert (= (fib 9) (fib2 9) 34) "fib(9)")
+(assert (= (fib 10) (fib2 10) 55) "fib(10)")
+
+# Closure in non function scope
+# 911b0b1
+(def outerfun (fn [x y]
+                (def c (do
+                         (def someval (+ 10 y))
+                         (def ctemp (if x (fn [] someval) (fn [] y)))
+                         ctemp
+                         ))
+                (+ 1 2 3 4 5 6 7)
+                c))
+
+(assert (= ((outerfun 1 2)) 12) "inner closure 1")
+(assert (= ((outerfun nil 2)) 2) "inner closure 2")
+(assert (= ((outerfun false 3)) 3) "inner closure 3")
+
+# d6967a5
+((fn []
+   (var accum 1)
+   (var counter 0)
+   (while (< counter 16)
+     (set accum (blshift accum 1))
+     (set counter (+ 1 counter)))
+   (assert (= accum 65536) "loop in closure")))
+
+(var accum 1)
+(var counter 0)
+(while (< counter 16)
+  (set accum (blshift accum 1))
+  (set counter (+ 1 counter)))
+(assert (= accum 65536) "loop globally")
+
+# Fiber tests
+# 21bd960
+(def afiber (fiber/new (fn []
+                         (def x (yield))
+                         (error (string "hello, " x))) :ye))
+
+(resume afiber) # first resume to prime
+(def afiber-result (resume afiber "world!"))
+
+(assert (= afiber-result "hello, world!") "fiber error result")
+(assert (= (fiber/status afiber) :error) "fiber error status")
+
+# Var arg tests
+# f054586
+(def vargf (fn [more] (apply + more)))
+
+(assert (= 0 (vargf @[])) "var arg no arguments")
+(assert (= 1 (vargf @[1])) "var arg no packed arguments")
+(assert (= 3 (vargf @[1 2])) "var arg tuple size 1")
+(assert (= 10 (vargf @[1 2 3 4])) "var arg tuple size 2, 2 normal args")
+(assert (= 110 (vargf @[1 2 3 4 10 10 10 10 10 10 10 10 10 10]))
+        "var arg large tuple")
+
+# Higher order functions
+# d9f24ef
+(def compose (fn [f g] (fn [& xs] (f (apply g xs)))))
+
+(def -+ (compose - +))
+(def +- (compose + -))
+
+(assert (= (-+ 1 2 3 4) -10) "compose - +")
+(assert (= (+- 1 2 3 4) -8) "compose + -")
+(assert (= ((compose -+ +-) 1 2 3 4) 8) "compose -+ +-")
+(assert (= ((compose +- -+) 1 2 3 4) 10) "compose +- -+")
+
+# UTF-8
+# d9f24ef
+#🐙🐙🐙🐙
+
+(defn foo [Θa Θb Θc] 0)
+(def 🦊 :fox)
+(def 🐮 :cow)
+(assert (= (string "🐼" 🦊 🐮) "🐼foxcow") "emojis 🙉 :)")
+(assert (not= 🦊 "🦊") "utf8 strings are not symbols and vice versa")
+(assert (= "\U01F637" "😷") "unicode escape 1")
+(assert (= "\u2623" "\U002623" "☣") "unicode escape 2")
+(assert (= "\u24c2" "\U0024c2" "Ⓜ") "unicode escape 3")
+(assert (= "\u0061" "a") "unicode escape 4")
+
+# Test max triangle program
+# c0e373f
+# Find the maximum path from the top (root)
+# of the triangle to the leaves of the triangle.
+
+(defn myfold [xs ys]
+  (let [xs1 [;xs 0]
+        xs2 [0 ;xs]
+        m1 (map + xs1 ys)
+        m2 (map + xs2 ys)]
+    (map max m1 m2)))
+
+(defn maxpath [t]
+ (extreme > (reduce myfold () t)))
+
+# Test it
+# Maximum path is 3 -> 10 -> 3 -> 9 for a total of 25
+(def triangle '[
+ [3]
+ [7 10]
+ [4 3 7]
+ [8 9 1 3]
+])
+
+(assert (= (maxpath triangle) 25) `max triangle`)
+
+# Large functions
+# 6822400
+(def manydefs (seq [i :range [0 300]]
+                (tuple 'def (gensym) (string "value_" i))))
+(array/push manydefs (tuple * 10000 3 5 7 9))
+(def f (compile ['do ;manydefs] (fiber/getenv (fiber/current))))
+(assert (= (f) (* 10000 3 5 7 9)) "long function compilation")
+
+# Closure in while loop
+# abe7d59
+(def closures (seq [i :range [0 5]] (fn [] i)))
+(assert (= 0 ((get closures 0))) "closure in loop 0")
+(assert (= 1 ((get closures 1))) "closure in loop 1")
+(assert (= 2 ((get closures 2))) "closure in loop 2")
+(assert (= 3 ((get closures 3))) "closure in loop 3")
+(assert (= 4 ((get closures 4))) "closure in loop 4")
+
+# Another regression test - no segfaults
+# 6b4824c
+(defn afn [x] x)
+(var afn-var afn)
+(var identity-var identity)
+(var map-var map)
+(var not-var not)
+(assert (= 1 (try (afn-var) ([err] 1))) "bad arity 1")
+(assert (= 4 (try ((fn [x y] (+ x y)) 1) ([_] 4))) "bad arity 2")
+(assert (= 1 (try (identity-var) ([err] 1))) "bad arity 3")
+(assert (= 1 (try (map-var) ([err] 1))) "bad arity 4")
+(assert (= 1 (try (not-var) ([err] 1))) "bad arity 5")
+
+# Detaching closure over non resumable fiber
+# issue #317 - 7c4ffe9b9
+(do
+  (defn f1
+    [a]
+    (defn f1 [] (++ (a 0)))
+    (defn f2 [] (++ (a 0)))
+    (error [f1 f2]))
+  (def [_ [f1 f2]] (protect (f1 @[0])))
+  # At time of writing, mark phase can detach closure envs.
+  (gccollect)
+  (assert (= 1 (f1)) "detach-non-resumable-closure 1")
+  (assert (= 2 (f2)) "detach-non-resumable-closure 2"))
+
+# Dynamic defs
+# ec65f03
+(def staticdef1 0)
+(defn staticdef1-inc [] (+ 1 staticdef1))
+(assert (= 1 (staticdef1-inc)) "before redefinition without :redef")
+(def staticdef1 1)
+(assert (= 1 (staticdef1-inc)) "after redefinition without :redef")
+(setdyn :redef true)
+(def dynamicdef2 0)
+(defn dynamicdef2-inc [] (+ 1 dynamicdef2))
+(assert (= 1 (dynamicdef2-inc)) "before redefinition with dyn :redef")
+(def dynamicdef2 1)
+(assert (= 2 (dynamicdef2-inc)) "after redefinition with dyn :redef")
+(setdyn :redef nil)
+
+# missing symbols
+# issue #914 - 1eb34989d
+(defn lookup-symbol [sym] (defglobal sym 10) (dyn sym))
+
+(setdyn :missing-symbol lookup-symbol)
+
+(assert (= (eval-string "(+ a 5)") 15) "lookup missing symbol")
+
+(setdyn :missing-symbol nil)
+(setdyn 'a nil)
+
+(assert-error "compile error" (eval-string "(+ a 5)"))
+
+# 88813c4
+(assert (deep= (in (disasm (defn a [] (def x 10) x)) :symbolmap)
+               @[[0 2 0 'a] [0 2 1 'x]])
+        "symbolmap when *debug* is true")
+
+(defn a [arg]
+  (def x 10)
+  (do
+    (def y 20)
+    (def z 30)
+    (+ x y z)))
+(def symbolslots (in (disasm a) :symbolslots))
+(def f (asm (disasm a)))
+(assert (deep= (in (disasm f) :symbolslots)
+               symbolslots)
+        "symbolslots survive disasm/asm")
+
+(comment
+  (setdyn *debug* true)
+  (setdyn :pretty-format "%.40M")
+  (def f (fn [x] (fn [y] (+ x y))))
+  (assert (deep= (map last (in (disasm (f 10)) :symbolmap))
+                 @['x 'y])
+          "symbolmap upvalues"))
+
+(assert (deep= (in (disasm (defn a [arg]
+                             (def x 10)
+                             (do
+                               (def y 20)
+                               (def z 30)
+                               (+ x y z)))) :symbolmap)
+               @[[0 6 0 'arg]
+                 [0 6 1 'a]
+                 [0 6 2 'x]
+                 [1 6 3 'y]
+                 [2 6 4 'z]])
+        "arg & inner symbolmap")
+
+(end-suite)
+

test/suite-value.janet

@@ -0,0 +1,72 @@
+# Copyright (c) 2023 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)
+
+# 3e1e25854
+(def test-struct {'def 1 'bork 2 'sam 3 'a 'b 'het @[1 2 3 4 5]})
+(assert (= (get test-struct 'def) 1) "struct get")
+(assert (= (get test-struct 'bork) 2) "struct get")
+(assert (= (get test-struct 'sam) 3) "struct get")
+(assert (= (get test-struct 'a) 'b) "struct get")
+(assert (= :array (type (get test-struct 'het))) "struct get")
+
+# Buffer stuff
+# 910cfd7dd
+(defn buffer=
+  [a b]
+  (= (string a) (string b)))
+
+(assert (buffer= @"abcd" @"abcd") "buffer equal 1")
+(assert (buffer= @"abcd" (buffer "ab" "cd")) "buffer equal 2")
+(assert (not= @"" @"") "buffer not equal 1")
+(assert (not= @"abcd" @"abcd") "buffer not equal 2")
+
+(defn buffer-factory
+  []
+  @"im am a buffer")
+
+(assert (not= (buffer-factory) (buffer-factory)) "buffer instantiation")
+
+(assert (= (length @"abcdef") 6) "buffer length")
+
+# Tuple comparison
+# da438a93e
+(assert (< [1 2 3] [2 2 3]) "tuple comparison 1")
+(assert (< [1 2 3] [2 2]) "tuple comparison 2")
+(assert (< [1 2 3] [2 2 3 4]) "tuple comparison 3")
+(assert (< [1 2 3] [1 2 3 4]) "tuple comparison 4")
+(assert (< [1 2 3] [1 2 3 -1]) "tuple comparison 5")
+(assert (> [1 2 3] [1 2]) "tuple comparison 6")
+
+# More numerical tests
+# e05022f
+(assert (= 1 1.0) "numerical equal 1")
+(assert (= 0 0.0) "numerical equal 2")
+(assert (= 0 -0.0) "numerical equal 3")
+(assert (= 2_147_483_647 2_147_483_647.0) "numerical equal 4")
+(assert (= -2_147_483_648 -2_147_483_648.0) "numerical equal 5")
+
+# issue #928 - d7ea122cf
+(assert (= (hash 0) (hash (* -1 0))) "hash -0 same as hash 0")
+
+(end-suite)
+

test/suite-vm.janet

@@ -0,0 +1,142 @@
+# Copyright (c) 2023 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)
+
+# More fiber semantics
+# 0fd9224e4
+(var myvar 0)
+(defn fiberstuff [&]
+  (++ myvar)
+  (def f (fiber/new (fn [&] (++ myvar) (debug) (++ myvar))))
+  (resume f)
+  (++ myvar))
+
+(def myfiber (fiber/new fiberstuff :dey))
+
+(assert (= myvar 0) "fiber creation does not call fiber function")
+(resume myfiber)
+(assert (= myvar 2) "fiber debug statement breaks at proper point")
+(assert (= (fiber/status myfiber) :debug) "fiber enters debug state")
+(resume myfiber)
+(assert (= myvar 4) "fiber resumes properly from debug state")
+(assert (= (fiber/status myfiber) :dead)
+        "fiber properly dies from debug state")
+
+# yield tests
+# 171c0ce
+(def t (fiber/new (fn [&] (yield 1) (yield 2) 3)))
+
+(assert (= 1 (resume t)) "initial transfer to new fiber")
+(assert (= 2 (resume t)) "second transfer to fiber")
+(assert (= 3 (resume t)) "return from fiber")
+(assert (= (fiber/status t) :dead) "finished fiber is dead")
+
+# Fix yields inside nested fibers
+# 909c906
+(def yielder
+  (coro
+    (defer (yield :end)
+      (repeat 5 (yield :item)))))
+(def items (seq [x :in yielder] x))
+(assert (deep= @[:item :item :item :item :item :end] items)
+        "yield within nested fibers")
+
+# Calling non functions
+# b9c0fc820
+(assert (= 1 ({:ok 1} :ok)) "calling struct")
+(assert (= 2 (@{:ok 2} :ok)) "calling table")
+(assert (= :bad (try ((identity @{:ok 2}) :ok :no) ([err] :bad)))
+        "calling table too many arguments")
+(assert (= :bad (try ((identity :ok) @{:ok 2} :no) ([err] :bad)))
+        "calling keyword too many arguments")
+(assert (= :oops (try ((+ 2 -1) 1) ([err] :oops)))
+        "calling number fails")
+
+# Method test
+# d5bab7262
+(def Dog @{:bark (fn bark [self what]
+                   (string (self :name) " says " what "!"))})
+(defn make-dog
+  [name]
+  (table/setproto @{:name name} Dog))
+
+(assert (= "fido" ((make-dog "fido") :name)) "oo 1")
+(def spot (make-dog "spot"))
+(assert (= "spot says hi!" (:bark spot "hi")) "oo 2")
+
+# Negative tests
+# 67f26b7d7
+(assert-error "+ check types" (+ 1 ()))
+(assert-error "- check types" (- 1 ()))
+(assert-error "* check types" (* 1 ()))
+(assert-error "/ check types" (/ 1 ()))
+(assert-error "band check types" (band 1 ()))
+(assert-error "bor check types" (bor 1 ()))
+(assert-error "bxor check types" (bxor 1 ()))
+(assert-error "bnot check types" (bnot ()))
+
+# Comparisons
+# 10dcbc639
+(assert (> 1e23 100) "less than immediate 1")
+(assert (> 1e23 1000) "less than immediate 2")
+(assert (< 100 1e23) "greater than immediate 1")
+(assert (< 1000 1e23) "greater than immediate 2")
+
+# Quasiquote bracketed tuples
+# e239980da
+(assert (= (tuple/type ~[1 2 3]) (tuple/type '[1 2 3]))
+        "quasiquote bracket tuples")
+
+# Regression #638
+# c68264802
+(compwhen
+  (dyn 'ev/go)
+  (assert
+    (= [true :caught]
+       (protect
+         (try
+           (do
+             (ev/sleep 0)
+             (with-dyns []
+               (ev/sleep 0)
+               (error "oops")))
+           ([err] :caught))))
+    "regression #638"))
+
+#
+# Test propagation of signals via fibers
+#
+# b8032ec61
+(def f (fiber/new (fn [] (error :abc) 1) :ei))
+(def res (resume f))
+(assert-error :abc (propagate res f) "propagate 1")
+
+# Cancel test
+# 28439d822
+(def f (fiber/new (fn [&] (yield 1) (yield 2) (yield 3) 4) :yti))
+(assert (= 1 (resume f)) "cancel resume 1")
+(assert (= 2 (resume f)) "cancel resume 2")
+(assert (= :hi (cancel f :hi)) "cancel resume 3")
+(assert (= :error (fiber/status f)) "cancel resume 4")
+
+(end-suite)
+

test/suite0000.janet

@@ -1,437 +0,0 @@
-# Copyright (c) 2023 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 0)
-
-(assert (= 10 (+ 1 2 3 4)) "addition")
-(assert (= -8 (- 1 2 3 4)) "subtraction")
-(assert (= 24 (* 1 2 3 4)) "multiplication")
-(assert (= 4 (blshift 1 2)) "left shift")
-(assert (= 1 (brshift 4 2)) "right shift")
-(assert (< 1 2 3 4 5 6) "less than integers")
-(assert (< 1.0 2.0 3.0 4.0 5.0 6.0) "less than reals")
-(assert (> 6 5 4 3 2 1) "greater than integers")
-(assert (> 6.0 5.0 4.0 3.0 2.0 1.0) "greater than reals")
-(assert (<= 1 2 3 3 4 5 6) "less than or equal to integers")
-(assert (<= 1.0 2.0 3.0 3.0 4.0 5.0 6.0) "less than or equal to reals")
-(assert (>= 6 5 4 4 3 2 1) "greater than or equal to integers")
-(assert (>= 6.0 5.0 4.0 4.0 3.0 2.0 1.0) "greater than or equal to reals")
-(assert (= 7 (% 20 13)) "modulo 1")
-(assert (= -7 (% -20 13)) "modulo 2")
-
-(assert (< 1.0 nil false true
-           (fiber/new (fn [] 1))
-           "hi"
-           (quote hello)
-           :hello
-           (array 1 2 3)
-           (tuple 1 2 3)
-           (table "a" "b" "c" "d")
-           (struct 1 2 3 4)
-           (buffer "hi")
-           (fn [x] (+ x x))
-           print) "type ordering")
-
-(assert (= (string (buffer "123" "456")) (string @"123456")) "buffer literal")
-(assert (= (get {} 1) nil) "get nil from empty struct")
-(assert (= (get @{} 1) nil) "get nil from empty table")
-(assert (= (get {:boop :bap} :boop) :bap) "get non nil from struct")
-(assert (= (get @{:boop :bap} :boop) :bap) "get non nil from table")
-(assert (= (get @"\0" 0) 0) "get non nil from buffer")
-(assert (= (get @"\0" 1) nil) "get nil from buffer oob")
-(assert (put @{} :boop :bap) "can add to empty table")
-(assert (put @{1 3} :boop :bap) "can add to non-empty table")
-
-(assert (not false) "false literal")
-(assert true "true literal")
-(assert (not nil) "nil literal")
-(assert (= 7 (bor 3 4)) "bit or")
-(assert (= 0 (band 3 4)) "bit and")
-(assert (= 0xFF (bxor 0x0F 0xF0)) "bit xor")
-(assert (= 0xF0 (bxor 0xFF 0x0F)) "bit xor 2")
-
-# Set global variables to prevent some possible compiler optimizations that defeat point of the test
-(var zero 0)
-(var one 1)
-(var two 2)
-(var three 3)
-(var plus +)
-(assert (= 22 (plus one (plus 1 2 two) (plus 8 (plus zero 1) 4 three))) "nested function calls")
-
-# String literals
-(assert (= "abcd" "\x61\x62\x63\x64") "hex escapes")
-(assert (= "\e" "\x1B") "escape character")
-(assert (= "\x09" "\t") "tab character")
-
-# McCarthy's 91 function
-(var f91 nil)
-(set f91 (fn [n] (if (> n 100) (- n 10) (f91 (f91 (+ n 11))))))
-(assert (= 91 (f91 10)) "f91(10) = 91")
-(assert (= 91 (f91 11)) "f91(11) = 91")
-(assert (= 91 (f91 20)) "f91(20) = 91")
-(assert (= 91 (f91 31)) "f91(31) = 91")
-(assert (= 91 (f91 100)) "f91(100) = 91")
-(assert (= 91 (f91 101)) "f91(101) = 91")
-(assert (= 92 (f91 102)) "f91(102) = 92")
-(assert (= 93 (f91 103)) "f91(103) = 93")
-(assert (= 94 (f91 104)) "f91(104) = 94")
-
-# Fibonacci
-(def fib (do (var fib nil) (set fib (fn [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))))))
-(def fib2 (fn fib2 [n] (if (< n 2) n (+ (fib2 (- n 1)) (fib2 (- n 2))))))
-
-(assert (= (fib 0) (fib2 0) 0) "fib(0)")
-(assert (= (fib 1) (fib2 1) 1) "fib(1)")
-(assert (= (fib 2) (fib2 2) 1) "fib(2)")
-(assert (= (fib 3) (fib2 3) 2) "fib(3)")
-(assert (= (fib 4) (fib2 4) 3) "fib(4)")
-(assert (= (fib 5) (fib2 5) 5) "fib(5)")
-(assert (= (fib 6) (fib2 6) 8) "fib(6)")
-(assert (= (fib 7) (fib2 7) 13) "fib(7)")
-(assert (= (fib 8) (fib2 8) 21) "fib(8)")
-(assert (= (fib 9) (fib2 9) 34) "fib(9)")
-(assert (= (fib 10) (fib2 10) 55) "fib(10)")
-
-# Closure in non function scope
-(def outerfun (fn [x y]
-                (def c (do
-                         (def someval (+ 10 y))
-                         (def ctemp (if x (fn [] someval) (fn [] y)))
-                         ctemp
-                         ))
-                (+ 1 2 3 4 5 6 7)
-                c))
-
-(assert (= ((outerfun 1 2)) 12) "inner closure 1")
-(assert (= ((outerfun nil 2)) 2) "inner closure 2")
-(assert (= ((outerfun false 3)) 3) "inner closure 3")
-
-(assert (= '(1 2 3) (quote (1 2 3)) (tuple 1 2 3)) "quote shorthand")
-
-((fn []
-   (var accum 1)
-   (var count 0)
-   (while (< count 16)
-     (set accum (blshift accum 1))
-     (set count (+ 1 count)))
-   (assert (= accum 65536) "loop in closure")))
-
-(var accum 1)
-(var count 0)
-(while (< count 16)
-  (set accum (blshift accum 1))
-  (set count (+ 1 count)))
-(assert (= accum 65536) "loop globally")
-
-(assert (= (struct 1 2 3 4 5 6 7 8) (struct 7 8 5 6 3 4 1 2)) "struct order does not matter 1")
-(assert (= (struct
-             :apple 1
-             6 :bork
-             '(1 2 3) 5)
-           (struct
-             6 :bork
-             '(1 2 3) 5
-             :apple 1)) "struct order does not matter 2")
-
-# Symbol function
-
-(assert (= (symbol "abc" 1 2 3) 'abc123) "symbol function")
-
-# Fiber tests
-
-(def afiber (fiber/new (fn []
-                         (def x (yield))
-                         (error (string "hello, " x))) :ye))
-
-(resume afiber) # first resume to prime
-(def afiber-result (resume afiber "world!"))
-
-(assert (= afiber-result "hello, world!") "fiber error result")
-(assert (= (fiber/status afiber) :error) "fiber error status")
-
-# yield tests
-
-(def t (fiber/new (fn [&] (yield 1) (yield 2) 3)))
-
-(assert (= 1 (resume t)) "initial transfer to new fiber")
-(assert (= 2 (resume t)) "second transfer to fiber")
-(assert (= 3 (resume t)) "return from fiber")
-(assert (= (fiber/status t) :dead) "finished fiber is dead")
-
-# Var arg tests
-
-(def vargf (fn [more] (apply + more)))
-
-(assert (= 0 (vargf @[])) "var arg no arguments")
-(assert (= 1 (vargf @[1])) "var arg no packed arguments")
-(assert (= 3 (vargf @[1 2])) "var arg tuple size 1")
-(assert (= 10 (vargf @[1 2 3 4])) "var arg tuple size 2, 2 normal args")
-(assert (= 110 (vargf @[1 2 3 4 10 10 10 10 10 10 10 10 10 10])) "var arg large tuple")
-
-# Higher order functions
-
-(def compose (fn [f g] (fn [& xs] (f (apply g xs)))))
-
-(def -+ (compose - +))
-(def +- (compose + -))
-
-(assert (= (-+ 1 2 3 4) -10) "compose - +")
-(assert (= (+- 1 2 3 4) -8) "compose + -")
-(assert (= ((compose -+ +-) 1 2 3 4) 8) "compose -+ +-")
-(assert (= ((compose +- -+) 1 2 3 4) 10) "compose +- -+")
-
-# UTF-8
-
-#🐙🐙🐙🐙
-
-(defn foo [Θa Θb Θc] 0)
-(def 🦊 :fox)
-(def 🐮 :cow)
-(assert (= (string "🐼" 🦊 🐮) "🐼foxcow") "emojis 🙉 :)")
-(assert (not= 🦊 "🦊") "utf8 strings are not symbols and vice versa")
-(assert (= "\U01F637" "😷") "unicode escape 1")
-(assert (= "\u2623" "\U002623" "☣") "unicode escape 2")
-(assert (= "\u24c2" "\U0024c2" "Ⓜ") "unicode escape 3")
-(assert (= "\u0061" "a") "unicode escape 4")
-
-# Symbols with @ character
-
-(def @ 1)
-(assert (= @ 1) "@ symbol")
-(def @-- 2)
-(assert (= @-- 2) "@-- symbol")
-(def @hey 3)
-(assert (= @hey 3) "@hey symbol")
-
-# Merge sort
-
-# Imperative (and verbose) merge sort merge
-(defn merge
-  [xs ys]
-  (def ret @[])
-  (def xlen (length xs))
-  (def ylen (length ys))
-  (var i 0)
-  (var j 0)
-  # Main merge
-  (while (if (< i xlen) (< j ylen))
-    (def xi (get xs i))
-    (def yj (get ys j))
-    (if (< xi yj)
-      (do (array/push ret xi) (set i (+ i 1)))
-      (do (array/push ret yj) (set j (+ j 1)))))
-  # Push rest of xs
-  (while (< i xlen)
-    (def xi (get xs i))
-    (array/push ret xi)
-    (set i (+ i 1)))
-  # Push rest of ys
-  (while (< j ylen)
-    (def yj (get ys j))
-    (array/push ret yj)
-    (set j (+ j 1)))
-  ret)
-
-(assert (apply <= (merge @[1 3 5] @[2 4 6])) "merge sort merge 1")
-(assert (apply <= (merge @[1 2 3] @[4 5 6])) "merge sort merge 2")
-(assert (apply <= (merge @[1 3 5] @[2 4 6 6 6 9])) "merge sort merge 3")
-(assert (apply <= (merge '(1 3 5) @[2 4 6 6 6 9])) "merge sort merge 4")
-
-(assert (deep= @[1 2 3 4 5] (sort @[5 3 4 1 2])) "sort 1")
-(assert (deep= @[{:a 1} {:a 4} {:a 7}] (sort-by |($ :a) @[{:a 4} {:a 7} {:a 1}])) "sort 2")
-(assert (deep= @[1 2 3 4 5] (sorted [5 3 4 1 2])) "sort 3")
-(assert (deep= @[{:a 1} {:a 4} {:a 7}] (sorted-by |($ :a) [{:a 4} {:a 7} {:a 1}])) "sort 4")
-
-# Gensym tests
-
-(assert (not= (gensym) (gensym)) "two gensyms not equal")
-((fn []
-   (def syms (table))
-   (var count 0)
-   (while (< count 128)
-     (put syms (gensym) true)
-     (set count (+ 1 count)))
-   (assert (= (length syms) 128) "many symbols")))
-
-# Let
-
-(assert (= (let [a 1 b 2] (+ a b)) 3) "simple let")
-(assert (= (let [[a b] @[1 2]] (+ a b)) 3) "destructured let")
-(assert (= (let [[a [c d] b] @[1 (tuple 4 3) 2]] (+ a b c d)) 10) "double destructured let")
-
-# Macros
-
-(defn dub [x] (+ x x))
-(assert (= 2 (dub 1)) "defn macro")
-(do
-  (defn trip [x] (+ x x x))
-  (assert (= 3 (trip 1)) "defn macro triple"))
-(do
-  (var i 0)
-  (when true
-    (++ i)
-    (++ i)
-    (++ i)
-    (++ i)
-    (++ i)
-    (++ i))
-  (assert (= i 6) "when macro"))
-
-# Dynamic defs
-
-(def staticdef1 0)
-(defn staticdef1-inc [] (+ 1 staticdef1))
-(assert (= 1 (staticdef1-inc)) "before redefinition without :redef")
-(def staticdef1 1)
-(assert (= 1 (staticdef1-inc)) "after redefinition without :redef")
-(setdyn :redef true)
-(def dynamicdef2 0)
-(defn dynamicdef2-inc [] (+ 1 dynamicdef2))
-(assert (= 1 (dynamicdef2-inc)) "before redefinition with dyn :redef")
-(def dynamicdef2 1)
-(assert (= 2 (dynamicdef2-inc)) "after redefinition with dyn :redef")
-(setdyn :redef nil)
-
-# Denormal tables and structs
-
-(assert (= (length {1 2 nil 3}) 1) "nil key struct literal")
-(assert (= (length @{1 2 nil 3}) 1) "nil key table literal")
-(assert (= (length (struct 1 2 nil 3)) 1) "nil key struct ctor")
-(assert (= (length (table 1 2 nil 3)) 1) "nil key table ctor")
-
-(assert (= (length (struct (/ 0 0) 2 1 3)) 1) "nan key struct ctor")
-(assert (= (length (table (/ 0 0) 2 1 3)) 1) "nan key table ctor")
-(assert (= (length {1 2 nil 3}) 1) "nan key struct literal")
-(assert (= (length @{1 2 nil 3}) 1) "nan key table literal")
-
-(assert (= (length (struct 2 1 3 nil)) 1) "nil value struct ctor")
-(assert (= (length (table 2 1 3 nil)) 1) "nil value table ctor")
-(assert (= (length {1 2 3 nil}) 1) "nil value struct literal")
-(assert (= (length @{1 2 3 nil}) 1) "nil value table literal")
-
-# Regression Test
-(assert (= 1 (((compile '(fn [] 1) @{})))) "regression test")
-
-# Regression Test #137
-(def [a b c] (range 10))
-(assert (= a 0) "regression #137 (1)")
-(assert (= b 1) "regression #137 (2)")
-(assert (= c 2) "regression #137 (3)")
-
-(var [x y z] (range 10))
-(assert (= x 0) "regression #137 (4)")
-(assert (= y 1) "regression #137 (5)")
-(assert (= z 2) "regression #137 (6)")
-
-(assert (= true ;(map truthy? [0 "" true @{} {} [] '()])) "truthy values")
-(assert (= false ;(map truthy? [nil false])) "non-truthy values")
-
-# Struct and Table duplicate elements
-(assert (= {:a 3 :b 2} {:a 1 :b 2 :a 3}) "struct literal duplicate keys")
-(assert (= {:a 3 :b 2} (struct :a 1 :b 2 :a 3)) "struct constructor duplicate keys")
-(assert (deep= @{:a 3 :b 2} @{:a 1 :b 2 :a 3}) "table literal duplicate keys")
-(assert (deep= @{:a 3 :b 2} (table :a 1 :b 2 :a 3)) "table constructor duplicate keys")
-
-## Polymorphic comparison -- Issue #272
-
-# confirm polymorphic comparison delegation to primitive comparators:
-(assert (= 0 (cmp 3 3)) "compare-primitive integers (1)")
-(assert (= -1 (cmp 3 5)) "compare-primitive integers (2)")
-(assert (= 1 (cmp "foo" "bar")) "compare-primitive strings")
-(assert (= 0 (compare 1 1)) "compare integers (1)")
-(assert (= -1 (compare 1 2)) "compare integers (2)")
-(assert (= 1 (compare "foo" "bar")) "compare strings (1)")
-
-(assert (compare< 1 2 3 4 5 6) "compare less than integers")
-(assert (not (compare> 1 2 3 4 5 6)) "compare not greater than integers")
-(assert (compare< 1.0 2.0 3.0 4.0 5.0 6.0) "compare less than reals")
-(assert (compare> 6 5 4 3 2 1) "compare greater than integers")
-(assert (compare> 6.0 5.0 4.0 3.0 2.0 1.0) "compare greater than reals")
-(assert (not (compare< 6.0 5.0 4.0 3.0 2.0 1.0)) "compare less than reals")
-(assert (compare<= 1 2 3 3 4 5 6) "compare less than or equal to integers")
-(assert (compare<= 1.0 2.0 3.0 3.0 4.0 5.0 6.0) "compare less than or equal to reals")
-(assert (compare>= 6 5 4 4 3 2 1) "compare greater than or equal to integers")
-(assert (compare>= 6.0 5.0 4.0 4.0 3.0 2.0 1.0) "compare greater than or equal to reals")
-(assert (compare< 1.0 nil false true
-           (fiber/new (fn [] 1))
-           "hi"
-           (quote hello)
-           :hello
-           (array 1 2 3)
-           (tuple 1 2 3)
-           (table "a" "b" "c" "d")
-           (struct 1 2 3 4)
-           (buffer "hi")
-           (fn [x] (+ x x))
-           print) "compare type ordering")
-
-# test polymorphic compare with 'objects' (table/setproto)
-(def mynum
-  @{:type :mynum :v 0 :compare
-    (fn [self other]
-      (case (type other)
-      :number (cmp (self :v) other)
-      :table (when (= (get other :type) :mynum)
-               (cmp (self :v) (other :v)))))})
-
-(let [n3 (table/setproto @{:v 3} mynum)]
-  (assert (= 0 (compare 3 n3)) "compare num to object (1)")
-  (assert (= -1 (compare n3 4)) "compare object to num (2)")
-  (assert (= 1 (compare (table/setproto @{:v 4} mynum) n3)) "compare object to object")
-  (assert (compare< 2 n3 4) "compare< poly")
-  (assert (compare> 4 n3 2) "compare> poly")
-  (assert (compare<= 2 3 n3 4) "compare<= poly")
-  (assert (compare= 3 n3 (table/setproto @{:v 3} mynum)) "compare= poly")
-  (assert (deep= (sorted @[4 5 n3 2] compare<) @[2 n3 4 5]) "polymorphic sort"))
-
-(let [MAX_INT_64_STRING "9223372036854775807"
-      MAX_UINT_64_STRING "18446744073709551615"
-      MAX_INT_IN_DBL_STRING "9007199254740991"
-      NAN (math/log -1)
-      INF (/ 1 0)
-      MINUS_INF (/ -1 0)
-      compare-poly-tests
-      [[(int/s64 3) (int/u64 3) 0]
-       [(int/s64 -3) (int/u64 3) -1]
-       [(int/s64 3) (int/u64 2) 1]
-       [(int/s64 3) 3 0] [(int/s64 3) 4 -1] [(int/s64 3) -9 1]
-       [(int/u64 3) 3 0] [(int/u64 3) 4 -1] [(int/u64 3) -9 1]
-       [3 (int/s64 3) 0] [3 (int/s64 4) -1] [3 (int/s64 -5) 1]
-       [3 (int/u64 3) 0] [3 (int/u64 4) -1] [3 (int/u64 2) 1]
-       [(int/s64 MAX_INT_64_STRING) (int/u64 MAX_UINT_64_STRING) -1]
-       [(int/s64 MAX_INT_IN_DBL_STRING) (scan-number MAX_INT_IN_DBL_STRING) 0]
-       [(int/u64 MAX_INT_IN_DBL_STRING) (scan-number MAX_INT_IN_DBL_STRING) 0]
-       [(+ 1 (int/u64 MAX_INT_IN_DBL_STRING)) (scan-number MAX_INT_IN_DBL_STRING) 1]
-       [(int/s64 0) INF -1] [(int/u64 0) INF -1]
-       [MINUS_INF (int/u64 0) -1] [MINUS_INF (int/s64 0) -1]
-       [(int/s64 1) NAN 0] [NAN (int/u64 1) 0]]]
-  (each [x y c] compare-poly-tests
-    (assert (= c (compare x y)) (string/format "compare polymorphic %q %q %d" x y c))))
-
-(assert (= nil (any? [])) "any? 1")
-(assert (= nil (any? [false nil])) "any? 2")
-(assert (= nil (any? [nil false])) "any? 3")
-(assert (= 1 (any? [1])) "any? 4")
-(assert (nan? (any? [nil math/nan nil])) "any? 5")
-(assert (= true (any? [nil nil false nil nil true nil nil nil nil false :a nil])) "any? 6")
-
-(end-suite)
-

test/suite0001.janet

@@ -1,384 +0,0 @@
-# Copyright (c) 2023 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 1)
-
-(assert (= 400 (math/sqrt 160000)) "sqrt(160000)=400")
-
-(def test-struct {'def 1 'bork 2 'sam 3 'a 'b 'het @[1 2 3 4 5]})
-(assert (= (get test-struct 'def) 1) "struct get")
-(assert (= (get test-struct 'bork) 2) "struct get")
-(assert (= (get test-struct 'sam) 3) "struct get")
-(assert (= (get test-struct 'a) 'b) "struct get")
-(assert (= :array (type (get test-struct 'het))) "struct get")
-
-(defn myfun [x]
-  (var a 10)
-  (set a (do
-         (def y x)
-         (if x 8 9))))
-
-(assert (= (myfun true) 8) "check do form regression")
-(assert (= (myfun false) 9) "check do form regression")
-
-(defn assert-many [f n e]
- (var good true)
- (loop [i :range [0 n]]
-  (if (not (f))
-   (set good false)))
- (assert good e))
-
-(assert-many (fn [] (>= 1 (math/random) 0)) 200 "(random) between 0 and 1")
-
-## Table prototypes
-
-(def roottab @{
- :parentprop 123
-})
-
-(def childtab @{
- :childprop 456
-})
-
-(table/setproto childtab roottab)
-
-(assert (= 123 (get roottab :parentprop)) "table get 1")
-(assert (= 123 (get childtab :parentprop)) "table get proto")
-(assert (= nil (get roottab :childprop)) "table get 2")
-(assert (= 456 (get childtab :childprop)) "proto no effect")
-
-# Long strings
-
-(assert (= "hello, world" `hello, world`) "simple long string")
-(assert (= "hello, \"world\"" `hello, "world"`) "long string with embedded quotes")
-(assert (= "hello, \\\\\\ \"world\"" `hello, \\\ "world"`)
-        "long string with embedded quotes and backslashes")
-
-# More fiber semantics
-
-(var myvar 0)
-(defn fiberstuff [&]
-  (++ myvar)
-  (def f (fiber/new (fn [&] (++ myvar) (debug) (++ myvar))))
-  (resume f)
-  (++ myvar))
-
-(def myfiber (fiber/new fiberstuff :dey))
-
-(assert (= myvar 0) "fiber creation does not call fiber function")
-(resume myfiber)
-(assert (= myvar 2) "fiber debug statement breaks at proper point")
-(assert (= (fiber/status myfiber) :debug) "fiber enters debug state")
-(resume myfiber)
-(assert (= myvar 4) "fiber resumes properly from debug state")
-(assert (= (fiber/status myfiber) :dead) "fiber properly dies from debug state")
-
-# Test max triangle program
-
-# Find the maximum path from the top (root)
-# of the triangle to the leaves of the triangle.
-
-(defn myfold [xs ys]
-  (let [xs1 [;xs 0]
-        xs2 [0 ;xs]
-        m1 (map + xs1 ys)
-        m2 (map + xs2 ys)]
-    (map max m1 m2)))
-
-(defn maxpath [t]
- (extreme > (reduce myfold () t)))
-
-# Test it
-# Maximum path is 3 -> 10 -> 3 -> 9 for a total of 25
-
-(def triangle '[
- [3]
- [7 10]
- [4 3 7]
- [8 9 1 3]
-])
-
-(assert (= (maxpath triangle) 25) `max triangle`)
-
-(assert (= (string/join @["one" "two" "three"]) "onetwothree") "string/join 1 argument")
-(assert (= (string/join @["one" "two" "three"] ", ") "one, two, three") "string/join 2 arguments")
-(assert (= (string/join @[] ", ") "") "string/join empty array")
-
-(assert (= (string/find "123" "abc123def") 3) "string/find positive")
-(assert (= (string/find "1234" "abc123def") nil) "string/find negative")
-
-# Test destructuring
-(do
-  (def test-tab @{:a 1 :b 2})
-  (def {:a a :b b} test-tab)
-  (assert (= a 1) "dictionary destructuring 1")
-  (assert (= b 2) "dictionary destructuring 2"))
-(do
-  (def test-tab @{'a 1 'b 2 3 4})
-  (def {'a a 'b b (+ 1 2) c} test-tab)
-  (assert (= a 1) "dictionary destructuring 3")
-  (assert (= b 2) "dictionary destructuring 4")
-  (assert (= c 4) "dictionary destructuring 5 - expression as key"))
-(let [test-tuple [:a :b 1 2]]
-  (def [a b one two] test-tuple)
-  (assert (= a :a) "tuple destructuring 1")
-  (assert (= b :b) "tuple destructuring 2")
-  (assert (= two 2) "tuple destructuring 3"))
-(let [test-tuple [:a :b 1 2]]
-  (def [a & rest] test-tuple)
-  (assert (= a :a) "tuple destructuring 4 - rest")
-  (assert (= rest [:b 1 2]) "tuple destructuring 5 - rest"))
-(do
-  (def [a b & rest] [:a :b nil :d])
-  (assert (= a :a) "tuple destructuring 6 - rest")
-  (assert (= b :b) "tuple destructuring 7 - rest")
-  (assert (= rest [nil :d]) "tuple destructuring 8 - rest"))
-(do
-  (def [[a b] x & rest] [[1 2] :a :c :b :a])
-  (assert (= a 1) "tuple destructuring 9 - rest")
-  (assert (= b 2) "tuple destructuring 10 - rest")
-  (assert (= x :a) "tuple destructuring 11 - rest")
-  (assert (= rest [:c :b :a]) "tuple destructuring 12 - rest"))
-(do
-  (def [a b & rest] [:a :b])
-  (assert (= a :a) "tuple destructuring 13 - rest")
-  (assert (= b :b) "tuple destructuring 14 - rest")
-  (assert (= rest []) "tuple destructuring 15 - rest"))
-
-(do
-  (def [[a b & r1] c & r2] [[:a :b 1 2] :c 3 4])
-  (assert (= a :a) "tuple destructuring 16 - rest")
-  (assert (= b :b) "tuple destructuring 17 - rest")
-  (assert (= c :c) "tuple destructuring 18 - rest")
-  (assert (= r1 [1 2]) "tuple destructuring 19 - rest")
-  (assert (= r2 [3 4]) "tuple destructuring 20 - rest"))
-
-# Marshal
-
-(def um-lookup (env-lookup (fiber/getenv (fiber/current))))
-(def m-lookup (invert um-lookup))
-
-(defn testmarsh [x msg]
-  (def marshx (marshal x m-lookup))
-  (def out (marshal (unmarshal marshx um-lookup) m-lookup))
-  (assert (= (string marshx) (string out)) msg))
-
-(testmarsh nil "marshal nil")
-(testmarsh false "marshal false")
-(testmarsh true "marshal true")
-(testmarsh 1 "marshal small integers")
-(testmarsh -1 "marshal integers (-1)")
-(testmarsh 199 "marshal small integers (199)")
-(testmarsh 5000 "marshal medium integers (5000)")
-(testmarsh -5000 "marshal small integers (-5000)")
-(testmarsh 10000 "marshal large integers (10000)")
-(testmarsh -10000 "marshal large integers (-10000)")
-(testmarsh 1.0 "marshal double")
-(testmarsh "doctordolittle" "marshal string")
-(testmarsh :chickenshwarma "marshal symbol")
-(testmarsh @"oldmcdonald" "marshal buffer")
-(testmarsh @[1 2 3 4 5] "marshal array")
-(testmarsh [tuple 1 2 3 4 5] "marshal tuple")
-(testmarsh @{1 2 3 4}  "marshal table")
-(testmarsh {1 2 3 4}  "marshal struct")
-(testmarsh (fn [x] x) "marshal function 0")
-(testmarsh (fn name [x] x) "marshal function 1")
-(testmarsh (fn [x] (+ 10 x 2)) "marshal function 2")
-(testmarsh (fn thing [x] (+ 11 x x 30)) "marshal function 3")
-(testmarsh map "marshal function 4")
-(testmarsh reduce "marshal function 5")
-(testmarsh (fiber/new (fn [] (yield 1) 2)) "marshal simple fiber 1")
-(testmarsh (fiber/new (fn [&] (yield 1) 2)) "marshal simple fiber 2")
-
-(def strct {:a @[nil]})
-(put (strct :a) 0 strct)
-(testmarsh strct "cyclic struct")
-
-# Large functions
-(def manydefs (seq [i :range [0 300]] (tuple 'def (gensym) (string "value_" i))))
-(array/push manydefs (tuple * 10000 3 5 7 9))
-(def f (compile ['do ;manydefs] (fiber/getenv (fiber/current))))
-(assert (= (f) (* 10000 3 5 7 9)) "long function compilation")
-
-# Some higher order functions and macros
-
-(def my-array @[1 2 3 4 5 6])
-(def x (if-let [x (get my-array 5)] x))
-(assert (= x 6) "if-let")
-(def x (if-let [y (get @{} :key)] 10 nil))
-(assert (not x) "if-let 2")
-
-(assert (= 14 (sum (map inc @[1 2 3 4]))) "sum map")
-(def myfun (juxt + - * /))
-(assert (= [2 -2 2 0.5] (myfun 2)) "juxt")
-
-# Case statements
-(assert
-  (= :six (case (+ 1 2 3)
-            1 :one
-            2 :two
-            3 :three
-            4 :four
-            5 :five
-            6 :six
-            7 :seven
-            8 :eight
-            9 :nine)) "case macro")
-
-(assert (= 7 (case :a :b 5 :c 6 :u 10 7)) "case with default")
-
-# Testing the loop and seq macros
-(def xs (apply tuple (seq [x :range [0 10] :when (even? x)] (tuple (/ x 2) x))))
-(assert (= xs '((0 0) (1 2) (2 4) (3 6) (4 8))) "seq macro 1")
-
-(def xs (apply tuple (seq [x :down [8 -2] :when (even? x)] (tuple (/ x 2) x))))
-(assert (= xs '((4 8) (3 6) (2 4) (1 2) (0 0))) "seq macro 2")
-
-(def xs (catseq [x :range [0 3]] [x x]))
-(assert (deep= xs @[0 0 1 1 2 2]) "catseq")
-
-# :range-to and :down-to
-(assert (deep= (seq [x :range-to [0 10]] x) (seq [x :range [0 11]] x)) "loop :range-to")
-(assert (deep= (seq [x :down-to [10 0]] x) (seq [x :down [10 -1]] x)) "loop :down-to")
-
-# Some testing for not=
-(assert (not= 1 1 0) "not= 1")
-(assert (not= 0 1 1) "not= 2")
-
-# Closure in while loop
-(def closures (seq [i :range [0 5]] (fn [] i)))
-(assert (= 0 ((get closures 0))) "closure in loop 0")
-(assert (= 1 ((get closures 1))) "closure in loop 1")
-(assert (= 2 ((get closures 2))) "closure in loop 2")
-(assert (= 3 ((get closures 3))) "closure in loop 3")
-(assert (= 4 ((get closures 4))) "closure in loop 4")
-
-# More numerical tests
-(assert (= 1 1.0) "numerical equal 1")
-(assert (= 0 0.0) "numerical equal 2")
-(assert (= 0 -0.0) "numerical equal 3")
-(assert (= 2_147_483_647 2_147_483_647.0) "numerical equal 4")
-(assert (= -2_147_483_648 -2_147_483_648.0) "numerical equal 5")
-
-# Array tests
-
-(defn array=
-  "Check if two arrays are equal in an element by element comparison"
-  [a b]
-  (if (and (array? a) (array? b))
-    (= (apply tuple a) (apply tuple b))))
-(assert (= (apply tuple @[1 2 3 4 5]) (tuple 1 2 3 4 5)) "array to tuple")
-(def arr (array))
-(array/push arr :hello)
-(array/push arr :world)
-(assert (array= arr @[:hello :world]) "array comparison")
-(assert (array= @[1 2 3 4 5] @[1 2 3 4 5]) "array comparison 2")
-(assert (array= @[:one :two :three :four :five] @[:one :two :three :four :five]) "array comparison 3")
-(assert (array= (array/slice @[1 2 3] 0 2) @[1 2]) "array/slice 1")
-(assert (array= (array/slice @[0 7 3 9 1 4] 2 -2) @[3 9 1]) "array/slice 2")
-
-# Even and odd
-
-(assert (odd? 9) "odd? 1")
-(assert (odd? -9) "odd? 2")
-(assert (not (odd? 10)) "odd? 3")
-(assert (not (odd? 0)) "odd? 4")
-(assert (not (odd? -10)) "odd? 5")
-(assert (not (odd? 1.1)) "odd? 6")
-(assert (not (odd? -0.1)) "odd? 7")
-(assert (not (odd? -1.1)) "odd? 8")
-(assert (not (odd? -1.6)) "odd? 9")
-
-(assert (even? 10) "even? 1")
-(assert (even? -10) "even? 2")
-(assert (even? 0) "even? 3")
-(assert (not (even? 9)) "even? 4")
-(assert (not (even? -9)) "even? 5")
-(assert (not (even? 0.1)) "even? 6")
-(assert (not (even? -0.1)) "even? 7")
-(assert (not (even? -10.1)) "even? 8")
-(assert (not (even? -10.6)) "even? 9")
-
-# Map arities
-(assert (deep= (map inc [1 2 3]) @[2 3 4]))
-(assert (deep= (map + [1 2 3] [10 20 30]) @[11 22 33]))
-(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300]) @[111 222 333]))
-(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300] [1000 2000 3000]) @[1111 2222 3333]))
-(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300] [1000 2000 3000] [10000 20000 30000]) @[11111 22222 33333]))
-(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300] [1000 2000 3000] [10000 20000 30000] [100000 200000 300000]) @[111111 222222 333333]))
-
-# Mapping uses the shortest sequence
-(assert (deep= (map + [1 2 3 4] [10 20 30]) @[11 22 33]))
-(assert (deep= (map + [1 2 3 4] [10 20 30] [100 200]) @[111 222]))
-(assert (deep= (map + [1 2 3 4] [10 20 30] [100 200] [1000]) @[1111]))
-(assert (deep= (map + [1 2 3 4] [10 20 30] [100 200] [1000] []) @[]))
-
-# Variadic arguments to map-like functions
-(assert (deep= (mapcat tuple [1 2 3 4] [5 6 7 8]) @[1 5 2 6 3 7 4 8]))
-(assert (deep= (keep |(if (> $1 0) (/ $0 $1)) [1 2 3 4 5] [1 2 1 0 1]) @[1 1 3 5]))
-
-(assert (= (count = [1 3 2 4 3 5 4 2 1] [1 2 3 4 5 4 3 2 1]) 4))
-
-(assert (= (some not= (range 5) (range 5)) nil))
-(assert (= (some = [1 2 3 4 5] [5 4 3 2 1]) true))
-
-(assert (= (all = (range 5) (range 5)) true))
-(assert (= (all not= [1 2 3 4 5] [5 4 3 2 1]) false))
-
-(assert (= false (deep-not= [1] [1])) "issue #1149")
-
-# Sort function
-(assert (deep=
-          (range 99)
-          (sort (mapcat (fn [[x y z]] [z y x]) (partition 3 (range 99))))) "sort 5")
-(assert (<= ;(sort (map (fn [x] (math/random)) (range 1000)))) "sort 6")
-
-# And and or
-
-(assert (= (and true true) true) "and true true")
-(assert (= (and true false) false) "and true false")
-(assert (= (and false true) false) "and false true")
-(assert (= (and true true true) true) "and true true true")
-(assert (= (and 0 1 2) 2) "and 0 1 2")
-(assert (= (and 0 1 nil) nil) "and 0 1 nil")
-(assert (= (and 1) 1) "and 1")
-(assert (= (and) true) "and with no arguments")
-(assert (= (and 1 true) true) "and with trailing true")
-(assert (= (and 1 true 2) 2) "and with internal true")
-
-(assert (= (or true true) true) "or true true")
-(assert (= (or true false) true) "or true false")
-(assert (= (or false true) true) "or false true")
-(assert (= (or false false) false) "or false true")
-(assert (= (or true true false) true) "or true true false")
-(assert (= (or 0 1 2) 0) "or 0 1 2")
-(assert (= (or nil 1 2) 1) "or nil 1 2")
-(assert (= (or 1) 1) "or 1")
-(assert (= (or) nil) "or with no arguments")
-
-(def yielder
-  (coro
-    (defer (yield :end)
-      (repeat 5 (yield :item)))))
-(def items (seq [x :in yielder] x))
-(assert (deep= @[:item :item :item :item :item :end] items) "yield within nested fibers")
-
-(end-suite)

test/suite0003.janet

@@ -1,497 +0,0 @@
-# Copyright (c) 2023 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 3)
-
-(assert (= (length (range 10)) 10) "(range 10)")
-(assert (= (length (range 1 10)) 9) "(range 1 10)")
-(assert (deep= @{:a 1 :b 2 :c 3} (zipcoll '[:a :b :c] '[1 2 3])) "zipcoll")
-
-(def- a 100)
-(assert (= a 100) "def-")
-
-(assert (= :first
-          (match @[1 3 5]
-                 @[x y z] :first
-                 :second)) "match 1")
-
-(def val1 :avalue)
-(assert (= :second
-          (match val1
-                 @[x y z] :first
-                 :avalue :second
-                 :third)) "match 2")
-
-(assert (= 100
-           (match @[50 40]
-                  @[x x] (* x 3)
-                  @[x y] (+ x y 10)
-                  0)) "match 3")
-
-# Edge case should cause old compilers to fail due to
-# if statement optimization
-(var var-a 1)
-(var var-b (if false 2 (string "hello")))
-
-(assert (= var-b "hello") "regression 1")
-
-# Scan number
-
-(assert (= 1 (scan-number "1")) "scan-number 1")
-(assert (= -1 (scan-number "-1")) "scan-number -1")
-(assert (= 1.3e4 (scan-number "1.3e4")) "scan-number 1.3e4")
-
-# Some macros
-
-(assert (= 2 (if-not 1 3 2)) "if-not 1")
-(assert (= 3 (if-not false 3)) "if-not 2")
-(assert (= 3 (if-not nil 3 2)) "if-not 3")
-(assert (= nil (if-not true 3)) "if-not 4")
-
-(assert (= 4 (unless false (+ 1 2 3) 4)) "unless")
-
-(def res @{})
-(loop [[k v] :pairs @{1 2 3 4 5 6}]
-  (put res k v))
-(assert (and
-          (= (get res 1) 2)
-          (= (get res 3) 4)
-          (= (get res 5) 6)) "loop :pairs")
-
-# Another regression test - no segfaults
-(defn afn [x] x)
-(var afn-var afn)
-(var identity-var identity)
-(var map-var map)
-(var not-var not)
-(assert (= 1 (try (afn-var) ([err] 1))) "bad arity 1")
-(assert (= 4 (try ((fn [x y] (+ x y)) 1) ([_] 4))) "bad arity 2")
-(assert (= 1 (try (identity-var) ([err] 1))) "bad arity 3")
-(assert (= 1 (try (map-var) ([err] 1))) "bad arity 4")
-(assert (= 1 (try (not-var) ([err] 1))) "bad arity 5")
-
-# Assembly test
-# Fibonacci sequence, implemented with naive recursion.
-(def fibasm (asm '{
-  :arity 1
-  :bytecode [
-    (ltim 1 0 0x2)      # $1 = $0 < 2
-    (jmpif 1 :done)     # if ($1) goto :done
-    (lds 1)             # $1 = self
-    (addim 0 0 -0x1)    # $0 = $0 - 1
-    (push 0)            # push($0), push argument for next function call
-    (call 2 1)          # $2 = call($1)
-    (addim 0 0 -0x1)    # $0 = $0 - 1
-    (push 0)            # push($0)
-    (call 0 1)          # $0 = call($1)
-    (add 0 0 2)        # $0 = $0 + $2 (integers)
-    :done
-    (ret 0)             # return $0
-  ]
-}))
-
-(assert (= 0 (fibasm 0)) "fibasm 1")
-(assert (= 1 (fibasm 1)) "fibasm 2")
-(assert (= 55 (fibasm 10)) "fibasm 3")
-(assert (= 6765 (fibasm 20)) "fibasm 4")
-
-# Calling non functions
-
-(assert (= 1 ({:ok 1} :ok)) "calling struct")
-(assert (= 2 (@{:ok 2} :ok)) "calling table")
-(assert (= :bad (try ((identity @{:ok 2}) :ok :no) ([err] :bad))) "calling table too many arguments")
-(assert (= :bad (try ((identity :ok) @{:ok 2} :no) ([err] :bad))) "calling keyword too many arguments")
-(assert (= :oops (try ((+ 2 -1) 1) ([err] :oops))) "calling number fails")
-
-# Method test
-
-(def Dog @{:bark (fn bark [self what] (string (self :name) " says " what "!"))})
-(defn make-dog
-  [name]
-  (table/setproto @{:name name} Dog))
-
-(assert (= "fido" ((make-dog "fido") :name)) "oo 1")
-(def spot (make-dog "spot"))
-(assert (= "spot says hi!" (:bark spot "hi")) "oo 2")
-
-# Negative tests
-
-(assert-error "+ check types" (+ 1 ()))
-(assert-error "- check types" (- 1 ()))
-(assert-error "* check types" (* 1 ()))
-(assert-error "/ check types" (/ 1 ()))
-(assert-error "band check types" (band 1 ()))
-(assert-error "bor check types" (bor 1 ()))
-(assert-error "bxor check types" (bxor 1 ()))
-(assert-error "bnot check types" (bnot ()))
-
-# Buffer blitting
-
-(def b (buffer/new-filled 100))
-(buffer/bit-set b 100)
-(buffer/bit-clear b 100)
-(assert (zero? (sum b)) "buffer bit set and clear")
-(buffer/bit-toggle b 101)
-(assert (= 32 (sum b)) "buffer bit set and clear")
-
-(def b2 @"hello world")
-
-(buffer/blit b2 "joyto ")
-(assert (= (string b2) "joyto world") "buffer/blit 1")
-
-(buffer/blit b2 "joyto" 6)
-(assert (= (string b2) "joyto joyto") "buffer/blit 2")
-
-(buffer/blit b2 "abcdefg" 5 6)
-(assert (= (string b2) "joytogjoyto") "buffer/blit 3")
-
-# Buffer self blitting, check for use after free
-(def buf1 @"1234567890")
-(buffer/blit buf1 buf1 -1)
-(buffer/blit buf1 buf1 -1)
-(buffer/blit buf1 buf1 -1)
-(buffer/blit buf1 buf1 -1)
-(assert (= (string buf1) (string/repeat "1234567890" 16)) "buffer blit against self")
-
-# Buffer push word
-
-(def b3 @"")
-(buffer/push-word b3 0xFF 0x11)
-(assert (= 8 (length b3)) "buffer/push-word 1")
-(assert (= "\xFF\0\0\0\x11\0\0\0" (string b3)) "buffer/push-word 2")
-(buffer/clear b3)
-(buffer/push-word b3 0xFFFFFFFF 0x1100)
-(assert (= 8 (length b3)) "buffer/push-word 3")
-(assert (= "\xFF\xFF\xFF\xFF\0\x11\0\0" (string b3)) "buffer/push-word 4")
-
-# Buffer push string
-
-(def b4 (buffer/new-filled 10 0))
-(buffer/push-string b4 b4)
-(assert (= "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" (string b4)) "buffer/push-buffer 1")
-(def b5 @"123")
-(buffer/push-string b5 "456" @"789")
-(assert (= "123456789" (string b5)) "buffer/push-buffer 2")
-
-# Check for bugs with printing self with buffer/format
-
-(def buftemp @"abcd")
-(assert (= (string (buffer/format buftemp "---%p---" buftemp)) `abcd---@"abcd"---`) "buffer/format on self 1")
-(def buftemp @"abcd")
-(assert (= (string (buffer/format buftemp "---%p %p---" buftemp buftemp)) `abcd---@"abcd" @"abcd"---`) "buffer/format on self 2")
-
-# Peg
-
-(defn check-match
-  [pat text should-match]
-  (def result (peg/match pat text))
-  (assert (= (not should-match) (not result)) (string "check-match " text)))
-
-(defn check-deep
-  [pat text what]
-  (def result (peg/match pat text))
-  (assert (deep= result what) (string "check-deep " text)))
-
-# Just numbers
-
-(check-match '(* 4 -1) "abcd" true)
-(check-match '(* 4 -1) "abc" false)
-(check-match '(* 4 -1) "abcde" false)
-
-# Simple pattern
-
-(check-match '(* (some (range "az" "AZ")) -1) "hello" true)
-(check-match '(* (some (range "az" "AZ")) -1) "hello world" false)
-(check-match '(* (some (range "az" "AZ")) -1) "1he11o" false)
-(check-match '(* (some (range "az" "AZ")) -1) "" false)
-
-# Pre compile
-
-(def pegleg (peg/compile '{:item "abc" :main (* :item "," :item -1)}))
-
-(peg/match pegleg "abc,abc")
-
-# Bad Grammars
-
-(assert-error "peg/compile error 1" (peg/compile nil))
-(assert-error "peg/compile error 2" (peg/compile @{}))
-(assert-error "peg/compile error 3" (peg/compile '{:a "abc" :b "def"}))
-(assert-error "peg/compile error 4" (peg/compile '(blarg "abc")))
-(assert-error "peg/compile error 5" (peg/compile '(1 2 3)))
-
-# IP address
-
-(def ip-address
-  '{:d (range "09")
-    :0-4 (range "04")
-    :0-5 (range "05")
-    :byte (+
-            (* "25" :0-5)
-            (* "2" :0-4 :d)
-            (* "1" :d :d)
-            (between 1 2 :d))
-    :main (* :byte "." :byte "." :byte "." :byte)})
-
-(check-match ip-address "10.240.250.250" true)
-(check-match ip-address "0.0.0.0" true)
-(check-match ip-address "1.2.3.4" true)
-(check-match ip-address "256.2.3.4" false)
-(check-match ip-address "256.2.3.2514" false)
-
-# Substitution test with peg
-
-(file/flush stderr)
-(file/flush stdout)
-
-(def grammar '(accumulate (any (+ (/ "dog" "purple panda") (<- 1)))))
-(defn try-grammar [text]
-  (assert (= (string/replace-all "dog" "purple panda" text) (0 (peg/match grammar text))) text))
-
-(try-grammar "i have a dog called doug the dog. he is good.")
-(try-grammar "i have a dog called doug the dog. he is a good boy.")
-(try-grammar "i have a dog called doug the do")
-(try-grammar "i have a dog called doug the dog")
-(try-grammar "i have a dog called doug the dogg")
-(try-grammar "i have a dog called doug the doggg")
-(try-grammar "i have a dog called doug the dogggg")
-
-# Peg CSV test
-
-(def csv
-  '{:field (+
-            (* `"` (% (any (+ (<- (if-not `"` 1)) (* (constant `"`) `""`)))) `"`)
-            (<- (any (if-not (set ",\n") 1))))
-    :main (* :field (any (* "," :field)) (+ "\n" -1))})
-
-(defn check-csv
-  [str res]
-  (check-deep csv str res))
-
-(check-csv "1,2,3" @["1" "2" "3"])
-(check-csv "1,\"2\",3" @["1" "2" "3"])
-(check-csv ``1,"1""",3`` @["1" "1\"" "3"])
-
-# Nested Captures
-
-(def grmr '(capture (* (capture "a") (capture 1) (capture "c"))))
-(check-deep grmr "abc" @["a" "b" "c" "abc"])
-(check-deep grmr "acc" @["a" "c" "c" "acc"])
-
-# Functions in grammar
-
-(def grmr-triple ~(% (any (/ (<- 1) ,(fn [x] (string x x x))))))
-(check-deep grmr-triple "abc" @["aaabbbccc"])
-(check-deep grmr-triple "" @[""])
-(check-deep grmr-triple " " @["   "])
-
-(def counter ~(/ (group (any (<- 1))) ,length))
-(check-deep counter "abcdefg" @[7])
-
-# Capture Backtracking
-
-(check-deep '(+ (* (capture "c") "d") "ce") "ce" @[])
-
-# Matchtime capture
-
-(def scanner (peg/compile ~(cmt (capture (some 1)) ,scan-number)))
-
-(check-deep scanner "123" @[123])
-(check-deep scanner "0x86" @[0x86])
-(check-deep scanner "-1.3e-7" @[-1.3e-7])
-(check-deep scanner "123A" nil)
-
-# Recursive grammars
-
-(def g '{:main (+ (* "a" :main "b") "c")})
-
-(check-match g "c" true)
-(check-match g "acb" true)
-(check-match g "aacbb" true)
-(check-match g "aadbb" false)
-
-# Back reference
-
-(def wrapped-string
-  ~{:pad (any "=")
-    :open (* "[" (<- :pad :n) "[")
-    :close (* "]" (cmt (* (-> :n) (<- :pad)) ,=) "]")
-    :main (* :open (any (if-not :close 1)) :close -1)})
-
-(check-match wrapped-string "[[]]" true)
-(check-match wrapped-string "[==[a]==]" true)
-(check-match wrapped-string "[==[]===]" false)
-(check-match wrapped-string "[[blark]]" true)
-(check-match wrapped-string "[[bl[ark]]" true)
-(check-match wrapped-string "[[bl]rk]]" true)
-(check-match wrapped-string "[[bl]rk]] " false)
-(check-match wrapped-string "[=[bl]]rk]=] " false)
-(check-match wrapped-string "[=[bl]==]rk]=] " false)
-(check-match wrapped-string "[===[]==]===]" true)
-
-(def janet-longstring
-  ~{:delim (some "`")
-    :open (capture :delim :n)
-    :close (cmt (* (not (> -1 "`")) (-> :n) (<- (backmatch :n))) ,=)
-    :main (* :open (any (if-not :close 1)) :close -1)})
-
-(check-match janet-longstring "`john" false)
-(check-match janet-longstring "abc" false)
-(check-match janet-longstring "` `" true)
-(check-match janet-longstring "`  `" true)
-(check-match janet-longstring "``  ``" true)
-(check-match janet-longstring "``` `` ```" true)
-(check-match janet-longstring "``  ```" false)
-(check-match janet-longstring "`a``b`" false)
-
-# Line and column capture
-
-(def line-col (peg/compile '(any (* (line) (column) 1))))
-(check-deep line-col "abcd" @[1 1 1 2 1 3 1 4])
-(check-deep line-col "" @[])
-(check-deep line-col "abcd\n" @[1 1 1 2 1 3 1 4 1 5])
-(check-deep line-col "abcd\nz" @[1 1 1 2 1 3 1 4 1 5 2 1])
-
-# Backmatch
-
-(def backmatcher-1 '(* (capture (any "x") :1) "y" (backmatch :1) -1))
-
-(check-match backmatcher-1 "y" true)
-(check-match backmatcher-1 "xyx" true)
-(check-match backmatcher-1 "xxxxxxxyxxxxxxx" true)
-(check-match backmatcher-1 "xyxx" false)
-(check-match backmatcher-1 "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxy" false)
-(check-match backmatcher-1 (string (string/repeat "x" 10000) "y") false)
-(check-match backmatcher-1 (string (string/repeat "x" 10000) "y" (string/repeat "x" 10000)) true)
-
-(def backmatcher-2 '(* '(any "x") "y" (backmatch) -1))
-
-(check-match backmatcher-2 "y" true)
-(check-match backmatcher-2 "xyx" true)
-(check-match backmatcher-2 "xxxxxxxyxxxxxxx" true)
-(check-match backmatcher-2 "xyxx" false)
-(check-match backmatcher-2 "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxy" false)
-(check-match backmatcher-2 (string (string/repeat "x" 10000) "y") false)
-(check-match backmatcher-2 (string (string/repeat "x" 10000) "y" (string/repeat "x" 10000)) true)
-
-(def longstring-2 '(* '(some "`") (some (if-not (backmatch) 1)) (backmatch) -1))
-
-(check-match longstring-2 "`john" false)
-(check-match longstring-2 "abc" false)
-(check-match longstring-2 "` `" true)
-(check-match longstring-2 "`  `" true)
-(check-match longstring-2 "``  ``" true)
-(check-match longstring-2 "``` `` ```" true)
-(check-match longstring-2 "``  ```" false)
-
-# Optional
-
-(check-match '(* (opt "hi") -1) "" true)
-(check-match '(* (opt "hi") -1) "hi" true)
-(check-match '(* (opt "hi") -1) "no" false)
-(check-match '(* (? "hi") -1) "" true)
-(check-match '(* (? "hi") -1) "hi" true)
-(check-match '(* (? "hi") -1) "no" false)
-
-# Drop
-
-(check-deep '(drop '"hello") "hello" @[])
-(check-deep '(drop "hello") "hello" @[])
-
-# Regression #24
-
-(def t (put @{} :hi 1))
-(assert (deep= t @{:hi 1}) "regression #24")
-
-# Peg swallowing errors
-(assert (try (peg/match ~(/ '1 ,(fn [x] (nil x))) "x") ([err] err))
-        "errors should not be swallowed")
-(assert (try ((fn [x] (nil x))) ([err] err))
-        "errors should not be swallowed 2")
-
-# Tuple types
-
-(assert (= (tuple/type '(1 2 3)) :parens) "normal tuple")
-(assert (= (tuple/type [1 2 3]) :parens) "normal tuple 1")
-(assert (= (tuple/type '[1 2 3]) :brackets) "bracketed tuple 2")
-(assert (= (tuple/type (-> '(1 2 3) marshal unmarshal)) :parens) "normal tuple marshalled/unmarshalled")
-(assert (= (tuple/type (-> '[1 2 3] marshal unmarshal)) :brackets) "normal tuple marshalled/unmarshalled")
-
-# Check for bad memoization (+ :a) should mean different things in different contexts.
-(def redef-a
-  ~{:a "abc"
-    :c (+ :a)
-    :main (* :c {:a "def" :main (+ :a)} -1)})
-
-(check-match redef-a "abcdef" true)
-(check-match redef-a "abcabc" false)
-(check-match redef-a "defdef" false)
-
-(def redef-b
-  ~{:pork {:pork "beef" :main (+ -1 (* 1 :pork))}
-    :main :pork})
-
-(check-match redef-b "abeef" true)
-(check-match redef-b "aabeef" false)
-(check-match redef-b "aaaaaa" false)
-
-# Integer parsing
-
-(check-deep '(int 1) "a" @[(chr "a")])
-(check-deep '(uint 1) "a" @[(chr "a")])
-(check-deep '(int-be 1) "a" @[(chr "a")])
-(check-deep '(uint-be 1) "a" @[(chr "a")])
-(check-deep '(int 1) "\xFF" @[-1])
-(check-deep '(uint 1) "\xFF" @[255])
-(check-deep '(int-be 1) "\xFF" @[-1])
-(check-deep '(uint-be 1) "\xFF" @[255])
-(check-deep '(int 2) "\xFF\x7f" @[0x7fff])
-(check-deep '(int-be 2) "\x7f\xff" @[0x7fff])
-(check-deep '(uint 2) "\xff\x7f" @[0x7fff])
-(check-deep '(uint-be 2) "\x7f\xff" @[0x7fff])
-(check-deep '(uint-be 2) "\x7f\xff" @[0x7fff])
-(check-deep '(uint 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" @[(int/u64 0x7fff)])
-(check-deep '(int 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" @[(int/s64 0x7fff)])
-(check-deep '(uint 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(int/u64 0x7fff)])
-(check-deep '(int 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(int/s64 0x7fff)])
-
-(check-deep '(* (int 2) -1) "123" nil)
-
-# to/thru bug
-(check-deep '(to -1) "aaaa" @[])
-(check-deep '(thru -1) "aaaa" @[])
-(check-deep ''(to -1) "aaaa" @["aaaa"])
-(check-deep ''(thru -1) "aaaa" @["aaaa"])
-(check-deep '(to "b") "aaaa" nil)
-(check-deep '(thru "b") "aaaa" nil)
-
-# unref
-(def grammar
-  (peg/compile
-    ~{:main (* :tagged -1)
-      :tagged (unref (replace (* :open-tag :value :close-tag) ,struct))
-      :open-tag (* (constant :tag) "<" (capture :w+ :tag-name) ">")
-      :value (* (constant :value) (group (any (+ :tagged :untagged))))
-      :close-tag (* "</" (backmatch :tag-name) ">")
-      :untagged (capture (any (if-not "<" 1)))}))
-(check-deep grammar "<p><em>foobar</em></p>" @[{:tag "p" :value @[{:tag "em" :value @["foobar"]}]}])
-(check-deep grammar "<p>foobar</p>" @[{:tag "p" :value @["foobar"]}])
-
-(end-suite)

test/suite0004.janet

@@ -1,86 +0,0 @@
-# Copyright (c) 2023 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 4)
-# some tests for string/format and buffer/format
-
-(assert (= (string (buffer/format @"" "pi = %6.3f" math/pi)) "pi =  3.142") "%6.3f")
-(assert (= (string (buffer/format @"" "pi = %+6.3f" math/pi)) "pi = +3.142") "%6.3f")
-(assert (= (string (buffer/format @"" "pi = %40.20g" math/pi)) "pi =                     3.141592653589793116") "%6.3f")
-
-(assert (= (string (buffer/format @"" "🐼 = %6.3f" math/pi)) "🐼 =  3.142") "UTF-8")
-(assert (= (string (buffer/format @"" "π = %.8g" math/pi)) "π = 3.1415927") "π")
-(assert (= (string (buffer/format @"" "\xCF\x80 = %.8g" math/pi)) "\xCF\x80 = 3.1415927") "\xCF\x80")
-
-(assert (= (string/format "pi = %6.3f" math/pi) "pi =  3.142") "%6.3f")
-(assert (= (string/format "pi = %+6.3f" math/pi) "pi = +3.142") "%6.3f")
-(assert (= (string/format "pi = %40.20g" math/pi) "pi =                     3.141592653589793116") "%6.3f")
-
-(assert (= (string/format "🐼 = %6.3f" math/pi) "🐼 =  3.142") "UTF-8")
-(assert (= (string/format "π = %.8g" math/pi) "π = 3.1415927") "π")
-(assert (= (string/format "\xCF\x80 = %.8g" math/pi) "\xCF\x80 = 3.1415927") "\xCF\x80")
-
-# Range
-(assert (deep= (range 10) @[0 1 2 3 4 5 6 7 8 9]) "range 1 argument")
-(assert (deep= (range 5 10) @[5 6 7 8 9]) "range 2 arguments")
-(assert (deep= (range 5 10 2) @[5 7 9]) "range 3 arguments")
-
-# More marshalling code
-
-(defn check-image
-  "Run a marshaling test using the make-image and load-image functions."
-  [x msg]
-  (def im (make-image x))
-  # (printf "\nimage-hash: %d" (-> im string hash))
-  (assert-no-error msg (load-image im)))
-
-(check-image (fn [] (fn [] 1)) "marshal nested functions")
-(check-image (fiber/new (fn [] (fn [] 1))) "marshal nested functions in fiber")
-(check-image (fiber/new (fn [] (fiber/new (fn [] 1)))) "marshal nested fibers")
-
-(def issue-53-x 
-  (fiber/new 
-    (fn [] 
-      (var y (fiber/new (fn [] (print "1") (yield) (print "2")))))))
-
-(check-image issue-53-x "issue 53 regression")
-
-# Bracket tuple issue
-
-(def do 3)
-(assert (= [3 1 2 3] [do 1 2 3]) "bracket tuples are never special forms")
-(assert (= ~(,defn 1 2 3) [defn 1 2 3]) "bracket tuples are never macros")
-(assert (= ~(,+ 1 2 3) [+ 1 2 3]) "bracket tuples are never function calls")
-
-# Metadata
-
-(def foo-with-tags :a-tag :bar)
-(assert (get (dyn 'foo-with-tags) :a-tag) "extra keywords in def are metadata tags")
-
-(def foo-with-meta {:baz :quux} :bar)
-(assert (= :quux (get (dyn 'foo-with-meta) :baz)) "extra struct in def is metadata")
-
-(defn foo-fn-with-meta {:baz :quux} "This is a function" [x] (identity x))
-(assert (= :quux (get (dyn 'foo-fn-with-meta) :baz)) "extra struct in defn is metadata")
-(assert (= "(foo-fn-with-meta x)\n\nThis is a function" (get (dyn 'foo-fn-with-meta) :doc)) "extra string in defn is docstring")
-
-(end-suite)
-

test/suite0005.janet

@@ -1,120 +0,0 @@
-# Copyright (c) 2023 Calvin Rose & contributors
-#
-# 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 5)
-
-# Array remove
-
-(assert (deep= (array/remove @[1 2 3 4 5] 2) @[1 2 4 5]) "array/remove 1")
-(assert (deep= (array/remove @[1 2 3 4 5] 2 2) @[1 2 5]) "array/remove 2")
-(assert (deep= (array/remove @[1 2 3 4 5] 2 200) @[1 2]) "array/remove 3")
-(assert (deep= (array/remove @[1 2 3 4 5] -3 200) @[1 2 3]) "array/remove 4")
-
-# Break
-
-(var summation 0)
-(for i 0 10
-  (+= summation i)
-  (if (= i 7) (break)))
-(assert (= summation 28) "break 1")
-
-(assert (= nil ((fn [] (break) 4))) "break 2")
-
-# Break with value
-
-# Shouldn't error out
-(assert-no-error "break 3" (for i 0 10 (if (> i 8) (break i))))
-(assert-no-error "break 4" ((fn [i] (if (> i 8) (break i))) 100))
-
-# take
-
-(assert (deep= (take 0 []) []) "take 1")
-(assert (deep= (take 10 []) []) "take 2")
-(assert (deep= (take 0 [1 2 3 4 5]) []) "take 3")
-(assert (deep= (take 10 [1 2 3]) [1 2 3]) "take 4")
-(assert (deep= (take -1 [:a :b :c]) []) "take 5")
-(assert (deep= (take 3 (generate [x :in [1 2 3 4 5]] x)) @[1 2 3]) "take from fiber")
-# NB: repeatedly resuming a fiber created with `generate` includes a `nil` as
-# the final element. Thus a generate of 2 elements will create an array of 3.
-(assert (= (length (take 4 (generate [x :in [1 2]] x))) 2) "take from short fiber")
-
-# take-until
-
-(assert (deep= (take-until pos? @[]) []) "take-until 1")
-(assert (deep= (take-until pos? @[1 2 3]) []) "take-until 2")
-(assert (deep= (take-until pos? @[-1 -2 -3]) [-1 -2 -3]) "take-until 3")
-(assert (deep= (take-until pos? @[-1 -2 3]) [-1 -2]) "take-until 4")
-(assert (deep= (take-until pos? @[-1 1 -2]) [-1]) "take-until 5")
-(assert (deep= (take-until |(= $ 115) "books") "book") "take-until 6")
-(assert (deep= (take-until |(= $ 115) (generate [x :in "books"] x))
-               @[98 111 111 107]) "take-until from fiber")
-
-# take-while
-
-(assert (deep= (take-while neg? @[]) []) "take-while 1")
-(assert (deep= (take-while neg? @[1 2 3]) []) "take-while 2")
-(assert (deep= (take-while neg? @[-1 -2 -3]) [-1 -2 -3]) "take-while 3")
-(assert (deep= (take-while neg? @[-1 -2 3]) [-1 -2]) "take-while 4")
-(assert (deep= (take-while neg? @[-1 1 -2]) [-1]) "take-while 5")
-(assert (deep= (take-while neg? (generate [x :in  @[-1 1 -2]] x))
-               @[-1]) "take-while from fiber")
-
-# drop
-
-(assert (deep= (drop 0 []) []) "drop 1")
-(assert (deep= (drop 10 []) []) "drop 2")
-(assert (deep= (drop 0 [1 2 3 4 5]) [1 2 3 4 5]) "drop 3")
-(assert (deep= (drop 10 [1 2 3]) []) "drop 4")
-(assert (deep= (drop -1 [1 2 3]) [1 2]) "drop 5")
-(assert (deep= (drop -10 [1 2 3]) []) "drop 6")
-(assert (deep= (drop 1 "abc") "bc") "drop 7")
-(assert (deep= (drop 10 "abc") "") "drop 8")
-(assert (deep= (drop -1 "abc") "ab") "drop 9")
-(assert (deep= (drop -10 "abc") "") "drop 10")
-(assert-error :invalid-type (drop 3 {}) "drop 11")
-
-# drop-until
-
-(assert (deep= (drop-until pos? @[]) []) "drop-until 1")
-(assert (deep= (drop-until pos? @[1 2 3]) [1 2 3]) "drop-until 2")
-(assert (deep= (drop-until pos? @[-1 -2 -3]) []) "drop-until 3")
-(assert (deep= (drop-until pos? @[-1 -2 3]) [3]) "drop-until 4")
-(assert (deep= (drop-until pos? @[-1 1 -2]) [1 -2]) "drop-until 5")
-(assert (deep= (drop-until |(= $ 115) "books") "s") "drop-until 6")
-
-# Quasiquote bracketed tuples
-(assert (= (tuple/type ~[1 2 3]) (tuple/type '[1 2 3])) "quasiquote bracket tuples")
-
-# No useless splices
-(check-compile-error '((splice [1 2 3]) 0))
-(check-compile-error '(if ;[1 2] 5))
-(check-compile-error '(while ;[1 2 3] (print :hi)))
-(check-compile-error '(def x ;[1 2 3]))
-(check-compile-error '(fn [x] ;[x 1 2 3]))
-
-# No splice propagation
-(check-compile-error '(+ 1 (do ;[2 3 4]) 5))
-(check-compile-error '(+ 1 (upscope ;[2 3 4]) 5))
-# compiler inlines when condition is constant, ensure that optimization doesn't break
-(check-compile-error '(+ 1 (if true ;[3 4])))
-(check-compile-error '(+ 1 (if false nil ;[3 4])))
-
-(end-suite)

test/suite0006.janet

@@ -1,272 +0,0 @@
-# Copyright (c) 2023 Calvin Rose & contributors
-#
-# 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 6)
-
-# some tests for bigint
-
-(def i64 int/s64)
-(def u64 int/u64)
-
-(assert-no-error
- "create some uint64 bigints"
- (do
-   # from number
-   (def a (u64 10))
-   # max double we can convert to int (2^53)
-   (def b (u64 0x1fffffffffffff))
-   (def b (u64 (math/pow 2 53)))
-   # from string
-   (def c (u64 "0xffff_ffff_ffff_ffff"))
-   (def c (u64 "32rvv_vv_vv_vv"))
-   (def d (u64 "123456789"))))
-
-# Conversion back to an int32
-(assert (= (int/to-number (u64 0xFaFa)) 0xFaFa))
-(assert (= (int/to-number (i64 0xFaFa)) 0xFaFa))
-(assert (= (int/to-number (u64 9007199254740991)) 9007199254740991))
-(assert (= (int/to-number (i64 9007199254740991)) 9007199254740991))
-(assert (= (int/to-number (i64 -9007199254740991)) -9007199254740991))
-
-(assert-error
-  "u64 out of bounds for safe integer"
-  (int/to-number (u64 "9007199254740993"))
-
-(assert-error
-  "s64 out of bounds for safe integer"
-  (int/to-number (i64 "-9007199254740993"))))
-
-(assert-error
-  "int/to-number fails on non-abstract types"
-  (int/to-number 1))
-
-(assert-no-error
- "create some int64 bigints"
- (do
-   # from number
-   (def a (i64 -10))
-   # max double we can convert to int (2^53)
-   (def b (i64 0x1fffffffffffff))
-   (def b (i64 (math/pow 2 53)))
-   # from string
-   (def c (i64 "0x7fff_ffff_ffff_ffff"))
-   (def d (i64 "123456789"))))
-
-(assert-error
- "bad initializers"
- (do
-   # double to big to be converted to uint64 without truncation (2^53 + 1)
-   (def b (u64 (+ 0xffff_ffff_ffff_ff 1)))
-   (def b (u64 (+ (math/pow 2 53) 1)))
-   # out of range 65 bits
-   (def c (u64 "0x1ffffffffffffffff"))
-   # just to big
-   (def d (u64 "123456789123456789123456789"))))
-
-(assert (= (:/ (u64 "0xffff_ffff_ffff_ffff") 8 2) (u64 "0xfffffffffffffff")) "bigint operations 1")
-(assert (let [a (u64 0xff)] (= (:+ a a a a) (:* a 2 2))) "bigint operations 2")
-
-(assert (= (string (i64 -123)) "-123") "i64 prints reasonably")
-(assert (= (string (u64 123)) "123") "u64 prints reasonably")
-
-(assert-error
- "trap INT64_MIN / -1"
- (:/ (int/s64 "-0x8000_0000_0000_0000") -1))
-
-# int/s64 and int/u64 serialization
-(assert (deep= (int/to-bytes (u64 0)) @"\x00\x00\x00\x00\x00\x00\x00\x00"))
-
-(assert (deep= (int/to-bytes (i64 1) :le) @"\x01\x00\x00\x00\x00\x00\x00\x00"))
-(assert (deep= (int/to-bytes (i64 1) :be) @"\x00\x00\x00\x00\x00\x00\x00\x01"))
-(assert (deep= (int/to-bytes (i64 -1)) @"\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF"))
-(assert (deep= (int/to-bytes (i64 -5) :be) @"\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFB"))
-
-(assert (deep= (int/to-bytes (u64 1) :le) @"\x01\x00\x00\x00\x00\x00\x00\x00"))
-(assert (deep= (int/to-bytes (u64 1) :be) @"\x00\x00\x00\x00\x00\x00\x00\x01"))
-(assert (deep= (int/to-bytes (u64 300) :be) @"\x00\x00\x00\x00\x00\x00\x01\x2C"))
-
-# int/s64 int/u64 to existing buffer
-(let [buf1 @""
-      buf2 @"abcd"]
-  (assert (deep= (int/to-bytes (i64 1) :le buf1) @"\x01\x00\x00\x00\x00\x00\x00\x00"))
-  (assert (deep= buf1 @"\x01\x00\x00\x00\x00\x00\x00\x00"))
-  (assert (deep= (int/to-bytes (u64 300) :be buf2) @"abcd\x00\x00\x00\x00\x00\x00\x01\x2C")))
-
-# int/s64 and int/u64 paramater type checking
-(assert-error
- "bad value passed to int/to-bytes"
- (int/to-bytes 1))
-
-(assert-error
-  "invalid endianness passed to int/to-bytes"
-   (int/to-bytes (u64 0) :little))
-
-(assert-error
-  "invalid buffer passed to int/to-bytes"
-   (int/to-bytes (u64 0) :little :buffer))
-
-
-# Dynamic bindings
-(setdyn :a 10)
-(assert (= 40 (with-dyns [:a 25 :b 15] (+ (dyn :a) (dyn :b)))) "dyn usage 1")
-(assert (= 10 (dyn :a)) "dyn usage 2")
-(assert (= nil (dyn :b)) "dyn usage 3")
-(setdyn :a 100)
-(assert (= 100 (dyn :a)) "dyn usage 4")
-
-# Keyword arguments
-(defn myfn [x y z &keys {:a a :b b :c c}]
-  (+ x y z a b c))
-
-(assert (= (+ ;(range 6)) (myfn 0 1 2 :a 3 :b 4 :c 5)) "keyword args 1")
-(assert (= (+ ;(range 6)) (myfn 0 1 2 :a 1 :b 6 :c 5 :d 11)) "keyword args 2")
-
-# Comment macro
-(comment 1)
-(comment 1 2)
-(comment 1 2 3)
-(comment 1 2 3 4)
-
-# Parser clone
-(def p (parser/new))
-(assert (= 7 (parser/consume p "(1 2 3 ")) "parser 1")
-(def p2 (parser/clone p))
-(parser/consume p2 ") 1 ")
-(parser/consume p ") 1 ")
-(assert (deep= (parser/status p) (parser/status p2)) "parser 2")
-(assert (deep= (parser/state p) (parser/state p2)) "parser 3")
-
-# Parser errors
-(defn parse-error [input]
-  (def p (parser/new))
-  (parser/consume p input)
-  (parser/error p))
-
-# Invalid utf-8 sequences
-(assert (not= nil (parse-error @"\xc3\x28")) "reject invalid utf-8 symbol")
-(assert (not= nil (parse-error @":\xc3\x28")) "reject invalid utf-8 keyword")
-
-# Parser line and column numbers
-(defn parser-location [input &opt location]
-  (def p (parser/new))
-  (parser/consume p input)
-  (if location
-    (parser/where p ;location)
-    (parser/where p)))
-
-(assert (= [1 7] (parser-location @"(+ 1 2)")) "parser location 1")
-(assert (= [5 7] (parser-location @"(+ 1 2)" [5])) "parser location 2")
-(assert (= [10 10] (parser-location @"(+ 1 2)" [10 10])) "parser location 3")
-
-# String check-set
-(assert (string/check-set "abc" "a") "string/check-set 1")
-(assert (not (string/check-set "abc" "z")) "string/check-set 2")
-(assert (string/check-set "abc" "abc") "string/check-set 3")
-(assert (string/check-set "abc" "") "string/check-set 4")
-(assert (not (string/check-set "" "aabc")) "string/check-set 5")
-(assert (not (string/check-set "abc" "abcdefg")) "string/check-set 6")
-
-# Marshal and unmarshal pegs
-(def p (-> "abcd" peg/compile marshal unmarshal))
-(assert (peg/match p "abcd") "peg marshal 1")
-(assert (peg/match p "abcdefg") "peg marshal 2")
-(assert (not (peg/match p "zabcdefg")) "peg marshal 3")
-
-# This should be valgrind clean.
-(var pegi 3)
-(defn marshpeg [p]
-  (assert (-> p peg/compile marshal unmarshal) (string "peg marshal " (++ pegi))))
-(marshpeg '(* 1 2 (set "abcd") "asdasd" (+ "." 3)))
-(marshpeg '(% (* (+ 1 2 3) (* "drop" "bear") '"hi")))
-(marshpeg '(> 123 "abcd"))
-(marshpeg '{:main (* 1 "hello" :main)})
-(marshpeg '(range "AZ"))
-(marshpeg '(if-not "abcdf" 123))
-(marshpeg '(error ($)))
-(marshpeg '(* "abcd" (constant :hi)))
-(marshpeg ~(/ "abc" ,identity))
-(marshpeg '(if-not "abcdf" 123))
-(marshpeg ~(cmt "abcdf" ,identity))
-(marshpeg '(group "abc"))
-
-# Module path expansion
-(setdyn :current-file "some-dir/some-file")
-(defn test-expand [path temp]
-  (string (module/expand-path path temp)))
-
-# Right hand operators
-(assert (= (int/s64 (sum (range 10))) (sum (map int/s64 (range 10)))) "right hand operators 1")
-(assert (= (int/s64 (product (range 1 10))) (product (map int/s64 (range 1 10)))) "right hand operators 2")
-(assert (= (int/s64 15) (bor 10 (int/s64 5)) (bor (int/s64 10) 5)) "right hand operators 3")
-
-(assert (= (test-expand "abc" ":cur:/:all:") "some-dir/abc") "module/expand-path 1")
-(assert (= (test-expand "./abc" ":cur:/:all:") "some-dir/abc") "module/expand-path 2")
-(assert (= (test-expand "abc/def.txt" ":cur:/:name:") "some-dir/def.txt") "module/expand-path 3")
-(assert (= (test-expand "abc/def.txt" ":cur:/:dir:/sub/:name:") "some-dir/abc/sub/def.txt") "module/expand-path 4")
-(assert (= (test-expand "/abc/../def.txt" ":all:") "/def.txt") "module/expand-path 5")
-(assert (= (test-expand "abc/../def.txt" ":all:") "def.txt") "module/expand-path 6")
-(assert (= (test-expand "../def.txt" ":all:") "../def.txt") "module/expand-path 7")
-(assert (= (test-expand "../././././abcd/../def.txt" ":all:") "../def.txt") "module/expand-path 8")
-
-# Integer type checks
-(assert (compare= 0 (- (int/u64 "1000") 1000)) "subtract from int/u64")
-
-(assert (odd? (int/u64 "1001")) "odd? 1")
-(assert (not (odd? (int/u64 "1000"))) "odd? 2")
-(assert (odd? (int/s64 "1001")) "odd? 3")
-(assert (not (odd? (int/s64 "1000"))) "odd? 4")
-(assert (odd? (int/s64 "-1001")) "odd? 5")
-(assert (not (odd? (int/s64 "-1000"))) "odd? 6")
-
-(assert (even? (int/u64 "1000")) "even? 1")
-(assert (not (even? (int/u64 "1001"))) "even? 2")
-(assert (even? (int/s64 "1000")) "even? 3")
-(assert (not (even? (int/s64 "1001"))) "even? 4")
-(assert (even? (int/s64 "-1000")) "even? 5")
-(assert (not (even? (int/s64 "-1001"))) "even? 6")
-
-# integer type operations
-(defn modcheck [x y]
-  (assert (= (string (mod x y)) (string (mod (int/s64 x) y)))
-          (string "int/s64 (mod " x " " y ") expected " (mod x y) ", got "
-                  (mod (int/s64 x) y)))
-  (assert (= (string (% x y)) (string (% (int/s64 x) y)))
-          (string "int/s64 (% " x " " y ") expected " (% x y) ", got "
-                  (% (int/s64 x) y))))
-
-(modcheck 1 2)
-(modcheck 1 3)
-(modcheck 4 2)
-(modcheck 4 1)
-(modcheck 10 3)
-(modcheck 10 -3)
-(modcheck -10 3)
-(modcheck -10 -3)
-
-# Check for issue #1130
-(var d (int/s64 7))
-(mod 0 d)
-
-(var d (int/s64 7))
-(def result (seq [n :in (range -21 0)] (mod n d)))
-(assert (deep= result (map int/s64 @[0 1 2 3 4 5 6 0 1 2 3 4 5 6 0 1 2 3 4 5 6])) "issue #1130")
-
-(end-suite)

test/suite0007.janet

@@ -1,361 +0,0 @@
-# Copyright (c) 2023 Calvin Rose & contributors
-#
-# 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 7)
-
-# Using a large test grammar
-
-(def- specials {'fn true
-               'var true
-               'do true
-               'while true
-               'def true
-               'splice true
-               'set true
-               'unquote true
-               'quasiquote true
-               'quote true
-               'if true})
-
-(defn- check-number [text] (and (scan-number text) text))
-
-(defn capture-sym
-  [text]
-  (def sym (symbol text))
-  [(if (or (root-env sym) (specials sym)) :coresym :symbol) text])
-
-(def grammar
-  ~{:ws (set " \v\t\r\f\n\0")
-    :readermac (set "';~,")
-    :symchars (+ (range "09" "AZ" "az" "\x80\xFF") (set "!$%&*+-./:<?=>@^_|"))
-    :token (some :symchars)
-    :hex (range "09" "af" "AF")
-    :escape (* "\\" (+ (set "ntrvzf0e\"\\")
-                       (* "x" :hex :hex)
-                       (error (constant "bad hex escape"))))
-    :comment (/ '(* "#" (any (if-not (+ "\n" -1) 1))) (constant :comment))
-    :symbol (/ ':token ,capture-sym)
-    :keyword (/ '(* ":" (any :symchars)) (constant :keyword))
-    :constant (/ '(+ "true" "false" "nil") (constant :constant))
-    :bytes (* "\"" (any (+ :escape (if-not "\"" 1))) "\"")
-    :string (/ ':bytes (constant :string))
-    :buffer (/ '(* "@" :bytes) (constant :string))
-    :long-bytes {:delim (some "`")
-                 :open (capture :delim :n)
-                 :close (cmt (* (not (> -1 "`")) (-> :n) '(backmatch :n)) ,=)
-                 :main (drop (* :open (any (if-not :close 1)) :close))}
-    :long-string (/ ':long-bytes (constant :string))
-    :long-buffer (/ '(* "@" :long-bytes) (constant :string))
-    :number (/ (cmt ':token ,check-number) (constant :number))
-    :raw-value (+ :comment :constant :number :keyword
-                  :string :buffer :long-string :long-buffer
-                  :parray :barray :ptuple :btuple :struct :dict :symbol)
-    :value (* (? '(some (+ :ws :readermac))) :raw-value '(any :ws))
-    :root (any :value)
-    :root2 (any (* :value :value))
-    :ptuple (* '"(" :root (+ '")" (error "")))
-    :btuple (* '"[" :root (+ '"]" (error "")))
-    :struct (* '"{" :root2 (+ '"}" (error "")))
-    :parray (* '"@" :ptuple)
-    :barray (* '"@" :btuple)
-    :dict (* '"@"  :struct)
-    :main (+ :root (error ""))})
-
-(def p (peg/compile grammar))
-
-# Just make sure is valgrind clean.
-(def p (-> p make-image load-image))
-
-(assert (peg/match p "abc") "complex peg grammar 1")
-(assert (peg/match p "[1 2 3 4]") "complex peg grammar 2")
-
-#
-# fn compilation special
-#
-(defn myfn1 [[x y z] & more]
-  more)
-(defn myfn2 [head & more]
-  more)
-(assert (= (myfn1 [1 2 3] 4 5 6) (myfn2 [:a :b :c] 4 5 6)) "destructuring and varargs")
-
-#
-# Test propagation of signals via fibers
-#
-
-(def f (fiber/new (fn [] (error :abc) 1) :ei))
-(def res (resume f))
-(assert-error :abc (propagate res f) "propagate 1")
-
-# table/clone
-
-(defn check-table-clone [x msg]
-  (assert (= (table/to-struct x) (table/to-struct (table/clone x))) msg))
-
-(check-table-clone @{:a 123 :b 34 :c :hello : 945 0 1 2 3 4 5} "table/clone 1")
-(check-table-clone @{} "table/clone 1")
-
-# Make sure Carriage Returns don't end up in doc strings.
-
-(assert (not (string/find "\r" (get ((fiber/getenv (fiber/current)) 'cond) :doc ""))) "no \\r in doc strings")
-
-# module/expand-path regression
-(with-dyns [:syspath ".janet/.janet"]
-  (assert (= (string (module/expand-path "hello" ":sys:/:all:.janet"))
-             ".janet/.janet/hello.janet") "module/expand-path 1"))
-
-# comp should be variadic
-(assert (= 10 ((comp +) 1 2 3 4)) "variadic comp 1")
-(assert (= 11 ((comp inc +) 1 2 3 4)) "variadic comp 2")
-(assert (= 12 ((comp inc inc +) 1 2 3 4)) "variadic comp 3")
-(assert (= 13 ((comp inc inc inc +) 1 2 3 4)) "variadic comp 4")
-(assert (= 14 ((comp inc inc inc inc +) 1 2 3 4)) "variadic comp 5")
-(assert (= 15 ((comp inc inc inc inc inc +) 1 2 3 4)) "variadic comp 6")
-(assert (= 16 ((comp inc inc inc inc inc inc +) 1 2 3 4)) "variadic comp 7")
-
-# Function shorthand
-(assert (= (|(+ 1 2 3)) 6) "function shorthand 1")
-(assert (= (|(+ 1 2 3 $) 4) 10) "function shorthand 2")
-(assert (= (|(+ 1 2 3 $0) 4) 10) "function shorthand 3")
-(assert (= (|(+ $0 $0 $0 $0) 4) 16) "function shorthand 4")
-(assert (= (|(+ $ $ $ $) 4) 16) "function shorthand 5")
-(assert (= (|4) 4) "function shorthand 6")
-(assert (= (((|||4))) 4) "function shorthand 7")
-(assert (= (|(+ $1 $1 $1 $1) 2 4) 16) "function shorthand 8")
-(assert (= (|(+ $0 $1 $3 $2 $6) 0 1 2 3 4 5 6) 12) "function shorthand 9")
-(assert (= (|(+ $0 $99) ;(range 100)) 99) "function shorthand 10")
-
-# Simple function break
-(debug/fbreak map 1)
-(def f (fiber/new (fn [] (map inc [1 2 3])) :a))
-(resume f)
-(assert (= :debug (fiber/status f)) "debug/fbreak")
-(debug/unfbreak map 1)
-(map inc [1 2 3])
-
-(defn idx= [x y] (= (tuple/slice x) (tuple/slice y)))
-
-# Simple take, drop, etc. tests.
-(assert (idx= (take 10 (range 100)) (range 10)) "take 10")
-(assert (idx= (drop 10 (range 100)) (range 10 100)) "drop 10")
-
-# Printing to buffers
-(def out-buf @"")
-(def err-buf @"")
-(with-dyns [:out out-buf :err err-buf]
-  (print "Hello")
-  (prin "hi")
-  (eprint "Sup")
-  (eprin "not much."))
-
-(assert (= (string out-buf) "Hello\nhi") "print and prin to buffer 1")
-(assert (= (string err-buf) "Sup\nnot much.") "eprint and eprin to buffer 1")
-
-# Printing to functions
-(def out-buf @"")
-(defn prepend [x]
-  (with-dyns [:out out-buf]
-    (prin "> " x)))
-(with-dyns [:out prepend]
-  (print "Hello world"))
-
-(assert (= (string out-buf) "> Hello world\n") "print to buffer via function")
-
-(assert (= (string '()) (string [])) "empty bracket tuple literal")
-
-# with-vars
-(var abc 123)
-(assert (= 356 (with-vars [abc 456] (- abc 100))) "with-vars 1")
-(assert-error "with-vars 2" (with-vars [abc 456] (error :oops)))
-(assert (= abc 123) "with-vars 3")
-
-# Trim empty string
-(assert (= "" (string/trim " ")) "string/trim regression")
-
-# RNGs
-
-(defn test-rng
-  [rng]
-  (assert (all identity (seq [i :range [0 1000]]
-                             (<= (math/rng-int rng i) i))) "math/rng-int test")
-  (assert (all identity (seq [i :range [0 1000]]
-    (def x (math/rng-uniform rng))
-    (and (>= x 0) (< x 1))))
-          "math/rng-uniform test"))
-
-(def seedrng (math/rng 123))
-(for i 0 75
-  (test-rng (math/rng (:int seedrng))))
-
-(assert (deep-not= (-> 123 math/rng (:buffer 16))
-                   (-> 456 math/rng (:buffer 16))) "math/rng-buffer 1")
-
-(assert-no-error "math/rng-buffer 2" (math/seedrandom "abcdefg"))
-
-# OS Date test
-
-(assert (deep= {:year-day 0
-                :minutes 30
-                :month 0
-                :dst false
-                :seconds 0
-                :year 2014
-                :month-day 0
-                :hours 20 
-                :week-day 3}
-               (os/date 1388608200)) "os/date")
-
-# OS mktime test
-
-(assert (= 1388608200 (os/mktime {:year-day 0
-                                  :minutes 30
-                                  :month 0
-                                  :dst false
-                                  :seconds 0
-                                  :year 2014
-                                  :month-day 0
-                                  :hours 20
-                                  :week-day 3})) "os/mktime")
-
-(def now (os/time))
-(assert (= (os/mktime (os/date now)) now) "UTC os/mktime")
-(assert (= (os/mktime (os/date now true) true) now) "local os/mktime")
-(assert (= (os/mktime {:year 1970}) 0) "os/mktime default values")
-
-# OS strftime test
-
-(assert (= (os/strftime "%Y-%m-%d %H:%M:%S" 0) "1970-01-01 00:00:00") "strftime UTC epoch")
-(assert (= (os/strftime "%Y-%m-%d %H:%M:%S" 1388608200) "2014-01-01 20:30:00") "strftime january 2014")
-(assert (= (try (os/strftime "%%%d%t") ([err] err)) "invalid conversion specifier '%t'") "invalid conversion specifier")
-
-# Appending buffer to self
-
-(with-dyns [:out @""]
-  (prin "abcd")
-  (prin (dyn :out))
-  (prin (dyn :out))
-  (assert (deep= (dyn :out) @"abcdabcdabcdabcd") "print buffer to self"))
-
-(os/setenv "TESTENV1" "v1")
-(os/setenv "TESTENV2" "v2")
-(assert (= (os/getenv "TESTENV1") "v1") "getenv works")
-(def environ (os/environ))
-(assert (= [(environ "TESTENV1") (environ "TESTENV2")] ["v1" "v2"]) "environ works")
-
-# Issue #183 - just parse it :)
-1e-4000000000000000000000
-
-# Ensure randomness puts n of pred into our buffer eventually
-(defn cryptorand-check
-  [n pred]
-  (def max-attempts 10000)
-  (var attempts 0)
-  (while (not= attempts max-attempts)
-    (def cryptobuf (os/cryptorand 10))
-    (when (= n (count pred cryptobuf))
-      (break))
-    (++ attempts))
-  (not= attempts max-attempts))
-
-(def v (math/rng-int (math/rng (os/time)) 100))
-(assert (cryptorand-check 0 |(= $ v)) "cryptorand skips value sometimes")
-(assert (cryptorand-check 1 |(= $ v)) "cryptorand has value sometimes")
-
-(do 
-  (def buf (buffer/new-filled 1))
-  (os/cryptorand 1 buf)
-  (assert (= (in buf 0) 0) "cryptorand doesn't overwrite buffer")
-  (assert (= (length buf) 2) "cryptorand appends to buffer"))
-
-# Nested quasiquotation
-
-(def nested ~(a ~(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f))
-(assert (deep= nested '(a ~(b ,(+ 1 2) ,(foo 4 d) e) f)) "nested quasiquote")
-
-# Top level unquote
-(defn constantly
-  []
-  (comptime (math/random)))
-
-(assert (= (constantly) (constantly)) "comptime 1")
-
-(assert-error "arity issue in macro" (eval '(each [])))
-(assert-error "comptime issue" (eval '(comptime (error "oops"))))
-
-(with [f (file/temp)]
-  (assert (= 0 (file/tell f)) "start of file")
-  (file/write f "foo\n")
-  (assert (= 4 (file/tell f)) "after written string")
-  (file/flush f)
-  (file/seek f :set 0)
-  (assert (= 0 (file/tell f)) "start of file again")
-  (assert (= (string (file/read f :all)) "foo\n") "temp files work"))
-
-(var counter 0)
-(when-with [x nil |$]
-           (++ counter))
-(when-with [x 10 |$]
-           (+= counter 10))
-
-(assert (= 10 counter) "when-with 1")
-
-(if-with [x nil |$] (++ counter) (+= counter 10))
-(if-with [x true |$] (+= counter 20) (+= counter 30))
-
-(assert (= 40 counter) "if-with 1")
-
-(def a @[])
-(eachk x [:a :b :c :d]
-  (array/push a x))
-(assert (deep= (range 4) a) "eachk 1")
-
-
-(with-dyns [:err @""]
-  (tracev (def my-unique-var-name true))
-  (assert my-unique-var-name "tracev upscopes"))
-
-(assert (pos? (length (gensym))) "gensym not empty, regression #753")
-
-
-# os/clock. These tests might prove fragile under CI because they
-# rely on measured time. We'll see.
-
-(defmacro measure-time [clocks & body]
-  (def [t1 t2] [(gensym) (gensym)])
-  ~(do
-    (def ,t1 (map |(os/clock $) ,clocks))
-    ,;body
-    (def ,t2 (map |(os/clock $) ,clocks))
-    (zipcoll ,clocks (map |(- ;$) (map tuple ,t2 ,t1))))
-)
-
-# Spin for 0.1 seconds
-(def dt (measure-time [:realtime :monotonic :cputime]
-  (def t1 (os/clock :monotonic))
-  (while (< (- (os/clock :monotonic) t1) 0.1) true)))
-(assert (> (dt :monotonic) 0.10))
-(assert (> (dt :cputime) 0.05))
-
-# Sleep for 0.1 seconds
-(def dt (measure-time [:realtime :monotonic :cputime] (os/sleep 0.1)))
-(assert (> (dt :monotonic) 0.10))
-(assert (< (dt :cputime) 0.05))
-
-(end-suite)

test/suite0008.janet

@@ -1,384 +0,0 @@
-# Copyright (c) 2023 Calvin Rose & contributors
-#
-# 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 8)
-
-###
-### Compiling brainfuck to Janet.
-###
-
-(def- bf-peg
-  "Peg for compiling brainfuck into a Janet source ast."
-  (peg/compile
-    ~{:+ (/ '(some "+") ,(fn [x] ~(+= (DATA POS) ,(length x))))
-      :- (/ '(some "-") ,(fn [x] ~(-= (DATA POS) ,(length x))))
-      :> (/ '(some ">") ,(fn [x] ~(+= POS ,(length x))))
-      :< (/ '(some "<") ,(fn [x] ~(-= POS ,(length x))))
-      :. (* "." (constant (prinf "%c" (get DATA POS))))
-      :loop (/ (* "[" :main "]") ,(fn [& captures]
-                                    ~(while (not= (get DATA POS) 0)
-                                       ,;captures)))
-      :main (any (+ :s :loop :+ :- :> :< :.))}))
-
-(defn bf
-  "Run brainfuck."
-  [text]
-  (eval
-    ~(let [DATA (array/new-filled 100 0)]
-       (var POS 50)
-       ,;(peg/match bf-peg text))))
-
-(defn test-bf
-  "Test some bf for expected output."
-  [input output]
-  (def b @"")
-  (with-dyns [:out b]
-    (bf input))
-  (assert (= (string output) (string b))
-          (string "bf input '"
-                  input
-                  "' failed, expected "
-                  (describe output)
-                  ", got "
-                  (describe (string b))
-                  ".")))
-
-(test-bf "++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++." "Hello World!\n")
-
-(test-bf ">++++++++[-<+++++++++>]<.>>+>-[+]++>++>+++[>[->+++<<+++>]<<]>-----.>->
-+++..+++.>-.<<+[>[+>+]>>]<--------------.>>.+++.------.--------.>+.>+."
-         "Hello World!\n")
-
-(test-bf "+[+[<<<+>>>>]+<-<-<<<+<++]<<.<++.<++..+++.<<++.<---.>>.>.+++.------.>-.>>--."
-         "Hello, World!")
-
-# Prompts and Labels
-
-(assert (= 10 (label a (for i 0 10 (if (= i 5) (return a 10))))) "label 1")
-
-(defn recur
-  [lab x y]
-  (when (= x y) (return lab :done))
-  (def res (label newlab (recur (or lab newlab) (+ x 1) y)))
-  (if lab :oops res))
-(assert (= :done (recur nil 0 10)) "label 2")
-
-(assert (= 10 (prompt :a (for i 0 10 (if (= i 5) (return :a 10))))) "prompt 1")
-
-(defn- inner-loop
-  [i]
-  (if (= i 5)
-    (return :a 10)))
-
-(assert (= 10 (prompt :a (for i 0 10 (inner-loop i)))) "prompt 2")
-
-(defn- inner-loop2
-  [i]
-  (try
-    (if (= i 5)
-      (error 10))
-    ([err] (return :a err))))
-
-(assert (= 10 (prompt :a (for i 0 10 (inner-loop2 i)))) "prompt 3")
-
-# Match checks
-
-(assert (= :hi (match nil nil :hi)) "match 1")
-(assert (= :hi (match {:a :hi} {:a a} a)) "match 2")
-(assert (= nil (match {:a :hi} {:a a :b b} a)) "match 3")
-(assert (= nil (match [1 2] [a b c] a)) "match 4")
-(assert (= 2 (match [1 2] [a b] b)) "match 5")
-(assert (= [2 :a :b] (match [1 2 :a :b] [o & rest] rest)) "match 6")
-(assert (= [] (match @[:a] @[x & r] r :fallback)) "match 7")
-(assert (= :fallback (match @[1] @[x y & r] r :fallback)) "match 8")
-(assert (= [1 2 3 4] (match @[1 2 3 4] @[x y z & r] [x y z ;r] :fallback)) "match 9")
-
-# And/or checks
-
-(assert (= false (and false false)) "and 1")
-(assert (= false (or false false)) "or 1")
-
-# #300 Regression test
-
-# Just don't segfault
-(assert (peg/match '{:main (replace "S" {"S" :spade})} "S7") "regression #300")
-
-# Test cases for #293
-(assert (= :yes (match [1 2 3] [_ a _] :yes :no)) "match wildcard 1")
-(assert (= :no (match [1 2 3] [__ a __] :yes :no)) "match wildcard 2")
-(assert (= :yes (match [1 2 [1 2 3]] [_ a [_ _ _]] :yes :no)) "match wildcard 3")
-(assert (= :yes (match [1 2 3] (_ (even? 2)) :yes :no)) "match wildcard 4")
-(assert (= :yes (match {:a 1} {:a _} :yes :no)) "match wildcard 5")
-(assert (= false (match {:a 1 :b 2 :c 3} {:a a :b _ :c _ :d _} :no {:a _ :b _ :c _} false :no)) "match wildcard 6")
-(assert (= nil (match {:a 1 :b 2 :c 3} {:a a :b _ :c _ :d _} :no {:a _ :b _ :c _} nil :no)) "match wildcard 7")
-(assert (= "t" (match [true nil] [true _] "t")) "match wildcard 8")
-
-# Regression #301
-(def b (buffer/new-filled 128 0x78))
-(assert (= 38 (length (buffer/blit @"" b -1 90))) "buffer/blit 1")
-
-(def a @"abcdefghijklm")
-(assert (deep= @"abcde" (buffer/blit @"" a -1 0 5)) "buffer/blit 2")
-(assert (deep= @"bcde" (buffer/blit @"" a -1 1 5)) "buffer/blit 3")
-(assert (deep= @"cde" (buffer/blit @"" a -1 2 5)) "buffer/blit 4")
-(assert (deep= @"de" (buffer/blit @"" a -1 3 5)) "buffer/blit 5")
-
-# chr
-(assert (= (chr "a") 97) "chr 1")
-
-# Detaching closure over non resumable fiber.
-(do
-  (defn f1
-    [a]
-    (defn f1 [] (++ (a 0)))
-    (defn f2 [] (++ (a 0)))
-    (error [f1 f2]))
-  (def [_ [f1 f2]] (protect (f1 @[0])))
-  # At time of writing, mark phase can detach closure envs.
-  (gccollect)
-  (assert (= 1 (f1)) "detach-non-resumable-closure 1")
-  (assert (= 2 (f2)) "detach-non-resumable-closure 2"))
-
-# Marshal closure over non resumable fiber.
-(do
-  (defn f1
-    [a]
-    (defn f1 [] (++ (a 0)))
-    (defn f2 [] (++ (a 0)))
-    (error [f1 f2]))
-  (def [_ tup] (protect (f1 @[0])))
-  (def [f1 f2] (unmarshal (marshal tup make-image-dict) load-image-dict))
-  (assert (= 1 (f1)) "marshal-non-resumable-closure 1")
-  (assert (= 2 (f2)) "marshal-non-resumable-closure 2"))
-
-# Marshal closure over currently alive fiber.
-(do
-  (defn f1
-    [a]
-    (defn f1 [] (++ (a 0)))
-    (defn f2 [] (++ (a 0)))
-    (marshal [f1 f2] make-image-dict))
-  (def [f1 f2] (unmarshal (f1 @[0]) load-image-dict))
-  (assert (= 1 (f1)) "marshal-live-closure 1")
-  (assert (= 2 (f2)) "marshal-live-closure 2"))
-
-(do
-  (var a 1)
-  (defn b [x] (+ a x))
-  (def c (unmarshal (marshal b)))
-  (assert (= 2 (c 1)) "marshal-on-stack-closure 1"))
-
-# Reduce2
-
-(assert (= (reduce + 0 (range 1 10)) (reduce2 + (range 10))) "reduce2 1")
-(assert (= (reduce * 1 (range 2 10)) (reduce2 * (range 1 10))) "reduce2 2")
-(assert (= nil (reduce2 * [])) "reduce2 3")
-
-# Accumulate
-
-(assert (deep= (accumulate + 0 (range 5)) @[0 1 3 6 10]) "accumulate 1")
-(assert (deep= (accumulate2 + (range 5)) @[0 1 3 6 10]) "accumulate2 1")
-(assert (deep= @[] (accumulate2 + [])) "accumulate2 2")
-(assert (deep= @[] (accumulate 0 + [])) "accumulate 2")
-
-# Perm strings
-
-(assert (= (os/perm-int "rwxrwxrwx") 8r777) "perm 1")
-(assert (= (os/perm-int "rwxr-xr-x") 8r755) "perm 2")
-(assert (= (os/perm-int "rw-r--r--") 8r644) "perm 3")
-
-(assert (= (band (os/perm-int "rwxrwxrwx") 8r077) 8r077) "perm 4")
-(assert (= (band (os/perm-int "rwxr-xr-x") 8r077) 8r055) "perm 5")
-(assert (= (band (os/perm-int "rw-r--r--") 8r077) 8r044) "perm 6")
-
-(assert (= (os/perm-string 8r777) "rwxrwxrwx") "perm 7")
-(assert (= (os/perm-string 8r755) "rwxr-xr-x") "perm 8")
-(assert (= (os/perm-string 8r644) "rw-r--r--") "perm 9")
-
-# Issue #336 cases - don't segfault
-
-(assert-error "unmarshal errors 1" (unmarshal @"\xd6\xb9\xb9"))
-(assert-error "unmarshal errors 2" (unmarshal @"\xd7bc"))
-(assert-error "unmarshal errors 3" (unmarshal "\xd3\x01\xd9\x01\x62\xcf\x03\x78\x79\x7a" load-image-dict))
-(assert-error "unmarshal errors 4"
-              (unmarshal
-                @"\xD7\xCD\0e/p\x98\0\0\x03\x01\x01\x01\x02\0\0\x04\0\xCEe/p../tools
-\0\0\0/afl\0\0\x01\0erate\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE
-\xA8\xDE\xDE\xDE\xDE\xDE\xDE\0\0\0\xDE\xDE_unmarshal_testcase3.ja
-neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
-\0\0\0\0\0*\xFE\x01\04\x02\0\0'\x03\0\r\0\r\0\r\0\r" load-image-dict))
-
-(gccollect)
-
-# in vs get regression
-(assert (nil? (first @"")) "in vs get 1")
-(assert (nil? (last @"")) "in vs get 1")
-
-# For undefined behavior sanitizer
-0xf&1fffFFFF
-
-# Tuple comparison
-(assert (< [1 2 3] [2 2 3]) "tuple comparison 1")
-(assert (< [1 2 3] [2 2]) "tuple comparison 2")
-(assert (< [1 2 3] [2 2 3 4]) "tuple comparison 3")
-(assert (< [1 2 3] [1 2 3 4]) "tuple comparison 4")
-(assert (< [1 2 3] [1 2 3 -1]) "tuple comparison 5")
-(assert (> [1 2 3] [1 2]) "tuple comparison 6")
-
-# Lenprefix rule
-
-(def peg (peg/compile ~(* (lenprefix (/ (* '(any (if-not ":" 1)) ":") ,scan-number) 1) -1)))
-
-(assert (peg/match peg "5:abcde") "lenprefix 1")
-(assert (not (peg/match peg "5:abcdef")) "lenprefix 2")
-(assert (not (peg/match peg "5:abcd")) "lenprefix 3")
-
-# Packet capture
-
-(def peg2
-  (peg/compile
-    ~{# capture packet length in tag :header-len
-      :packet-header (* (/ ':d+ ,scan-number :header-len) ":")
-
-      # capture n bytes from a backref :header-len
-      :packet-body '(lenprefix (-> :header-len) 1)
-
-      # header, followed by body, and drop the :header-len capture
-      :packet (/ (* :packet-header :packet-body) ,|$1)
-
-      # any exact seqence of packets (no extra characters)
-      :main (* (any :packet) -1)}))
-
-(assert (deep= @["a" "bb" "ccc"] (peg/match peg2 "1:a2:bb3:ccc")) "lenprefix 4")
-(assert (deep= @["a" "bb" "cccccc"] (peg/match peg2 "1:a2:bb6:cccccc")) "lenprefix 5")
-(assert (= nil (peg/match peg2 "1:a2:bb:5:cccccc")) "lenprefix 6")
-(assert (= nil (peg/match peg2 "1:a2:bb:7:cccccc")) "lenprefix 7")
-
-# Regression #400
-(assert (= nil (while (and false false) (fn []) (error "should not happen"))) "strangeloop 1")
-(assert (= nil (while (not= nil nil) (fn []) (error "should not happen"))) "strangeloop 2")
-
-# Issue #412
-(assert (peg/match '(* "a" (> -1 "a") "b") "abc") "lookhead does not move cursor")
-
-(def peg3
-  ~{:main (* "(" (thru ")"))})
-
-(def peg4 (peg/compile ~(* (thru "(") '(to ")"))))
-
-(assert (peg/match peg3 "(12345)") "peg thru 1")
-(assert (not (peg/match peg3 " (12345)")) "peg thru 2")
-(assert (not (peg/match peg3 "(12345")) "peg thru 3")
-
-(assert (= "abc" (0 (peg/match peg4 "123(abc)"))) "peg thru/to 1")
-(assert (= "abc" (0 (peg/match peg4 "(abc)"))) "peg thru/to 2")
-(assert (not (peg/match peg4 "123(abc")) "peg thru/to 3")
-
-(def peg5 (peg/compile [3 "abc"]))
-
-(assert (:match peg5 "abcabcabc") "repeat alias 1")
-(assert (:match peg5 "abcabcabcac") "repeat alias 2")
-(assert (not (:match peg5 "abcabc")) "repeat alias 3")
-
-(defn check-jdn [x]
-  (assert (deep= (parse (string/format "%j" x)) x) "round trip jdn"))
-
-(check-jdn 0)
-(check-jdn nil)
-(check-jdn [])
-(check-jdn @[[] [] 1231 9.123123 -123123 0.1231231230001])
-(check-jdn -0.123123123123)
-(check-jdn 12837192371923)
-(check-jdn "a string")
-(check-jdn @"a buffer")
-
-# Issue 428
-(var result nil)
-(defn f [] (yield {:a :ok}))
-(assert-no-error "issue 428 1" (loop [{:a x} :in (fiber/new f)] (set result x)))
-(assert (= result :ok) "issue 428 2")
-
-# Inline 3 argument get
-(assert (= 10 (do (var a 10) (set a (get '{} :a a)))) "inline get 1")
-
-# Keyword and Symbol slice
-(assert (= :keyword (keyword/slice "some_keyword_slice" 5 12)) "keyword slice")
-(assert (= 'symbol (symbol/slice "some_symbol_slice" 5 11)) "symbol slice")
-
-# Peg find and find-all
-(def p "/usr/local/bin/janet")
-(assert (= (peg/find '"n/" p) 13) "peg find 1")
-(assert (not (peg/find '"t/" p)) "peg find 2")
-(assert (deep= (peg/find-all '"/" p) @[0 4 10 14]) "peg find-all")
-
-# Peg replace and replace-all
-(defn check-replacer
-  [x y z]
-  (assert (= (string/replace x y z) (string (peg/replace x y z))) "replacer test replace")
-  (assert (= (string/replace-all x y z) (string (peg/replace-all x y z))) "replacer test replace-all"))
-(check-replacer "abc" "Z" "abcabcabcabasciabsabc")
-(check-replacer "abc" "Z" "")
-(check-replacer "aba" "ZZZZZZ" "ababababababa")
-(check-replacer "aba" "" "ababababababa")
-(check-replacer "aba" string/ascii-upper "ababababababa")
-(check-replacer "aba" 123 "ababababababa")
-
-(assert (= (string (peg/replace-all ~(set "ab") string/ascii-upper "abcaa"))
-           "ABcAA")
-        "peg/replace-all cfunction")
-(assert (= (string (peg/replace-all ~(set "ab") |$ "abcaa"))
-           "abcaa")
-        "peg/replace-all function")
-
-(defn peg-test [name f peg subst text expected]
-  (assert (= (string (f peg subst text)) expected) name))
-
-(peg-test "peg/replace has access to captures"
-  peg/replace
-  ~(sequence "." (capture (set "ab")))
-  (fn [str char] (string/format "%s -> %s, " str (string/ascii-upper char)))
-  ".a.b.c"
-  ".a -> A, .b.c")
-
-(peg-test "peg/replace-all has access to captures"
-  peg/replace-all
-  ~(sequence "." (capture (set "ab")))
-  (fn [str char] (string/format "%s -> %s, " str (string/ascii-upper char)))
-  ".a.b.c"
-  ".a -> A, .b -> B, .c")
-
-# Peg bug
-(assert (deep= @[] (peg/match '(any 1) @"")) "peg empty pattern 1")
-(assert (deep= @[] (peg/match '(any 1) (buffer))) "peg empty pattern 2")
-(assert (deep= @[] (peg/match '(any 1) "")) "peg empty pattern 3")
-(assert (deep= @[] (peg/match '(any 1) (string))) "peg empty pattern 4")
-(assert (deep= @[] (peg/match '(* "test" (any 1)) @"test")) "peg empty pattern 5")
-(assert (deep= @[] (peg/match '(* "test" (any 1)) (buffer "test"))) "peg empty pattern 6")
-
-# number pattern
-(assert (deep= @[111] (peg/match '(number :d+) "111")) "simple number capture 1")
-(assert (deep= @[255] (peg/match '(number :w+) "0xff")) "simple number capture 2")
-
-# quoted match test
-(assert (= :yes (match 'john 'john :yes _ :nope)) "quoted literal match 1")
-(assert (= :nope (match 'john ''john :yes _ :nope)) "quoted literal match 2")
-
-(end-suite)

test/suite0010.janet

@@ -1,265 +0,0 @@
-# Copyright (c) 2023 Calvin Rose & contributors
-#
-# 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 10)
-
-# index-of
-(assert (= nil (index-of 10 [])) "index-of 1")
-(assert (= nil (index-of 10 [1 2 3])) "index-of 2")
-(assert (= 1 (index-of 2 [1 2 3])) "index-of 3")
-(assert (= 0 (index-of :a [:a :b :c])) "index-of 4")
-(assert (= nil (index-of :a {})) "index-of 5")
-(assert (= :a (index-of :A {:a :A :b :B})) "index-of 6")
-(assert (= :a (index-of :A @{:a :A :b :B})) "index-of 7")
-(assert (= 0 (index-of (chr "a") "abc")) "index-of 8")
-(assert (= nil (index-of (chr "a") "")) "index-of 9")
-(assert (= nil (index-of 10 @[])) "index-of 10")
-(assert (= nil (index-of 10 @[1 2 3])) "index-of 11")
-
-# Regression
-(assert (= {:x 10} (|(let [x $] ~{:x ,x}) 10)) "issue 463")
-
-# macex testing
-(assert (deep= (macex1 '~{1 2 3 4}) '~{1 2 3 4}) "macex1 qq struct")
-(assert (deep= (macex1 '~@{1 2 3 4}) '~@{1 2 3 4}) "macex1 qq table")
-(assert (deep= (macex1 '~(1 2 3 4)) '~[1 2 3 4]) "macex1 qq tuple")
-(assert (= :brackets (tuple/type (1 (macex1 '~[1 2 3 4])))) "macex1 qq bracket tuple")
-(assert (deep= (macex1 '~@[1 2 3 4 ,blah]) '~@[1 2 3 4 ,blah]) "macex1 qq array")
-
-# Sourcemaps in threading macros
-(defn check-threading [macro expansion]
-  (def expanded (macex1 (tuple macro 0 '(x) '(y))))
-  (assert (= expanded expansion) (string macro " expansion value"))
-  (def smap-x (tuple/sourcemap (get expanded 1)))
-  (def smap-y (tuple/sourcemap expanded))
-  (def line first)
-  (defn column [t] (t 1))
-  (assert (not= smap-x [-1 -1]) (string macro " x sourcemap existence"))
-  (assert (not= smap-y [-1 -1]) (string macro " y sourcemap existence"))
-  (assert (or (< (line smap-x) (line smap-y))
-              (and (= (line smap-x) (line smap-y))
-                   (< (column smap-x) (column smap-y))))
-          (string macro " relation between x and y sourcemap")))
-
-(check-threading '-> '(y (x 0)))
-(check-threading '->> '(y (x 0)))
-
-# keep-syntax
-(let [brak '[1 2 3]
-      par '(1 2 3)]
-
-  (tuple/setmap brak 2 1)
-
-  (assert (deep= (keep-syntax brak @[1 2 3]) @[1 2 3]) "keep-syntax brackets ignore array")
-  (assert (= (keep-syntax! brak @[1 2 3]) '[1 2 3]) "keep-syntax! brackets replace array")
-
-  (assert (= (keep-syntax! par (map inc @[1 2 3])) '(2 3 4)) "keep-syntax! parens coerce array")
-  (assert (not= (keep-syntax! brak @[1 2 3]) '(1 2 3)) "keep-syntax! brackets not parens")
-  (assert (not= (keep-syntax! par @[1 2 3]) '[1 2 3]) "keep-syntax! parens not brackets")
-  (assert (= (tuple/sourcemap brak)
-             (tuple/sourcemap (keep-syntax! brak @[1 2 3]))) "keep-syntax! brackets source map")
-
-  (keep-syntax par brak)
-  (assert (not= (tuple/sourcemap brak) (tuple/sourcemap par)) "keep-syntax no mutate")
-  (assert (= (keep-syntax 1 brak) brak) "keep-syntax brackets ignore type"))
-
-# Cancel test
-(def f (fiber/new (fn [&] (yield 1) (yield 2) (yield 3) 4) :yti))
-(assert (= 1 (resume f)) "cancel resume 1")
-(assert (= 2 (resume f)) "cancel resume 2")
-(assert (= :hi (cancel f :hi)) "cancel resume 3")
-(assert (= :error (fiber/status f)) "cancel resume 4")
-
-# Curenv
-(assert (= (curenv) (curenv 0)) "curenv 1")
-(assert (= (table/getproto (curenv)) (curenv 1)) "curenv 2")
-(assert (= nil (curenv 1000000)) "curenv 3")
-(assert (= root-env (curenv 1)) "curenv 4")
-
-# Import macro test
-(assert-no-error "import macro 1" (macex '(import a :as b :fresh maybe)))
-(assert (deep= ~(,import* "a" :as "b" :fresh maybe) (macex '(import a :as b :fresh maybe))) "import macro 2")
-
-# #477 walk preserving bracket type
-(assert (= :brackets (tuple/type (postwalk identity '[]))) "walk square brackets 1")
-(assert (= :brackets (tuple/type (walk identity '[]))) "walk square brackets 2")
-
-# # off by 1 error in inttypes
-(assert (= (int/s64 "-0x8000_0000_0000_0000") (+ (int/s64 "0x7FFF_FFFF_FFFF_FFFF") 1)) "int types wrap around")
-
-#
-# Longstring indentation
-#
-
-(defn reindent
-  "Reindent a the contents of a longstring as the Janet parser would.
-  This include removing leading and trailing newlines."
-  [text indent]
-
-  # Detect minimum indent
-  (var rewrite true)
-  (each index (string/find-all "\n" text)
-    (for i (+ index 1) (+ index indent 1)
-      (case (get text i)
-        nil (break)
-        (chr "\n") (break)
-        (chr " ") nil
-        (set rewrite false))))
-
-  # Only re-indent if no dedented characters.
-  (def str
-    (if rewrite
-      (peg/replace-all ~(* "\n" (between 0 ,indent " ")) "\n" text)
-      text))
-
-  (def first-nl (= (chr "\n") (first str)))
-  (def last-nl (= (chr "\n") (last str)))
-  (string/slice str (if first-nl 1 0) (if last-nl -2)))
-
-(defn reindent-reference
-  "Same as reindent but use parser functionality. Useful for validating conformance."
-  [text indent]
-  (if (empty? text) (break text))
-  (def source-code
-    (string (string/repeat " " indent) "``````"
-            text
-            "``````"))
-  (parse source-code))
-
-(var indent-counter 0)
-(defn check-indent
-  [text indent]
-  (++ indent-counter)
-  (let [a (reindent text indent)
-        b (reindent-reference text indent)]
-    (assert (= a b) (string "indent " indent-counter " (indent=" indent ")"))))
-
-(check-indent "" 0)
-(check-indent "\n" 0)
-(check-indent "\n" 1)
-(check-indent "\n\n" 0)
-(check-indent "\n\n" 1)
-(check-indent "\nHello, world!" 0)
-(check-indent "\nHello, world!" 1)
-(check-indent "Hello, world!" 0)
-(check-indent "Hello, world!" 1)
-(check-indent "\n    Hello, world!" 4)
-(check-indent "\n    Hello, world!\n" 4)
-(check-indent "\n    Hello, world!\n   " 4)
-(check-indent "\n    Hello, world!\n    " 4)
-(check-indent "\n    Hello, world!\n   dedented text\n    " 4)
-(check-indent "\n    Hello, world!\n    indented text\n    " 4)
-
-# String bugs
-(assert (deep= (string/find-all "qq" "qqq") @[0 1]) "string/find-all 1")
-(assert (deep= (string/find-all "q" "qqq") @[0 1 2]) "string/find-all 2")
-(assert (deep= (string/split "qq" "1qqqqz") @["1" "" "z"]) "string/split 1")
-(assert (deep= (string/split "aa" "aaa") @["" "a"]) "string/split 2")
-
-# Comparisons
-(assert (> 1e23 100) "less than immediate 1")
-(assert (> 1e23 1000) "less than immediate 2")
-(assert (< 100 1e23) "greater than immediate 1")
-(assert (< 1000 1e23) "greater than immediate 2")
-
-# os/execute with environment variables
-(assert (= 0 (os/execute [(dyn :executable) "-e" "(+ 1 2 3)"] :pe (merge (os/environ) {"HELLO" "WORLD"}))) "os/execute with env")
-
-# Regression #638
-(compwhen
-  (dyn 'ev/go)
-  (assert
-    (= [true :caught]
-       (protect
-         (try
-           (do
-             (ev/sleep 0)
-             (with-dyns []
-               (ev/sleep 0)
-               (error "oops")))
-           ([err] :caught))))
-    "regression #638"))
-
-
-# Struct prototypes
-(def x (struct/with-proto {1 2 3 4} 5 6))
-(def y (-> x marshal unmarshal))
-(def z {1 2 3 4})
-(assert (= 2 (get x 1)) "struct get proto value 1")
-(assert (= 4 (get x 3)) "struct get proto value 2")
-(assert (= 6 (get x 5)) "struct get proto value 3")
-(assert (= x y) "struct proto marshal equality 1")
-(assert (= (getproto x) (getproto y)) "struct proto marshal equality 2")
-(assert (= 0 (cmp x y)) "struct proto comparison 1")
-(assert (= 0 (cmp (getproto x) (getproto y))) "struct proto comparison 2")
-(assert (not= (cmp x z) 0) "struct proto comparison 3")
-(assert (not= (cmp y z) 0) "struct proto comparison 4")
-(assert (not= x z) "struct proto comparison 5")
-(assert (not= y z) "struct proto comparison 6")
-(assert (= (x 5) 6) "struct proto get 1")
-(assert (= (y 5) 6) "struct proto get 1")
-(assert (deep= x y) "struct proto deep= 1")
-(assert (deep-not= x z) "struct proto deep= 2")
-(assert (deep-not= y z) "struct proto deep= 3")
-
-# Issue #751
-(def t {:side false})
-(assert (nil? (get-in t [:side :note])) "get-in with false value")
-(assert (= (get-in t [:side :note] "dflt") "dflt")
-        "get-in with false value and default")
-
-(assert (= (math/gcd 462 1071) 21) "math/gcd 1")
-(assert (= (math/lcm 462 1071) 23562) "math/lcm 1")
-
-# Evaluate stream with `dofile`
-(def [r w] (os/pipe))
-(:write w "(setdyn :x 10)")
-(:close w)
-(def stream-env (dofile r))
-(assert (= (stream-env :x) 10) "dofile stream 1")
-
-# Issue #861 - should be valgrind clean
-(def step1 "(a b c d)\n")
-(def step2 "(a b)\n")
-(def p1 (parser/new))
-(parser/state p1)
-(parser/consume p1 step1)
-(loop [v :iterate (parser/produce p1)])
-(parser/state p1)
-(def p2 (parser/clone p1))
-(parser/state p2)
-(parser/consume p2 step2)
-(loop [v :iterate (parser/produce p2)])
-(parser/state p2)
-
-# Check missing struct proto bug.
-(assert (struct/getproto (struct/with-proto {:a 1} :b 2 :c nil)) "missing struct proto")
-
-# Test thaw and freeze
-(def table-to-freeze @{:c 22 :b [1 2 3 4] :d @"test" :e "test2"})
-(def table-to-freeze-with-inline-proto @{:a @[1 2 3] :b @[1 2 3 4] :c 22 :d @"test" :e @"test2"})
-(def struct-to-thaw (struct/with-proto {:a [1 2 3]} :c 22 :b [1 2 3 4] :d "test" :e "test2"))
-(table/setproto table-to-freeze @{:a @[1 2 3]})
-(assert (deep= {:a [1 2 3] :b [1 2 3 4] :c 22 :d "test" :e "test2"} (freeze table-to-freeze)))
-(assert (deep= table-to-freeze-with-inline-proto (thaw table-to-freeze)))
-(assert (deep= table-to-freeze-with-inline-proto (thaw struct-to-thaw)))
-
-(end-suite)

test/suite0011.janet

@@ -1,108 +0,0 @@
-# Copyright (c) 2023 Calvin Rose & contributors
-#
-# 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 11)
-
-# math gamma
-
-(assert (< 11899423.08 (math/gamma 11.5) 11899423.085) "math/gamma")
-(assert (< 2605.1158 (math/log-gamma 500) 2605.1159) "math/log-gamma")
-
-# missing symbols
-
-(defn lookup-symbol [sym] (defglobal sym 10) (dyn sym))
-
-(setdyn :missing-symbol lookup-symbol)
-
-(assert (= (eval-string "(+ a 5)") 15) "lookup missing symbol")
-
-(setdyn :missing-symbol nil)
-(setdyn 'a nil)
-
-(assert-error "compile error" (eval-string "(+ a 5)"))
-
-# 919
-(defn test
-  []
-  (var x 1)
-  (set x ~(,x ()))
-  x)
-
-(assert (= (test) '(1 ())) "issue #919")
-
-(assert (= (hash 0) (hash (* -1 0))) "hash -0 same as hash 0")
-
-# os/execute regressions
-(for i 0 10
-  (assert (= i (os/execute [(dyn :executable) "-e" (string/format "(os/exit %d)" i)] :p)) (string "os/execute " i)))
-
-# to/thru bug
-(def pattern
-  (peg/compile
-    '{:dd (sequence :d :d)
-      :sep (set "/-")
-      :date (sequence :dd :sep :dd)
-      :wsep (some (set " \t"))
-      :entry (group (sequence (capture :date) :wsep (capture :date)))
-      :main (some (thru :entry))}))
-
-(def alt-pattern
-  (peg/compile
-    '{:dd (sequence :d :d)
-      :sep (set "/-")
-      :date (sequence :dd :sep :dd)
-      :wsep (some (set " \t"))
-      :entry (group (sequence (capture :date) :wsep (capture :date)))
-      :main (some (choice :entry 1))}))
-
-(def text "1800-10-818-9-818 16/12\n17/12 19/12\n20/12 11/01")
-(assert (deep= (peg/match pattern text) (peg/match alt-pattern text)) "to/thru bug #971")
-
-(assert-error
-  "table rawget regression"
-  (table/new -1))
-
-# Named arguments
-(defn named-arguments
-  [&named bob sally joe]
-  (+ bob sally joe))
-
-(assert (= 15 (named-arguments :bob 3 :sally 5 :joe 7)) "named arguments 1")
-
-(defn named-opt-arguments
-  [&opt x &named a b c]
-  (+ x a b c))
-
-(assert (= 10 (named-opt-arguments 1 :a 2 :b 3 :c 4)) "named arguments 2")
-
-(let [b @""]
-  (defn dummy [a b c]
-    (+ a b c))
-  (trace dummy)
-  (defn errout [arg]
-    (buffer/push b arg))
-  (assert (= 6 (with-dyns [*err* errout] (dummy 1 2 3))) "trace to custom err function")
-  (assert (deep= @"trace (dummy 1 2 3)\n" b) "trace buffer correct"))
-
-(def f (asm (disasm (fn [x] (fn [y] (+ x y))))))
-(assert (= ((f 10) 37) 47) "asm environment tables")
-
-(end-suite)

test/suite0014.janet

@@ -1,20 +0,0 @@
-(import ./helper :prefix "" :exit true)
-(start-suite 14)
-
-(assert (deep=
-  (peg/match '(not (* (constant 7) "a")) "hello")
-  @[]) "peg not")
-
-(assert (deep=
-  (peg/match '(if-not (* (constant 7) "a") "hello") "hello")
-  @[]) "peg if-not")
-
-(assert (deep=
-  (peg/match '(if-not (drop (* (constant 7) "a")) "hello") "hello")
-  @[]) "peg if-not drop")
-
-(assert (deep=
-  (peg/match '(if (not (* (constant 7) "a")) "hello") "hello")
-  @[]) "peg if not")
-
-(end-suite)

test/suite0015.janet

@@ -1,50 +0,0 @@
-# test *debug* flags
-
-(import ./helper :prefix "" :exit true)
-(start-suite 15)
-
-(assert (deep= (in (disasm (defn a [] (def x 10) x)) :symbolmap)
-               @[[0 2 0 'a] [0 2 1 'x]])
-        "symbolslots when *debug* is true")
-
-(defn a [arg]
-  (def x 10)
-  (do
-    (def y 20)
-    (def z 30)
-    (+ x y z)))
-(def symbolslots (in (disasm a) :symbolslots))
-(def f (asm (disasm a)))
-(assert (deep= (in (disasm f) :symbolslots)
-               symbolslots)
-        "symbolslots survive disasm/asm")
-
-(comment
-  (setdyn *debug* true)
-  (setdyn :pretty-format "%.40M")
-  (def f (fn [x] (fn [y] (+ x y))))
-  (assert (deep= (map last (in (disasm (f 10)) :symbolmap))
-                 @['x 'y])
-          "symbolslots upvalues"))
-
-(assert (deep= (in (disasm (defn a [arg]
-                             (def x 10)
-                             (do
-                               (def y 20)
-                               (def z 30)
-                               (+ x y z)))) :symbolmap)
-               @[[0 6 0 'arg]
-                 [0 6 1 'a]
-                 [0 6 2 'x]
-                 [1 6 3 'y]
-                 [2 6 4 'z]])
-        "arg & inner symbolslots")
-
-# buffer/push-at
-(assert (deep= @"abc456" (buffer/push-at @"abc123" 3 "456")) "buffer/push-at 1")
-(assert (deep= @"abc456789" (buffer/push-at @"abc123" 3 "456789")) "buffer/push-at 2")
-(assert (deep= @"abc423" (buffer/push-at @"abc123" 3 "4")) "buffer/push-at 3")
-
-(assert (= 10 (do (var x 10) (def y x) (++ x) y)) "no invalid aliasing")
-
-(end-suite)

tools/format.sh

@@ -1,4 +1,4 @@
-#!/usr/bin/env bash
+#!/usr/bin/env sh
 
 # Format all code with astyle