Dans Pervasives.input_line, traiter correctement les fichiers ne se terminant pas par \n (PR#73)

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

2 files changed, 47 insertions, 25 deletions

diff --git a/otherlibs/threads/Tests/testio.ml b/otherlibs/threads/Tests/testio.ml
index f7610c0cd..3553b28dd 100644
--- a/otherlibs/threads/Tests/testio.ml
+++ b/otherlibs/threads/Tests/testio.ml
@@ -65,6 +65,24 @@ let make_lines ofile =
   done;
   close_out oc
 
+(* Test input_line on truncated lines *)
+
+let test_trunc_line ofile =
+  print_string "truncated line"; print_newline();
+  let oc = open_out ofile in
+  output_string oc "A line without newline!";
+  close_out oc;
+  try
+    let ic = open_in ofile in
+    let s = input_line ic in
+    close_in ic;
+    if s = "A line without newline!"
+    then print_string "passed"
+    else print_string "FAILED";
+    print_newline()
+  with End_of_file ->
+    print_string "FAILED"; print_newline()  
+
 (* The test *)
 
 let main() =
@@ -93,6 +111,7 @@ let main() =
   make_lines "/tmp/lines";
   test "line per line, short and long lines"
        copy_line copy_line "/tmp/lines" ofile;
+  test_trunc_line ofile;
   Sys.remove "/tmp/lines";
   Sys.remove ofile;
   exit 0
diff --git a/otherlibs/threads/pervasives.ml b/otherlibs/threads/pervasives.ml
index 5258d40fd..ad5c15652 100644
--- a/otherlibs/threads/pervasives.ml
+++ b/otherlibs/threads/pervasives.ml
@@ -142,6 +142,15 @@ external ignore : 'a -> unit = "%ignore"
 external fst : 'a * 'b -> 'a = "%field0"
 external snd : 'a * 'b -> 'b = "%field1"
 
+(* References *)
+
+type 'a ref = { mutable contents: 'a }
+external ref: 'a -> 'a ref = "%makemutable"
+external (!): 'a ref -> 'a = "%field0"
+external (:=): 'a ref -> 'a -> unit = "%setfield0"
+external incr: int ref -> unit = "%incr"
+external decr: int ref -> unit = "%decr"
+
 (* String conversion functions *)
 
 external format_int: string -> int -> string = "format_int"
@@ -338,23 +347,26 @@ let really_input ic s ofs len =
   else unsafe_really_input ic s ofs len
 
 let input_line ic =
-  let rec do_input buf pos =
-    if pos >= string_length buf then begin
-      let newbuf = string_create (2 * string_length buf) in
-      string_blit buf 0 newbuf 0 (string_length buf);
-      do_input newbuf pos
-    end else begin
+  let buf = ref (string_create 128) in
+  let pos = ref 0 in
+  begin try
+    while true do
+      if !pos = string_length !buf then begin
+        let newbuf = string_create (2 * !pos) in
+        string_blit !buf 0 newbuf 0 !pos;
+        buf := newbuf
+      end;
       let c = input_char ic in
-      if c = '\n' then begin
-        let res = string_create pos in
-        string_blit buf 0 res 0 pos;
-        res
-      end else begin
-        buf.[pos] <- c;
-        do_input buf (pos + 1)
-      end
-    end in
-  do_input (string_create 128) 0
+      if c = '\n' then raise Exit;
+      !buf.[!pos] <- c;
+      incr pos
+    done
+  with Exit -> ()
+     | End_of_file -> if !pos = 0 then raise End_of_file
+  end;
+  let res = string_create !pos in
+  string_blit !buf 0 res 0 !pos;
+  res
 
 let rec input_byte ic =
   try
@@ -414,15 +426,6 @@ let read_line () = flush stdout; input_line stdin
 let read_int () = int_of_string(read_line())
 let read_float () = float_of_string(read_line())
 
-(* References *)
-
-type 'a ref = { mutable contents: 'a }
-external ref: 'a -> 'a ref = "%makemutable"
-external (!): 'a ref -> 'a = "%field0"
-external (:=): 'a ref -> 'a -> unit = "%setfield0"
-external incr: int ref -> unit = "%incr"
-external decr: int ref -> unit = "%decr"
-
 (* Miscellaneous *)
 
 external sys_exit : int -> 'a = "sys_exit"