mirror of
https://github.com/janet-lang/janet
synced 2026-04-03 13:31:28 +00:00
Compare commits
8 Commits
contributi
...
lint-shado
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
df32109eea | ||
|
|
8b89901298 | ||
|
|
079776d39e | ||
|
|
6c2f08ef49 | ||
|
|
980999c97b | ||
|
|
1197cfe433 | ||
|
|
c63c6740d9 | ||
|
|
612971503d |
@@ -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))
|
||||
|
||||
@@ -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))
|
||||
|
||||
@@ -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)))))))
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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);
|
||||
|
||||
@@ -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);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@@ -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]
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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")
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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))
|
||||
|
||||
@@ -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")
|
||||
|
||||
@@ -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))
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
Reference in New Issue
Block a user