diff --git a/compiler/tests/channel.ml b/compiler/tests/channel.ml new file mode 100644 index 0000000000..a35f27f5ee --- /dev/null +++ b/compiler/tests/channel.ml @@ -0,0 +1,107 @@ +(* 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 {| 00448 |}] + +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 |}] + +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=4 + start=59 |}] + +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 |}] diff --git a/runtime/io.js b/runtime/io.js index 8a972a5be6..e351c2e63d 100644 --- a/runtime/io.js +++ b/runtime/io.js @@ -394,26 +394,32 @@ 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; } //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); }