Fusion des modifs faites sur la branche release jusqu'a la release 3.08.0

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@6553 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

11 files changed, 90 insertions, 46 deletions

diff --git a/stdlib/.depend b/stdlib/.depend
index 0d15561d0..82a3ead49 100644
--- a/stdlib/.depend
+++ b/stdlib/.depend
@@ -17,10 +17,10 @@ buffer.cmo: string.cmi sys.cmi buffer.cmi
 buffer.cmx: string.cmx sys.cmx buffer.cmi 
 callback.cmo: obj.cmi callback.cmi 
 callback.cmx: obj.cmx callback.cmi 
-camlinternalOO.cmo: array.cmi hashtbl.cmi list.cmi map.cmi obj.cmi random.cmi \
-    sort.cmi sys.cmi camlinternalOO.cmi 
-camlinternalOO.cmx: array.cmx hashtbl.cmx list.cmx map.cmx obj.cmx random.cmx \
-    sort.cmx sys.cmx camlinternalOO.cmi 
+camlinternalOO.cmo: array.cmi char.cmi list.cmi map.cmi obj.cmi string.cmi \
+    sys.cmi camlinternalOO.cmi 
+camlinternalOO.cmx: array.cmx char.cmx list.cmx map.cmx obj.cmx string.cmx \
+    sys.cmx camlinternalOO.cmi 
 char.cmo: char.cmi 
 char.cmx: char.cmi 
 complex.cmo: complex.cmi 
@@ -67,8 +67,8 @@ parsing.cmo: array.cmi lexing.cmi obj.cmi parsing.cmi
 parsing.cmx: array.cmx lexing.cmx obj.cmx parsing.cmi 
 pervasives.cmo: pervasives.cmi 
 pervasives.cmx: pervasives.cmi 
-printexc.cmo: obj.cmi printf.cmi sys.cmi printexc.cmi 
-printexc.cmx: obj.cmx printf.cmx sys.cmx printexc.cmi 
+printexc.cmo: obj.cmi printf.cmi printexc.cmi 
+printexc.cmx: obj.cmx printf.cmx printexc.cmi 
 printf.cmo: buffer.cmi char.cmi list.cmi obj.cmi string.cmi printf.cmi 
 printf.cmx: buffer.cmx char.cmx list.cmx obj.cmx string.cmx printf.cmi 
 queue.cmo: obj.cmi queue.cmi 
@@ -78,9 +78,9 @@ random.cmo: array.cmi char.cmi digest.cmi int32.cmi int64.cmi nativeint.cmi \
 random.cmx: array.cmx char.cmx digest.cmx int32.cmx int64.cmx nativeint.cmx \
     pervasives.cmx string.cmx random.cmi 
 scanf.cmo: buffer.cmi hashtbl.cmi list.cmi obj.cmi printf.cmi string.cmi \
-    sys.cmi scanf.cmi 
+    scanf.cmi 
 scanf.cmx: buffer.cmx hashtbl.cmx list.cmx obj.cmx printf.cmx string.cmx \
-    sys.cmx scanf.cmi 
+    scanf.cmi 
 set.cmo: set.cmi 
 set.cmx: set.cmi 
 sort.cmo: array.cmi sort.cmi 
diff --git a/stdlib/Compflags b/stdlib/Compflags
index e263fbcf2..697f38dca 100755
--- a/stdlib/Compflags
+++ b/stdlib/Compflags
@@ -15,12 +15,12 @@
 # $Id$
 
 case $1 in
-  pervasives.cm[iox]|pervasives.p.cmx) echo '-nopervasives';;
-  camlinternalOO.cmi) echo '-nopervasives';;
-  camlinternalOO.cmx|camlinternalOO.p.cmx) echo '-inline 0';;
-  arrayLabels.cm[ox]|arrayLabels.p.cmx) echo '-nolabels';;
-  listLabels.cm[ox]|listLabels.p.cmx) echo '-nolabels';;
-  stringLabels.cm[ox]|stringLabels.p.cmx) echo '-nolabels';;
-  moreLabels.cm[ox]|moreLabels.p.cmx) echo '-nolabels';;
-  *) echo '';;
+  pervasives.cm[iox]|pervasives.p.cmx) echo ' -nopervasives';;
+  camlinternalOO.cmi) echo ' -nopervasives';;
+  camlinternalOO.cmx|camlinternalOO.p.cmx) echo ' -inline 0';;
+  arrayLabels.cm[ox]|arrayLabels.p.cmx) echo ' -nolabels';;
+  listLabels.cm[ox]|listLabels.p.cmx) echo ' -nolabels';;
+  stringLabels.cm[ox]|stringLabels.p.cmx) echo ' -nolabels';;
+  moreLabels.cm[ox]|moreLabels.p.cmx) echo ' -nolabels';;
+  *) echo ' ';;
 esac
