merge changes from ocaml3110 to ocaml3111rc0

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@9270 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
author: Damien Doligez <damien.doligez-inria.fr> 2009-05-20 11:52:42 +0000
committer: Damien Doligez <damien.doligez-inria.fr> 2009-05-20 11:52:42 +0000
commit: ed32f569e3b636e0f12efdbbd5bba9e05cc434ac (patch)
tree: 20b551901a72edf7733a6fe5287deab21ed9b83b /otherlibs
parent: 7795eafa896b0c5b3066d5efec7ec49d69d44e4d (diff)
14 files changed, 65 insertions, 46 deletions
diff --git a/otherlibs/dbm/Makefile b/otherlibs/dbm/Makefile
index bb65b6b1c..099327d69 100644
--- a/otherlibs/dbm/Makefile
+++ b/otherlibs/dbm/Makefile
@@ -21,6 +21,7 @@ CAMLOBJS=dbm.cmo
 COBJS=cldbm.o
 EXTRACFLAGS=$(DBM_INCLUDES)
 LINKOPTS=$(DBM_LINK)
+LDOPTS=-ldopt "$(DBM_LINK)"
 
 include ../Makefile
 
diff --git a/otherlibs/labltk/lib/Makefile b/otherlibs/labltk/lib/Makefile
index e2fe5f16e..5aec48c45 100644
--- a/otherlibs/labltk/lib/Makefile
+++ b/otherlibs/labltk/lib/Makefile
@@ -32,7 +32,7 @@ $(LIBNAME).cma: $(SUPPORT) ../Widgets.src
 	$(MAKE) superclean
 	cd ../labltk; $(MAKE)
 	cd ../camltk; $(MAKE)
-	$(MKLIB) -ocamlc '$(CAMLC)' -o $(LIBNAME) \
+	$(MKLIB) -ocamlc '$(CAMLCB)' -o $(LIBNAME) \
           -I ../labltk -I ../camltk $(TKOBJS) \
           -ccopt "\"$(TK_LINK)\""
 
@@ -40,7 +40,7 @@ $(LIBNAME).cmxa: $(SUPPORT:.cmo=.cmx) ../Widgets.src
 	$(MAKE) superclean
 	cd ../labltk; $(MAKE) opt
 	cd ../camltk; $(MAKE) opt
-	$(MKLIB) -ocamlopt '$(CAMLOPT)' -o $(LIBNAME) -oc $(LIBNAME) \
+	$(MKLIB) -ocamlopt '$(CAMLOPTB)' -o $(LIBNAME) -oc $(LIBNAME) \
           -I ../labltk -I ../camltk $(TKOBJS:.cmo=.cmx) \
           -ccopt "\"$(TK_LINK)\""
 
diff --git a/otherlibs/labltk/support/Makefile.common b/otherlibs/labltk/support/Makefile.common
index 215804826..56f6fd137 100644
--- a/otherlibs/labltk/support/Makefile.common
+++ b/otherlibs/labltk/support/Makefile.common
@@ -13,8 +13,10 @@ INSTALLDIR=$(LIBDIR)/$(LIBNAME)
 ## Tools from the Objective Caml distribution
 
 CAMLRUN=$(TOPDIR)/boot/ocamlrun
-CAMLC=$(CAMLRUN) $(TOPDIR)/ocamlc -nostdlib -I $(TOPDIR)/stdlib 
-CAMLOPT=$(CAMLRUN) $(TOPDIR)/ocamlopt -nostdlib -I $(TOPDIR)/stdlib 
+CAMLC=$(TOPDIR)/ocamlcomp.sh
+CAMLOPT=$(TOPDIR)/ocamlcompopt.sh
+CAMLCB=$(CAMLRUN) $(TOPDIR)/ocamlc
+CAMLOPTB=$(CAMLRUN) $(TOPDIR)/ocamlopt
 CAMLCOMP=$(CAMLC) -c -warn-error A
 CAMLYACC=$(TOPDIR)/boot/ocamlyacc -v
 CAMLLEX=$(CAMLRUN) $(TOPDIR)/boot/ocamllex
