1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
/*
* Test that GC does not collect fibers during janet_pcall.
*
* Bug: janet_collect() marks janet_vm.root_fiber but not janet_vm.fiber.
* When janet_pcall is called from a C function, the inner fiber becomes
* janet_vm.fiber while root_fiber still points to the outer fiber. If GC
* triggers inside the inner fiber's execution, the inner fiber is not in
* any GC root set and can be collected — including its stack memory —
* while it is actively running.
*
* Two tests:
* 1. Single nesting: F1 -> C func -> janet_pcall -> F2
* F2 is not marked (it's janet_vm.fiber but not root_fiber)
* 2. Deep nesting: F1 -> C func -> janet_pcall -> F2 -> C func -> janet_pcall -> F3
* F2 is not marked (saved only in a C stack local tstate.vm_fiber)
*
* Build (after building janet):
* cc -o build/test-gc-pcall test/test-gc-pcall.c \
* -Isrc/include -Isrc/conf build/libjanet.a -lm -lpthread -ldl
*
* Run:
* ./build/test-gc-pcall
*/
#include "janet.h"
#include <stdio.h>
/* C function that calls a Janet callback via janet_pcall. */
static Janet cfun_call_via_pcall(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetFunction *fn = janet_getfunction(argv, 0);
Janet result;
JanetFiber *fiber = NULL;
JanetSignal sig = janet_pcall(fn, 0, NULL, &result, &fiber);
if (sig != JANET_SIGNAL_OK) {
janet_panicv(result);
}
return result;
}
static int run_test(JanetTable *env, const char *name, const char *source) {
printf(" %s... ", name);
fflush(stdout);
Janet result;
int status = janet_dostring(env, source, name, &result);
if (status != 0) {
printf("FAIL (crashed or errored)\n");
return 1;
}
printf("PASS\n");
return 0;
}
/* Test 1: Single nesting.
* F1 -> cfun_call_via_pcall -> janet_pcall -> F2
* F2 is janet_vm.fiber but not root_fiber, so GC can collect it.
*
* All allocations are done in Janet code so GC checks trigger in the
* VM loop (janet_gcalloc does NOT call janet_collect — only the VM's
* vm_checkgc_next does). */
static const char test_single[] =
"(gcsetinterval 1024)\n"
"(def cb\n"
" (do\n"
" (def captured @{:key \"value\" :nested @[1 2 3 4 5]})\n"
" (fn []\n"
" (var result nil)\n"
" (for i 0 500\n"
" (def t @{:i i :s (string \"iter-\" i) :arr @[i (+ i 1) (+ i 2)]})\n"
" (set result (get captured :key)))\n"
" result)))\n"
"(for round 0 200\n"
" (def result (call-via-pcall cb))\n"
" (assert (= result \"value\")\n"
" (string \"round \" round \": expected 'value', got \" (describe result))))\n";
/* Test 2: Deep nesting.
* F1 -> cfun_call_via_pcall -> janet_pcall -> F2 -> cfun_call_via_pcall -> janet_pcall -> F3
* F2 is saved only in C stack local tstate.vm_fiber, invisible to GC.
* F2's stack data can be freed if F2 is collected during F3's execution.
*
* The inner callback allocates in Janet code (not C) to ensure the
* VM loop triggers GC checks during F3's execution. */
static const char test_deep[] =
"(gcsetinterval 1024)\n"
"(def inner-cb\n"
" (do\n"
" (def captured @{:key \"deep\" :nested @[10 20 30]})\n"
" (fn []\n"
" (var result nil)\n"
" (for i 0 500\n"
" (def t @{:i i :s (string \"iter-\" i) :arr @[i (+ i 1) (+ i 2)]})\n"
" (set result (get captured :key)))\n"
" result)))\n"
"\n"
"(def outer-cb\n"
" (do\n"
" (def state @{:count 0 :data @[\"a\" \"b\" \"c\" \"d\" \"e\"]})\n"
" (fn []\n"
" # This runs on F2. Calling call-via-pcall here creates F3.\n"
" # F2 becomes unreachable: it's not root_fiber (that's F1)\n"
" # and it's no longer janet_vm.fiber (that's now F3).\n"
" (def inner-result (call-via-pcall inner-cb))\n"
" # If F2 was collected during F3's execution, accessing\n"
" # state here reads freed memory.\n"
" (put state :count (+ (state :count) 1))\n"
" (string inner-result \"-\" (state :count)))))\n"
"\n"
"(for round 0 200\n"
" (def result (call-via-pcall outer-cb))\n"
" (def expected (string \"deep-\" (+ round 1)))\n"
" (assert (= result expected)\n"
" (string \"round \" round \": expected '\" expected \"', got '\" (describe result) \"'\")))\n";
int main(int argc, char **argv) {
(void)argc;
(void)argv;
int failures = 0;
janet_init();
JanetTable *env = janet_core_env(NULL);
janet_def(env, "call-via-pcall",
janet_wrap_cfunction(cfun_call_via_pcall),
"Call a function via janet_pcall from C.");
printf("Testing janet_pcall GC safety:\n");
failures += run_test(env, "single-nesting", test_single);
failures += run_test(env, "deep-nesting", test_deep);
janet_deinit();
if (failures > 0) {
printf("\n%d test(s) FAILED\n", failures);
return 1;
}
printf("\nAll tests passed.\n");
return 0;
}
|