diff --git a/stdlib/arg.ml b/stdlib/arg.ml
index 9514b9557..dd6c51753 100644
--- a/stdlib/arg.ml
+++ b/stdlib/arg.ml
@@ -133,7 +133,7 @@ let parse_argv ?(current=current) argv speclist anonfun errmsg =
       begin try
         let rec treat_action = function
         | Unit f -> f ();
-        | Bool f ->
+        | Bool f when !current + 1 < l ->
             let arg = argv.(!current + 1) in
             begin try f (bool_of_string arg)
             with Invalid_argument "bool_of_string" ->
diff --git a/stdlib/format.ml b/stdlib/format.ml
index dcee1a491..0c345137d 100644
--- a/stdlib/format.ml
+++ b/stdlib/format.ml
@@ -184,10 +184,25 @@ let pp_clear_queue state =
     state.pp_left_total <- 1; state.pp_right_total <- 1;
     clear_queue state.pp_queue;;
 
-(* Large value for default tokens size. *)
-(* Could be 1073741823 that is 2^30 - 1, that is the minimal upper bound
-   of integers; now that max_int is defined, could also be max_int - 1. *)
-let pp_infinity = 1000000000;;
+(* Pp_infinity: large value for default tokens size.
+
+   Pp_infinity is documented as being greater than 1e10; to avoid
+   confusion about the word ``greater'' we shoose pp_infinity greater
+   than 1e10 + 1; for correct handling of tests in the algorithm
+   pp_infinity must be even one more than that; let's stand on the
+   safe side by choosing 1.e10+10.
+
+   Pp_infinity could probably be 1073741823 that is 2^30 - 1, that is
+   the minimal upper bound of integers; now that max_int is defined,
+   could also be defined as max_int - 1.
+
+   We must carefully double-check all the integer arithmetic
+   operations that involve pp_infinity before setting pp_infinity to
+   something around max_int: otherwise any overflow would wreck havoc
+   the pretty-printing algorithm's invariants.
+   Is it worth the burden ? *)
+
+let pp_infinity = 1000000010;;
 
 (* Output functions for the formatter. *)
 let pp_output_string state s = state.pp_output_function s 0 (String.length s)
@@ -632,11 +647,15 @@ let pp_set_ellipsis_text state s = state.pp_ellipsis <- s
 and pp_get_ellipsis_text state () = state.pp_ellipsis;;
 
 (* To set the margin of pretty-printer. *)
+let pp_limit n =
+  if n < pp_infinity then n else pred pp_infinity;;
+
 let pp_set_min_space_left state n =
-  if n >= 1 && n < pp_infinity then begin
+  if n >= 1 then
+    let n = pp_limit n in
     state.pp_min_space_left <- n;
     state.pp_max_indent <- state.pp_margin - state.pp_min_space_left;
-    pp_rinit state end;;
+    pp_rinit state;;
 
 (* Initially, we have :
   pp_max_indent = pp_margin - pp_min_space_left, and
@@ -646,7 +665,8 @@ let pp_set_max_indent state n =
 let pp_get_max_indent state () = state.pp_max_indent;;
 
 let pp_set_margin state n =
-  if n >= 1 && n < pp_infinity then begin
+  if n >= 1 then
+    let n = pp_limit n in
     state.pp_margin <- n;
     let new_max_indent =
         (* Try to maintain max_indent to its actual value. *)
@@ -658,7 +678,7 @@ let pp_set_margin state n =
          max (max (state.pp_margin - state.pp_min_space_left)
                   (state.pp_margin / 2)) 1 in
     (* Rebuild invariants. *)
-    pp_set_max_indent state new_max_indent end;;
+    pp_set_max_indent state new_max_indent;;
 
 let pp_get_margin state () = state.pp_margin;;
 
diff --git a/stdlib/format.mli b/stdlib/format.mli
index 3526e2365..09f9badf1 100644
--- a/stdlib/format.mli
+++ b/stdlib/format.mli
@@ -162,8 +162,9 @@ val set_margin : int -> unit;;
 (** [set_margin d] sets the value of the right margin
    to [d] (in characters): this value is used to detect line
    overflows that leads to split lines.
-   Nothing happens if [d] is smaller than 2 or
-   bigger than 999999999. *)
+   Nothing happens if [d] is smaller than 2.
+   If [d] is too large, the right margin is set to the maximum
+   admissible value (which is greater than [10^10]). *)
 
 val get_margin : unit -> int;;
 (** Returns the position of the right margin. *)
