merging poly_meth2poly_meth2

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

9 files changed, 86 insertions, 34 deletions

diff --git a/stdlib/buffer.ml b/stdlib/buffer.ml
index 86812de9cb..855c81d612 100644
--- a/stdlib/buffer.ml
+++ b/stdlib/buffer.ml
@@ -39,6 +39,11 @@ let resize b more =
   let len = b.length in
   let new_len = ref len in
   while b.position + more > !new_len do new_len := 2 * !new_len done;
+  if !new_len > Sys.max_string_length then begin
+    if b.position + more <= Sys.max_string_length
+    then new_len := Sys.max_string_length
+    else failwith "Buffer.add: cannot grow buffer"
+  end;
   let new_buffer = String.create !new_len in
   String.blit b.buffer 0 new_buffer 0 b.position;
   b.buffer <- new_buffer;
diff --git a/stdlib/complex.ml b/stdlib/complex.ml
index fe2e0388d1..3095534bab 100644
--- a/stdlib/complex.ml
+++ b/stdlib/complex.ml
@@ -62,16 +62,21 @@ let arg x = atan2 x.im x.re
 
 let polar n a = { re = cos a *. n; im = sin a *. n }
 
-let sqrt x =
-  (* Avoid cancellation in computing norm x + x.re 
-     when x.re < 0 and x.im is small *)
-  if x.re >= 0.0 then begin
-    let r = sqrt(0.5 *. norm x +. 0.5 *. x.re) in
-    { re = r; im = if r = 0.0 then 0.0 else 0.5 *. x.im /. r }
-  end else begin
-    let s = sqrt(0.5 *. norm x -. 0.5 *. x.re) in
-    { re = if s = 0.0 then 0.0 else 0.5 *. abs_float x.im /. s;
-      im = if x.im >= 0.0 then s else -. s }
+let sqrt x = 
+  if x.re = 0.0 && x.im = 0.0 then { re = 0.0; im = 0.0 }
+  else begin
+    let r = abs_float x.re and i = abs_float x.im in
+    let w =
+      if r >= i then begin
+        let q = i /. r in 
+        sqrt(r) *. sqrt(0.5 *. (1.0 +. sqrt(1.0 +. q *. q))) 
+      end else begin
+        let q = r /. i in
+        sqrt(i) *. sqrt(0.5 *. (q +. sqrt(1.0 +. q *. q)))
+      end in   
+    if x.re >= 0.0
+    then { re = w;  im = 0.5 *. x.im /. w }  
+    else { re = 0.5 *. i /. w;  im = if x.im >= 0.0 then w else -. w }
   end
 
 let exp x =
diff --git a/stdlib/complex.mli b/stdlib/complex.mli
index 72e974a2f7..0fc3696f58 100644
--- a/stdlib/complex.mli
+++ b/stdlib/complex.mli
@@ -55,7 +55,8 @@ val div: t -> t -> t
 (** Division *)
 
 val sqrt: t -> t
-(** Square root.  The result always lies within the semispace [real >= 0].
+(** Square root.  The result [x + i.y] is such that [x > 0] or
+    [x = 0] and [y >= 0].
     This function has a discontinuity along the negative real axis. *)
 
 val norm2: t -> float
diff --git a/stdlib/filename.ml b/stdlib/filename.ml
index bf7ad1761a..34853f85dc 100644
--- a/stdlib/filename.ml
+++ b/stdlib/filename.ml
@@ -182,19 +182,40 @@ let chop_extension name =
 
 external open_desc: string -> open_flag list -> int -> int = "sys_open"
 external close_desc: int -> unit = "sys_close"
+external random_seed: unit -> int = "sys_random_seed"
+
+let temp_file_counter = ref 0
+
+let temp_file_name prefix suffix =
+  if !temp_file_counter = 0 then temp_file_counter := random_seed();
+  let name =
+    concat temporary_directory
+           (Printf.sprintf "%s%06x%s"
+                           prefix (!temp_file_counter land 0xFFFFFF) suffix) in
+  (* Linear congruential PRNG *)
+  temp_file_counter := !temp_file_counter * 69069 + 25173;
+  name
 
 let temp_file prefix suffix =
   let rec try_name counter =
     if counter >= 1000 then
-      invalid_arg "Filename.temp_file: temp dir nonexistent or full"
-    else begin
-      let name =
-        concat temporary_directory (prefix ^ string_of_int counter ^ suffix) in
-      try
-        close_desc(open_desc name [Open_wronly; Open_creat; Open_excl] 0o666);
-        name
-      with Sys_error _ ->
-        try_name (counter + 1)
-    end
+      invalid_arg "Filename.temp_file: temp dir nonexistent or full";
+    let name = temp_file_name prefix suffix in
+    try
+      close_desc(open_desc name [Open_wronly; Open_creat; Open_excl] 0o600);
+      name
+    with Sys_error _ ->
+      try_name (counter + 1)
   in try_name 0
 
+let open_temp_file ?(mode = [Open_text]) prefix suffix =
+  let rec try_name counter =
+    if counter >= 1000 then
+      invalid_arg "Filename.open_temp_file: temp dir nonexistent or full";
+    let name = temp_file_name prefix suffix in
+    try
+      (name,
+       open_out_gen (Open_wronly::Open_creat::Open_excl::mode) 0o600 name)
+    with Sys_error _ ->
+      try_name (counter + 1)
+  in try_name 0
diff --git a/stdlib/filename.mli b/stdlib/filename.mli
index a0c79976f6..167fb6a789 100644
--- a/stdlib/filename.mli
+++ b/stdlib/filename.mli
@@ -69,9 +69,10 @@ val temp_file : string -> string -> string
    fresh temporary file in the temporary directory.
    The base name of the temporary file is formed by concatenating
    [prefix], then a suitably chosen integer number, then [suffix].
-   The temporary file is created empty, and is guaranteed to be
-   different from any other file that existed when [temp_file]
-   was called.
+   The temporary file is created empty, with permissions [0o600]
+   (readable and writable only by the file owner).  The file is
+   guaranteed to be different from any other file that existed when
+   [temp_file] was called.
    Under Unix, the temporary directory is [/tmp] by default; if set,
    the value of the environment variable [TMPDIR] is used instead.
    Under Windows, the name of the temporary directory is the
@@ -81,6 +82,17 @@ val temp_file : string -> string -> string
    by the environment variable [TempFolder]; if not set,
    temporary files are created in the current directory. *)
 
