Runtime: fix support for unbuffered channels

CHANGES.md

@@ -6,6 +6,7 @@
 
 ## Bug fixes
 * Compiler: fix rewriter bug in share_constant (fix #1247)
+* Runtime: fix Out_channel.is_buffered, set_buffered
 
 # 4.0.0 (2021-01-24) - Lille
 ## Features/Changes

compiler/tests-jsoo/test_io.ml

@@ -44,3 +44,57 @@ let%expect_test _ =
   in
   [%expect {|
     33 |}]
+
+(* TODO: uncomment after switching to 4.14
+   let%expect_test _ =
+     Printf.printf "%b%!" (Out_channel.(is_buffered stdout));
+     [%expect {| true |}];
+     Printf.printf "%b%!" (Out_channel.(is_buffered stderr));
+     [%expect {| true |}];
+     Out_channel.(set_buffered stdout false);
+     Printf.printf "%b%!" (Out_channel.(is_buffered stdout));
+     [%expect {| false |}];
+     Out_channel.(set_buffered stderr false);
+     Printf.printf "%b%!" (Out_channel.(is_buffered stderr));
+     [%expect {| false |}];
+     Out_channel.(set_buffered stdout true);
+     Printf.printf "%b%!" (Out_channel.(is_buffered stdout));
+     [%expect {| true |}];
+     Out_channel.(set_buffered stderr true);
+     Printf.printf "%b%!" (Out_channel.(is_buffered stderr));
+     [%expect {| true |}]
+
+   let%expect_test _ =
+     let file_contents fname =
+       let ic = open_in_bin fname in
+       match really_input_string ic (in_channel_length ic) with
+       | s           -> close_in ic; s
+       | exception e -> close_in ic; raise e
+     in
+     let fname = "file2.txt" in
+     let oc = open_out fname in
+     Printf.printf "%b%!" (Out_channel.(is_buffered oc));
+     [%expect {| true |}];
+     output_string oc "this ";
+     print_endline (file_contents fname);
+     [%expect {||}];
+     flush oc;
+     print_endline (file_contents fname);
+     [%expect {| this |}];
+     output_string oc "is ";
+     print_endline (file_contents fname);
+     [%expect {| this |}];
+     Out_channel.set_buffered oc false;
+     print_endline (file_contents fname);
+     [%expect {| this is |}];
+     output_string oc "a test";
+     print_endline (file_contents fname);
+     [%expect {| this is a test |}];
+     flush oc;
+     print_endline (file_contents fname);
+     [%expect {| this is a test |}];
+     close_out oc;
+     print_endline (file_contents fname);
+     [%expect {| this is a test |}];
+     ()
+*)

runtime/io.js

@@ -82,9 +82,9 @@ function caml_sys_open (name, flags, _perms) {
   var idx = caml_global_data.fd_last_idx?caml_global_data.fd_last_idx:0;
   return caml_sys_open_internal (idx+1,caml_std_output,file,f);
 }
-caml_sys_open_internal(0,caml_std_output, new MlFakeFile(caml_create_bytes(0))); //stdin
-caml_sys_open_internal(1,js_print_stdout, new MlFakeFile(caml_create_bytes(0))); //stdout
-caml_sys_open_internal(2,js_print_stderr, new MlFakeFile(caml_create_bytes(0))); //stderr
+caml_sys_open_internal(0,caml_std_output, new MlFakeFile(caml_create_bytes(0)), {rdonly:1}); //stdin
+caml_sys_open_internal(1,js_print_stdout, new MlFakeFile(caml_create_bytes(0)), {buffered:2}); //stdout
+caml_sys_open_internal(2,js_print_stderr, new MlFakeFile(caml_create_bytes(0)), {buffered:2}); //stderr
 
 
 // ocaml Channels
@@ -115,13 +115,15 @@ function caml_ml_out_channels_list () {
 function caml_ml_open_descriptor_out (fd) {
   var data = caml_global_data.fds[fd];
   if(data.flags.rdonly) caml_raise_sys_error("fd "+ fd + " is readonly");
+  var buffered = (data.flags.buffered !== undefined) ? data.flags.buffered : 1;
   var channel = {
     file:data.file,
     offset:data.offset,
     fd:fd,
     opened:true,
     out:true,
-    buffer:""
+    buffer:"",
+    buffered:buffered
   };
   caml_ml_channels[channel.fd]=channel;
   return channel.fd;
@@ -378,13 +380,22 @@ function caml_ml_output_bytes(chanid,buffer,offset,len) {
   }
   var string = caml_string_of_bytes(bytes);
   var jsstring = caml_jsbytes_of_string(string);
-  var id = jsstring.lastIndexOf("\n");
-  if(id < 0)
-    chan.buffer+=jsstring;
-  else {
-    chan.buffer+=jsstring.substr(0,id+1);
+  switch(chan.buffered){
+  case 0: // Unbuffered
+    chan.buffer+=jsstring
     caml_ml_flush (chanid);
-    chan.buffer += jsstring.substr(id+1);
+    break
+  case 1: // Buffered (the default)
+  case 2: // Buffered (only for stdout and stderr)
+    var id = jsstring.lastIndexOf("\n");
+    if(id < 0)
+      chan.buffer+=jsstring;
+    else {
+      chan.buffer+=jsstring.substr(0,id+1);
+      caml_ml_flush (chanid);
+      chan.buffer += jsstring.substr(id+1);
+    }
+    break;
   }
   return 0;
 }
@@ -454,7 +465,15 @@ function caml_ml_output_int (chanid,i) {
 }
 
 //Provides: caml_ml_is_buffered
-function caml_ml_is_buffered(c) { return 1 }
+//Requires: caml_ml_channels
+function caml_ml_is_buffered(chanid) {
+  return caml_ml_channels[chanid].buffered ? 1 : 0
+}
 
 //Provides: caml_ml_set_buffered
-function caml_ml_set_buffered(c,v) { return 0 }
+//Requires: caml_ml_channels, caml_ml_flush
+function caml_ml_set_buffered(chanid,v) {
+  caml_ml_channels[chanid].buffered = v;
+  if(!v) caml_ml_flush(chanid);
+  return 0
+}