@@ -176,13 +177,13 @@ val set_max_indent : int -> unit;;
    indentation limit to [d] (in characters):
    once this limit is reached, boxes are rejected to the left,
    if they do not fit on the current line.
-   Nothing happens if [d] is smaller than 2 or
-   bigger than 999999999. *)
+   Nothing happens if [d] is smaller than 2.
+   If [d] is too large, the limit is set to the maximum
+   admissible value (which is greater than [10^10]). *)
 
 val get_max_indent : unit -> int;;
 (** Return the value of the maximum indentation limit (in characters). *)
 
-
 (** {6 Formatting depth: maximum number of boxes allowed before ellipsis} *)
 
 val set_max_boxes : int -> unit;;
@@ -191,7 +192,7 @@ val set_max_boxes : int -> unit;;
    Material inside boxes nested deeper is printed as an
    ellipsis (more precisely as the text returned by
    [get_ellipsis_text ()]).
-   Nothing happens if [max] is not greater than 1. *)
+   Nothing happens if [max] is smaller than 2. *)
 
 val get_max_boxes : unit -> int;;
 (** Returns the maximum number of boxes allowed before ellipsis. *)
diff --git a/stdlib/pervasives.ml b/stdlib/pervasives.ml
index 514adeee7..7cdfe9325 100644
--- a/stdlib/pervasives.ml
+++ b/stdlib/pervasives.ml
@@ -401,12 +401,20 @@ external decr: int ref -> unit = "%decr"
 type ('a, 'b, 'c) format = ('a, 'b, 'c, 'c) format4
 external format_of_string :
  ('a, 'b, 'c, 'd) format4 -> ('a, 'b, 'c, 'd) format4 = "%identity"
-external string_of_format : ('a, 'b, 'c, 'd) format4 -> string = "%identity"
-
+external string_of_format_sys :
+ ('a, 'b, 'c, 'd) format4 -> string = "%identity"
 external string_to_format : string -> ('a, 'b, 'c, 'd) format4 = "%identity"
+
 let (( ^^ ) : ('a, 'b, 'c, 'd) format4 -> ('d, 'b, 'c, 'e) format4 ->
               ('a, 'b, 'c, 'e) format4) = fun fmt1 fmt2 ->
-  string_to_format (string_of_format fmt1 ^ string_of_format fmt2);;
+  string_to_format (string_of_format_sys fmt1 ^ string_of_format_sys fmt2);;
+
+let string_of_format f =
+  let s = string_of_format_sys f in
+  let l = string_length s in
+  let r = string_create l in
+  string_blit s 0 r 0 l;
+  r
 
 (* Miscellaneous *)
 
diff --git a/stdlib/pervasives.mli b/stdlib/pervasives.mli
index 0b678ca28..430d1d7ab 100644
--- a/stdlib/pervasives.mli
+++ b/stdlib/pervasives.mli
@@ -630,9 +630,9 @@ val pos_out : out_channel -> int
     unspecified results). *)
 
 val out_channel_length : out_channel -> int