+val open_temp_file :
+      ?mode: open_flag list -> string -> string -> string * out_channel
+(** Same as {!temp_file}, but returns both the name of a fresh
+   temporary file, and an output channel opened (atomically) on
+   this file.  This function is more secure than [temp_file]: there
+   is no risk that the temporary file will be modified (e.g. replaced
+   by a symbolic link) before the program opens it.  The optional argument
+   [mode] is a list of additional flags to control the opening of the file.
+   It can contain one or several of [Open_append], [Open_binary],
+   and [Open_text].  The default is [[Open_text]] (open in text mode). *)
+
 val quote : string -> string
 (** Return a quoted version of a file name, suitable for use as
    one argument in a shell command line, escaping all shell
diff --git a/stdlib/format.ml b/stdlib/format.ml
index 35e03ebeae..1450be30e8 100644
--- a/stdlib/format.ml
+++ b/stdlib/format.ml
@@ -1001,7 +1001,9 @@ let fprintf_out str out ppf format =
          if i >= limit then format_invalid_arg "bad box format" format i else
          begin match format.[i] with
          | 'v' -> Pp_hovbox, succ i
-         | _ -> format_invalid_arg "bad box name ho" format i end
+         | c ->
+            format_invalid_arg
+              ("bad box name ho" ^ String.make 1 c) format i end
       | 'v' -> Pp_hvbox, succ i
       | c -> Pp_hbox, i
       end
diff --git a/stdlib/lexing.ml b/stdlib/lexing.ml
index 8307c6f624..baba74ef4e 100644
--- a/stdlib/lexing.ml
+++ b/stdlib/lexing.ml
@@ -60,8 +60,13 @@ let lex_refill read_fun aux_buffer lexbuf =
                   (lexbuf.lex_buffer_len - lexbuf.lex_start_pos)
     end else begin
       (* We must grow the buffer.  Doubling its size will provide enough
-         space since n <= String.length aux_buffer <= String.length buffer *)
-      let newbuf = String.create (2 * String.length lexbuf.lex_buffer) in
+         space since n <= String.length aux_buffer <= String.length buffer.
+         Watch out for string length overflow, though. *)
+      let newlen =
+        min (2 * String.length lexbuf.lex_buffer) Sys.max_string_length in
+      if lexbuf.lex_buffer_len - lexbuf.lex_start_pos + n > newlen
+      then failwith "Lexing.lex_refill: cannot grow buffer";
+      let newbuf = String.create newlen in
       (* Copy the valid data to the beginning of the new buffer *)
       String.blit lexbuf.lex_buffer lexbuf.lex_start_pos
                   newbuf 0
diff --git a/stdlib/pervasives.mli b/stdlib/pervasives.mli
index c7f85f4943..8cdb2f4c0f 100644
--- a/stdlib/pervasives.mli
+++ b/stdlib/pervasives.mli
@@ -653,8 +653,8 @@ val output_string : out_channel -> string -> unit
 (** Write the string on the given output channel. *)
 
 val output : out_channel -> string -> int -> int -> unit
-(** Write [len] characters from string [buf], starting at offset
-   [pos], to the given output channel.
+(** [output oc buf pos len] writes [len] characters from string [buf],
+   starting at offset [pos], to the given output channel [oc].
    Raise [Invalid_argument "output"] if [pos] and [len] do not
    designate a valid substring of [buf]. *)
 
@@ -738,8 +738,9 @@ val input_line : in_channel -> string
    at the beginning of line. *)
 
 val input : in_channel -> string -> int -> int -> int
-(** Read up to [len] characters from the given channel,
-   storing them in string [buf], starting at character number [pos].
+(** [input ic buf pos len] reads up to [len] characters from
+   the given channel [ic], storing them in string [buf], starting at
+   character number [pos].
    It returns the actual number of characters read, between 0 and
    [len] (inclusive).
    A return value of 0 means that the end of file was reached.
@@ -754,8 +755,8 @@ val input : in_channel -> string -> int -> int -> int
    do not designate a valid substring of [buf]. *)          
 
 val really_input : in_channel -> string -> int -> int -> unit
-(** Read [len] characters from the given channel, storing them in
-   string [buf], starting at character number [pos].
+(** [really_input ic buf pos len] reads [len] characters from channel [ic],
+   storing them in string [buf], starting at character number [pos].
    Raise [End_of_file] if the end of file is reached before [len]
    characters have been read.
    Raise [Invalid_argument "really_input"] if
diff --git a/stdlib/sys.ml b/stdlib/sys.ml
index c4aebc74da..98373b7245 100644
--- a/stdlib/sys.ml
+++ b/stdlib/sys.ml
@@ -78,4 +78,4 @@ let catch_break on =
 (* OCaml version string, moved from utils/config.mlp.
    Must be in the format described in sys.mli. *)
 
-let ocaml_version = "3.04+8 polymorphic methods (2002-03-25)"
+let ocaml_version = "3.04+10 (2002-04-18)"