diff --git a/otherlibs/labltk/tkanim/Makefile b/otherlibs/labltk/tkanim/Makefile
index 574069ea5..c29743881 100644
--- a/otherlibs/labltk/tkanim/Makefile
+++ b/otherlibs/labltk/tkanim/Makefile
@@ -14,10 +14,10 @@ OBJS=tkanim.cmo
 COBJS= cltkaniminit.$(O) tkAnimGIF.$(O)
 
 tkanim.cma: $(OBJS)
-	$(MKLIB) -ocamlc '$(CAMLC)' -o tkanim $(OBJS)
+	$(MKLIB) -ocamlc '$(CAMLCB)' -o tkanim $(OBJS)
 
 tkanim.cmxa: $(OBJS:.cmo=.cmx)
-	$(MKLIB) -ocamlopt '$(CAMLOPT)' -o tkanim $(OBJS:.cmo=.cmx)
+	$(MKLIB) -ocamlopt '$(CAMLOPTB)' -o tkanim $(OBJS:.cmo=.cmx)
 
 libtkanim.$(A): $(COBJS)
 	$(MKLIB) -o tkanim $(COBJS)
diff --git a/otherlibs/num/big_int.ml b/otherlibs/num/big_int.ml
index 9465bcd6c..933721ca5 100644
--- a/otherlibs/num/big_int.ml
+++ b/otherlibs/num/big_int.ml
@@ -367,8 +367,8 @@ let big_int_of_int64 i =
       else if i > 0L then (1, i)
       else (-1, Int64.neg i) in
     let res = create_nat 2 in
-    set_digit_nat_native res 0 (Int64.to_nativeint i);
-    set_digit_nat_native res 1 (Int64.to_nativeint (Int64.shift_right i 32));
+    set_digit_nat_native res 0 (Int64.to_nativeint absi);
+    set_digit_nat_native res 1 (Int64.to_nativeint (Int64.shift_right absi 32));
     { sign = sg; abs_value = res }
   end
 
diff --git a/otherlibs/num/test/test_big_ints.ml b/otherlibs/num/test/test_big_ints.ml
index e1e4b88b0..572b86863 100644
--- a/otherlibs/num/test/test_big_ints.ml
+++ b/otherlibs/num/test/test_big_ints.ml
@@ -750,6 +750,16 @@ test 2 eq_big_int
   (big_int_of_int64 9223372036854775807L, big_int_of_string "9223372036854775807");;
 test 3 eq_big_int
   (big_int_of_int64 (-9223372036854775808L), big_int_of_string "-9223372036854775808");;