-(** Return the total length (number of characters) of the
-   given channel.  This works only for regular files. On files of
-   other kinds, the result is meaningless. *)
+(** Return the size (number of characters) of the regular file
+   on which the given channel is opened.  If the channel is opened
+    on a file that is not a regular file, the result is meaningless. *)
 
 val close_out : out_channel -> unit
 (** Close the given channel, flushing all buffered write operations.
@@ -738,9 +738,12 @@ val pos_in : in_channel -> int
 (** Return the current reading position for the given channel. *)
 
 val in_channel_length : in_channel -> int
-(** Return the total length (number of characters) of the
-   given channel. This works only for regular files. On files of
-   other kinds, the result is meaningless. *)
+(** Return the size (number of characters) of the regular file
+    on which the given channel is opened.  If the channel is opened
+    on a file that is not a regular file, the result is meaningless.
+    The returned size does not take into account the end-of-line
+    translations that can be performed when reading from a channel
+    opened in text mode. *)
 
 val close_in : in_channel -> unit
 (** Close the given channel.  Input functions raise a [Sys_error]
@@ -819,9 +822,9 @@ type ('a, 'b, 'c) format = ('a, 'b, 'c, 'c) format4
     and ['b] is the type of the first argument given to
     [%a] and [%t] printing functions. *)
 
-external string_of_format :
-  ('a, 'b, 'c, 'd) format4 -> string = "%identity"
+val string_of_format : ('a, 'b, 'c, 'd) format4 -> string
 (** Converts a format string into a string. *)
+
 external format_of_string :
   ('a, 'b, 'c, 'd) format4 -> ('a, 'b, 'c, 'd) format4 = "%identity"
 (** [format_of_string s] returns a format string read from the string
diff --git a/stdlib/scanf.ml b/stdlib/scanf.ml
index 78adcc706..cb0291b20 100644
--- a/stdlib/scanf.ml
+++ b/stdlib/scanf.ml
@@ -256,6 +256,7 @@ let bad_float () = bad_input "no dot or exponent part found in float token";;
 
 (* Checking that the current char is indeed one of range, then skip it. *)
 let check_char_in range ib =
+  if range <> [] && not (Scanning.end_of_input ib) then
   let ci = Scanning.checked_peek_char ib in
   if List.memq ci range then Scanning.next_char ib else
   let sr = String.concat "" (List.map (String.make 1) range) in
@@ -486,7 +487,7 @@ let scan_Float max ib =
    characters has been read.*)
 let scan_string stp max ib =
   let rec loop max =
-    if max = 0 || Scanning.eof ib then max else
+    if max = 0 || Scanning.end_of_input ib then max else
     let c = Scanning.checked_peek_char ib in
     if stp == [] then
       match c with
@@ -495,7 +496,7 @@ let scan_string stp max ib =
     if List.mem c stp then max else
     loop (Scanning.store_char ib c max) in
   let max = loop max in
-  if stp != [] then check_char_in stp ib;
+  check_char_in stp ib;
   max;;
 
 (* Scan a char: peek strictly one character in the input, whatsoever. *)
@@ -795,7 +796,7 @@ let scan_chars_in_char_set stp char_set max ib =
         | 2 -> loop_neg2 set.[0] set.[1] max
         | 3 when set.[1] != '-' -> loop_neg3 set.[0] set.[1] set.[2] max
         | n -> loop (find_setp stp char_set) max end in
-  if stp != [] then check_char_in stp ib;
+  check_char_in stp ib;
   max;;
 
 let get_count t ib =
diff --git a/stdlib/stdLabels.mli b/stdlib/stdLabels.mli
index fbda4b7a4..73f72dc68 100644
--- a/stdlib/stdLabels.mli
+++ b/stdlib/stdLabels.mli
@@ -99,6 +99,7 @@ module List :
     val sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list
     val stable_sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list
     val fast_sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list
+    val merge : cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
   end
 
 module String :
@@ -128,6 +129,8 @@ module String :
     val lowercase : string -> string
     val capitalize : string -> string
     val uncapitalize : string -> string
+    type t = string
+    val compare: t -> t -> int
     external unsafe_get : string -> int -> char = "%string_unsafe_get"
     external unsafe_set : string -> int -> char -> unit = "%string_unsafe_set"
     external unsafe_blit :
diff --git a/stdlib/stringLabels.mli b/stdlib/stringLabels.mli
index b1f957751..7ea72bafe 100644
--- a/stdlib/stringLabels.mli
+++ b/stdlib/stringLabels.mli
@@ -142,6 +142,14 @@ val capitalize : string -> string
 val uncapitalize : string -> string
 (** Return a copy of the argument, with the first letter set to lowercase. *)
 
+type t = string
+(** An alias for the type of strings. *)
+
+val compare: t -> t -> int
+(** The comparison function for strings, with the same specification as
+    {!Pervasives.compare}.  Along with the type [t], this function [compare]
+    allows the module [String] to be passed as argument to the functors
+    {!Set.Make} and {!Map.Make}. *)
 
 (**/**)
 
diff --git a/stdlib/sys.ml b/stdlib/sys.ml
index f11f2929e..9554a82a1 100644
--- a/stdlib/sys.ml
+++ b/stdlib/sys.ml
@@ -78,4 +78,4 @@ let catch_break on =
 
 (* OCaml version string, must be in the format described in sys.mli. *)
 
-let ocaml_version = "3.09+dev0 (2004-06-22)";;
+let ocaml_version = "3.09+dev0 (2004-07-13)";;