1
0
mirror of https://github.com/janet-lang/janet synced 2025-11-18 08:15:13 +00:00

Compare commits

..

13 Commits

Author SHA1 Message Date
Calvin Rose
e7c5e75343 Add regression test for chat server issues. 2024-09-06 08:03:24 -05:00
Calvin Rose
4f65c2707e Undo workaround for unsetting reference from streams -> fibers after
async event completes. Moves this logic back into janet_async_end.
2024-09-06 00:20:50 -05:00
Calvin Rose
75bdea5155 Fix memory leak with weak table frees.
The backing buffer for weak arrays and tables was not freed upon
being garbage collected. This shows up in traces and valgrind. Verified
by running `make valtest` with changes.
2024-09-06 00:15:17 -05:00
Calvin Rose
f553c5da47 Update ev.c with workaround for failing chat server.
2 issues:
- With poll backend, we were polling for writes even after we finished
  writing. Presents as wasting a lot of CPU.
- Fixes  strange closing behavior of chat server.
2024-09-06 00:00:09 -05:00
Calvin Rose
5f70a85f7e Add chat server example. 2024-09-05 23:09:02 -05:00
Calvin Rose
c82fd106a7 Merge pull request #1494 from pyrmont/bugfix.changelog 2024-09-04 18:31:21 -07:00
Michael Camilleri
0e9b866b98 Move unreleased change out of v1.35.2 section 2024-09-05 08:29:45 +09:00
Calvin Rose
67a8c6df09 Merge pull request #1492 from sogaiu/tweak-changelog
Move bundle/add-bin changelog line to unreleased
2024-09-04 05:39:30 -07:00
sogaiu
86cf8127b6 Move bundle/add-bin changelog line to unreleased 2024-09-04 17:47:10 +09:00
Calvin Rose
828e0a07cd Don't check for docstrings when explicitly disabled. 2024-08-31 17:23:28 -05:00
Calvin Rose
90018b35c0 Begin standardizing of event properties for filewatch.
- `:file-name` for the name of the file that triggered the event.
- `:dir-name` for the containing directory of the file
- `:type` for the event type.
2024-08-31 14:26:08 -05:00
Calvin Rose
5a199716cb Save :source-form in environment when debugging is enabled. 2024-08-29 21:12:53 -05:00
Calvin Rose
43ecd4f2d8 Add fixes for marshalling weak containers - Fix #1488
Weak containers did not preserve their weakness when marshalled. This
fixes that for tables and arrays, as well as adds some tests for this.
Also exposes functions for creating weak tables in janet.h
2024-08-22 19:37:41 -05:00
15 changed files with 377 additions and 25 deletions

View File

@@ -2,6 +2,7 @@
All notable changes to this project will be documented in this file.
## Unreleased - ???
- Save `:source-form` in environment entries when `*debug*` is set.
- Add experimental `filewatch/` module for listening to file system changes.
- Add `bundle/who-is` to query which bundle a file on disk was installed by.
- Add `geomean` function
@@ -9,10 +10,12 @@ All notable changes to this project will be documented in this file.
These streams cannot be directly read to and written from, but can be passed to subprocesses.
- Add `array/join`
- Add `tuple/join`
## 1.35.2 - 2024-06-16
- Fix marshalling weak tables and weak arrays.
- Expose C functions for constructing weak tables in janet.h
- Add `bundle/add-bin` to make installing scripts easier. This also establishes a packaging convention for it.
- Let range take non-integer values.
## 1.35.2 - 2024-06-16
- Fix some documentation typos.
- Allow using `:only` in import without quoting.

35
examples/chatserver.janet Normal file
View File

@@ -0,0 +1,35 @@
(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]
(print "connection: " connection)
(net/write connection "Whats your name?\n")
(def name (string/trim (string (ev/read connection 100))))
(print name " connected")
(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)))
(print name " disconnected")))))
(defn main [& args]
(printf "STARTING SERVER...")
(flush)
(def my-server (net/listen "127.0.0.1" "8000"))
(forever
(def connection (net/accept my-server))
(ev/call handler connection)))

