1
0
mirror of https://github.com/janet-lang/janet synced 2026-04-03 13:31:28 +00:00

Compare commits

..

8 Commits

Author SHA1 Message Date
Calvin Rose
df32109eea Small typo fixes in comments. 2026-03-15 20:22:20 -05:00
Calvin Rose
8b89901298 Deduplicate lints.
Why see the same message twice?
2026-03-15 18:27:13 -05:00
Calvin Rose
079776d39e Elaborate comment. 2026-03-15 15:34:52 -05:00
Calvin Rose
6c2f08ef49 Add unit tests for variable shadowing. 2026-03-15 13:34:12 -05:00
Calvin Rose
980999c97b Make test suite not shadow any variables. 2026-03-15 13:14:10 -05:00
Calvin Rose
1197cfe433 Check redef only once per compile call. 2026-03-15 12:56:10 -05:00
Calvin Rose
c63c6740d9 First pass at linting binding shadowing.
Prevent redefining bindings by accident. There are
a few cases where we want to allow this, such as the `default` macro, so
we allow a keyword :shadow to be included in the `def` expression to
turn off this lint.

TODO:
* Clean up test suite to remove binding shadowing
* Make sure that we don't get lints with *redef* turned on
* Add positive and negative tests for lint messages.
* Add location of shadowed binding in message
2026-03-15 11:24:07 -05:00
Calvin Rose
612971503d Add LLM, AI and tool usage section to contribution guide. (#1730)
* Add LLM, AI and tool usage section to contribution guide.

* Word order and punctuation.

* Add suggestions.

- No bot PRs
- Define "Large" code contribution

Also try to disuade users from using AI for one-line or simple changes, instead
preferring to treat that as "feedback" and rewrite instead.

* Remove wiggle room for any AI code in the Janet runtime.

Still leave open the possibity for AI / tool usage for static analysis
and bug repots. However, the 5-15 lines of code limitation is fuzzy and
arbitrary. We can just say no.

* Remove word.
2026-03-14 23:13:29 -05:00
19 changed files with 196 additions and 151 deletions

View File

@@ -3,10 +3,10 @@
(defn bork [x]
(defn bark [x]
(defn bark [y]
(print "Woof!")
(print x)
(error x)
(print y)
(error y)
(print "Woof!"))
(bark (* 2 x))

View File

@@ -7,13 +7,13 @@
(print "simple yielding")
(each item f (print "got: " item ", now " (fiber/status f)))
(def f
(def f2
(coro
(for i 0 10
(yield (string "yield " i))
(ev/sleep 0))))
(print "complex yielding")
(each item f (print "got: " item ", now " (fiber/status f)))
(each item f2 (print "got: " item ", now " (fiber/status f2)))
(print (fiber/status f))
(print (fiber/status f2))

View File

@@ -4,7 +4,7 @@
# that must be called (realizing it), and the memoized.
# Use with (import "./path/to/this/file" :prefix "seq.")
(defmacro delay
(defmacro dolazy
"Lazily evaluate a series of expressions. Returns a function that
returns the result of the last expression. Will only evaluate the
body once, and then memoizes the result."
@@ -35,7 +35,7 @@
(def x (tuple h t))
(fn [] x))
(defn empty?
(defn lazy-empty?
"Check if a sequence is empty."
[s]
(not (s)))
@@ -55,14 +55,14 @@
[start end &]
(if end
(if (< start end)
(delay (tuple start (lazy-range (+ 1 start) end)))
(dolazy (tuple start (lazy-range (+ 1 start) end)))
empty-seq)
(lazy-range 0 start)))
(defn lazy-map
"Return a sequence that is the result of applying f to each value in s."
[f s]
(delay
(dolazy
(def x (s))
(if x (tuple (f (get x HEAD)) (map f (get x TAIL))))))
@@ -76,31 +76,31 @@
[f s]
(when (s) (f (head s)) (realize-map f (tail s))))
(defn drop
(defn lazy-drop
"Ignores the first n values of the sequence and returns the rest."
[n s]
(delay
(dolazy
(def x (s))
(if (and x (pos? n)) ((drop (- n 1) (get x TAIL))))))
(if (and x (pos? n)) ((lazy-drop (- n 1) (get x TAIL))))))
(defn take
(defn lazy-take
"Returns at most the first n values of s."
[n s]
(delay
(dolazy
(def x (s))
(if (and x (pos? n))
(tuple (get x HEAD) (take (- n 1) (get x TAIL))))))
(tuple (get x HEAD) (lazy-take (- n 1) (get x TAIL))))))
(defn randseq
"Return a sequence of random numbers."
[]
(delay (tuple (math/random) (randseq))))
(dolazy (tuple (math/random) (randseq))))
(defn take-while
(defn lazy-take-while
"Returns a sequence of values until the predicate is false."
[pred s]
(delay
(dolazy
(def x (s))
(when x
(def thehead (get HEAD x))
(if thehead (tuple thehead (take-while pred (get TAIL x)))))))
(if thehead (tuple thehead (lazy-take-while pred (get TAIL x)))))))

View File

@@ -16,8 +16,8 @@
(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)))]
:let [ncount (get neighbor-set coord)]
:when (or (= ncount 3) (and (get cell-set coord) (= ncount 2)))]
coord))
(defn draw

View File

@@ -46,7 +46,6 @@
(defn defmacro :macro :flycheck
"Define a macro."
[name & more]
(setdyn name @{}) # override old macro definitions in the case of a recursive macro
(apply defn name :macro more))
(defmacro as-macro
@@ -219,9 +218,9 @@
(defmacro default
``Define a default value for an optional argument.
Expands to `(def sym (if (= nil sym) val sym))`.``
Expands to `(def sym :shadow (if (= nil sym) val sym))`.``
[sym val]
~(def ,sym (if (,= nil ,sym) ,val ,sym)))
~(def ,sym :shadow (if (,= nil ,sym) ,val ,sym)))
(defmacro comment
"Ignores the body of the comment."
@@ -2675,17 +2674,17 @@
(var resumeval nil)
(def f
(fiber/new
(fn []
(fn :compile-and-lint []
(array/clear lints)
(def res (compile source env where lints))
(unless (empty? lints)
(when (next lints)
# Convert lint levels to numbers.
(def levels (get env *lint-levels* lint-levels))
(def lint-error (get env *lint-error*))
(def lint-warning (get env *lint-warn*))
(def lint-error (or (get levels lint-error lint-error) 0))
(def lint-warning (or (get levels lint-warning lint-warning) 2))
(each [level line col msg] lints
(each [level line col msg] (distinct lints) # some macros might cause code to be duplicated. Avoid repeated messages.
(def lvl (get lint-levels level 0))
(cond
(<= lvl lint-error) (do

View File

@@ -91,29 +91,28 @@ void janetc_freeslot(JanetCompiler *c, JanetSlot s) {
}
/* Add a slot to a scope with a symbol associated with it (def or var). */
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s) {
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s, uint32_t flags) {
if (!(flags & JANET_DEFFLAG_NO_SHADOWCHECK)) {
if (sym[0] != '_') {
int check = janetc_shadowcheck(c, sym);
if (check == 2) {
janetc_lintf(c, JANET_C_LINT_NORMAL, "binding %q is shadowing a local binding", janet_wrap_symbol(sym));
} else if (check) {
janetc_lintf(c, JANET_C_LINT_NORMAL, "binding %q is shadowing a global binding", janet_wrap_symbol(sym));
}
}
}
SymPair sp;
int32_t cnt = janet_v_count(c->buffer);
sp.sym = sym;
sp.sym2 = sym;
sp.slot = s;
sp.keep = 0;
sp.referenced = sym[0] == '_'; /* Fake ref if symbol is _ to avoid lints */
sp.slot.flags |= JANET_SLOT_NAMED;
sp.birth_pc = cnt ? cnt - 1 : 0;
sp.death_pc = UINT32_MAX;
janet_v_push(c->scope->syms, sp);
}
/* Same as janetc_nameslot, but don't have a lint for unused bindings. */
void janetc_nameslot_no_unused(JanetCompiler *c, const uint8_t *sym, JanetSlot s) {
SymPair sp;
int32_t cnt = janet_v_count(c->buffer);
sp.sym = sym;
sp.sym2 = sym;
sp.slot = s;
sp.keep = 0;
sp.referenced = 1;
if (flags & JANET_DEFFLAG_NO_UNUSED) {
sp.referenced = 1;
} else {
sp.referenced = sym[0] == '_'; /* Fake ref if symbol starts with _ to avoid lints */
}
sp.slot.flags |= JANET_SLOT_NAMED;
sp.birth_pc = cnt ? cnt - 1 : 0;
sp.death_pc = UINT32_MAX;
@@ -260,6 +259,24 @@ static int lookup_missing(
return 1;
}
/* Check if a binding is defined in an upper scope. This lets us check for
* variable shadowing. */
int janetc_shadowcheck(JanetCompiler *c, const uint8_t *sym) {
/* Check locals */
JanetScope *scope = c->scope;
while (scope) {
int32_t len = janet_v_count(scope->syms);
for (int32_t i = len - 1; i >= 0; i--) {
SymPair *pair = scope->syms + i;
if (pair->sym == sym) return 2;
}
scope = scope->parent;
}
/* Check globals */
JanetBinding binding = janet_resolve_ext(c->env, sym);
return binding.type != JANET_BINDING_NONE;
}
/* Allow searching for symbols. Return information about the symbol */
JanetSlot janetc_resolve(
JanetCompiler *c,
@@ -1103,6 +1120,7 @@ static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where,
c->current_mapping.line = -1;
c->current_mapping.column = -1;
c->lints = lints;
c->is_redef = janet_truthy(janet_table_get_keyword(c->env, "redef"));
/* Init result */
c->result.error = NULL;
c->result.status = JANET_COMPILE_OK;

View File

@@ -184,6 +184,9 @@ struct JanetCompiler {
/* Collect linting results */
JanetArray *lints;
/* Cached version of (dyn *redef*) */
int is_redef;
};
#define JANET_FOPTS_TAIL 0x10000
@@ -221,9 +224,11 @@ const JanetFunOptimizer *janetc_funopt(uint32_t flags);
/* Get a special. Return NULL if none exists */
const JanetSpecial *janetc_special(const uint8_t *name);
#define JANET_DEFFLAG_NO_SHADOWCHECK 1
#define JANET_DEFFLAG_NO_UNUSED 2
void janetc_freeslot(JanetCompiler *c, JanetSlot s);
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s);
void janetc_nameslot_no_unused(JanetCompiler *c, const uint8_t *sym, JanetSlot s);
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s, uint32_t flags);
JanetSlot janetc_farslot(JanetCompiler *c);
/* Throw away some code after checking that it is well formed. */
@@ -267,9 +272,12 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c);
/* Create a destroy slot */
JanetSlot janetc_cslot(Janet x);
/* Search for a symbol */
/* Search for a symbol, and mark any found symbols as "used" for dead code elimination and linting */
JanetSlot janetc_resolve(JanetCompiler *c, const uint8_t *sym);
/* Check if a symbol is already in scope for shadowing lints */
int janetc_shadowcheck(JanetCompiler *c, const uint8_t *sym);
/* Bytecode optimization */
void janet_bytecode_movopt(JanetFuncDef *def);
void janet_bytecode_remove_noops(JanetFuncDef *def);

View File

@@ -404,7 +404,7 @@ SlotHeadPair *dohead_destructure(JanetCompiler *c, SlotHeadPair *into, JanetFopt
}
/* Def or var a symbol in a local scope */
static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, JanetSlot ret, int no_unused) {
static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, JanetSlot ret, uint32_t def_flags) {
int isUnnamedRegister = !(ret.flags & JANET_SLOT_NAMED) &&
ret.index > 0 &&
ret.envindex >= 0;
@@ -425,11 +425,10 @@ static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, Janet
ret = localslot;
}
ret.flags |= flags;
if ((c->scope->flags & JANET_SCOPE_TOP) || no_unused) {
janetc_nameslot_no_unused(c, head, ret);
} else {
janetc_nameslot(c, head, ret);
if (c->scope->flags & JANET_SCOPE_TOP) {
def_flags |= JANET_DEFFLAG_NO_UNUSED;
}
janetc_nameslot(c, head, ret, def_flags);
return !isUnnamedRegister;
}
@@ -443,7 +442,7 @@ static int varleaf(
JanetSlot refslot;
JanetTable *entry = janet_table_clone(reftab);
int is_redef = janet_truthy(janet_table_get_keyword(c->env, "redef"));
int is_redef = c->is_redef;
JanetArray *ref;
JanetBinding old_binding;
@@ -464,7 +463,11 @@ static int varleaf(
return 1;
} else {
int no_unused = reftab && reftab->count && janet_truthy(janet_table_get_keyword(reftab, "unused"));
return namelocal(c, sym, JANET_SLOT_MUTABLE, s, no_unused);
int no_shadow = reftab && reftab->count && janet_truthy(janet_table_get_keyword(reftab, "shadow"));
uint32_t def_flags = 0;
if (no_unused) def_flags |= JANET_DEFFLAG_NO_UNUSED;
if (no_shadow) def_flags |= JANET_DEFFLAG_NO_SHADOWCHECK;
return namelocal(c, sym, JANET_SLOT_MUTABLE, s, def_flags);
}
}
@@ -505,12 +508,14 @@ static int defleaf(
const uint8_t *sym,
JanetSlot s,
JanetTable *tab) {
JanetTable *entry = NULL;
int is_redef = 0;
if (c->scope->flags & JANET_SCOPE_TOP) {
JanetTable *entry = janet_table_clone(tab);
entry = janet_table_clone(tab);
janet_table_put(entry, janet_ckeywordv("source-map"),
janet_wrap_tuple(janetc_make_sourcemap(c)));
int is_redef = janet_truthy(janet_table_get_keyword(c->env, "redef"));
is_redef = c->is_redef;
if (is_redef) janet_table_put(entry, janet_ckeywordv("redef"), janet_wrap_true());
if (is_redef) {
@@ -530,12 +535,18 @@ static int defleaf(
JanetSlot tabslot = janetc_cslot(janet_wrap_table(entry));
janetc_emit_sss(c, JOP_PUT, tabslot, valsym, s, 0);
}
/* Add env entry to env */
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(entry));
}
int no_unused = tab && tab->count && janet_truthy(janet_table_get_keyword(tab, "unused"));
return namelocal(c, sym, 0, s, no_unused);
int no_shadow = is_redef || (tab && tab->count && janet_truthy(janet_table_get_keyword(tab, "shadow")));
uint32_t def_flags = 0;
if (no_unused) def_flags |= JANET_DEFFLAG_NO_UNUSED;
if (no_shadow) def_flags |= JANET_DEFFLAG_NO_SHADOWCHECK;
int result = namelocal(c, sym, 0, s, def_flags);
if (entry) {
/* Add env entry to env AFTER namelocal to avoid the shadowcheck false positive */
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(entry));
}
return result;
}
static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
@@ -1066,10 +1077,10 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
named_table = janet_table(10);
named_slot = janetc_farslot(c);
} else {
janetc_nameslot(c, sym, janetc_farslot(c));
janetc_nameslot(c, sym, janetc_farslot(c), 0);
}
} else {
janetc_nameslot(c, sym, janetc_farslot(c));
janetc_nameslot(c, sym, janetc_farslot(c), 0);
}
} else {
janet_v_push(destructed_params, janetc_farslot(c));
@@ -1118,7 +1129,9 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
JanetSlot slot = janetc_farslot(c);
slot.flags = JANET_SLOT_NAMED | JANET_FUNCTION;
janetc_emit_s(c, JOP_LOAD_SELF, slot, 1);
janetc_nameslot_no_unused(c, sym, slot);
/* We should figure out a better way to avoid `(def x 1) (def x :shadow (fn x [...] ...))` triggering a
* shadow lint for the last x */
janetc_nameslot(c, sym, slot, JANET_DEFFLAG_NO_UNUSED | JANET_DEFFLAG_NO_SHADOWCHECK);
}
}

View File

@@ -27,9 +27,11 @@
(def line-info (string/format "%s:%d"
(frame :source) (frame :source-line)))
(if x
(when is-verbose (eprintf "\e[32m✔\e[0m %s: %s: %v" line-info (describe e) x))
(when is-verbose
(eprintf "\e[32m✔\e[0m %s: %s: %v" line-info (describe e) x)
(eflush) (flush))
(do
(eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush)))
(eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush) (flush)))
x)
(defn skip-asserts
@@ -38,7 +40,7 @@
(+= skip-n n)
nil)
(defmacro assert
(defmacro assert :shadow
[x &opt e]
(def xx (gensym))
(default e (string/format "%j" x))
@@ -50,12 +52,12 @@
(defmacro assert-error
[msg & forms]
(def errsym (keyword (gensym)))
~(assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
~(as-macro ,assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
(defmacro assert-error-value
[msg errval & forms]
(def e (gensym))
~(assert (= ,errval (try (do ,;forms) ([,e] ,e))) ,msg))
~(as-macro ,assert (= ,errval (try (do ,;forms) ([,e] ,e))) ,msg))
(defn check-compile-error
[form]

View File

@@ -70,9 +70,9 @@
(assert (= (array/pop @[]) nil) "array/pop empty")
# Code coverage
(def a @[1])
(array/pop a)
(array/trim a)
(def a1 @[1])
(array/pop a1)
(array/trim a1)
(array/ensure @[1 1] 6 2)
# array/join

View File

@@ -48,8 +48,8 @@
(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")
(def b1 @"AA")
(assert (deep= (buffer/push b1 b1) @"AAAA") "buffer/push buffer self")
# buffer/push-byte
(assert (deep= (buffer/push-byte @"AA" 66) @"AAB") "buffer/push-byte")
@@ -145,8 +145,8 @@
# Regression #301
# a3d4ecddb
(def b (buffer/new-filled 128 0x78))
(assert (= 38 (length (buffer/blit @"" b -1 90))) "buffer/blit 1")
(def b8 (buffer/new-filled 128 0x78))
(assert (= 38 (length (buffer/blit @"" b8 -1 90))) "buffer/blit 1")
(def a @"abcdefghijklm")
(assert (deep= @"abcde" (buffer/blit @"" a -1 0 5)) "buffer/blit 2")

View File

@@ -84,23 +84,23 @@
(assert (get result :error) "bad sum3 fuzz issue valgrind")
# Issue #1700
(def result
(def result1
(compile
'(defn fuzz-case-1
[start end &]
(if end
(if e start (lazy-range (+ 1 start) end)))
1)))
(assert (get result :error) "fuzz case issue #1700")
(assert (get result1 :error) "fuzz case issue #1700")
# Issue #1702 - fuzz case with upvalues
(def result
(def result2
(compile
'(each item [1 2 3]
# Generate a lot of upvalues (more than 224)
(def ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;out-buf @"")
(with-dyns [:out out-buf] 1))))
(assert result "bad upvalues fuzz case")
(assert result2 "bad upvalues fuzz case")
# Named argument linting
# Enhancement for #1654
@@ -117,14 +117,14 @@
(defn check-good-compile
[code msg]
(def lints @[])
(def result (compile code (curenv) "suite-compile.janet" lints))
(assert (and (function? result) (empty? lints)) msg))
(def result4 (compile code (curenv) "suite-compile.janet" lints))
(assert (and (function? result4) (empty? lints)) msg))
(defn check-lint-compile
[code msg]
(def lints @[])
(def result (compile code (curenv) "suite-compile.janet" lints))
(assert (and (function? result) (next lints)) msg))
(def result4 (compile code (curenv) "suite-compile.janet" lints))
(assert (and (function? result4) (next lints)) msg))
(check-good-compile '(fnamed) "named no args")
(check-good-compile '(fnamed :x 1 :y 2 :z 3) "named full args")
@@ -150,5 +150,10 @@
(check-lint-compile '(g 1 2 :z) "g lint 1")
(check-lint-compile '(g 1 2 :z 4 5) "g lint 2")
(end-suite)
# Variable shadowing linting
(def outer1 "a")
(check-lint-compile '(def outer1 "b") "shadow global-to-global")
(check-lint-compile '(let [outer1 "b"] outer1) "shadow local-to-global")
(check-lint-compile '(do (def x "b") (def x "c")) "shadow local-to-local")
(end-suite)

View File

@@ -43,9 +43,9 @@
(assert (deep= '(:error "deadline expired" nil) (ev/take super)) "deadline expirataion")
# Another variant
(def thread-channel (ev/thread-chan 100))
(def super (ev/thread-chan 10))
(defn worker []
(def thread-channel :shadow (ev/thread-chan 100))
(def super :shadow (ev/thread-chan 10))
(defn worker :shadow []
(while true
(def item (ev/take thread-channel))
(when (= item :deadline)

View File

@@ -37,7 +37,7 @@
# Printing to functions
# 4e263b8c3
(def out-buf @"")
(def out-buf :shadow @"")
(defn prepend [x]
(with-dyns [:out out-buf]
(prin "> " x)))
@@ -59,8 +59,8 @@
# issue #1055 - 2c927ea76
(let [b @""]
(defn dummy [a b c]
(+ a b c))
(defn dummy [a bb c]
(+ a bb c))
(trace dummy)
(defn errout [arg]
(buffer/push b arg))

View File

@@ -95,11 +95,11 @@
(do
(defn f1
[a]
(defn f1 [] (++ (a 0)))
(defn f1 :shadow [] (++ (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))
(def [f1 f2] :shadow (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"))
@@ -108,10 +108,10 @@
(do
(defn f1
[a]
(defn f1 [] (++ (a 0)))
(defn f2 [] (++ (a 0)))
(defn f1 :shadow [] (++ (a 0)))
(defn f2 :shadow [] (++ (a 0)))
(marshal [f1 f2] make-image-dict))
(def [f1 f2] (unmarshal (f1 @[0]) load-image-dict))
(def [f1 f2] :shadow (unmarshal (f1 @[0]) load-image-dict))
(assert (= 1 (f1)) "marshal-live-closure 1")
(assert (= 2 (f2)) "marshal-live-closure 2"))
@@ -189,11 +189,11 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
(assert (deep= t tclone) "table/weak marsh 7")
# table weak keys
(def t (table/weak-keys 1))
(def t :shadow (table/weak-keys 1))
(put t @"" keep-value)
(put t :key @"")
(assert (= 2 (length t)) "table/weak-keys marsh 1")
(def tclone (-> t marshal unmarshal))
(def tclone :shadow (-> t marshal unmarshal))
(assert (= 2 (length tclone)) "table/weak-keys marsh 2")
(gccollect)
(assert (= 1 (length tclone)) "table/weak-keys marsh 3")
@@ -201,23 +201,23 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
(assert (deep= t tclone) "table/weak-keys marsh 5")
# table weak values
(def t (table/weak-values 1))
(def t :shadow (table/weak-values 1))
(put t @"" keep-value)
(put t :key @"")
(assert (= 2 (length t)) "table/weak-values marsh 1")
(def tclone (-> t marshal unmarshal))
(def tclone :shadow (-> t marshal unmarshal))
(assert (= 2 (length tclone)) "table/weak-values marsh 2")
(gccollect)
(assert (= 1 (length t)) "table/weak-value marsh 3")
(assert (deep= (freeze t) (freeze tclone)) "table/weak-values marsh 4")
# tables with prototypes
(def t (table/weak-values 1))
(def t :shadow (table/weak-values 1))
(table/setproto t @{:abc 123})
(put t @"" keep-value)
(put t :key @"")
(assert (= 2 (length t)) "marsh weak tables with prototypes 1")
(def tclone (-> t marshal unmarshal))
(def tclone :shadow (-> t marshal unmarshal))
(assert (= 2 (length tclone)) "marsh weak tables with prototypes 2")
(gccollect)
(assert (= 1 (length t)) "marsh weak tables with prototypes 3")

View File

@@ -138,13 +138,13 @@
# Parser clone
# 43520ac67
(def p (parser/new))
(assert (= 7 (parser/consume p "(1 2 3 ")) "parser 1")
(def p2 (parser/clone p))
(def p0 (parser/new))
(assert (= 7 (parser/consume p0 "(1 2 3 ")) "parser 1")
(def p2 (parser/clone p0))
(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/consume p0 ") 1 ")
(assert (deep= (parser/status p0) (parser/status p2)) "parser 2")
(assert (deep= (parser/state p0) (parser/state p2)) "parser 3")
# Parser errors
# 976dfc719
@@ -179,11 +179,11 @@
(parser/consume p1 step1)
(loop [_ :iterate (parser/produce p1)])
(parser/state p1)
(def p2 (parser/clone p1))
(parser/state p2)
(parser/consume p2 step2)
(loop [_ :iterate (parser/produce p2)])
(parser/state p2)
(def p3 (parser/clone p1))
(parser/state p3)
(parser/consume p3 step2)
(loop [_ :iterate (parser/produce p3)])
(parser/state p3)
# parser delimiter errors
(defn test-error [delim fmt]
@@ -202,11 +202,11 @@
(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"]))
(def p4 (parser/new))
(parser/consume p4 `("hel`)
(parser/insert p4 `lo`)
(parser/consume p4 `")`)
(assert (= (parser/produce p4) ["hello"]))
# Hex floats
(assert (= math/pi +0x1.921fb54442d18p+0001))

View File

@@ -84,10 +84,10 @@
# Substitution test with peg
# d7626f8c5
(def grammar '(accumulate (any (+ (/ "dog" "purple panda") (<- 1)))))
(def grammar1 '(accumulate (any (+ (/ "dog" "purple panda") (<- 1)))))
(defn try-grammar [text]
(assert (= (string/replace-all "dog" "purple panda" text)
(0 (peg/match grammar text))) text))
(0 (peg/match grammar1 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.")
@@ -336,7 +336,7 @@
# unref
# 96513665d
(def grammar
(def grammar2
(peg/compile
~{:main (* :tagged -1)
:tagged (unref (replace (* :open-tag :value :close-tag) ,struct))
@@ -344,9 +344,9 @@
: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>"
(check-deep grammar2 "<p><em>foobar</em></p>"
@[{:tag "p" :value @[{:tag "em" :value @["foobar"]}]}])
(check-deep grammar "<p>foobar</p>" @[{:tag "p" :value @["foobar"]}])
(check-deep grammar2 "<p>foobar</p>" @[{:tag "p" :value @["foobar"]}])
# Using a large test grammar
# cf05ff610
@@ -369,7 +369,7 @@
(def sym (symbol text))
[(if (or (root-env sym) (specials sym)) :coresym :symbol) text])
(def grammar
(def grammar3
~{:ws (set " \v\t\r\f\n\0")
:readermac (set "';~,")
:symchars (+ (range "09" "AZ" "az" "\x80\xFF")
@@ -408,13 +408,13 @@
:dict (* '"@" :struct)
:main (+ :root (error ""))})
(def p (peg/compile grammar))
(def porig (peg/compile grammar3))
# Just make sure is valgrind clean.
(def p (-> p make-image load-image))
(def pprime (-> porig 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")
(assert (peg/match pprime "abc") "complex peg grammar 1")
(assert (peg/match pprime "[1 2 3 4]") "complex peg grammar 2")
###
### Compiling brainfuck to Janet.
@@ -565,8 +565,8 @@
"peg/replace-all function")
# 9dc7e8ed3
(defn peg-test [name f peg subst text expected]
(assert (= (string (f peg subst text)) expected) name))
(defn peg-test [name f pegg subst text expected]
(assert (= (string (f pegg subst text)) expected) name))
(peg-test "peg/replace has access to captures"
peg/replace
@@ -602,10 +602,10 @@
# 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")
(def p3 (-> "abcd" peg/compile marshal unmarshal))
(assert (peg/match p3 "abcd") "peg marshal 1")
(assert (peg/match p3 "abcdefg") "peg marshal 2")
(assert (not (peg/match p3 "zabcdefg")) "peg marshal 3")
# to/thru bug
# issue #971 - a895219d2
@@ -669,10 +669,10 @@
(peg/match '(if (not (* (constant 7) "a")) "hello") "hello")
@[]) "peg if not")
(defn test [name peg input expected]
(assert-no-error "compile peg" (peg/compile peg))
(assert-no-error "marshal/unmarshal peg" (-> peg marshal unmarshal))
(assert (deep= (peg/match peg input) expected) name))
(defn test [name pegg input expected]
(assert-no-error "compile peg" (peg/compile pegg))
(assert-no-error "marshal/unmarshal peg" (-> pegg marshal unmarshal))
(assert (deep= (peg/match pegg input) expected) name))
(test "sub: matches the same input twice"
~(sub "abcd" "abc")
@@ -852,20 +852,20 @@
@[["b" "b" "b"]])
# Debug and ?? tests.
(defn test-stderr [name peg input expected-matches expected-stderr]
(defn test-stderr [name pegg input expected-matches expected-stderr]
(with-dyns [:err @""]
(test name peg input expected-matches))
(test name pegg input expected-matches))
(def actual @"")
(with-dyns [:err actual *err-color* true]
(peg/match peg input))
(peg/match pegg input))
(assert (deep= (string actual) expected-stderr)))
(defn test-stderr-no-color [name peg input expected-matches expected-stderr]
(defn test-stderr-no-color [name pegg input expected-matches expected-stderr]
(with-dyns [:err @""]
(test name peg input expected-matches))
(test name pegg input expected-matches))
(def actual @"")
(with-dyns [:err actual *err-color* false]
(peg/match peg input))
(peg/match pegg input))
(assert (deep= (string actual) expected-stderr)))
(test-stderr

View File

@@ -44,8 +44,8 @@
(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))
(def buftemp2 @"abcd")
(assert (= (string (buffer/format buftemp2 "---%p %p---" buftemp2 buftemp2))
`abcd---@"abcd" @"abcd"---`) "buffer/format on self 2")
# 5c364e0

View File

@@ -132,11 +132,11 @@
# 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")
(def fc (fiber/new (fn [&] (yield 1) (yield 2) (yield 3) 4) :yti))
(assert (= 1 (resume fc)) "cancel resume 1")
(assert (= 2 (resume fc)) "cancel resume 2")
(assert (= :hi (cancel fc :hi)) "cancel resume 3")
(assert (= :error (fiber/status fc)) "cancel resume 4")
(end-suite)