Ticket #1337: test.scm

; build with:
; csc -C -I/usr/include/glib-2.0 -C -I/usr/lib/glib-2.0/include -L -lglib-2.0 test.scm

(require-extension bind)
(use irregex)

(foreign-declare "#include <glib.h>")

(bind #<<EOF

typedef int gint;
typedef gint   gboolean;
typedef unsigned int guint;

GMainLoop *
g_main_loop_new (GMainContext *context,
                 gboolean is_running);

___safe void
g_main_loop_run (GMainLoop *loop);

guint
g_timeout_add_seconds (guint interval,
                       void * function,
                       void * data);

EOF
)

(define-external
  (my_callback (c-pointer data)) void
  ; on my machine, it dies at the 2nd attempt
  (print "let's try and crash")
  (work)
  (print "done")
  (define timer (g_timeout_add_seconds 1 #$my_callback #f)))

; just to keep the thing busy, this is what triggers the crash
(define (work)
  (do ([i 0 (+ i 1)]) ((< 150000 i) #t)
    (irregex-search "( |_|-|#|\\.)[0 ]*14[^0-9]" "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")))

(define timer (g_timeout_add_seconds 1 #$my_callback #f))

(define loop (g_main_loop_new #f 0))
(g_main_loop_run loop)