mirror of
https://github.com/janet-lang/janet
synced 2025-10-29 14:47:42 +00:00
Merge branch 'master' into compile-opt
This commit is contained in:
@@ -4,24 +4,47 @@
|
||||
(var num-tests-run 0)
|
||||
(var suite-name 0)
|
||||
(var start-time 0)
|
||||
(var skip-count 0)
|
||||
(var skip-n 0)
|
||||
|
||||
(def is-verbose (os/getenv "VERBOSE"))
|
||||
|
||||
(defn assert
|
||||
(defn- assert-no-tail
|
||||
"Override's the default assert with some nice error handling."
|
||||
[x &opt e]
|
||||
(default e "assert error")
|
||||
(++ num-tests-run)
|
||||
(when (pos? skip-n)
|
||||
(-- skip-n)
|
||||
(++ skip-count)
|
||||
(break x))
|
||||
(default e "assert error")
|
||||
(when x (++ num-tests-passed))
|
||||
(def str (string e))
|
||||
(def frame (last (debug/stack (fiber/current))))
|
||||
(def stack (debug/stack (fiber/current)))
|
||||
(def frame (last stack))
|
||||
(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))
|
||||
(do (eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush)))
|
||||
(do
|
||||
(eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush)))
|
||||
x)
|
||||
|
||||
(defn skip-asserts
|
||||
"Skip some asserts"
|
||||
[n]
|
||||
(+= skip-n n)
|
||||
nil)
|
||||
|
||||
(defmacro assert
|
||||
[x &opt e]
|
||||
(def xx (gensym))
|
||||
(default e ~',x)
|
||||
~(do
|
||||
(def ,xx ,x)
|
||||
(,assert-no-tail ,xx ,e)
|
||||
,xx))
|
||||
|
||||
(defmacro assert-error
|
||||
[msg & forms]
|
||||
(def errsym (keyword (gensym)))
|
||||
@@ -52,5 +75,22 @@
|
||||
(defn end-suite []
|
||||
(def delta (- (os/clock) start-time))
|
||||
(eprinf "Finished suite %s in %.3f seconds - " suite-name delta)
|
||||
(eprint num-tests-passed " of " num-tests-run " tests passed.")
|
||||
(if (not= num-tests-passed num-tests-run) (os/exit 1)))
|
||||
(eprint num-tests-passed " of " num-tests-run " tests passed (" skip-count " skipped).")
|
||||
(if (not= (+ skip-count num-tests-passed) num-tests-run) (os/exit 1)))
|
||||
|
||||
(defn rmrf
|
||||
"rm -rf in janet"
|
||||
[x]
|
||||
(case (os/lstat x :mode)
|
||||
nil nil
|
||||
:directory (do
|
||||
(each y (os/dir x)
|
||||
(rmrf (string x "/" y)))
|
||||
(os/rmdir x))
|
||||
(os/rm x))
|
||||
nil)
|
||||
|
||||
(defn randdir
|
||||
"Get a random directory name"
|
||||
[]
|
||||
(string "tmp_dir_" (slice (string (math/random) ".tmp") 2)))
|
||||
|
||||
@@ -46,7 +46,6 @@
|
||||
(assert (deep= (array/remove @[1 2 3 4 5] 2 200) @[1 2]) "array/remove 3")
|
||||
(assert (deep= (array/remove @[1 2 3 4 5] -2 200) @[1 2 3]) "array/remove 4")
|
||||
|
||||
|
||||
# array/peek
|
||||
(assert (nil? (array/peek @[])) "array/peek empty")
|
||||
|
||||
@@ -76,6 +75,16 @@
|
||||
(array/trim a)
|
||||
(array/ensure @[1 1] 6 2)
|
||||
|
||||
# array/join
|
||||
(assert (deep= @[1 2 3] (array/join @[] [1] [2] [3])) "array/join 1")
|
||||
(assert (deep= @[] (array/join @[])) "array/join 2")
|
||||
(assert (deep= @[1 :a :b :c] (array/join @[1] @[:a :b] [] [:c])) "array/join 3")
|
||||
(assert (deep= @[:x :y :z "abc123" "def456"] (array/join @[:x :y :z] ["abc123" "def456"])) "array/join 4")
|
||||
(assert-error "array/join error 1" (array/join))
|
||||
(assert-error "array/join error 2" (array/join []))
|
||||
(assert-error "array/join error 3" (array/join [] "abc123"))
|
||||
(assert-error "array/join error 4" (array/join @[] "abc123"))
|
||||
(assert-error "array/join error 5" (array/join @[] "abc123"))
|
||||
|
||||
(end-suite)
|
||||
|
||||
|
||||
@@ -754,7 +754,7 @@
|
||||
(default name (string "has-key? " (++ test-has-key-auto)))
|
||||
(assert (= expected (has-key? col key)) name)
|
||||
(if
|
||||
# guarenteed by `has-key?` to never fail
|
||||
# guaranteed by `has-key?` to never fail
|
||||
expected (in col key)
|
||||
# if `has-key?` is false, then `in` should fail (for indexed types)
|
||||
#
|
||||
@@ -990,4 +990,11 @@
|
||||
(assert (= :a (with-env @{:b :a} (dyn :b))) "with-env dyn")
|
||||
(assert-error "unknown symbol +" (with-env @{} (eval '(+ 1 2))))
|
||||
|
||||
(setdyn *debug* true)
|
||||
(def source '(defn a [x] (+ x x)))
|
||||
(eval source)
|
||||
(assert (= 20 (a 10)))
|
||||
(assert (deep= (get (dyn 'a) :source-form) source))
|
||||
(setdyn *debug* nil)
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -23,30 +23,20 @@
|
||||
|
||||
(assert true) # smoke test
|
||||
|
||||
# Testing here is stateful since we are manipulating the filesystem.
|
||||
|
||||
# Copy since not exposed in boot.janet
|
||||
(defn- bundle-rpath
|
||||
[path]
|
||||
(string/replace-all "\\" "/" (os/realpath path)))
|
||||
|
||||
(defn- rmrf
|
||||
"rm -rf in janet"
|
||||
[x]
|
||||
(case (os/lstat x :mode)
|
||||
nil nil
|
||||
:directory (do
|
||||
(each y (os/dir x)
|
||||
(rmrf (string x "/" y)))
|
||||
(os/rmdir x))
|
||||
(os/rm x))
|
||||
nil)
|
||||
|
||||
# Test mkdir -> rmdir
|
||||
(assert (os/mkdir "tempdir123"))
|
||||
(rmrf "tempdir123")
|
||||
|
||||
# Setup a temporary syspath for manipultation
|
||||
(math/seedrandom (os/cryptorand 16))
|
||||
(def syspath (string (math/random) "_jpm_tree.tmp"))
|
||||
(def syspath (randdir))
|
||||
(rmrf syspath)
|
||||
(assert (os/mkdir syspath))
|
||||
(put root-env *syspath* (bundle-rpath syspath))
|
||||
@@ -100,6 +90,13 @@
|
||||
(assert-error "cannot uninstall sample-dep1, breaks dependent bundles @[\"sample-bundle\"]"
|
||||
(bundle/uninstall "sample-dep1"))
|
||||
|
||||
# Check bundle file aliases
|
||||
(assert-no-error "sample-bundle-aliases install" (bundle/install "./examples/sample-bundle-aliases"))
|
||||
(assert (= 4 (length (bundle/list))) "bundles are listed correctly 5")
|
||||
(assert-no-error "import aliases" (import aliases-mod))
|
||||
(assert (deep= (range 12) (aliases-mod/fun 12)) "using sample-bundle-aliases")
|
||||
(assert-no-error "aliases uninstall" (bundle/uninstall "sample-bundle-aliases"))
|
||||
|
||||
# Now re-install sample-bundle as auto-remove
|
||||
(assert-no-error "sample-bundle install" (bundle/reinstall "sample-bundle" :auto-remove true))
|
||||
|
||||
|
||||
@@ -69,6 +69,13 @@
|
||||
(seq [n :range [0 10]] (% n 5 3))
|
||||
[0 1 2 0 1 0 1 2 0 1]) "variadic mod")
|
||||
|
||||
# linspace range
|
||||
(assert (deep= @[0 1 2 3] (range 4)) "range 1")
|
||||
(assert (deep= @[0 1 2 3] (range 3.01)) "range 2")
|
||||
(assert (deep= @[0 1 2 3] (range 3.999)) "range 3")
|
||||
(assert (deep= @[0.8 1.8 2.8 3.8] (range 0.8 3.999)) "range 4")
|
||||
(assert (deep= @[0.8 1.8 2.8 3.8] (range 0.8 3.999)) "range 5")
|
||||
|
||||
(assert (< 1.0 nil false true
|
||||
(fiber/new (fn [] 1))
|
||||
"hi"
|
||||
|
||||
@@ -375,4 +375,94 @@
|
||||
(ev/cancel f (gensym))
|
||||
(ev/take superv)
|
||||
|
||||
# Chat server test
|
||||
(def conmap @{})
|
||||
|
||||
(defn broadcast [em msg]
|
||||
(eachk par conmap
|
||||
(if (not= par em)
|
||||
(if-let [tar (get conmap par)]
|
||||
(net/write tar (string/format "[%s]:%s" em msg))))))
|
||||
|
||||
(defn handler
|
||||
[connection]
|
||||
(net/write connection "Whats your name?\n")
|
||||
(def name (string/trim (string (ev/read connection 100))))
|
||||
(if (get conmap name)
|
||||
(do
|
||||
(net/write connection "Name already taken!")
|
||||
(:close connection))
|
||||
(do
|
||||
(put conmap name connection)
|
||||
(net/write connection (string/format "Welcome %s\n" name))
|
||||
(defer (do
|
||||
(put conmap name nil)
|
||||
(:close connection))
|
||||
(while (def msg (ev/read connection 100))
|
||||
(broadcast name (string msg)))))))
|
||||
|
||||
# Now launch the chat server
|
||||
(def chat-server (net/listen test-host test-port))
|
||||
(ev/spawn
|
||||
(forever
|
||||
(def [ok connection] (protect (net/accept chat-server)))
|
||||
(if (and ok connection)
|
||||
(ev/call handler connection)
|
||||
(break))))
|
||||
|
||||
# Read from socket
|
||||
|
||||
(defn expect-read
|
||||
[stream text]
|
||||
(def result (string (net/read stream 100)))
|
||||
(assert (= result text) (string/format "expected %v, got %v" text result)))
|
||||
|
||||
# Now do our telnet chat
|
||||
(def bob (net/connect test-host test-port))
|
||||
(expect-read bob "Whats your name?\n")
|
||||
(net/write bob "bob")
|
||||
(expect-read bob "Welcome bob\n")
|
||||
(def alice (net/connect test-host test-port))
|
||||
(expect-read alice "Whats your name?\n")
|
||||
(net/write alice "alice")
|
||||
(expect-read alice "Welcome alice\n")
|
||||
|
||||
# Bob says hello, alice gets the message
|
||||
(net/write bob "hello\n")
|
||||
(expect-read alice "[bob]:hello\n")
|
||||
|
||||
# Alice says hello, bob gets the message
|
||||
(net/write alice "hi\n")
|
||||
(expect-read bob "[alice]:hi\n")
|
||||
|
||||
# Ted joins the chat server
|
||||
(def ted (net/connect test-host test-port))
|
||||
(expect-read ted "Whats your name?\n")
|
||||
(net/write ted "ted")
|
||||
(expect-read ted "Welcome ted\n")
|
||||
|
||||
# Ted says hi, alice and bob get message
|
||||
(net/write ted "hi\n")
|
||||
(expect-read alice "[ted]:hi\n")
|
||||
(expect-read bob "[ted]:hi\n")
|
||||
|
||||
# Bob leaves for work. Now it's just ted and alice
|
||||
(:close bob)
|
||||
|
||||
# Alice messages ted, ted gets message
|
||||
(net/write alice "wuzzup\n")
|
||||
(expect-read ted "[alice]:wuzzup\n")
|
||||
(net/write ted "not much\n")
|
||||
(expect-read alice "[ted]:not much\n")
|
||||
|
||||
# Alice bounces
|
||||
(:close alice)
|
||||
|
||||
# Ted can send messages, nobody gets them :(
|
||||
(net/write ted "hello?\n")
|
||||
(:close ted)
|
||||
|
||||
# Close chat server
|
||||
(:close chat-server)
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -21,7 +21,6 @@
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
# We should get ARM support...
|
||||
(def has-ffi (dyn 'ffi/native))
|
||||
(def has-full-ffi
|
||||
(and has-ffi
|
||||
|
||||
204
test/suite-filewatch.janet
Normal file
204
test/suite-filewatch.janet
Normal file
@@ -0,0 +1,204 @@
|
||||
# Copyright (c) 2024 Calvin Rose & contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
# deal in the Software without restriction, including without limitation the
|
||||
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
# sell copies of the Software, and to permit persons to whom the Software is
|
||||
# furnished to do so, subject to the following conditions:
|
||||
#
|
||||
# The above copyright notice and this permission notice shall be included in
|
||||
# all copies or substantial portions of the Software.
|
||||
#
|
||||
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
# IN THE SOFTWARE.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
(assert true)
|
||||
|
||||
(def chan (ev/chan 1000))
|
||||
(def is-win (or (= :mingw (os/which)) (= :windows (os/which))))
|
||||
(def is-linux (= :linux (os/which)))
|
||||
|
||||
# If not supported, exit early
|
||||
(def [supported msg] (protect (filewatch/new chan)))
|
||||
(when (and (not supported) (string/find "filewatch not supported" msg))
|
||||
(end-suite)
|
||||
(quit))
|
||||
|
||||
# Test GC
|
||||
(assert-no-error "filewatch/new" (filewatch/new chan))
|
||||
(gccollect)
|
||||
|
||||
(defn- expect
|
||||
[key value & more-kvs]
|
||||
(ev/with-deadline
|
||||
1
|
||||
(def event (ev/take chan))
|
||||
(when is-verbose (pp event))
|
||||
(assert event "check event")
|
||||
(assert (= value (get event key)) (string/format "got %p, expected %p" (get event key) value))
|
||||
(when (next more-kvs)
|
||||
(each [k v] (partition 2 more-kvs)
|
||||
(assert (= v (get event k)) (string/format "got %p, expected %p" (get event k) v))))))
|
||||
|
||||
(defn- expect-empty
|
||||
[]
|
||||
(assert (zero? (ev/count chan)) "channel check empty")
|
||||
(ev/sleep 0) # turn the event loop
|
||||
(assert (zero? (ev/count chan)) "channel check empty")
|
||||
# Drain if not empty, help with failures after this
|
||||
(while (pos? (ev/count chan)) (printf "extra: %p" (ev/take chan))))
|
||||
|
||||
(defn- expect-maybe
|
||||
"On wine + mingw, we get an extra event. This is a wine peculiarity."
|
||||
[key value]
|
||||
(ev/with-deadline
|
||||
1
|
||||
(ev/sleep 0)
|
||||
(when (pos? (ev/count chan))
|
||||
(def event (ev/take chan))
|
||||
(when is-verbose (pp event))
|
||||
(assert event "check event")
|
||||
(assert (= value (get event key)) (string/format "got %p, expected %p" (get event key) value)))))
|
||||
|
||||
(defn spit-file
|
||||
[dir name]
|
||||
(def path (string dir "/" name))
|
||||
(spit path "test text"))
|
||||
|
||||
# Different operating systems report events differently. While it would be nice to
|
||||
# normalize this, each system has very large limitations in what can be reported when
|
||||
# compared with other systems. As such, the maximum subset of common functionality here
|
||||
# is quite small. Instead, test the capabilities of each system.
|
||||
|
||||
# Create a file watcher on two test directories
|
||||
(def fw (filewatch/new chan))
|
||||
(def td1 (randdir))
|
||||
(def td2 (randdir))
|
||||
(def td3 (randdir))
|
||||
(rmrf td1)
|
||||
(rmrf td2)
|
||||
(os/mkdir td1)
|
||||
(os/mkdir td2)
|
||||
(os/mkdir td3)
|
||||
(spit-file td3 "file3.txt")
|
||||
(when is-win
|
||||
(filewatch/add fw td1 :last-write :last-access :file-name :dir-name :size :attributes :recursive)
|
||||
(filewatch/add fw td2 :last-write :last-access :file-name :dir-name :size :attributes))
|
||||
(when is-linux
|
||||
(filewatch/add fw (string td3 "/file3.txt") :close-write :create :delete)
|
||||
(filewatch/add fw td1 :close-write :create :delete)
|
||||
(filewatch/add fw td2 :close-write :create :delete :ignored))
|
||||
(assert-no-error "filewatch/listen no error" (filewatch/listen fw))
|
||||
|
||||
#
|
||||
# Windows file writing
|
||||
#
|
||||
|
||||
(when is-win
|
||||
(spit-file td1 "file1.txt")
|
||||
(expect :type :added :file-name "file1.txt" :dir-name td1)
|
||||
(expect :type :modified)
|
||||
(expect-maybe :type :modified) # for mingw + wine
|
||||
(gccollect)
|
||||
(spit-file td1 "file1.txt")
|
||||
(expect :type :modified)
|
||||
(expect :type :modified)
|
||||
(expect-empty)
|
||||
(gccollect)
|
||||
|
||||
# Check td2
|
||||
(spit-file td2 "file2.txt")
|
||||
(expect :type :added)
|
||||
(expect :type :modified)
|
||||
(expect-maybe :type :modified)
|
||||
|
||||
# Remove a file, then wait for remove event
|
||||
(rmrf (string td1 "/file1.txt"))
|
||||
(expect :type :removed)
|
||||
(expect-empty)
|
||||
|
||||
# Unlisten to some events
|
||||
(filewatch/remove fw td2)
|
||||
|
||||
# Check that we don't get anymore events from test directory 2
|
||||
(spit-file td2 "file2.txt")
|
||||
(expect-empty)
|
||||
|
||||
# Repeat and things should still work with test directory 1
|
||||
(spit-file td1 "file1.txt")
|
||||
(expect :type :added)
|
||||
(expect :type :modified)
|
||||
(expect-maybe :type :modified)
|
||||
(gccollect)
|
||||
(spit-file td1 "file1.txt")
|
||||
(expect :type :modified)
|
||||
(expect :type :modified)
|
||||
(expect-maybe :type :modified)
|
||||
(gccollect))
|
||||
|
||||
#
|
||||
# Linux file writing
|
||||
#
|
||||
|
||||
(when is-linux
|
||||
(spit-file td1 "file1.txt")
|
||||
(expect :type :create :file-name "file1.txt" :dir-name td1)
|
||||
(expect :type :close-write)
|
||||
(expect-empty)
|
||||
(gccollect)
|
||||
(spit-file td1 "file1.txt")
|
||||
(expect :type :close-write)
|
||||
(expect-empty)
|
||||
(gccollect)
|
||||
|
||||
# Check file3.txt
|
||||
(spit-file td3 "file3.txt")
|
||||
(expect :type :close-write :file-name "file3.txt" :dir-name td3)
|
||||
(expect-empty)
|
||||
|
||||
# Check td2
|
||||
(spit-file td2 "file2.txt")
|
||||
(expect :type :create)
|
||||
(expect :type :close-write)
|
||||
(expect-empty)
|
||||
|
||||
# Remove a file, then wait for remove event
|
||||
(rmrf (string td1 "/file1.txt"))
|
||||
(expect :type :delete)
|
||||
(expect-empty)
|
||||
|
||||
# Unlisten to some events
|
||||
(filewatch/remove fw td2)
|
||||
(expect :type :ignored)
|
||||
(expect-empty)
|
||||
|
||||
# Check that we don't get anymore events from test directory 2
|
||||
(spit-file td2 "file2.txt")
|
||||
(expect-empty)
|
||||
|
||||
# Repeat and things should still work with test directory 1
|
||||
(spit-file td1 "file1.txt")
|
||||
(expect :type :create)
|
||||
(expect :type :close-write)
|
||||
(expect-empty)
|
||||
(gccollect)
|
||||
(spit-file td1 "file1.txt")
|
||||
(expect :type :close-write)
|
||||
(expect-empty)
|
||||
(gccollect))
|
||||
|
||||
(assert-no-error "filewatch/unlisten no error" (filewatch/unlisten fw))
|
||||
(assert-no-error "cleanup 1" (rmrf td1))
|
||||
(assert-no-error "cleanup 2" (rmrf td2))
|
||||
(assert-no-error "cleanup 3" (rmrf td3))
|
||||
|
||||
(end-suite)
|
||||
@@ -47,6 +47,14 @@
|
||||
(assert (= (int/to-number (i64 9007199254740991)) 9007199254740991))
|
||||
(assert (= (int/to-number (i64 -9007199254740991)) -9007199254740991))
|
||||
|
||||
# New parser
|
||||
(assert (= (u64 "123") 123:u) "u64 parsing")
|
||||
(assert (= (u64 "0") 0:u) "u64 parsing")
|
||||
(assert (= (u64 "0xFFFF_FFFF_FFFF_FFFF") 0xFFFF_FFFF_FFFF_FFFF:u) "u64 parsing")
|
||||
(assert (= (i64 "123") 123:s) "s64 parsing")
|
||||
(assert (= (i64 "-123") -123:s) "s64 parsing")
|
||||
(assert (= (i64 "0") 0:s) "s64 parsing")
|
||||
|
||||
(assert-error
|
||||
"u64 out of bounds for safe integer"
|
||||
(int/to-number (u64 "9007199254740993"))
|
||||
|
||||
@@ -146,5 +146,80 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
|
||||
(def item (ev/take newchan))
|
||||
(assert (= item newchan) "ev/chan marshalling"))
|
||||
|
||||
(end-suite)
|
||||
# Issue #1488 - marshalling weak values
|
||||
(testmarsh (array/weak 10) "marsh array/weak")
|
||||
(testmarsh (table/weak-keys 10) "marsh table/weak-keys")
|
||||
(testmarsh (table/weak-values 10) "marsh table/weak-values")
|
||||
(testmarsh (table/weak 10) "marsh table/weak")
|
||||
|
||||
# Now check that gc works with weak containers after marshalling
|
||||
|
||||
# Turn off automatic GC for testing weak references
|
||||
(gcsetinterval 0x7FFFFFFF)
|
||||
|
||||
# array
|
||||
(def a (array/weak 1))
|
||||
(array/push a @"")
|
||||
(assert (= 1 (length a)) "array/weak marsh 1")
|
||||
(def aclone (-> a marshal unmarshal))
|
||||
(assert (= 1 (length aclone)) "array/weak marsh 2")
|
||||
(gccollect)
|
||||
(assert (= 1 (length aclone)) "array/weak marsh 3")
|
||||
(assert (= 1 (length a)) "array/weak marsh 4")
|
||||
(assert (= nil (get a 0)) "array/weak marsh 5")
|
||||
(assert (= nil (get aclone 0)) "array/weak marsh 6")
|
||||
(assert (deep= a aclone) "array/weak marsh 7")
|
||||
|
||||
# table weak keys and values
|
||||
(def t (table/weak 1))
|
||||
(def keep-key :key)
|
||||
(def keep-value :value)
|
||||
(put t :abc @"")
|
||||
(put t :key :value)
|
||||
(assert (= 2 (length t)) "table/weak marsh 1")
|
||||
(def tclone (-> t marshal unmarshal))
|
||||
(assert (= 2 (length tclone)) "table/weak marsh 2")
|
||||
(gccollect)
|
||||
(assert (= 1 (length tclone)) "table/weak marsh 3")
|
||||
(assert (= 1 (length t)) "table/weak marsh 4")
|
||||
(assert (= keep-value (get t keep-key)) "table/weak marsh 5")
|
||||
(assert (= keep-value (get tclone keep-key)) "table/weak marsh 6")
|
||||
(assert (deep= t tclone) "table/weak marsh 7")
|
||||
|
||||
# table weak keys
|
||||
(def t (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))
|
||||
(assert (= 2 (length tclone)) "table/weak-keys marsh 2")
|
||||
(gccollect)
|
||||
(assert (= 1 (length tclone)) "table/weak-keys marsh 3")
|
||||
(assert (= 1 (length t)) "table/weak-keys marsh 4")
|
||||
(assert (deep= t tclone) "table/weak-keys marsh 5")
|
||||
|
||||
# table weak values
|
||||
(def t (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))
|
||||
(assert (= 2 (length tclone)) "table/weak-values marsh 2")
|
||||
(gccollect)
|
||||
(assert (= 1 (length t)) "table/weak-value marsh 3")
|
||||
(assert (deep= t tclone) "table/weak-values marsh 4")
|
||||
|
||||
# tables with prototypes
|
||||
(def t (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))
|
||||
(assert (= 2 (length tclone)) "marsh weak tables with prototypes 2")
|
||||
(gccollect)
|
||||
(assert (= 1 (length t)) "marsh weak tables with prototypes 3")
|
||||
(assert (deep= t tclone) "marsh weak tables with prototypes 4")
|
||||
(assert (deep= (getproto t) (getproto tclone)) "marsh weak tables with prototypes 5")
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -131,6 +131,12 @@
|
||||
(assert (= (os/perm-string 8r755) "rwxr-xr-x") "perm 8")
|
||||
(assert (= (os/perm-string 8r644) "rw-r--r--") "perm 9")
|
||||
|
||||
# Pipes
|
||||
(assert-no-error (os/pipe))
|
||||
(assert-no-error (os/pipe :RW))
|
||||
(assert-no-error (os/pipe :R))
|
||||
(assert-no-error (os/pipe :W))
|
||||
|
||||
# os/execute with environment variables
|
||||
# issue #636 - 7e2c433ab
|
||||
(assert (= 0 (os/execute [;run janet "-e" "(+ 1 2 3)"] :pe
|
||||
|
||||
@@ -492,7 +492,7 @@
|
||||
# header, followed by body, and drop the :header-len capture
|
||||
:packet (/ (* :packet-header :packet-body) ,|$1)
|
||||
|
||||
# any exact seqence of packets (no extra characters)
|
||||
# any exact sequence of packets (no extra characters)
|
||||
:main (* (any :packet) -1)}))
|
||||
|
||||
(assert (deep= @["a" "bb" "ccc"] (peg/match peg2 "1:a2:bb3:ccc"))
|
||||
|
||||
30
test/suite-tuple.janet
Normal file
30
test/suite-tuple.janet
Normal file
@@ -0,0 +1,30 @@
|
||||
# Copyright (c) 2023 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
# deal in the Software without restriction, including without limitation the
|
||||
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
# sell copies of the Software, and to permit persons to whom the Software is
|
||||
# furnished to do so, subject to the following conditions:
|
||||
#
|
||||
# The above copyright notice and this permission notice shall be included in
|
||||
# all copies or substantial portions of the Software.
|
||||
#
|
||||
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
# IN THE SOFTWARE.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
(assert (= [1 2 3] (tuple/join [1] [2] [3])) "tuple/join 1")
|
||||
(assert (= [] (tuple/join)) "tuple/join 2")
|
||||
(assert (= [:a :b :c] (tuple/join @[:a :b] [] [:c])) "tuple/join 3")
|
||||
(assert (= ["abc123" "def456"] (tuple/join ["abc123" "def456"])) "tuple/join 4")
|
||||
|
||||
(end-suite)
|
||||
|
||||
Reference in New Issue
Block a user