Original bug ID: 1784
Reporter: administrator
Assigned to: @xavierleroy
Status: closed (set by @xavierleroy on 2011-05-29T10:19:35Z)
Resolution: fixed
Priority: normal
Severity: feature
Fixed in version: 3.12.0+dev
Category: ~DO NOT USE (was: OCaml general)
Related to: #4702
Monitored by: @db4

Bug description

Full_Name: Annan Harley
Version: 3.06
OS: Linux 2.4
Submission from: h24-78-76-99.vc.shawcable.net (24.78.76.99)

I can regularly reproduce segfaults by using pthread_create in a C function,
then calling an OCaml closure set up in a different thread. Code to reproduce
the condition follows.

***************** oops.c
#include <pthread.h>
#include <unistd.h>
#include <caml/mlvalues.h>
#include <caml/memory.h>
#include <caml/callback.h>

static value * f = 0;
static value * v = 0;
static pthread_t p = 0;
static pthread_mutex_t m = PTHREAD_MUTEX_INITIALIZER;
static pthread_cond_t c = PTHREAD_COND_INITIALIZER;

/* so we need a function to call from OCaml that sets the callback,
a function that runs the callback, and a function (called from OCaml)
that starts the thread that runs the function that runs the callback.

whee. */

value im_setting_the_callback(value no_val) {
CAMLparam1 (no_val);

f = caml_named_value("segfault_function");
v = caml_named_value("segfault_function_val");

CAMLreturn(Val_unit);
}

void* look_at_me_segfault(void *arg) {
CAMLparam0 ();

pthread_mutex_lock(&m);
pthread_cond_signal(&c);
pthread_mutex_unlock(&m);

callback(*f, *v);

CAMLreturn0;
}

value segfault_thread_in_C(value v) {
CAMLparam1 (v);

pthread_mutex_lock(&m);

pthread_create(&p, NULL, &look_at_me_segfault, NULL);

pthread_cond_wait(&c, &m);
pthread_mutex_unlock(&m);

CAMLreturn(Val_unit);
}

********** oops.ml
external set_callback : unit -> unit = "im_setting_the_callback"
external run_callback_from_C_thread : unit -> unit = "segfault_thread_in_C"

let look_at_me_segfault s = print_string s; flush Pervasives.stdout

let main () =
Callback.register "segfault_function" look_at_me_segfault;
Callback.register "segfault_function_val" "oops, i'm segfaulting\n";

set_callback ();
Thread.create run_callback_from_C_thread ();

Unix.sleep 2;;

main ();;

build with
gcc -c -g -I /usr/local/lib/ocaml -o oops_c.o oops.c
ocamlopt -o oops -thread -cclib -lpthread unix.cmxa threads.cmxa oops_c.o
oops.ml

Thanks much.