mirror of
https://github.com/janet-lang/janet
synced 2026-09-17 14:51:22 +00:00
Make test suite not shadow any variables.
This commit is contained in:
Calvin Rose
@@ -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")
|
||||
|
||||
@@ -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)
|
||||
|
||||
+3
-3
@@ -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))
|
||||
|
||||
+11
-11
@@ -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")
|
||||
|
||||
+16
-16
@@ -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))
|
||||
|
||||
+26
-26
@@ -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
|
||||
|
||||
+2
-2
@@ -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
|
||||
|
||||
+5
-5
@@ -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