1 | ; build with: |
---|
2 | ; csc -C -I/usr/include/glib-2.0 -C -I/usr/lib/glib-2.0/include -L -lglib-2.0 test.scm |
---|
3 | |
---|
4 | (require-extension bind) |
---|
5 | (use irregex) |
---|
6 | |
---|
7 | (foreign-declare "#include <glib.h>") |
---|
8 | |
---|
9 | (bind #<<EOF |
---|
10 | |
---|
11 | typedef int gint; |
---|
12 | typedef gint gboolean; |
---|
13 | typedef unsigned int guint; |
---|
14 | |
---|
15 | GMainLoop * |
---|
16 | g_main_loop_new (GMainContext *context, |
---|
17 | gboolean is_running); |
---|
18 | |
---|
19 | ___safe void |
---|
20 | g_main_loop_run (GMainLoop *loop); |
---|
21 | |
---|
22 | guint |
---|
23 | g_timeout_add_seconds (guint interval, |
---|
24 | void * function, |
---|
25 | void * data); |
---|
26 | |
---|
27 | EOF |
---|
28 | ) |
---|
29 | |
---|
30 | (define-external |
---|
31 | (my_callback (c-pointer data)) void |
---|
32 | ; on my machine, it dies at the 2nd attempt |
---|
33 | (print "let's try and crash") |
---|
34 | (work) |
---|
35 | (print "done") |
---|
36 | (define timer (g_timeout_add_seconds 1 #$my_callback #f))) |
---|
37 | |
---|
38 | ; just to keep the thing busy, this is what triggers the crash |
---|
39 | (define (work) |
---|
40 | (do ([i 0 (+ i 1)]) ((< 150000 i) #t) |
---|
41 | (irregex-search "( |_|-|#|\\.)[0 ]*14[^0-9]" "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"))) |
---|
42 | |
---|
43 | (define timer (g_timeout_add_seconds 1 #$my_callback #f)) |
---|
44 | |
---|
45 | (define loop (g_main_loop_new #f 0)) |
---|
46 | (g_main_loop_run loop) |
---|