+test 4 eq_big_int (*PR#4792*)
+  (big_int_of_int64 (Int64.of_int32 Int32.min_int), big_int_of_string "-2147483648");;
+test 5 eq_big_int
+  (big_int_of_int64 1234L, big_int_of_string "1234");;
+test 6 eq_big_int
+  (big_int_of_int64 0x1234567890ABCDEFL, big_int_of_string "1311768467294899695");;
+test 7 eq_big_int
+  (big_int_of_int64 (-1234L), big_int_of_string "-1234");;
+test 8 eq_big_int
+  (big_int_of_int64 (-0x1234567890ABCDEFL), big_int_of_string "-1311768467294899695");;
 
 testing_function "int64_of_big_int";;
 
diff --git a/otherlibs/str/str.ml b/otherlibs/str/str.ml
index bb3231ad7..bbbef0a27 100644
--- a/otherlibs/str/str.ml
+++ b/otherlibs/str/str.ml
@@ -96,7 +96,7 @@ module Charset =
 type re_syntax =
     Char of char
   | String of string
-  | CharClass of Charset.t
+  | CharClass of Charset.t * bool  (* true = complemented, false = normal *)
   | Seq of re_syntax list
   | Alt of re_syntax * re_syntax
   | Star of re_syntax
@@ -156,7 +156,7 @@ let displ dest from = dest - from - 1
 let rec is_nullable = function
     Char c -> false
   | String s -> s = ""
-  | CharClass cl -> false
+  | CharClass(cl, cmpl) -> false
   | Seq rl -> List.for_all is_nullable rl
   | Alt (r1, r2) -> is_nullable r1 || is_nullable r2
   | Star r -> true
@@ -175,7 +175,7 @@ let rec is_nullable = function
 let rec first = function
     Char c -> Charset.singleton c
   | String s -> if s = "" then Charset.full else Charset.singleton s.[0]
-  | CharClass cl -> cl
+  | CharClass(cl, cmpl) -> if cmpl then Charset.complement cl else cl
   | Seq rl -> first_seq rl
   | Alt (r1, r2) -> Charset.union (first r1) (first r2)
   | Star r -> Charset.full
@@ -197,12 +197,13 @@ and first_seq = function
 (* Transform a Char or CharClass regexp into a character class *)
 
 let charclass_of_regexp fold_case re =
-  let cl =
+  let (cl1, compl) =
     match re with
-      Char c -> Charset.singleton c
-    | CharClass cl -> cl
+    | Char c -> (Charset.singleton c, false)
+    | CharClass(cl, compl) -> (cl, compl)
     | _ -> assert false in
-  if fold_case then Charset.fold_case cl else cl
+  let cl2 = if fold_case then Charset.fold_case cl1 else cl1 in
+  if compl then Charset.complement cl2 else cl2
 
 (* The case fold table: maps characters to their lowercase equivalent *)
 
@@ -289,9 +290,10 @@ let compile fold_case re =
           else
             emit_instr op_STRING (cpool_index s)
       end
-  | CharClass cl ->
-      let cl' = if fold_case then Charset.fold_case cl else cl in
-      emit_instr op_CHARCLASS (cpool_index cl')
+  | CharClass(cl, compl) ->
+      let cl1 = if fold_case then Charset.fold_case cl else cl in
+      let cl2 = if compl then Charset.complement cl1 else cl1 in
+      emit_instr op_CHARCLASS (cpool_index cl2)
   | Seq rl ->
       emit_seq_code rl
   | Alt(r1, r2) ->
@@ -492,10 +494,11 @@ let parse s =
   and regexp3 i =
     match s.[i] with
       '\\' -> regexpbackslash (i+1)
-    | '['  -> let (c, j) = regexpclass0 (i+1) in (CharClass c, j)
+    | '['  -> let (c, compl, j) = regexpclass0 (i+1) in
+              (CharClass(c, compl), j)
     | '^'  -> (Bol, i+1)
     | '$'  -> (Eol, i+1)
-    | '.'  -> (CharClass dotclass, i+1)
+    | '.'  -> (CharClass(dotclass, false), i+1)
     | c    -> (Char c, i+1)
   and regexpbackslash i =
     if i >= len then (Char '\\', i) else
@@ -520,8 +523,8 @@ let parse s =
           (Char c, i + 1)
   and regexpclass0 i =
     if i < len && s.[i] = '^'
-    then let (c, j) = regexpclass1 (i+1) in (Charset.complement c, j)
-    else regexpclass1 i
+    then let (c, j) = regexpclass1 (i+1) in (c, true, j)
+    else let (c, j) = regexpclass1 i in (c, false, j)
   and regexpclass1 i =
     let c = Charset.make_empty() in
     let j = regexpclass2 c i i in
diff --git a/otherlibs/systhreads/Tests/Makefile b/otherlibs/systhreads/Tests/Makefile
index 0c38dd7e5..5911fafdb 100644
--- a/otherlibs/systhreads/Tests/Makefile
+++ b/otherlibs/systhreads/Tests/Makefile
@@ -16,7 +16,7 @@
 PROGS=test1.byt test2.byt test3.byt test4.byt test5.byt test6.byt \
   test7.byt test8.byt test9.byt testA.byt sieve.byt \
   testio.byt testsocket.byt testsignal.byt testsignal2.byt \
-  torture.byt
+  torture.byt testfork.byt
 
 MOREPROGS=testfork.byt
 
diff --git a/otherlibs/systhreads/posix.c b/otherlibs/systhreads/posix.c
index 715741fc5..da45be06c 100644
--- a/otherlibs/systhreads/posix.c
+++ b/otherlibs/systhreads/posix.c
@@ -111,6 +111,9 @@ static pthread_mutex_t caml_runtime_mutex = PTHREAD_MUTEX_INITIALIZER;
 /* Condition signaled when caml_runtime_busy becomes 0 */
 static pthread_cond_t caml_runtime_is_free = PTHREAD_COND_INITIALIZER;
 
+/* Whether the ``tick'' thread is already running */
+static int caml_tick_thread_running = 0;
+
 /* The key used for storing the thread descriptor in the specific data
    of the corresponding Posix thread. */
 static pthread_key_t thread_descriptor_key;
@@ -332,8 +335,6 @@ static void * caml_thread_tick(void * arg)
 static void caml_thread_reinitialize(void)
 {
   caml_thread_t thr, next;
-  pthread_t tick_pthread;
-  pthread_attr_t attr;
   struct channel * chan;
 
   /* Remove all other threads (now nonexistent)
@@ -353,24 +354,21 @@ static void caml_thread_reinitialize(void)
   pthread_cond_init(&caml_runtime_is_free, NULL);
   caml_runtime_waiters = 0;     /* no other thread is waiting for the RTS */
   caml_runtime_busy = 1;        /* normally useless */
+  /* Tick thread is not currently running in child process, will be
+     re-created at next Thread.create */
+  caml_tick_thread_running = 0;
   /* Reinitialize all IO mutexes */
   for (chan = caml_all_opened_channels;
        chan != NULL;
        chan = chan->next) {
     if (chan->mutex != NULL) pthread_mutex_init(chan->mutex, NULL);
   }
-  /* Fork a new tick thread */
-  pthread_attr_init(&attr);
-  pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED);
-  pthread_create(&tick_pthread, &attr, caml_thread_tick, NULL);
 }
 
 /* Initialize the thread machinery */
 
 value caml_thread_initialize(value unit)   /* ML */
 {
-  pthread_t tick_pthread;
-  pthread_attr_t attr;
   value mu = Val_unit;
   value descr;
 
@@ -395,6 +393,7 @@ value caml_thread_initialize(value unit)   /* ML */
     curr_thread->descr = descr;
     curr_thread->next = curr_thread;
     curr_thread->prev = curr_thread;
+    curr_thread->backtrace_last_exn = Val_unit;
 #ifdef NATIVE_CODE
     curr_thread->exit_buf = &caml_termination_jmpbuf;
 #endif
@@ -415,12 +414,6 @@ value caml_thread_initialize(value unit)   /* ML */
     caml_channel_mutex_lock = caml_io_mutex_lock;
     caml_channel_mutex_unlock = caml_io_mutex_unlock;
     caml_channel_mutex_unlock_exn = caml_io_mutex_unlock_exn;
-    /* Fork the tick thread */
-    pthread_attr_init(&attr);
-    pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED);
-    caml_pthread_check(
-        pthread_create(&tick_pthread, &attr, caml_thread_tick, NULL),
-        "Thread.init");
     /* Set up fork() to reinitialize the thread machinery in the child
        (PR#4577) */
     pthread_atfork(NULL, NULL, caml_thread_reinitialize);
@@ -488,6 +481,7 @@ value caml_thread_new(value clos)          /* ML */
 {
   pthread_attr_t attr;
   caml_thread_t th;
+  pthread_t tick_pthread;
   value mu = Val_unit;
   value descr;
   int err;
@@ -526,12 +520,12 @@ value caml_thread_new(value clos)          /* ML */
     th->prev = curr_thread;
     curr_thread->next->prev = th;
     curr_thread->next = th;
-    /* Fork the new thread */
+    /* Create the new thread */
     pthread_attr_init(&attr);
     pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED);
     err = pthread_create(&th->pthread, &attr, caml_thread_start, (void *) th);
     if (err != 0) {
-      /* Fork failed, remove thread info block from list of threads */
+      /* Creation failed, remove thread info block from list of threads */
       th->next->prev = curr_thread;
       curr_thread->next = th->next;
 #ifndef NATIVE_CODE
@@ -541,6 +535,16 @@ value caml_thread_new(value clos)          /* ML */
       caml_pthread_check(err, "Thread.create");
     }
   End_roots();
+  /* Create the tick thread if not already done.  
+     Because of PR#4666, we start the tick thread late, only when we create
+     the first additional thread in the current process*/
+  if (! caml_tick_thread_running) {
+    caml_tick_thread_running = 1;
+    pthread_attr_init(&attr);
+    pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED);
+    err = pthread_create(&tick_pthread, &attr, caml_thread_tick, NULL);
+    caml_pthread_check(err, "Thread.create");
+  }
   return descr;
 }
 
