diff --git a/.builds/epoll.yml b/.builds/linux.yml
similarity index 100%
rename from .builds/epoll.yml
rename to .builds/linux.yml
diff --git a/.builds/meson.yml b/.builds/meson.yml
deleted file mode 100644
index a3a6324f..00000000
--- a/.builds/meson.yml
+++ /dev/null
@@ -1,14 +0,0 @@
-image: openbsd/latest
-sources:
-- https://git.sr.ht/~bakpakin/janet
-packages:
-- meson
-tasks:
-- build: |
- cd janet
- meson setup build --buildtype=release
- cd build
- ninja
- ninja test
- doas ninja install
- doas jpm --verbose install circlet
diff --git a/.builds/meson2.yml b/.builds/meson2.yml
deleted file mode 100644
index f9015ca5..00000000
--- a/.builds/meson2.yml
+++ /dev/null
@@ -1,15 +0,0 @@
-image: openbsd/latest
-sources:
-- https://git.sr.ht/~bakpakin/janet
-packages:
-- meson
-tasks:
-- build: |
- cd janet
- meson setup build --buildtype=release
- cd build
- meson configure -Dprf=true
- ninja
- ninja test
- doas ninja install
- doas jpm --verbose install circlet
diff --git a/.builds/meson_min.yml b/.builds/meson_min.yml
deleted file mode 100644
index e0fa4adb..00000000
--- a/.builds/meson_min.yml
+++ /dev/null
@@ -1,22 +0,0 @@
-image: openbsd/latest
-sources:
-- https://git.sr.ht/~bakpakin/janet
-packages:
-- meson
-tasks:
-- build: |
- cd janet
- meson setup build --buildtype=release
- cd build
- meson configure -Dsingle_threaded=true
- meson configure -Dnanbox=false
- meson configure -Ddynamic_modules=false
- meson configure -Ddocstrings=false
- meson configure -Dnet=false
- meson configure -Dsourcemaps=false
- meson configure -Dpeg=false
- meson configure -Dassembler=false
- meson configure -Dint_types=false
- meson configure -Dtyped_array=false
- meson configure -Dreduced_os=true
- ninja # will not pass tests but should build
diff --git a/.builds/openbsd.yml b/.builds/openbsd.yml
index 27ad30a1..f2fc3733 100644
--- a/.builds/openbsd.yml
+++ b/.builds/openbsd.yml
@@ -3,10 +3,31 @@ sources:
- https://git.sr.ht/~bakpakin/janet
packages:
- gmake
+- meson
tasks:
-- build: |
+- gmake: |
cd janet
gmake
gmake test
doas gmake install
gmake test-install
+- meson_min: |
+ cd janet
+ meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dtyped_array=false -Dreduced_os=true
+ cd build_meson_min
+ ninja
+- meson_prf: |
+ cd janet
+ meson setup build_meson_prf --buildtype=release -Dprf=true
+ cd build_meson_prf
+ ninja
+ ninja test
+- meson_default: |
+ cd janet
+ meson setup build_meson_default --buildtype=release
+ cd build_meson_default
+ ninja
+ ninja test
+ doas ninja install
+ doas jpm --verbose install circlet
+
diff --git a/CHANGELOG.md b/CHANGELOG.md
index e1e0db63..9c33e830 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -2,8 +2,24 @@
All notable changes to this project will be documented in this file.
## Unreleased - ???
+- Deprecate `file/popen` in favor of `os/spawn`.
+- Add `:all` keyword to `ev/read` and `net/read` to make them more like `file/read`. However, we
+ do not provide any `:line` option as that requires buffering.
+- Change repl behavior to make Ctrl-C raise SIGINT on posix. The old behavior for Ctrl-C,
+ to clear the current line buffer, has been moved to Ctrl-Q.
+- Importing modules that start with `/` is now the only way to import from project root.
+ Before, this would import from / on disk.
+- Change hash function for numbers.
+- Improve error handling of `dofile`.
+
+## 1.13.1 - 2020-12-13
+- Pretty printing a table with a prototype will look for `:_name` instead of `:name`
+ in the prototype table to tag the output.
+- `match` macro implementation changed to be tail recursive.
+- Adds a :preload loader which allows one to manually put things into `module/cache`.
+- Add `buffer/push` function.
- Backtick delimited strings and buffers are now reindented based on the column of the
- opening delimiter. WHitespace in columns to the left of the starting column is ignored unless
+ opening delimiter. Whitespace in columns to the left of the starting column is ignored unless
there are non-space/non-newline characters in that region, in which case the old behavior is preserved.
- Argument to `(error)` combinator in PEGs is now optional.
- Add `(line)` and `(column)` combinators to PEGs to capture source line and column.
@@ -12,16 +28,17 @@ All notable changes to this project will be documented in this file.
- During installation and release, merge janetconf.h into janet.h for easier install.
- Add `upscope` special form.
- `os/execute` and `os/spawn` can take streams for redirecting IO.
-- Add `;parser` and `:read` parameters to `run-context`.
+- Add `:parser` and `:read` parameters to `run-context`.
- Add `os/open` if ev is enabled.
- Add `os/pipe` if ev is enabled.
- Add `janet_thread_current(void)` to C API
- Add integer parsing forms to pegs. This makes parsing many binary protocols easier.
- Lots of updates to networking code - now can use epoll (or poll) on linux and IOCP on windows.
- Add `ev/` module. This exposes a fiber scheduler, queues, timeouts, and other functionality to users
- for single threaded cooperative scheduling and asynchornous IO.
+ for single threaded cooperative scheduling and asynchronous IO.
- Add `net/accept-loop` and `net/listen`. These functions break down `net/server` into it's essential parts
- and are more flexible. They also allow furter improvements to these utility functions.
+ and are more flexible. They also allow further improvements to these utility functions.
+- Various small bug fixes.
## 1.12.2 - 2020-09-20
- Add janet\_try and janet\_restore to C API.
diff --git a/Makefile b/Makefile
index b863b659..9b6ee905 100644
--- a/Makefile
+++ b/Makefile
@@ -157,7 +157,7 @@ build/janet.c: build/janet_boot src/boot/boot.janet
##### Amalgamation #####
########################
-SONAME=libjanet.so.1.12
+SONAME=libjanet.so.1.13
build/shell.c: src/mainclient/shell.c
cp $< $@
diff --git a/README.md b/README.md
index 3af472a5..735c2733 100644
--- a/README.md
+++ b/README.md
@@ -4,8 +4,6 @@
[](https://travis-ci.org/janet-lang/janet)
[](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml?)
[](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml?)
-[](https://builds.sr.ht/~bakpakin/janet/commits/meson.yml?)
-[](https://builds.sr.ht/~bakpakin/janet/commits/meson_min.yml?)
diff --git a/janet.1 b/janet.1
index 61c65b64..e25989e2 100644
--- a/janet.1
+++ b/janet.1
@@ -64,6 +64,10 @@ Move cursor to the beginning of input line.
.BR Ctrl\-B
Move cursor one character to the left.
+.TP 16
+.BR Ctrl\-D
+If on a newline, indicate end of stream and exit the repl.
+
.TP 16
.BR Ctrl\-E
Move cursor to the end of input line.
@@ -100,6 +104,10 @@ Delete one word before the cursor.
.BR Ctrl\-G
Show documentation for the current symbol under the cursor.
+.TP 16
+.BR Ctrl\-Q
+Clear the current command, including already typed lines.
+
.TP 16
.BR Alt\-B/Alt\-F
Move cursor backwards and forwards one word.
diff --git a/meson.build b/meson.build
index 8745bf02..1a6c679d 100644
--- a/meson.build
+++ b/meson.build
@@ -20,7 +20,7 @@
project('janet', 'c',
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
- version : '1.13.0')
+ version : '1.13.1')
# Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
diff --git a/src/boot/boot.janet b/src/boot/boot.janet
index 3da90a8d..d8a564ec 100644
--- a/src/boot/boot.janet
+++ b/src/boot/boot.janet
@@ -180,8 +180,8 @@
(defmacro cond
`Evaluates conditions sequentially until the first true condition
is found, and then executes the corresponding body. If there are an
- odd number of forms, the last expression is executed if no forms
- are matched. If there are no matches, return nil.`
+ odd number of forms, and no forms are matched, the last expression
+ is executed. If there are no matches, return nil.`
[& pairs]
(defn aux [i]
(def restlen (- (length pairs) i))
@@ -494,13 +494,13 @@
(error (string "unexpected loop verb " verb)))))
(defmacro forv
- `Do a c style for loop for side effects. The iteration variable i
- can be mutated in the loop, unlike normal for. Returns nil.`
+ ``Do a C-style for-loop for side effects. The iteration variable `i`
+ can be mutated in the loop, unlike normal `for`. Returns nil.``
[i start stop & body]
(for-var-template i start stop 1 < + body))
(defmacro for
- "Do a c style for loop for side effects. Returns nil."
+ "Do a C-style for-loop for side effects. Returns nil."
[i start stop & body]
(for-template i start stop 1 < + body))
@@ -562,7 +562,7 @@
two-element tuple with a start and (exclusive) end value, and an optional
(positive!) step size.
- * :down-to -- same :as down, but the range is inclusive [start, end].
+ * :down-to -- same as :down, but the range is inclusive [start, end].
* :keys -- iterate over the keys in a data structure.
@@ -692,7 +692,7 @@
;(tuple/slice functions 4 -1)))))
(defn identity
- "A function that returns its first argument."
+ "A function that returns its argument."
[x]
x)
@@ -731,11 +731,11 @@
## Polymorphic comparisons
(defn compare
- `Polymorphic compare. Returns -1, 0, 1 for x < y, x = y, x > y respectively.
+ ``Polymorphic compare. Returns -1, 0, 1 for x < y, x = y, x > y respectively.
Differs from the primitive comparators in that it first checks to
- see whether either x or y implement a 'compare' method which can
- compare x and y. If so it uses that compare method. If not, it
- delegates to the primitive comparators.`
+ see whether either x or y implement a `compare` method which can
+ compare x and y. If so, it uses that method. If not, it
+ delegates to the primitive comparators.``
[x y]
(or
(when-let [f (get x :compare)] (f x y))
@@ -753,27 +753,27 @@
r)
(defn compare=
- "Equivalent of '=' but using compare function instead of primitive comparator"
+ ``Equivalent of `=` but using polymorphic `compare` instead of primitive comparator.``
[& xs]
(compare-reduce = xs))
(defn compare<
- "Equivalent of '<' but using compare function instead of primitive comparator"
+ ``Equivalent of `<` but using polymorphic `compare` instead of primitive comparator.``
[& xs]
(compare-reduce < xs))
(defn compare<=
- "Equivalent of '<=' but using compare function instead of primitive comparator"
+ ``Equivalent of `<=` but using polymorphic `compare` instead of primitive comparator.``
[& xs]
(compare-reduce <= xs))
(defn compare>
- "Equivalent of '>' but using compare function instead of primitive comparator"
+ ``Equivalent of `>` but using polymorphic `compare` instead of primitive comparator.``
[& xs]
(compare-reduce > xs))
(defn compare>=
- "Equivalent of '>=' but using compare function instead of primitive comparator"
+ ``Equivalent of `>=` but using polymorphic `compare` instead of primitive comparator.``
[& xs]
(compare-reduce >= xs))
@@ -790,36 +790,50 @@
###
###
-(defn- sort-part
- [a lo hi by]
- (def pivot (in a hi))
- (var i lo)
- (forv j lo hi
- (def aj (in a j))
- (when (by aj pivot)
- (def ai (in a i))
- (set (a i) aj)
- (set (a j) ai)
- (++ i)))
- (set (a hi) (in a i))
- (set (a i) pivot)
- i)
+(defn- median-of-three [a b c]
+ (if (not= (> a b) (> a c))
+ a
+ (if (not= (> b a) (> b c)) b c)))
-(defn- sort-help
- [a lo hi by]
- (when (> hi lo)
- (def piv (sort-part a lo hi by))
- (sort-help a lo (- piv 1) by)
- (sort-help a (+ piv 1) hi by))
+(defn- insertion-sort [a lo hi by]
+ (for i (+ lo 1) (+ hi 1)
+ (def temp (in a i))
+ (var j (- i 1))
+ (while (and (>= j lo) (by temp (in a j)))
+ (set (a (+ j 1)) (in a j))
+ (-- j))
+
+ (set (a (+ j 1)) temp))
a)
(defn sort
"Sort an array in-place. Uses quick-sort and is not a stable sort."
[a &opt by]
- (sort-help a 0 (- (length a) 1) (or by <)))
+ (default by <)
+ (def stack @[[0 (- (length a) 1)]])
+ (while (not (empty? stack))
+ (def [lo hi] (array/pop stack))
+ (when (< lo hi)
+ (when (< (- hi lo) 32) (insertion-sort a lo hi by) (break))
+ (def pivot (median-of-three (in a hi) (in a lo) (in a (math/floor (/ (+ lo hi) 2)))))
+ (var left lo)
+ (var right hi)
+ (while true
+ (while (by (in a left) pivot) (++ left))
+ (while (by pivot (in a right)) (-- right))
+ (when (<= left right)
+ (def tmp (in a left))
+ (set (a left) (in a right))
+ (set (a right) tmp)
+ (++ left)
+ (-- right))
+ (if (>= left right) (break)))
+ (array/push stack [lo right])
+ (array/push stack [left hi])))
+ a)
-(undef sort-part)
-(undef sort-help)
+(undef median-of-three)
+(undef insertion-sort)
(defn sort-by
`Returns a new sorted array that compares elements by invoking
@@ -945,8 +959,10 @@
counter)
(defn keep
- `Given a predicate, take only elements from an array or tuple for
- which (pred element) is truthy. Returns a new array of truthy predicate results.`
+ ``Given a predicate `pred`, return a new array containing the truthy results
+ of applying `pred` to each element in the indexed collection `ind`. This is
+ different from `filter` which returns an array of the original elements where
+ the predicate is truthy.``
[pred ind]
(def res @[])
(each item ind
@@ -1557,109 +1573,173 @@
###
###
-(defmacro- with-idemp
- `Return janet code body that has been prepended
- with a binding of form to atom. If form is a non-idempotent
- form (a function call, etc.), make sure the resulting
- code will only evaluate once, even if body contains multiple
- copies of binding. In body, use binding instead of form.`
- [binding form & body]
- (def $result (gensym))
- (def $form (gensym))
- ~(do
- (def ,$form ,form)
- (def ,binding (if (idempotent? ,$form) ,$form (gensym)))
- (def ,$result (do ,;body))
- (if (= ,$form ,binding)
- ,$result
- (tuple 'do (tuple 'def ,binding ,$form) ,$result))))
-
-
-# Sentinel value for mismatches
-(def- sentinel ~',(gensym))
-
-(defn- match-1
- [pattern expr onmatch seen]
- (cond
-
- (= '_ pattern)
- (onmatch)
-
- (symbol? pattern)
- (if (in seen pattern)
- ~(if (= ,pattern ,expr) ,(onmatch) ,sentinel)
- (do
- (put seen pattern true)
- ~(do (def ,pattern ,expr) ,(onmatch))))
-
- (and (tuple? pattern) (= :parens (tuple/type pattern)))
- (if (= (get pattern 0) '@)
- # Unification with external values
- ~(if (= ,(get pattern 1) ,expr) ,(onmatch) ,sentinel)
- (match-1
- (in pattern 0) expr
- (fn []
- ~(if (and ,;(tuple/slice pattern 1)) ,(onmatch) ,sentinel)) seen))
-
- (indexed? pattern)
- (do
- (def len (length pattern))
- (var i -1)
- (with-idemp
- $arr expr
- ~(if (,indexed? ,$arr)
- (if (< (,length ,$arr) ,len)
- ,sentinel
- ,((fn aux []
- (++ i)
- (if (= i len)
- (onmatch)
- (match-1 (in pattern i) (tuple in $arr i) aux seen)))))
- ,sentinel)))
-
- (dictionary? pattern)
- (do
- (var key nil)
- (with-idemp
- $dict expr
- ~(if (,dictionary? ,$dict)
- ,((fn aux []
- (set key (next pattern key))
- (def $val (gensym))
- (if (= key nil)
- (onmatch)
- ~(do (def ,$val (,get ,$dict ,key))
- ,(match-1 [(in pattern key) [not= nil $val]] $val aux seen)))))
- ,sentinel)))
-
- :else ~(if (= ,pattern ,expr) ,(onmatch) ,sentinel)))
-
(defmacro match
- `Pattern matching. Match an expression x against
- any number of cases. Each case is a pattern to match against, followed
- by an expression to evaluate to if that case is matched. A pattern that is
- a symbol will match anything, binding x's value to that symbol. An array
- will match only if all of it's elements match the corresponding elements in
- x. A table or struct will match if all values match with the corresponding
- values in x. A tuple pattern will match if it's first element matches, and the following
- elements are treated as predicates and are true. The last special case is
- the '_ symbol, which is a wildcard that will match any value without creating a binding.
- Any other value pattern will only match if it is equal to x.`
- [x & cases]
- (with-idemp $x x
- (def len (length cases))
- (def len-1 (dec len))
- ((fn aux [i]
- (cond
- (= i len-1) (in cases i)
- (< i len-1) (with-syms [$res]
- ~(if (= ,sentinel (def ,$res ,(match-1 (in cases i) $x (fn [] (in cases (inc i))) @{})))
- ,(aux (+ 2 i))
- ,$res)))) 0)))
+ ```
+ Pattern matching. Match an expression `x` against any number of cases.
+ Each case is a pattern to match against, followed by an expression to
+ evaluate to if that case is matched. Legal patterns are:
-(undef sentinel)
-(undef match-1)
-(undef with-idemp)
+ * symbol -- a pattern that is a symbol will match anything, binding `x`'s
+ value to that symbol.
+
+ * array -- an array will match only if all of its elements match the
+ corresponding elements in `x`.
+
+ * table or struct -- a table or struct will match if all values match with
+ the corresponding values in `x`.
+
+ * tuple -- a tuple pattern will match if its first element matches, and the
+ following elements are treated as predicates and are true.
+
+ * `_` symbol -- the last special case is the `_` symbol, which is a wildcard
+ that will match any value without creating a binding.
+
+ Any other value pattern will only match if it is equal to `x`.
+ ```
+ [x & cases]
+
+ # Partition body into sections.
+ (def oddlen (odd? (length cases)))
+ (def else (if oddlen (last cases)))
+ (def patterns (partition 2 (if oddlen (slice cases 0 -2) cases)))
+
+ # Keep an array for accumulating the compilation output
+ (def x-sym (if (idempotent? x) x (gensym)))
+ (def accum @[])
+ (if (not= x x-sym) (array/push accum ['def x-sym x]))
+
+ # Table of gensyms
+ (def symbols @{[nil nil] x-sym})
+ (def length-symbols @{})
+
+ (defn emit [x] (array/push accum x))
+ (defn emit-branch [condition result] (array/push accum :branch condition result))
+
+ (defn get-sym
+ [parent-sym key]
+ (def symbol-key [parent-sym key])
+ (or (get symbols symbol-key)
+ (let [s (gensym)]
+ (put symbols symbol-key s)
+ (emit ['def s [get parent-sym key]])
+ s)))
+
+ (defn get-length-sym
+ [parent-sym]
+ (or (get length-symbols parent-sym)
+ (let [s (gensym)]
+ (put length-symbols parent-sym s)
+ (emit ['def s ['if [indexed? parent-sym] [length parent-sym]]])
+ s)))
+
+ (defn visit-pattern-1
+ [b2g parent-sym key pattern]
+ (if (= pattern '_) (break))
+ (def s (get-sym parent-sym key))
+ (def t (type pattern))
+ (def isarr (or (= t :array) (and (= t :tuple) (= (tuple/type pattern) :brackets))))
+ (cond
+
+ # match local binding
+ (= t :symbol)
+ (if-let [x (in b2g pattern)]
+ (array/push x s)
+ (put b2g pattern @[s]))
+
+ # match data structure template
+ (or isarr (= t :struct) (= t :table))
+ (do
+ (when isarr (get-length-sym s))
+ (eachp [i sub-pattern] pattern
+ (visit-pattern-1 b2g s i sub-pattern)))
+
+ # match global unification
+ (and (= t :tuple) (= 2 (length pattern)) (= '@ (pattern 0)))
+ (break)
+
+ # match predicated binding
+ (and (= t :tuple) (>= (length pattern) 2))
+ (do
+ (visit-pattern-1 b2g parent-sym key (pattern 0)))))
+
+ (defn visit-pattern-2
+ [anda gun preds parent-sym key pattern]
+ (if (= pattern '_) (break))
+ (def s (get-sym parent-sym key))
+ (def t (type pattern))
+ (def isarr (or (= t :array) (and (= t :tuple) (= (tuple/type pattern) :brackets))))
+ (when isarr
+ (array/push anda (get-length-sym s))
+ (array/push anda [<= (length pattern) (get-length-sym s)]))
+ (cond
+
+ # match data structure template
+ (or isarr (= t :struct) (= t :table))
+ (eachp [i sub-pattern] pattern
+ (when (not isarr)
+ (array/push anda [not= nil (get-sym s i)]))
+ (visit-pattern-2 anda gun preds s i sub-pattern))
+
+ # match local binding
+ (= t :symbol) (break)
+
+ # match global unification
+ (and (= t :tuple) (= 2 (length pattern)) (= '@ (pattern 0)))
+ (if-let [x (in gun (pattern 1))]
+ (array/push x s)
+ (put gun (pattern 1) @[s]))
+
+ # match predicated binding
+ (and (= t :tuple) (>= (length pattern) 2))
+ (do
+ (array/push preds ;(slice pattern 1))
+ (visit-pattern-2 anda gun preds parent-sym key (pattern 0)))
+
+ # match literal
+ (array/push anda ['= s pattern])))
+
+ # Compile the patterns
+ (each [pattern expression] patterns
+ (def b2g @{})
+ (def gun @{})
+ (def preds @[])
+ (visit-pattern-1 b2g nil nil pattern)
+ (def anda @['and])
+ (visit-pattern-2 anda gun preds nil nil pattern)
+ # Local unification
+ (def unify @[])
+ (each syms b2g
+ (when (< 1 (length syms))
+ (array/push unify [= ;syms])))
+ # Global unification
+ (eachp [binding syms] gun
+ (array/push unify [= binding ;syms]))
+ (sort unify)
+ (array/concat anda unify)
+ # Final binding
+ (def defs (seq [[k v] :in (sort (pairs b2g))] ['def k (first v)]))
+ # Predicates
+ (unless (empty? preds)
+ (def pred-join ~(do ,;defs (and ,;preds)))
+ (array/push anda pred-join))
+ (emit-branch (tuple/slice anda) ['do ;defs expression]))
+
+ # Expand branches
+ (def stack @[else])
+ (each el (reverse accum)
+ (if (= :branch el)
+ (let [condition (array/pop stack)
+ truthy (array/pop stack)
+ if-form ~(if ,condition ,truthy
+ ,(case (length stack)
+ 0 nil
+ 1 (stack 0)
+ ~(do ,;(reverse stack))))]
+ (array/remove stack 0 (length stack))
+ (array/push stack if-form))
+ (array/push stack el)))
+
+ ~(do ,;(reverse stack)))
###
###
@@ -2061,7 +2141,8 @@
'quasiquote expandqq
'var expanddef
'while expandall
- 'break expandall})
+ 'break expandall
+ 'upscope expandall})
(defn dotup [t]
(def h (in t 0))
@@ -2359,9 +2440,6 @@
(default where "")
(default guard :ydt)
- # Are we done yet?
- (var going true)
-
# Evaluate 1 source form in a protected manner
(defn eval1 [source]
(def source (if expand (expand source) source))
@@ -2385,7 +2463,7 @@
(fiber/setenv f env)
(while (fiber/can-resume? f)
(def res (resume f resumeval))
- (when good (when going (set resumeval (onstatus f res))))))
+ (when good (set resumeval (onstatus f res)))))
# Reader version
(when read
@@ -2410,11 +2488,11 @@
# Loop
(def buf @"")
- (while going
+ (var parser-not-done true)
+ (while parser-not-done
(if (env :exit) (break))
(buffer/clear buf)
- (if (= (chunks buf p)
- :cancel)
+ (if (= (chunks buf p) :cancel)
(do
# A :cancel chunk represents a cancelled form in the REPL, so reset.
(:flush p)
@@ -2425,19 +2503,23 @@
(def len (length buf))
(when (= len 0)
(:eof p)
- (set going false))
+ (set parser-not-done false))
(while (> len pindex)
(+= pindex (p-consume p buf pindex))
(while (p-has-more p)
- (eval1 (p-produce p)))
+ (eval1 (p-produce p))
+ (if (env :exit) (break)))
(when (= (p-status p) :error)
- (parse-err p where))))))
+ (parse-err p where)
+ (if (env :exit) (break)))))))
# Check final parser state
- (while (p-has-more p)
- (eval1 (p-produce p)))
- (when (= (p-status p) :error)
- (parse-err p where))
+ (unless (env :exit)
+ (while (p-has-more p)
+ (eval1 (p-produce p))
+ (if (env :exit) (break)))
+ (when (= (p-status p) :error)
+ (parse-err p where)))
(in env :exit-value env))
@@ -2497,16 +2579,16 @@
(error (parser/error p))
(error "no value")))))
-(def make-image-dict
- `A table used in combination with marshal to marshal code (images), such that
- (make-image x) is the same as (marshal x make-image-dict).`
- @{})
-
(def load-image-dict
`A table used in combination with unmarshal to unmarshal byte sequences created
by make-image, such that (load-image bytes) is the same as (unmarshal bytes load-image-dict).`
@{})
+(def make-image-dict
+ `A table used in combination with marshal to marshal code (images), such that
+ (make-image x) is the same as (marshal x make-image-dict).`
+ @{})
+
(defmacro comptime
"Evals x at compile time and returns the result. Similar to a top level unquote."
[x]
@@ -2536,8 +2618,9 @@
[image]
(unmarshal image load-image-dict))
-(defn- check-. [x] (if (string/has-prefix? "." x) x))
-(defn- not-check-. [x] (unless (string/has-prefix? "." x) x))
+(defn- check-relative [x] (if (string/has-prefix? "." x) x))
+(defn- check-is-dep [x] (unless (or (string/has-prefix? "/" x) (string/has-prefix? "." x)) x))
+(defn- check-project-relative [x] (if (string/has-prefix? "/" x) x))
(def module/paths
```
@@ -2557,6 +2640,10 @@
(setdyn :syspath (boot/opts "JANET_PATH"))
(setdyn :headerpath (boot/opts "JANET_HEADERPATH"))
+(def module/cache
+ "Table mapping loaded module identifiers to their environments."
+ @{})
+
(defn module/add-paths
```
Add paths to module/paths for a given loader such that
@@ -2569,18 +2656,19 @@
(defn- find-prefix
[pre]
(or (find-index |(and (string? ($ 0)) (string/has-prefix? pre ($ 0))) module/paths) 0))
- (def all-index (find-prefix ":all:"))
- (array/insert module/paths all-index [(string ":all:" ext) loader not-check-.])
+ (def all-index (find-prefix ".:all:"))
+ (array/insert module/paths all-index [(string ".:all:" ext) loader check-project-relative])
(def sys-index (find-prefix ":sys:"))
- (array/insert module/paths sys-index [(string ":sys:/:all:" ext) loader not-check-.])
+ (array/insert module/paths sys-index [(string ":sys:/:all:" ext) loader check-is-dep])
(def curall-index (find-prefix ":cur:/:all:"))
- (array/insert module/paths curall-index [(string ":cur:/:all:" ext) loader check-.])
+ (array/insert module/paths curall-index [(string ":cur:/:all:" ext) loader check-relative])
module/paths)
(module/add-paths ":native:" :native)
(module/add-paths "/init.janet" :source)
(module/add-paths ".janet" :source)
(module/add-paths ".jimage" :image)
+(array/insert module/paths 0 [(fn is-cached [path] (if (in module/cache path) path)) :preload])
# Version of fexists that works even with a reduced OS
(defn fexists
@@ -2632,12 +2720,9 @@
(undef fexists)
(undef mod-filter)
-(undef check-.)
-(undef not-check-.)
-
-(def module/cache
- "Table mapping loaded module identifiers to their environments."
- @{})
+(undef check-relative)
+(undef check-project-relative)
+(undef check-is-dep)
(def module/loading
`Table mapping currently loading modules to true. Used to prevent
@@ -2665,15 +2750,25 @@
(def spath (string path))
(put env :current-file (or src (if-not path-is-file spath)))
(put env :source (or src (if-not path-is-file spath path)))
+ (var exit-error nil)
+ (var exit-fiber nil)
(defn chunks [buf _] (file/read f 2048 buf))
(defn bp [&opt x y]
- (def ret (bad-parse x y))
- (if exit (os/exit 1))
- ret)
+ (when exit
+ (bad-parse x y)
+ (os/exit 1))
+ (put env :exit true)
+ (def [line col] (:where x))
+ (def pe (string (:error x) " in " y " around line " line ", column " col))
+ (set exit-error pe))
(defn bc [&opt x y z]
- (def ret (bad-compile x y z))
- (if exit (os/exit 1))
- ret)
+ (when exit
+ (bad-compile x y z)
+ (os/exit 1))
+ (put env :exit true)
+ (def ce (string x " while compiling " z))
+ (set exit-error ce)
+ (set exit-fiber y))
(unless f
(error (string "could not find file " path)))
(def nenv
@@ -2683,27 +2778,40 @@
:on-compile-error bc
:on-status (fn [f x]
(when (not= (fiber/status f) :dead)
- (debug/stacktrace f x)
- (if exit (os/exit 1) (eflush))))
+ (when exit
+ (debug/stacktrace f x)
+ (eflush)
+ (os/exit 1))
+ (put env :exit true)
+ (set exit-error x)
+ (set exit-fiber f)))
:evaluator evaluator
:expander expander
:read read
:parser parser
:source (or src (if path-is-file "" spath))}))
(if-not path-is-file (file/close f))
+ (when exit-error
+ (if exit-fiber
+ (propagate exit-error exit-fiber)
+ (error exit-error)))
nenv)
(def module/loaders
`A table of loading method names to loading functions.
This table lets require and import load many different kinds
of files as modules.`
- @{:native (fn [path &] (native path (make-env)))
- :source (fn [path args]
+ @{:native (fn native-loader [path &] (native path (make-env)))
+ :source (fn source-loader [path args]
(put module/loading path true)
- (def newenv (dofile path ;args))
- (put module/loading path nil)
- newenv)
- :image (fn [path &] (load-image (slurp path)))})
+ (defer (put module/loading path nil)
+ (dofile path ;args)))
+ :preload (fn preload-loader [path & args]
+ (when-let [m (in module/cache path)]
+ (if (function? m)
+ (set (module/cache path) (m path ;args))
+ m)))
+ :image (fn image-loader [path &] (load-image (slurp path)))})
(defn require-1
[path args kargs]
@@ -3019,7 +3127,16 @@
(defmacro ev/spawn
"Run some code in a new fiber. This is shorthand for (ev/call (fn [] ;body))."
[& body]
- ~(,ev/call (fn [] ,;body))))
+ ~(,ev/call (fn [] ,;body)))
+
+ (defmacro ev/with-deadline
+ `Run a body of code with a deadline, such that if the code does not complete before
+ the deadline is up, it will be canceled.`
+ [deadline & body]
+ (with-syms [f]
+ ~(let [,f (coro ,;body)]
+ (,ev/deadline ,deadline nil ,f)
+ (,resume ,f)))))
(compwhen (dyn 'net/listen)
(defn net/server
@@ -3214,8 +3331,7 @@
(put load-dict 'boot/args nil)
(each [k v] (pairs load-dict)
(if (number? v) (put load-dict k nil)))
- (merge-into load-image-dict load-dict)
- (merge-into make-image-dict (invert load-dict)))
+ (merge-into load-image-dict load-dict))
###
###
diff --git a/src/conf/janetconf.h b/src/conf/janetconf.h
index b8875f7b..ef4efb88 100644
--- a/src/conf/janetconf.h
+++ b/src/conf/janetconf.h
@@ -5,9 +5,9 @@
#define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 13
-#define JANET_VERSION_PATCH 0
+#define JANET_VERSION_PATCH 2
#define JANET_VERSION_EXTRA "-dev"
-#define JANET_VERSION "1.13.0-dev"
+#define JANET_VERSION "1.13.2-dev"
/* #define JANET_BUILD "local" */
diff --git a/src/core/buffer.c b/src/core/buffer.c
index 6e040c00..ae490ddb 100644
--- a/src/core/buffer.c
+++ b/src/core/buffer.c
@@ -31,12 +31,11 @@
/* Initialize a buffer */
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
uint8_t *data = NULL;
- if (capacity > 0) {
- janet_gcpressure(capacity);
- data = malloc(sizeof(uint8_t) * (size_t) capacity);
- if (NULL == data) {
- JANET_OUT_OF_MEMORY;
- }
+ if (capacity < 4) capacity = 4;
+ janet_gcpressure(capacity);
+ data = malloc(sizeof(uint8_t) * (size_t) capacity);
+ if (NULL == data) {
+ JANET_OUT_OF_MEMORY;
}
buffer->count = 0;
buffer->capacity = capacity;
@@ -200,19 +199,14 @@ static Janet cfun_buffer_fill(int32_t argc, Janet *argv) {
static Janet cfun_buffer_trim(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
- if (buffer->count) {
- if (buffer->count < buffer->capacity) {
- uint8_t *newData = realloc(buffer->data, buffer->count);
- if (NULL == newData) {
- JANET_OUT_OF_MEMORY;
- }
- buffer->data = newData;
- buffer->capacity = buffer->count;
+ if (buffer->count < buffer->capacity) {
+ int32_t newcap = buffer->count > 4 ? buffer->count : 4;
+ uint8_t *newData = realloc(buffer->data, newcap);
+ if (NULL == newData) {
+ JANET_OUT_OF_MEMORY;
}
- } else {
- buffer->capacity = 0;
- free(buffer->data);
- buffer->data = NULL;
+ buffer->data = newData;
+ buffer->capacity = newcap;
}
return argv[0];
}
@@ -256,6 +250,26 @@ static Janet cfun_buffer_chars(int32_t argc, Janet *argv) {
return argv[0];
}
+static Janet cfun_buffer_push(int32_t argc, Janet *argv) {
+ int32_t i;
+ janet_arity(argc, 1, -1);
+ JanetBuffer *buffer = janet_getbuffer(argv, 0);
+ for (i = 1; i < argc; i++) {
+ if (janet_checktype(argv[i], JANET_NUMBER)) {
+ janet_buffer_push_u8(buffer, (uint8_t)(janet_getinteger(argv, i) & 0xFF));
+ } else {
+ JanetByteView view = janet_getbytes(argv, i);
+ if (view.bytes == buffer->data) {
+ janet_buffer_ensure(buffer, buffer->count + view.len, 2);
+ view.bytes = buffer->data;
+ }
+ janet_buffer_push_bytes(buffer, view.bytes, view.len);
+ }
+ }
+ return argv[0];
+}
+
+
static Janet cfun_buffer_clear(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
@@ -407,22 +421,32 @@ static const JanetReg buffer_cfuns[] = {
},
{
"buffer/push-byte", cfun_buffer_u8,
- JDOC("(buffer/push-byte buffer x)\n\n"
- "Append a byte to a buffer. Will expand the buffer as necessary. "
+ JDOC("(buffer/push-byte buffer & xs)\n\n"
+ "Append bytes to a buffer. Will expand the buffer as necessary. "
"Returns the modified buffer. Will throw an error if the buffer overflows.")
},
{
"buffer/push-word", cfun_buffer_word,
- JDOC("(buffer/push-word buffer x)\n\n"
- "Append a machine word to a buffer. The 4 bytes of the integer are appended "
- "in twos complement, little endian order, unsigned. Returns the modified buffer. Will "
+ JDOC("(buffer/push-word buffer & xs)\n\n"
+ "Append machine words to a buffer. The 4 bytes of the integer are appended "
+ "in twos complement, little endian order, unsigned for all x. Returns the modified buffer. Will "
"throw an error if the buffer overflows.")
},
{
"buffer/push-string", cfun_buffer_chars,
- JDOC("(buffer/push-string buffer str)\n\n"
- "Push a string onto the end of a buffer. Non string values will be converted "
- "to strings before being pushed. Returns the modified buffer. "
+ JDOC("(buffer/push-string buffer & xs)\n\n"
+ "Push byte sequences onto the end of a buffer. "
+ "Will accept any of strings, keywords, symbols, and buffers. "
+ "Returns the modified buffer. "
+ "Will throw an error if the buffer overflows.")
+ },
+ {
+ "buffer/push", cfun_buffer_push,
+ JDOC("(buffer/push buffer & xs)\n\n"
+ "Push both individual bytes and byte sequences to a buffer. For each x in xs, "
+ "push the byte if x is an integer, otherwise push the bytesequence to the buffer. "
+ "Thus, this function behaves like both `buffer/push-string` and `buffer/push-byte`. "
+ "Returns the modified buffer. "
"Will throw an error if the buffer overflows.")
},
{
diff --git a/src/core/corelib.c b/src/core/corelib.c
index f1c6c0d2..5e35bc18 100644
--- a/src/core/corelib.c
+++ b/src/core/corelib.c
@@ -548,35 +548,35 @@ static const JanetReg corelib_cfuns[] = {
{
"describe", janet_core_describe,
JDOC("(describe x)\n\n"
- "Returns a string that is a human readable description of a value x.")
+ "Returns a string that is a human-readable description of a value x.")
},
{
"string", janet_core_string,
- JDOC("(string & parts)\n\n"
- "Creates a string by concatenating values together. Values are "
- "converted to bytes via describe if they are not byte sequences. "
+ JDOC("(string & xs)\n\n"
+ "Creates a string by concatenating the elements of `xs` together. If an "
+ "element is not a byte sequence, it is converted to bytes via `describe`. "
"Returns the new string.")
},
{
"symbol", janet_core_symbol,
JDOC("(symbol & xs)\n\n"
- "Creates a symbol by concatenating values together. Values are "
- "converted to bytes via describe if they are not byte sequences. Returns "
- "the new symbol.")
+ "Creates a symbol by concatenating the elements of `xs` together. If an "
+ "element is not a byte sequence, it is converted to bytes via `describe`. "
+ "Returns the new symbol.")
},
{
"keyword", janet_core_keyword,
JDOC("(keyword & xs)\n\n"
- "Creates a keyword by concatenating values together. Values are "
- "converted to bytes via describe if they are not byte sequences. Returns "
- "the new keyword.")
+ "Creates a keyword by concatenating the elements of `xs` together. If an "
+ "element is not a byte sequence, it is converted to bytes via `describe`. "
+ "Returns the new keyword.")
},
{
"buffer", janet_core_buffer,
JDOC("(buffer & xs)\n\n"
- "Creates a new buffer by concatenating values together. Values are "
- "converted to bytes via describe if they are not byte sequences. Returns "
- "the new buffer.")
+ "Creates a buffer by concatenating the elements of `xs` together. If an "
+ "element is not a byte sequence, it is converted to bytes via `describe`. "
+ "Returns the new buffer.")
},
{
"abstract?", janet_core_is_abstract,
@@ -1250,6 +1250,21 @@ JanetTable *janet_core_env(JanetTable *replacements) {
JanetTable *env = janet_unwrap_table(marsh_out);
janet_vm_core_env = env;
+ /* Invert image dict manually here. We can't do this in boot.janet as it
+ * breaks deterministic builds */
+ Janet lidv, midv;
+ lidv = midv = janet_wrap_nil();
+ janet_resolve(env, janet_csymbol("load-image-dict"), &lidv);
+ janet_resolve(env, janet_csymbol("make-image-dict"), &midv);
+ JanetTable *lid = janet_unwrap_table(lidv);
+ JanetTable *mid = janet_unwrap_table(midv);
+ for (int32_t i = 0; i < lid->capacity; i++) {
+ const JanetKV *kv = lid->data + i;
+ if (!janet_checktype(kv->key, JANET_NIL)) {
+ janet_table_put(mid, kv->value, kv->key);
+ }
+ }
+
return env;
}
diff --git a/src/core/ev.c b/src/core/ev.c
index 94736642..d6fe845a 100644
--- a/src/core/ev.c
+++ b/src/core/ev.c
@@ -132,6 +132,7 @@ typedef struct JanetTimeout JanetTimeout;
struct JanetTimeout {
JanetTimestamp when;
JanetFiber *fiber;
+ JanetFiber *curr_fiber;
uint32_t sched_id;
int is_error;
};
@@ -378,12 +379,56 @@ static int janet_stream_getter(void *p, Janet key, Janet *out) {
return 0;
}
+static void janet_stream_marshal(void *p, JanetMarshalContext *ctx) {
+ JanetStream *s = p;
+ if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
+ janet_panic("can only marshal stream with unsafe flag");
+ }
+ janet_marshal_abstract(ctx, p);
+ janet_marshal_int(ctx, (int32_t) s->flags);
+ janet_marshal_int64(ctx, (intptr_t) 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
+ * unless there is a need to. */
+ janet_marshal_int64(ctx, (int64_t)(s->handle));
+#else
+ /* Marshal after dup becuse it is easier than maintaining our own ref counting. */
+ int duph = dup(s->handle);
+ if (duph < 0) janet_panicf("failed to duplicate stream handle: %V", janet_ev_lasterr());
+ janet_marshal_int(ctx, (int32_t)(duph));
+#endif
+}
+
+static void *janet_stream_unmarshal(JanetMarshalContext *ctx) {
+ if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
+ janet_panic("can only unmarshal stream with unsafe flag");
+ }
+ JanetStream *p = janet_unmarshal_abstract(ctx, sizeof(JanetStream));
+ /* Can't share listening state and such across threads */
+ p->_mask = 0;
+ p->state = NULL;
+ p->flags = (uint32_t) janet_unmarshal_int(ctx);
+ p->methods = (void *) janet_unmarshal_int64(ctx);
+#ifdef JANET_WINDOWS
+ p->handle = (JanetHandle) janet_unmarshal_int64(ctx);
+#else
+ p->handle = (JanetHandle) janet_unmarshal_int(ctx);
+#endif
+ return p;
+}
+
+
const JanetAbstractType janet_stream_type = {
"core/stream",
janet_stream_gc,
janet_stream_mark,
janet_stream_getter,
- JANET_ATEND_GET
+ NULL,
+ janet_stream_marshal,
+ janet_stream_unmarshal,
+ JANET_ATEND_UNMARSHAL
};
/* Register a fiber to resume with value */
@@ -435,6 +480,9 @@ void janet_ev_mark(void) {
/* Pending timeouts */
for (size_t i = 0; i < janet_vm_tq_count; i++) {
janet_mark(janet_wrap_fiber(janet_vm_tq[i].fiber));
+ if (janet_vm_tq[i].curr_fiber != NULL) {
+ janet_mark(janet_wrap_fiber(janet_vm_tq[i].curr_fiber));
+ }
}
/* Pending listeners */
@@ -488,6 +536,7 @@ void janet_addtimeout(double sec) {
JanetTimeout to;
to.when = ts_delta(ts_now(), sec);
to.fiber = fiber;
+ to.curr_fiber = NULL;
to.sched_id = fiber->sched_id;
to.is_error = 1;
add_timeout(to);
@@ -776,11 +825,27 @@ void janet_loop1(void) {
JanetTimestamp now = ts_now();
while (peek_timeout(&to) && to.when <= now) {
pop_timeout(0);
- if (to.fiber->sched_id == to.sched_id) {
- if (to.is_error) {
- janet_cancel(to.fiber, janet_cstringv("timeout"));
- } else {
- janet_schedule(to.fiber, janet_wrap_nil());
+ if (to.curr_fiber != NULL) {
+ /* This is a deadline (for a fiber, not a function call) */
+ JanetFiberStatus s = janet_fiber_status(to.curr_fiber);
+ int isFinished = s == (JANET_STATUS_DEAD ||
+ s == JANET_STATUS_ERROR ||
+ s == JANET_STATUS_USER0 ||
+ s == JANET_STATUS_USER1 ||
+ s == JANET_STATUS_USER2 ||
+ s == JANET_STATUS_USER3 ||
+ s == JANET_STATUS_USER4);
+ if (!isFinished) {
+ janet_cancel(to.fiber, janet_cstringv("deadline expired"));
+ }
+ } else {
+ /* This is a timeout (for a function call, not a whole fiber) */
+ if (to.fiber->sched_id == to.sched_id) {
+ if (to.is_error) {
+ janet_cancel(to.fiber, janet_cstringv("timeout"));
+ } else {
+ janet_schedule(to.fiber, janet_wrap_nil());
+ }
}
}
}
@@ -798,7 +863,7 @@ void janet_loop1(void) {
memset(&to, 0, sizeof(to));
int has_timeout;
/* Drop timeouts that are no longer needed */
- while ((has_timeout = peek_timeout(&to)) && to.fiber->sched_id != to.sched_id) {
+ while ((has_timeout = peek_timeout(&to)) && (to.curr_fiber == NULL) && to.fiber->sched_id != to.sched_id) {
pop_timeout(0);
}
/* Run polling implementation only if pending timeouts or pending events */
@@ -1319,7 +1384,7 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
janet_buffer_push_bytes(state->buf, state->chunk_buf, s->bytes);
state->bytes_left -= s->bytes;
- if (state->bytes_left <= 0 || !state->is_chunk || s->bytes == 0) {
+ if (state->bytes_left == 0 || !state->is_chunk || s->bytes == 0) {
Janet resume_val;
#ifdef JANET_NET
if (state->mode == JANET_ASYNC_READMODE_RECVFROM) {
@@ -1382,12 +1447,11 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
}
return JANET_ASYNC_STATUS_DONE;
}
- case JANET_ASYNC_EVENT_READ:
- /* Read in bytes */
- {
+ case JANET_ASYNC_EVENT_READ: {
JanetBuffer *buffer = state->buf;
int32_t bytes_left = state->bytes_left;
- janet_buffer_extra(buffer, bytes_left);
+ int32_t read_limit = bytes_left < 0 ? 4096 : bytes_left;
+ janet_buffer_extra(buffer, read_limit);
ssize_t nread;
#ifdef JANET_NET
char saddr[256];
@@ -1396,14 +1460,14 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
do {
#ifdef JANET_NET
if (state->mode == JANET_ASYNC_READMODE_RECVFROM) {
- nread = recvfrom(s->stream->handle, buffer->data + buffer->count, bytes_left, state->flags,
+ nread = recvfrom(s->stream->handle, buffer->data + buffer->count, read_limit, state->flags,
(struct sockaddr *)&saddr, &socklen);
} else if (state->mode == JANET_ASYNC_READMODE_RECV) {
- nread = recv(s->stream->handle, buffer->data + buffer->count, bytes_left, state->flags);
+ nread = recv(s->stream->handle, buffer->data + buffer->count, read_limit, state->flags);
} else
#endif
{
- nread = read(s->stream->handle, buffer->data + buffer->count, bytes_left);
+ nread = read(s->stream->handle, buffer->data + buffer->count, read_limit);
}
} while (nread == -1 && errno == EINTR);
@@ -1784,6 +1848,7 @@ JANET_NO_RETURN void janet_sleep_await(double sec) {
to.fiber = janet_vm_root_fiber;
to.is_error = 0;
to.sched_id = to.fiber->sched_id;
+ to.curr_fiber = NULL;
add_timeout(to);
janet_await();
}
@@ -1794,6 +1859,21 @@ static Janet cfun_ev_sleep(int32_t argc, Janet *argv) {
janet_sleep_await(sec);
}
+static Janet cfun_ev_deadline(int32_t argc, Janet *argv) {
+ janet_arity(argc, 1, 3);
+ double sec = janet_getnumber(argv, 0);
+ JanetFiber *tocancel = janet_optfiber(argv, argc, 1, janet_vm_root_fiber);
+ JanetFiber *tocheck = janet_optfiber(argv, argc, 2, janet_vm_fiber);
+ JanetTimeout to;
+ to.when = ts_delta(ts_now(), sec);
+ to.fiber = tocancel;
+ to.curr_fiber = tocheck;
+ to.is_error = 0;
+ to.sched_id = to.fiber->sched_id;
+ add_timeout(to);
+ return janet_wrap_fiber(tocancel);
+}
+
static Janet cfun_ev_cancel(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
JanetFiber *fiber = janet_getfiber(argv, 0);
@@ -1813,11 +1893,16 @@ Janet janet_cfun_stream_read(int32_t argc, Janet *argv) {
janet_arity(argc, 2, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_READABLE);
- int32_t n = janet_getnat(argv, 1);
JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, 10);
double to = janet_optnumber(argv, argc, 3, INFINITY);
- if (to != INFINITY) janet_addtimeout(to);
- janet_ev_read(stream, buffer, n);
+ if (janet_keyeq(argv[1], "all")) {
+ if (to != INFINITY) janet_addtimeout(to);
+ janet_ev_readchunk(stream, buffer, -1);
+ } else {
+ int32_t n = janet_getnat(argv, 1);
+ if (to != INFINITY) janet_addtimeout(to);
+ janet_ev_read(stream, buffer, n);
+ }
janet_await();
}
@@ -1867,6 +1952,14 @@ static const JanetReg ev_cfuns[] = {
JDOC("(ev/sleep sec)\n\n"
"Suspend the current fiber for sec seconds without blocking the event loop.")
},
+ {
+ "ev/deadline", cfun_ev_deadline,
+ JDOC("(ev/deadline sec &opt tocancel tocheck)\n\n"
+ "Set a deadline for a fiber `tocheck`. If `tocheck` is not finished after `sec` seconds, "
+ "`tocancel` will be canceled as with `ev/cancel`. "
+ "If `tocancel` and `tocheck` are not given, they default to `(fiber/root)` and "
+ "`(fiber/current)` respectively. Returns `tocancel`.")
+ },
{
"ev/chan", cfun_channel_new,
JDOC("(ev/chan &opt capacity)\n\n"
@@ -1924,7 +2017,8 @@ static const JanetReg ev_cfuns[] = {
{
"ev/read", janet_cfun_stream_read,
JDOC("(ev/read stream n &opt buffer timeout)\n\n"
- "Read up to n bytes into a buffer asynchronously from a stream. "
+ "Read up to n bytes into a buffer asynchronously from a stream. `n` can also be the keyword "
+ "`:all` to read into the buffer until end of stream. "
"Optionally provide a buffer to write into "
"as well as a timeout in seconds after which to cancel the operation and raise an error. "
"Returns the buffer if the read was successful or nil if end-of-stream reached. Will raise an "
diff --git a/src/core/fiber.c b/src/core/fiber.c
index f08aa047..546c89c5 100644
--- a/src/core/fiber.c
+++ b/src/core/fiber.c
@@ -420,8 +420,7 @@ void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun) {
newframe->flags = 0;
}
-/* Pop a stack frame from the fiber. Returns the new stack frame, or
- * NULL if there are no more frames */
+/* Pop a stack frame from the fiber. */
void janet_fiber_popframe(JanetFiber *fiber) {
JanetStackFrame *frame = janet_fiber_frame(fiber);
if (fiber->frame == 0) return;
diff --git a/src/core/gc.c b/src/core/gc.c
index 33435d9f..7788f48b 100644
--- a/src/core/gc.c
+++ b/src/core/gc.c
@@ -226,11 +226,14 @@ static void janet_mark_function(JanetFunction *func) {
if (janet_gc_reachable(func))
return;
janet_gc_mark(func);
- numenvs = func->def->environments_length;
- for (i = 0; i < numenvs; ++i) {
- janet_mark_funcenv(func->envs[i]);
+ if (NULL != func->def) {
+ /* this should always be true, except if function is only partially constructed */
+ numenvs = func->def->environments_length;
+ for (i = 0; i < numenvs; ++i) {
+ janet_mark_funcenv(func->envs[i]);
+ }
+ janet_mark_funcdef(func->def);
}
- janet_mark_funcdef(func->def);
}
static void janet_mark_fiber(JanetFiber *fiber) {
diff --git a/src/core/io.c b/src/core/io.c
index 47376290..8bdb3202 100644
--- a/src/core/io.c
+++ b/src/core/io.c
@@ -777,7 +777,7 @@ static const JanetReg io_cfuns[] = {
#ifndef JANET_NO_PROCESSES
{
"file/popen", cfun_io_popen,
- JDOC("(file/popen command &opt mode)\n\n"
+ JDOC("(file/popen command &opt mode) (DEPRECATED for os/spawn)\n\n"
"Open a file that is backed by a process. The file must be opened in either "
"the :r (read) or the :w (write) mode. In :r mode, the stdout of the "
"process can be read from the file. In :w mode, the stdin of the process "
diff --git a/src/core/marsh.c b/src/core/marsh.c
index 96767a53..e80932bc 100644
--- a/src/core/marsh.c
+++ b/src/core/marsh.c
@@ -286,7 +286,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
#define JANET_FIBER_FLAG_HASCHILD (1 << 29)
#define JANET_FIBER_FLAG_HASENV (1 << 30)
-#define JANET_STACKFRAME_HASENV (1 << 31)
+#define JANET_STACKFRAME_HASENV (INT32_MIN)
/* Marshal a fiber */
static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
@@ -542,9 +542,10 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
case JANET_FUNCTION: {
pushbyte(st, LB_FUNCTION);
JanetFunction *func = janet_unwrap_function(x);
- marshal_one_def(st, func->def, flags);
- /* Mark seen after reading def, but before envs */
+ /* Mark seen before reading def */
MARK_SEEN();
+ pushint(st, func->def->environments_length);
+ marshal_one_def(st, func->def, flags);
for (int32_t i = 0; i < func->def->environments_length; i++)
marshal_one_env(st, func->envs[i], flags + 1);
return;
@@ -1228,12 +1229,20 @@ static const uint8_t *unmarshal_one(
case LB_FUNCTION: {
JanetFunction *func;
JanetFuncDef *def;
- data = unmarshal_one_def(st, data + 1, &def, flags + 1);
+ data++;
+ int32_t len = readnat(st, &data);
+ if (len > 255) {
+ janet_panicf("invalid function");
+ }
func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) +
- def->environments_length * sizeof(JanetFuncEnv));
- func->def = def;
+ len * sizeof(JanetFuncEnv));
*out = janet_wrap_function(func);
janet_v_push(st->lookup, *out);
+ data = unmarshal_one_def(st, data, &def, flags + 1);
+ if (def->environments_length != len) {
+ janet_panicf("invalid function");
+ }
+ func->def = def;
for (int32_t i = 0; i < def->environments_length; i++) {
data = unmarshal_one_env(st, data, &(func->envs[i]), flags + 1);
}
diff --git a/src/core/net.c b/src/core/net.c
index f0b3984e..ed8a6e17 100644
--- a/src/core/net.c
+++ b/src/core/net.c
@@ -509,11 +509,16 @@ static Janet cfun_stream_read(int32_t argc, Janet *argv) {
janet_arity(argc, 2, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET);
- int32_t n = janet_getnat(argv, 1);
JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, 10);
double to = janet_optnumber(argv, argc, 3, INFINITY);
- if (to != INFINITY) janet_addtimeout(to);
- janet_ev_recv(stream, buffer, n, MSG_NOSIGNAL);
+ if (janet_keyeq(argv[1], "all")) {
+ if (to != INFINITY) janet_addtimeout(to);
+ janet_ev_recvchunk(stream, buffer, -1, MSG_NOSIGNAL);
+ } else {
+ int32_t n = janet_getnat(argv, 1);
+ if (to != INFINITY) janet_addtimeout(to);
+ janet_ev_recv(stream, buffer, n, MSG_NOSIGNAL);
+ }
janet_await();
}
@@ -643,6 +648,7 @@ static const JanetReg net_cfuns[] = {
"net/read", cfun_stream_read,
JDOC("(net/read stream nbytes &opt buf timeout)\n\n"
"Read up to n bytes from a stream, suspending the current fiber until the bytes are available. "
+ "`n` can also be the keyword `:all` to read into the buffer until end of stream. "
"If less than n bytes are available (and more than 0), will push those bytes and return early. "
"Takes an optional timeout in seconds, after which will return nil. "
"Returns a buffer with up to n more bytes in it, or raises an error if the read failed.")
diff --git a/src/core/os.c b/src/core/os.c
index 64539727..1f996732 100644
--- a/src/core/os.c
+++ b/src/core/os.c
@@ -2126,25 +2126,25 @@ static const JanetReg os_cfuns[] = {
"mode should be a file mode as passed to os/chmod, but only if the create flag is given. "
"The default mode is 8r666. "
"Allowed flags are as follows:\n\n"
- "\t:r - open this file for reading\n"
- "\t:w - open this file for writing\n"
- "\t:c - create a new file (O_CREATE)\n"
- "\t:e - fail if the file exists (O_EXCL)\n"
- "\t:t - shorten an existing file to length 0 (O_TRUNC)\n\n"
- "Posix only flags:\n"
- "\t:a - append to a file (O_APPEND)\n"
- "\t:x - O_SYNC\n"
- "\t:C - O_NOCTTY\n\n"
- "Windows only flags:\n"
- "\t:R - share reads (FILE_SHARE_READ)\n"
- "\t:W - share writes (FILE_SHARE_WRITE)\n"
- "\t:D - share deletes (FILE_SHARE_DELETE)\n"
- "\t:H - FILE_ATTRIBUTE_HIDDEN\n"
- "\t:O - FILE_ATTRIBUTE_READONLY\n"
- "\t:F - FILE_ATTRIBUTE_OFFLINE\n"
- "\t:T - FILE_ATTRIBUTE_TEMPORARY\n"
- "\t:d - FILE_FLAG_DELETE_ON_CLOSE\n"
- "\t:b - FILE_FLAG_NO_BUFFERING\n")
+ " * :r - open this file for reading\n"
+ " * :w - open this file for writing\n"
+ " * :c - create a new file (O_CREATE)\n"
+ " * :e - fail if the file exists (O_EXCL)\n"
+ " * :t - shorten an existing file to length 0 (O_TRUNC)\n\n"
+ "Posix only flags:\n\n"
+ " * :a - append to a file (O_APPEND)\n"
+ " * :x - O_SYNC\n"
+ " * :C - O_NOCTTY\n\n"
+ "Windows only flags:\n\n"
+ " * :R - share reads (FILE_SHARE_READ)\n"
+ " * :W - share writes (FILE_SHARE_WRITE)\n"
+ " * :D - share deletes (FILE_SHARE_DELETE)\n"
+ " * :H - FILE_ATTRIBUTE_HIDDEN\n"
+ " * :O - FILE_ATTRIBUTE_READONLY\n"
+ " * :F - FILE_ATTRIBUTE_OFFLINE\n"
+ " * :T - FILE_ATTRIBUTE_TEMPORARY\n"
+ " * :d - FILE_FLAG_DELETE_ON_CLOSE\n"
+ " * :b - FILE_FLAG_NO_BUFFERING\n")
},
{
"os/pipe", os_pipe,
diff --git a/src/core/parse.c b/src/core/parse.c
index 16b67c17..e59ca132 100644
--- a/src/core/parse.c
+++ b/src/core/parse.c
@@ -985,8 +985,20 @@ static Janet cfun_parse_flush(int32_t argc, Janet *argv) {
}
static Janet cfun_parse_where(int32_t argc, Janet *argv) {
- janet_fixarity(argc, 1);
+ janet_arity(argc, 1, 3);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
+ if (argc > 1) {
+ int32_t line = janet_getinteger(argv, 1);
+ if (line < 1)
+ janet_panicf("invalid line number %d", line);
+ p->line = (size_t) line;
+ }
+ if (argc > 2) {
+ int32_t column = janet_getinteger(argv, 2);
+ if (column < 0)
+ janet_panicf("invalid column number %d", column);
+ p->column = (size_t) column;
+ }
Janet *tup = janet_tuple_begin(2);
tup[0] = janet_wrap_integer(p->line);
tup[1] = janet_wrap_integer(p->column);
@@ -1247,8 +1259,10 @@ static const JanetReg parse_cfuns[] = {
},
{
"parser/where", cfun_parse_where,
- JDOC("(parser/where parser)\n\n"
- "Returns the current line number and column of the parser's internal state.")
+ JDOC("(parser/where parser &opt line col)\n\n"
+ "Returns the current line number and column of the parser's internal state. If line is "
+ "provided, the current line number of the parser is first set to that value. If column is "
+ "also provided, the current column number of the parser is also first set to that value.")
},
{
"parser/eof", cfun_parse_eof,
diff --git a/src/core/pp.c b/src/core/pp.c
index 1fcc1e18..65a8d755 100644
--- a/src/core/pp.c
+++ b/src/core/pp.c
@@ -565,7 +565,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
JanetTable *t = janet_unwrap_table(x);
JanetTable *proto = t->proto;
if (NULL != proto) {
- Janet name = janet_table_get(proto, janet_ckeywordv("name"));
+ Janet name = janet_table_get(proto, janet_ckeywordv("_name"));
const uint8_t *n;
int32_t len;
if (janet_bytes_view(name, &n, &len)) {
diff --git a/src/core/util.c b/src/core/util.c
index e2257759..3886ced1 100644
--- a/src/core/util.c
+++ b/src/core/util.c
@@ -227,19 +227,21 @@ int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
/* Computes hash of an array of values */
int32_t janet_array_calchash(const Janet *array, int32_t len) {
const Janet *end = array + len;
- uint32_t hash = 5381;
- while (array < end)
- hash = (hash << 5) + hash + janet_hash(*array++);
+ uint32_t hash = 0;
+ while (array < end) {
+ uint32_t elem = janet_hash(*array++);
+ hash ^= elem + 0x9e3779b9 + (hash << 6) + (hash >> 2);
+ }
return (int32_t) hash;
}
/* Computes hash of an array of values */
int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len) {
const JanetKV *end = kvs + len;
- uint32_t hash = 5381;
+ uint32_t hash = 0;
while (kvs < end) {
- hash = (hash << 5) + hash + janet_hash(kvs->key);
- hash = (hash << 5) + hash + janet_hash(kvs->value);
+ hash ^= janet_hash(kvs->key) + 0x9e3779b9 + (hash << 6) + (hash >> 2);
+ hash ^= janet_hash(kvs->value) + 0x9e3779b9 + (hash << 6) + (hash >> 2);
kvs++;
}
return (int32_t) hash;
diff --git a/src/core/value.c b/src/core/value.c
index 1be7966c..ae418d5e 100644
--- a/src/core/value.c
+++ b/src/core/value.c
@@ -28,6 +28,8 @@
#include
#endif
+#include
+
JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal = NULL;
JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_top = NULL;
JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_base = NULL;
@@ -261,6 +263,21 @@ int32_t janet_hash(Janet x) {
case JANET_STRUCT:
hash = janet_struct_hash(janet_unwrap_struct(x));
break;
+ case JANET_NUMBER: {
+ double num = janet_unwrap_number(x);
+ if (isnan(num) || isinf(num) || num == 0) {
+ hash = 0;
+ } else {
+ hash = (int32_t)num;
+ hash = ((hash >> 16) ^ hash) * 0x45d9f3b;
+ hash = ((hash >> 16) ^ hash) * 0x45d9f3b;
+ hash = (hash >> 16) ^ hash;
+
+ uint32_t lo = (uint32_t)(janet_u64(x) & 0xFFFFFFFF);
+ hash ^= lo + 0x9e3779b9 + (hash << 6) + (hash >> 2);
+ }
+ break;
+ }
case JANET_ABSTRACT: {
JanetAbstract xx = janet_unwrap_abstract(x);
const JanetAbstractType *at = janet_abstract_type(xx);
diff --git a/src/mainclient/shell.c b/src/mainclient/shell.c
index 47de7788..174a324f 100644
--- a/src/mainclient/shell.c
+++ b/src/mainclient/shell.c
@@ -126,28 +126,21 @@ https://github.com/antirez/linenoise/blob/master/linenoise.c
#define JANET_LINE_MAX 1024
#define JANET_MATCH_MAX 256
#define JANET_HISTORY_MAX 100
-static int gbl_israwmode = 0;
-static const char *gbl_prompt = "> ";
-static int gbl_plen = 2;
-static char gbl_buf[JANET_LINE_MAX];
-static int gbl_len = 0;
-static int gbl_pos = 0;
-static int gbl_cols = 80;
-static char *gbl_history[JANET_HISTORY_MAX];
-static int gbl_history_count = 0;
-static int gbl_historyi = 0;
-static int gbl_sigint_flag = 0;
-static struct termios gbl_termios_start;
-static JanetByteView gbl_matches[JANET_MATCH_MAX];
-static int gbl_match_count = 0;
-static int gbl_lines_below = 0;
-
-/* Put a lock around this global state so we don't screw up
- * the terminal in a multithreaded situation */
-#ifndef JANET_SINGLE_THREADED
-#include
-static pthread_mutex_t gbl_lock = PTHREAD_MUTEX_INITIALIZER;
-#endif
+static JANET_THREAD_LOCAL int gbl_israwmode = 0;
+static JANET_THREAD_LOCAL const char *gbl_prompt = "> ";
+static JANET_THREAD_LOCAL int gbl_plen = 2;
+static JANET_THREAD_LOCAL char gbl_buf[JANET_LINE_MAX];
+static JANET_THREAD_LOCAL int gbl_len = 0;
+static JANET_THREAD_LOCAL int gbl_pos = 0;
+static JANET_THREAD_LOCAL int gbl_cols = 80;
+static JANET_THREAD_LOCAL char *gbl_history[JANET_HISTORY_MAX];
+static JANET_THREAD_LOCAL int gbl_history_count = 0;
+static JANET_THREAD_LOCAL int gbl_historyi = 0;
+static JANET_THREAD_LOCAL int gbl_sigint_flag = 0;
+static JANET_THREAD_LOCAL struct termios gbl_termios_start;
+static JANET_THREAD_LOCAL JanetByteView gbl_matches[JANET_MATCH_MAX];
+static JANET_THREAD_LOCAL int gbl_match_count = 0;
+static JANET_THREAD_LOCAL int gbl_lines_below = 0;
/* Unsupported terminal list from linenoise */
static const char *badterms[] = {
@@ -169,9 +162,6 @@ static char *sdup(const char *s) {
/* Ansi terminal raw mode */
static int rawmode(void) {
struct termios t;
-#ifndef JANET_SINGLE_THREADED
- pthread_mutex_lock(&gbl_lock);
-#endif
if (!isatty(STDIN_FILENO)) goto fatal;
if (tcgetattr(STDIN_FILENO, &gbl_termios_start) == -1) goto fatal;
t = gbl_termios_start;
@@ -185,9 +175,6 @@ static int rawmode(void) {
return 0;
fatal:
errno = ENOTTY;
-#ifndef JANET_SINGLE_THREADED
- pthread_mutex_unlock(&gbl_lock);
-#endif
return -1;
}
@@ -195,9 +182,6 @@ fatal:
static void norawmode(void) {
if (gbl_israwmode && tcsetattr(STDIN_FILENO, TCSADRAIN, &gbl_termios_start) != -1)
gbl_israwmode = 0;
-#ifndef JANET_SINGLE_THREADED
- pthread_mutex_unlock(&gbl_lock);
-#endif
}
static int curpos(void) {
@@ -774,6 +758,10 @@ static int line() {
kleft();
break;
case 3: /* ctrl-c */
+ clearlines();
+ gbl_sigint_flag = 1;
+ return -1;
+ case 17: /* ctrl-q */
gbl_cancel_current_repl_form = 1;
clearlines();
return -1;
diff --git a/test/helper.janet b/test/helper.janet
index 3e697b8a..0d97265b 100644
--- a/test/helper.janet
+++ b/test/helper.janet
@@ -13,7 +13,7 @@
(when x (++ num-tests-passed))
(def str (string e))
(def truncated
- (if (> (length e) 40) (string (string/slice e 0 35) "...") (string e)))
+ (if (> (length e) 40) (string (string/slice e 0 35) "...") (describe e)))
(if x
(eprintf "\e[32m✔\e[0m %s: %v" truncated x)
(eprintf "\n\e[31m✘\e[0m %s: %v" truncated x))
diff --git a/test/install/test/test1.janet b/test/install/test/test1.janet
index 57fde0e1..d6c9c0f5 100644
--- a/test/install/test/test1.janet
+++ b/test/install/test/test1.janet
@@ -1,3 +1,3 @@
-(import build/testmod :as testmod)
+(import /build/testmod :as testmod)
(if (not= 5 (testmod/get5)) (error "testmod/get5 failed"))
diff --git a/test/install/testexec.janet b/test/install/testexec.janet
index 4f4c5020..36c91498 100644
--- a/test/install/testexec.janet
+++ b/test/install/testexec.janet
@@ -1,7 +1,7 @@
-(use build/testmod)
-(use build/testmod2)
-(use build/testmod3)
-(use build/test-mod-4)
+(use /build/testmod)
+(use /build/testmod2)
+(use /build/testmod3)
+(use /build/test-mod-4)
(defn main [&]
(print "Hello from executable!")
diff --git a/test/suite0006.janet b/test/suite0006.janet
index 679a6425..42f2367d 100644
--- a/test/suite0006.janet
+++ b/test/suite0006.janet
@@ -128,6 +128,18 @@
(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")
diff --git a/test/suite0008.janet b/test/suite0008.janet
index 92e40e44..a10508bf 100644
--- a/test/suite0008.janet
+++ b/test/suite0008.janet
@@ -125,6 +125,7 @@
(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))
@@ -221,20 +222,6 @@
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))
-# No segfault, valgrind clean.
-
-(def x @"\xCC\xCD.nd\x80\0\r\x1C\xCDg!\0\x07\xCC\xCD\r\x1Ce\x10\0\r;\xCDb\x04\xFF9\xFF\x80\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04uu\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\0\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04}\x04\x04\x04\x04\x04\x04\x04\x04#\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\0\x01\0\0\x03\x04\x04\x04\xE2\x03\x04\x04\x04\x04\x04\x04\x04\x04\x04\x14\x1A\x04\x04\x04\x04\x04\x18\x04\x04!\x04\xE2\x03\x04\x04\x04\x04\x04\x04$\x04\x04\x04\x04\x04\x04\x04\x04\x04\x80\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04A\0\0\0\x03\0\0!\xBF\xFF")
-(assert-error "bad fiber status" (unmarshal x load-image-dict))
-(gccollect)
-(marshal x make-image-dict)
-
-(def b @"\xCC\xCD\0\x03\0\x08\x04\rm\xCD\x7F\xFF\xFF\xFF\x02\0\x02\xD7\xCD\0\x98\0\0\x05\x01\x01\x01\x01\x08\xCE\x01f\xCE../tools/afl/generate_unmarshal_testcases.janet\xCE\x012,\x01\0\0&\x03\0\06\x02\x03\x03)\x03\x01\0*\x04\0\00\x03\x04\0>\x03\0\0\x03\x03\0\0*\x05\0\x11\0\x11\0\x05\0\x05\0\x05\0\x05\0\x05\xC9\xDA\x04\xC9\xC9\xC9")
-(unmarshal b load-image-dict)
-(gccollect)
-
-(def v (unmarshal
- @"\xD7\xCD0\xD4000000\0\x03\x01\xCE\00\0\x01\0\0000\x03\0\0\0000000000\xCC0\0000"
- load-image-dict))
(gccollect)
# in vs get regression
@@ -349,4 +336,12 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
(check-replacer "aba" "ZZZZZZ" "ababababababa")
(check-replacer "aba" "" "ababababababa")
+# 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")
+
(end-suite)