View File

@@ -39,6 +39,7 @@
(buffer/format buf "%j" (in args index))
(set index (+ index 1)))
(array/push modifiers (string buf ")\n\n" docstr))
(if (dyn :debug) (array/push modifiers {:source-form (dyn :macro-form)}))
# Build return value
~(def ,name ,;modifiers (fn ,name ,;(tuple/slice more start)))))
@@ -4654,6 +4655,10 @@
(put flat :doc nil))
(when (boot/config :no-sourcemaps)
(put flat :source-map nil))
(unless (boot/config :no-docstrings)
(unless (v :private)
(unless (v :doc)
(errorf "no docs: %v %p" k v)))) # make sure we have docs
# Fix directory separators on windows to make image identical between windows and non-windows
(when-let [sm (get flat :source-map)]
(put flat :source-map [(string/replace-all "\\" "/" (sm 0)) (sm 1) (sm 2)]))

View File

@@ -255,6 +255,12 @@ static void add_timeout(JanetTimeout to) {
void janet_async_end(JanetFiber *fiber) {
if (fiber->ev_callback) {
if (fiber->ev_stream->read_fiber == fiber) {
fiber->ev_stream->read_fiber = NULL;
}
if (fiber->ev_stream->write_fiber == fiber) {
fiber->ev_stream->write_fiber = NULL;
}
fiber->ev_callback(fiber, JANET_ASYNC_EVENT_DEINIT);
janet_gcunroot(janet_wrap_abstract(fiber->ev_stream));
fiber->ev_callback = NULL;
@@ -2361,6 +2367,7 @@ void ev_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
} else {
janet_schedule(fiber, janet_wrap_nil());
}
stream->read_fiber = NULL;
janet_async_end(fiber);
break;
}

View File

@@ -213,8 +213,25 @@ static void watcher_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
JanetKV *event = janet_struct_begin(6);
janet_struct_put(event, janet_ckeywordv("wd"), janet_wrap_integer(inevent.wd));
janet_struct_put(event, janet_ckeywordv("wd-path"), path);
janet_struct_put(event, janet_ckeywordv("mask"), janet_wrap_integer(inevent.mask));
janet_struct_put(event, janet_ckeywordv("path"), name);
if (janet_checktype(name, JANET_NIL)) {
/* We were watching a file directly, so path is the full path. Split into dirname / basename */
JanetString spath = janet_unwrap_string(path);
const uint8_t *cursor = spath + janet_string_length(spath);
const uint8_t *cursor_end = cursor;
while (cursor > spath && cursor[0] != '/') {
cursor--;
}
if (cursor == spath) {
janet_struct_put(event, janet_ckeywordv("dir-name"), path);
janet_struct_put(event, janet_ckeywordv("file-name"), name);
} else {
janet_struct_put(event, janet_ckeywordv("dir-name"), janet_wrap_string(janet_string(spath, (cursor - spath))));
janet_struct_put(event, janet_ckeywordv("file-name"), janet_wrap_string(janet_string(cursor + 1, (cursor_end - cursor - 1))));
}
} else {
janet_struct_put(event, janet_ckeywordv("dir-name"), path);
janet_struct_put(event, janet_ckeywordv("file-name"), name);
}
janet_struct_put(event, janet_ckeywordv("cookie"), janet_wrap_integer(inevent.cookie));
Janet etype = janet_ckeywordv("type");
const JanetWatchFlagName *wfn_end = watcher_flags_linux + sizeof(watcher_flags_linux) / sizeof(watcher_flags_linux[0]);
@@ -392,7 +409,7 @@ static void watcher_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
JanetKV *event = janet_struct_begin(3);
janet_struct_put(event, janet_ckeywordv("type"), janet_ckeywordv(watcher_actions_windows[fni->Action]));
janet_struct_put(event, janet_ckeywordv("file-name"), filename);
janet_struct_put(event, janet_ckeywordv("dir"), janet_wrap_string(ow->dir_path));
janet_struct_put(event, janet_ckeywordv("dir-name"), janet_wrap_string(ow->dir_path));
Janet eventv = janet_wrap_struct(janet_struct_end(event));
janet_channel_give(watcher->channel, eventv);
@@ -558,7 +575,19 @@ static const JanetAbstractType janet_filewatch_at = {
JANET_CORE_FN(cfun_filewatch_make,
"(filewatch/new channel &opt default-flags)",
"Create a new filewatcher that will give events to a channel channel.") {
"Create a new filewatcher that will give events to a channel channel. See `filewatch/add` for available flags.\n\n"
"When an event is triggered by the filewatcher, a struct containing information will be given to channel as with `ev/give`. "
"The contents of the channel depend on the OS, but will contain some common keys:\n\n"
"* `:type` -- the type of the event that was raised.\n\n"
"* `:file-name` -- the base file name of the file that triggered the event.\n\n"
"* `:dir-name` -- the directory name of the file that triggered the event.\n\n"
"Events also will contain keys specific to the host OS.\n\n"
"Windows has no extra properties on events.\n\n"
"Linux has the following extra properties on events:\n\n"
"* `:wd` -- the integer key returned by `filewatch/add` for the path that triggered this.\n\n"
"* `:wd-path` -- the string path for watched directory of file. For files, will be the same as `:file-name`, and for directories, will be the same as `:dir-name`.\n\n"
"* `:cookie` -- a randomized integer used to associate related events, such as :moved-from and :moved-to events.\n\n"
"") {
janet_arity(argc, 1, -1);
JanetChannel *channel = janet_getchannel(argv, 0);
JanetWatcher *watcher = janet_abstract(&janet_filewatch_at, sizeof(JanetWatcher));
@@ -569,7 +598,43 @@ JANET_CORE_FN(cfun_filewatch_make,
JANET_CORE_FN(cfun_filewatch_add,
"(filewatch/add watcher path &opt flags)",
"Add a path to the watcher.") {
"Add a path to the watcher. Available flags depend on the current OS, and are as follows:\n\n"
"Windows/MINGW (flags correspond to FILE_NOTIFY_CHANGE_* flags in win32 documentation):\n\n"
"* `:all` - trigger an event for all of the below triggers.\n\n"
"* `:attributes` - FILE_NOTIFY_CHANGE_ATTRIBUTES\n\n"
"* `:creation` - FILE_NOTIFY_CHANGE_CREATION\n\n"
"* `:dir-name` - FILE_NOTIFY_CHANGE_DIR_NAME\n\n"
"* `:last-access` - FILE_NOTIFY_CHANGE_LAST_ACCESS\n\n"
"* `:last-write` - FILE_NOTIFY_CHANGE_LAST_WRITE\n\n"
"* `:security` - FILE_NOTIFY_CHANGE_SECURITY\n\n"
"* `:size` - FILE_NOTIFY_CHANGE_SIZE\n\n"
"* `:recursive` - watch subdirectories recursively\n\n"
"Linux (flags correspond to IN_* flags from <sys/inotify.h>):\n\n"
"* `:access` - IN_ACCESS\n\n"
"* `:all` - IN_ALL_EVENTS\n\n"
"* `:attrib` - IN_ATTRIB\n\n"
"* `:close-nowrite` - IN_CLOSE_NOWRITE\n\n"
"* `:close-write` - IN_CLOSE_WRITE\n\n"
"* `:create` - IN_CREATE\n\n"
"* `:delete` - IN_DELETE\n\n"
"* `:delete-self` - IN_DELETE_SELF\n\n"
"* `:ignored` - IN_IGNORED\n\n"
"* `:modify` - IN_MODIFY\n\n"
"* `:move-self` - IN_MOVE_SELF\n\n"
"* `:moved-from` - IN_MOVED_FROM\n\n"
"* `:moved-to` - IN_MOVED_TO\n\n"
"* `:open` - IN_OPEN\n\n"
"* `:q-overflow` - IN_Q_OVERFLOW\n\n"
"* `:unmount` - IN_UNMOUNT\n\n\n"
"On Windows, events will have the following possible types:\n\n"
"* `:unknown`\n\n"
"* `:added`\n\n"
"* `:removed`\n\n"
"* `:modified`\n\n"
"* `:renamed-old`\n\n"
"* `:renamed-new`\n\n"
"On Linux, events will a `:type` corresponding to the possible flags, excluding `:all`.\n"
"") {
janet_arity(argc, 2, -1);
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
const char *path = janet_getcstring(argv, 1);

View File

@@ -321,9 +321,13 @@ static void janet_deinit_block(JanetGCObject *mem) {
janet_symbol_deinit(((JanetStringHead *) mem)->data);
break;
case JANET_MEMORY_ARRAY:
case JANET_MEMORY_ARRAY_WEAK:
janet_free(((JanetArray *) mem)->data);
break;
case JANET_MEMORY_TABLE:
case JANET_MEMORY_TABLE_WEAKK:
case JANET_MEMORY_TABLE_WEAKV:
case JANET_MEMORY_TABLE_WEAKKV:
janet_free(((JanetTable *) mem)->data);
break;
case JANET_MEMORY_FIBER: {

View File

@@ -68,8 +68,15 @@ enum {
LB_STRUCT_PROTO, /* 223 */
#ifdef JANET_EV
LB_THREADED_ABSTRACT, /* 224 */
LB_POINTER_BUFFER, /* 224 */
LB_POINTER_BUFFER, /* 225 */
#endif
LB_TABLE_WEAKK, /* 226 */
LB_TABLE_WEAKV, /* 227 */
LB_TABLE_WEAKKV, /* 228 */
LB_TABLE_WEAKK_PROTO, /* 229 */
LB_TABLE_WEAKV_PROTO, /* 230 */
LB_TABLE_WEAKKV_PROTO, /* 231 */
LB_ARRAY_WEAK, /* 232 */
} LeadBytes;
/* Helper to look inside an entry in an environment */
@@ -569,7 +576,8 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
int32_t i;
JanetArray *a = janet_unwrap_array(x);
MARK_SEEN();
pushbyte(st, LB_ARRAY);
enum JanetMemoryType memtype = janet_gc_type(a);
pushbyte(st, memtype == JANET_MEMORY_ARRAY_WEAK ? LB_ARRAY_WEAK : LB_ARRAY);
pushint(st, a->count);
for (i = 0; i < a->count; i++)
marshal_one(st, a->data[i], flags + 1);
@@ -592,7 +600,16 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
case JANET_TABLE: {
JanetTable *t = janet_unwrap_table(x);
MARK_SEEN();
pushbyte(st, t->proto ? LB_TABLE_PROTO : LB_TABLE);
enum JanetMemoryType memtype = janet_gc_type(t);
if (memtype == JANET_MEMORY_TABLE_WEAKK) {
pushbyte(st, t->proto ? LB_TABLE_WEAKK_PROTO : LB_TABLE_WEAKK);
} else if (memtype == JANET_MEMORY_TABLE_WEAKV) {
pushbyte(st, t->proto ? LB_TABLE_WEAKV_PROTO : LB_TABLE_WEAKV);
} else if (memtype == JANET_MEMORY_TABLE_WEAKKV) {
pushbyte(st, t->proto ? LB_TABLE_WEAKKV_PROTO : LB_TABLE_WEAKKV);
} else {
pushbyte(st, t->proto ? LB_TABLE_PROTO : LB_TABLE);
}
pushint(st, t->count);
if (t->proto)
marshal_one(st, janet_wrap_table(t->proto), flags + 1);
@@ -1417,11 +1434,18 @@ static const uint8_t *unmarshal_one(
}
case LB_REFERENCE:
case LB_ARRAY:
case LB_ARRAY_WEAK:
case LB_TUPLE:
case LB_STRUCT:
case LB_STRUCT_PROTO:
case LB_TABLE:
case LB_TABLE_PROTO:
case LB_TABLE_WEAKK:
case LB_TABLE_WEAKV:
case LB_TABLE_WEAKKV:
case LB_TABLE_WEAKK_PROTO:
case LB_TABLE_WEAKV_PROTO:
case LB_TABLE_WEAKKV_PROTO:
/* Things that open with integers */
{
data++;
@@ -1430,9 +1454,9 @@ static const uint8_t *unmarshal_one(
if (lead != LB_REFERENCE) {
MARSH_EOS(st, data - 1 + len);
}
if (lead == LB_ARRAY) {
if (lead == LB_ARRAY || lead == LB_ARRAY_WEAK) {
/* Array */
JanetArray *array = janet_array(len);
JanetArray *array = (lead == LB_ARRAY_WEAK) ? janet_array_weak(len) : janet_array(len);
array->count = len;
*out = janet_wrap_array(array);
janet_v_push(st->lookup, *out);
@@ -1472,10 +1496,19 @@ static const uint8_t *unmarshal_one(
*out = st->lookup[len];
} else {
/* Table */
JanetTable *t = janet_table(len);
JanetTable *t;
if (lead == LB_TABLE_WEAKK_PROTO || lead == LB_TABLE_WEAKK) {
t = janet_table_weakk(len);
} else if (lead == LB_TABLE_WEAKV_PROTO || lead == LB_TABLE_WEAKV) {
t = janet_table_weakv(len);
} else if (lead == LB_TABLE_WEAKKV_PROTO || lead == LB_TABLE_WEAKKV) {
t = janet_table_weakkv(len);
} else {
t = janet_table(len);
}
*out = janet_wrap_table(t);
janet_v_push(st->lookup, *out);
if (lead == LB_TABLE_PROTO) {
if (lead == LB_TABLE_PROTO || lead == LB_TABLE_WEAKK_PROTO || lead == LB_TABLE_WEAKV_PROTO || lead == LB_TABLE_WEAKKV_PROTO) {
Janet proto;
data = unmarshal_one(st, data, &proto, flags + 1);
janet_asserttype(proto, JANET_TABLE, st);

View File

@@ -497,8 +497,8 @@ int janet_scan_numeric(
Janet *out) {
int result;
double num;
int64_t i64;
uint64_t u64;
int64_t i64 = 0;
uint64_t u64 = 0;
if (len < 2 || str[len - 2] != ':') {
result = janet_scan_number_base(str, len, 0, &num);
*out = janet_wrap_number(num);

View File

@@ -1742,6 +1742,9 @@ JANET_API void janet_table_merge_struct(JanetTable *table, JanetStruct other);
JANET_API JanetKV *janet_table_find(JanetTable *t, Janet key);
JANET_API JanetTable *janet_table_clone(JanetTable *table);
JANET_API void janet_table_clear(JanetTable *table);
JANET_API JanetTable *janet_table_weakk(int32_t capacity);
JANET_API JanetTable *janet_table_weakv(int32_t capacity);
JANET_API JanetTable *janet_table_weakkv(int32_t capacity);
/* Fiber */
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv);

View File

@@ -4,14 +4,20 @@
(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-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 stack (debug/stack (fiber/current)))
@@ -24,9 +30,16 @@
(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)
@@ -62,8 +75,8 @@
(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"

View File

@@ -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")

View File

@@ -979,4 +979,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)

View File

@@ -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)

View File

@@ -38,13 +38,16 @@
(gccollect)
(defn- expect
[key value]
[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))))
(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
[]
@@ -80,14 +83,18 @@
(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))
@@ -98,7 +105,7 @@
(when is-win
(spit-file td1 "file1.txt")
(expect :type :added)
(expect :type :added :file-name "file1.txt" :dir-name td1)
(expect :type :modified)
(expect-maybe :type :modified) # for mingw + wine
(gccollect)
@@ -144,7 +151,7 @@
(when is-linux
(spit-file td1 "file1.txt")
(expect :type :create)
(expect :type :create :file-name "file1.txt" :dir-name td1)
(expect :type :close-write)
(expect-empty)
(gccollect)
@@ -153,6 +160,11 @@
(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)
@@ -187,5 +199,6 @@
(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)

View File

@@ -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)