From d2e54c4c7479266b416414619755304599cfeca3 Mon Sep 17 00:00:00 2001 From: Ty Overby Date: Thu, 25 Apr 2019 12:26:41 +0800 Subject: [PATCH 1/4] Tests: exhibit bug wrt out_channel_pos --- compiler/tests/channel.ml | 49 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 49 insertions(+) create mode 100644 compiler/tests/channel.ml diff --git a/compiler/tests/channel.ml b/compiler/tests/channel.ml new file mode 100644 index 0000000000..6ae65d1c88 --- /dev/null +++ b/compiler/tests/channel.ml @@ -0,0 +1,49 @@ +(* Js_of_ocaml compiler + * http://www.ocsigen.org/js_of_ocaml/ + * Copyright (C) 2019 Hugo Heuzard + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, with linking exception; + * either version 2.1 of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +(* https://github.com/ocsigen/js_of_ocaml/issues/777 *) + +let%expect_test _ = + Util.compile_and_run + {| + let oc = open_out "a.txt" + let () = print_int (out_channel_length oc) + let () = output_string oc "test" + let () = print_int (out_channel_length oc) + let () = flush oc + let () = print_int (out_channel_length oc) + let () = output_string oc "test" + let () = print_int (out_channel_length oc) + let () = seek_out oc 0 + let () = print_int (out_channel_length oc) +|}; + [%expect {| 00444 |}] + +let%expect_test _ = + let oc = open_out "b.txt" in + let () = print_int (out_channel_length oc) in + let () = output_string oc "test" in + let () = print_int (out_channel_length oc) in + let () = flush oc in + let () = print_int (out_channel_length oc) in + let () = output_string oc "test" in + let () = print_int (out_channel_length oc) in + let () = seek_out oc 0 in + let () = print_int (out_channel_length oc) in + [%expect {| 00448 |}] From fffe1adc9d3b1fda4ea1003a20790cf49ea3c688 Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Fri, 26 Apr 2019 10:28:08 +0800 Subject: [PATCH 2/4] Runtime: fix #777 --- compiler/tests/channel.ml | 2 +- runtime/io.js | 6 ++++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/compiler/tests/channel.ml b/compiler/tests/channel.ml index 6ae65d1c88..a505e8c25a 100644 --- a/compiler/tests/channel.ml +++ b/compiler/tests/channel.ml @@ -33,7 +33,7 @@ let%expect_test _ = let () = seek_out oc 0 let () = print_int (out_channel_length oc) |}; - [%expect {| 00444 |}] + [%expect {| 00448 |}] let%expect_test _ = let oc = open_out "b.txt" in diff --git a/runtime/io.js b/runtime/io.js index 8a972a5be6..e274b08c3a 100644 --- a/runtime/io.js +++ b/runtime/io.js @@ -394,15 +394,17 @@ function caml_output_value (chanid,v,_flags) { //Provides: caml_ml_seek_out -//Requires: caml_ml_channels +//Requires: caml_ml_channels, caml_ml_flush function caml_ml_seek_out(chanid,pos){ + caml_ml_flush(chanid); caml_ml_channels[chanid].offset = pos; return 0; } //Provides: caml_ml_seek_out_64 -//Requires: caml_int64_to_float, caml_ml_channels +//Requires: caml_int64_to_float, caml_ml_channels, caml_ml_flush function caml_ml_seek_out_64(chanid,pos){ + caml_ml_flush(chanid); caml_ml_channels[chanid].offset = caml_int64_to_float(pos); return 0; } From 16272414f40e8f9f8f5284e264c54c577d81c7d7 Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Fri, 26 Apr 2019 12:26:58 +0800 Subject: [PATCH 3/4] Tests: exhibit other bug --- compiler/tests/channel.ml | 60 ++++++++++++++++++++++++++++++++++++++- 1 file changed, 59 insertions(+), 1 deletion(-) diff --git a/compiler/tests/channel.ml b/compiler/tests/channel.ml index a505e8c25a..322407b767 100644 --- a/compiler/tests/channel.ml +++ b/compiler/tests/channel.ml @@ -32,7 +32,7 @@ let%expect_test _ = let () = print_int (out_channel_length oc) let () = seek_out oc 0 let () = print_int (out_channel_length oc) -|}; + |}; [%expect {| 00448 |}] let%expect_test _ = @@ -47,3 +47,61 @@ let%expect_test _ = let () = seek_out oc 0 in let () = print_int (out_channel_length oc) in [%expect {| 00448 |}] + +let%expect_test _ = + Util.compile_and_run + {| + + let marshal_out ch v = Marshal.to_channel ch v []; flush ch + + let marshal_out_segment f ch v = + let start = pos_out ch in + Format.printf "start=%d\n%!" start; + output_binary_int ch 0; (* dummy value for stop *) + marshal_out ch v; + let stop = pos_out ch in + seek_out ch start; + output_binary_int ch stop; + seek_out ch stop; + Digest.output ch (Digest.file f) + + + let _ = + let filename = "out.txt" in + let chan = open_out filename in + output_binary_int chan 8900; + marshal_out_segment filename chan ["output";"data"]; + marshal_out_segment filename chan ["more";"stuff"] +|}; + [%expect {| + start=0 + start=43 |}] + +let%expect_test _ = + let module M = struct + let marshal_out ch v = + Marshal.to_channel ch v []; + flush ch + + let marshal_out_segment f ch v = + let start = pos_out ch in + Format.printf "start=%d\n%!" start; + output_binary_int ch 0; + (* dummy value for stop *) + marshal_out ch v; + let stop = pos_out ch in + seek_out ch start; + output_binary_int ch stop; + seek_out ch stop; + Digest.output ch (Digest.file f) + + let _ = + let filename = "out.txt" in + let chan = open_out filename in + output_binary_int chan 8900; + marshal_out_segment filename chan ["output"; "data"]; + marshal_out_segment filename chan ["more"; "stuff"] + end in + [%expect {| + start=4 + start=59 |}] From 2f2a589dc9c9e87d45a812cde943ed0dda078157 Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Fri, 26 Apr 2019 12:27:40 +0800 Subject: [PATCH 4/4] Tests: fix #777 --- compiler/tests/channel.ml | 4 ++-- runtime/io.js | 10 +++++++--- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/compiler/tests/channel.ml b/compiler/tests/channel.ml index 322407b767..a35f27f5ee 100644 --- a/compiler/tests/channel.ml +++ b/compiler/tests/channel.ml @@ -74,8 +74,8 @@ let%expect_test _ = marshal_out_segment filename chan ["more";"stuff"] |}; [%expect {| - start=0 - start=43 |}] + start=4 + start=59 |}] let%expect_test _ = let module M = struct diff --git a/runtime/io.js b/runtime/io.js index e274b08c3a..e351c2e63d 100644 --- a/runtime/io.js +++ b/runtime/io.js @@ -410,12 +410,16 @@ function caml_ml_seek_out_64(chanid,pos){ } //Provides: caml_ml_pos_out -//Requires: caml_ml_channels -function caml_ml_pos_out(chanid) {return caml_ml_channels[chanid].offset} +//Requires: caml_ml_channels, caml_ml_flush +function caml_ml_pos_out(chanid) { + caml_ml_flush(chanid); + return caml_ml_channels[chanid].offset +} //Provides: caml_ml_pos_out_64 -//Requires: caml_int64_of_float, caml_ml_channels +//Requires: caml_int64_of_float, caml_ml_channels, caml_ml_flush function caml_ml_pos_out_64(chanid) { + caml_ml_flush(chanid); return caml_int64_of_float (caml_ml_channels[chanid].offset); }