diff --git a/otherlibs/threads/Tests/Makefile b/otherlibs/threads/Tests/Makefile
index be271f469..ff4388d14 100644
--- a/otherlibs/threads/Tests/Makefile
+++ b/otherlibs/threads/Tests/Makefile
@@ -16,7 +16,7 @@
 PROGS=test1.byt test2.byt test3.byt test4.byt test5.byt test6.byt \
   test7.byt test8.byt test9.byt testA.byt sieve.byt \
   testio.byt testsocket.byt testwait.byt testsignal.byt testsignal2.byt \
-  testsieve.byt token1.byt token2.byt
+  testsieve.byt token1.byt token2.byt testfork.byt
 
 CAMLC=../../../boot/ocamlrun ../../../ocamlc -I .. -I ../../../stdlib -I ../../unix
 
diff --git a/otherlibs/unix/unix.mli b/otherlibs/unix/unix.mli
index 386864e05..251c31ae3 100644
--- a/otherlibs/unix/unix.mli
+++ b/otherlibs/unix/unix.mli
@@ -910,7 +910,8 @@ type socket_domain =
     PF_UNIX                     (** Unix domain *)
   | PF_INET                     (** Internet domain (IPv4) *)
   | PF_INET6                    (** Internet domain (IPv6) *)
-(** The type of socket domains. *)
+(** The type of socket domains.  Not all platforms support
+    IPv6 sockets (type [PF_INET6]).  *)
 
 type socket_type =
     SOCK_STREAM                 (** Stream socket *)
