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

CHANGELOG.md

@@ -9,6 +9,8 @@ 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`
+- Fix marshalling weak tables and weak arrays.
+- Expose C functions for constructing weak tables in janet.h
 
 ## 1.35.2 - 2024-06-16
 - Add `bundle/add-bin` to make installing scripts easier. This also establishes a packaging convention for it.

src/core/marsh.c

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

src/include/janet.h

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

test/suite-marsh.janet

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