diff --git a/otherlibs/win32unix/pipe.c b/otherlibs/win32unix/pipe.c
index 67e381298..afacd3e17 100644
--- a/otherlibs/win32unix/pipe.c
+++ b/otherlibs/win32unix/pipe.c
@@ -19,7 +19,8 @@
 #include "unixsupport.h"
 #include <fcntl.h>
 
-#define SIZEBUF 1024
+/* PR#4749: pick a size that matches that of I/O buffers */
+#define SIZEBUF 4096
 
 CAMLprim value unix_pipe(value unit)
 {
diff --git a/otherlibs/win32unix/stat.c b/otherlibs/win32unix/stat.c
index 313882a52..79fc3b2eb 100644
--- a/otherlibs/win32unix/stat.c
+++ b/otherlibs/win32unix/stat.c
@@ -107,9 +107,5 @@ CAMLprim value unix_fstat_64(value handle)
 
   ret = _fstati64(win_CRT_fd_of_filedescr(handle), &buf);
   if (ret == -1) uerror("fstat", Nothing);
-  if (buf.st_size > Max_long) {
-    win32_maperr(ERROR_ARITHMETIC_OVERFLOW);
-    uerror("fstat", Nothing);
-  }
   return stat_aux(1, &buf);
 }
diff --git a/otherlibs/win32unix/unixsupport.c b/otherlibs/win32unix/unixsupport.c
index b7d4ad92d..24c4a9e45 100644
--- a/otherlibs/win32unix/unixsupport.c
+++ b/otherlibs/win32unix/unixsupport.c
@@ -108,6 +108,7 @@ static struct error_entry win_error_table[] = {
   { ERROR_NO_PROC_SLOTS, 0, EAGAIN},
   { ERROR_DRIVE_LOCKED, 0, EACCES},
   { ERROR_BROKEN_PIPE, 0, EPIPE},
+  { ERROR_NO_DATA, 0, EPIPE},
   { ERROR_DISK_FULL, 0, ENOSPC},
   { ERROR_INVALID_TARGET_HANDLE, 0, EBADF},
   { ERROR_INVALID_HANDLE, 0, EINVAL},
author	Damien Doligez <damien.doligez-inria.fr>	2009-05-20 11:52:42 +0000
committer	Damien Doligez <damien.doligez-inria.fr>	2009-05-20 11:52:42 +0000
commit	ed32f569e3b636e0f12efdbbd5bba9e05cc434ac (patch)
tree	20b551901a72edf7733a6fe5287deab21ed9b83b /otherlibs
parent	7795eafa896b0c5b3066d5efec7ec49d69d44e4d (diff)