v0.16~preview.127.22+307

janestreet · Jul 8, 2022 · a1f22ff · a1f22ff
1 parent 94d2862
commit a1f22ff
Show file tree

Hide file tree

Showing 14 changed files with 189 additions and 296 deletions.
diff --git a/collector/expect_test_collector.ml b/collector/expect_test_collector.ml
@@ -115,7 +115,7 @@ module Instance = struct
   ;;
 end
 
-let basic_flush () =
+let flush () =
   Format.pp_print_flush Format.std_formatter ();
   Format.pp_print_flush Format.err_formatter ();
   Stdlib.flush Stdlib.stdout;
@@ -124,33 +124,21 @@ let basic_flush () =
 
 let save_and_return_output location =
   let instance = Instance.get_current () in
-  basic_flush ();
+  flush ();
   Instance.save_and_return_output_without_flush instance location
 ;;
 
 module Make (C : Expect_test_config_types.S) = struct
-  let ( >>= ) t f = C.IO_flush.bind t ~f
-  let return = C.IO_flush.return
-
-  module C = struct
-    include C
-
-    let flush () =
-      basic_flush ();
-      C.IO_flush.return ()
-    ;;
-  end
-
   module Instance_io : sig
-    val save_output : File.Location.t -> unit C.IO_flush.t
-    val save_and_return_output : File.Location.t -> string C.IO_flush.t
+    val save_output : File.Location.t -> unit
+    val save_and_return_output : File.Location.t -> string
 
     val exec
       :  file_digest:File.Digest.t
       -> location:File.Location.t
       -> expectations:Expectation.Raw.t list
       -> uncaught_exn_expectation:Expectation.Raw.t option
-      -> f:(unit -> unit C.IO_run.t)
+      -> f:(unit -> unit C.IO.t)
       -> unit
   end = struct
     open Instance
@@ -189,15 +177,14 @@ module Make (C : Expect_test_config_types.S) = struct
 
     let save_output location =
       let t = get_current () in
-      C.flush ()
-      >>= fun () ->
-      save_output_without_flush t location;
-      return ()
+      flush ();
+      save_output_without_flush t location
     ;;
 
     let save_and_return_output location =
       let t = get_current () in
-      C.flush () >>= fun () -> return (save_and_return_output_without_flush t location)
+      flush ();
+      save_and_return_output_without_flush t location
     ;;
 
     let () =
@@ -221,8 +208,7 @@ module Make (C : Expect_test_config_types.S) = struct
 
     let rec final_flush ?(count = 0) k =
       let max_attempts = 10 in
-      C.flush ()
-      >>= fun () ->
+      flush ();
       if C.flushed ()
       then k ~append:""
       else if count = max_attempts
@@ -242,7 +228,7 @@ module Make (C : Expect_test_config_types.S) = struct
       current_test := Some (location, t);
       let finally uncaught_exn =
         C.run (fun () ->
-          C.IO_flush.to_run
+          C.IO.return
             (final_flush (fun ~append ->
                current_test := None;
                let saved_output, trailing_output = get_outputs_and_cleanup t in
@@ -256,8 +242,7 @@ module Make (C : Expect_test_config_types.S) = struct
                   ; upon_unreleasable_issue = C.upon_unreleasable_issue
                   ; uncaught_exn
                   }
-                  :: !tests_run;
-               return ())))
+                  :: !tests_run)))
       in
       match C.run f with
       | () -> finally None
@@ -307,7 +292,7 @@ module Make (C : Expect_test_config_types.S) = struct
              registering_tests_for
          else (
            (* To avoid capturing not-yet flushed data of the stdout buffer *)
-           C.run (fun () -> C.IO_flush.to_run (C.flush ()));
+           C.run (fun () -> C.IO.return (flush ()));
            Instance_io.exec
              ~file_digest
              ~location

diff --git a/collector/expect_test_collector.mli b/collector/expect_test_collector.mli
@@ -20,9 +20,9 @@ module Make (Config : Expect_test_config_types.S) : sig
       This function should only be called while a test is running. It is meant to be
       called as a result of ppx_expect translating an expect-test, and is not intended
       to be called manually. *)
-  val save_output : File.Location.t -> unit Config.IO_flush.t
+  val save_output : File.Location.t -> unit
 
-  val save_and_return_output : File.Location.t -> string Config.IO_flush.t
+  val save_and_return_output : File.Location.t -> string
 
   (** Run an expect-test *)
   val run
@@ -34,7 +34,7 @@ module Make (Config : Expect_test_config_types.S) : sig
     -> expectations:Expectation.Raw.t list
     -> uncaught_exn_expectation:Expectation.Raw.t option
     -> inline_test_config:Ppx_inline_test_lib.Runtime.config
-    -> (unit -> unit Config.IO_run.t)
+    -> (unit -> unit Config.IO.t)
     -> unit
 end
 

diff --git a/collector/expect_test_collector_stubs.c b/collector/expect_test_collector_stubs.c
@@ -1,7 +1,7 @@
 #include <caml/alloc.h>
 #include <caml/fail.h>
-#include <caml/signals.h>
 #include <caml/mlvalues.h>
+#include <caml/signals.h>
 #include <unistd.h>
 
 /* #include <caml/io.h> */
@@ -22,73 +22,84 @@ typedef long file_offset;
 #endif
 
 struct channel {
-  int fd;                       /* Unix file descriptor */
-  file_offset offset;           /* Absolute position of fd in the file */
-  char * end;                   /* Physical end of the buffer */
-  char * curr;                  /* Current position in the buffer */
-  char * max;                   /* Logical end of the buffer (for input) */
-  void * mutex;                 /* Placeholder for mutex (for systhreads) */
-  struct channel * next, * prev;/* Double chaining of channels (flush_all) */
-  int revealed;                 /* For Cash only */
-  int old_revealed;             /* For Cash only */
-  int refcount;                 /* For flush_all and for Cash */
-  int flags;                    /* Bitfield */
-  char buff[IO_BUFFER_SIZE];    /* The buffer itself */
-  char * name;                  /* Optional name (to report fd leaks) */
+  int fd;                      /* Unix file descriptor */
+  file_offset offset;          /* Absolute position of fd in the file */
+  char *end;                   /* Physical end of the buffer */
+  char *curr;                  /* Current position in the buffer */
+  char *max;                   /* Logical end of the buffer (for input) */
+  void *mutex;                 /* Placeholder for mutex (for systhreads) */
+  struct channel *next, *prev; /* Double chaining of channels (flush_all) */
+  int revealed;                /* For Cash only */
+  int old_revealed;            /* For Cash only */
+  int refcount;                /* For flush_all and for Cash */
+  int flags;                   /* Bitfield */
+  char buff[IO_BUFFER_SIZE];   /* The buffer itself */
+  char *name;                  /* Optional name (to report fd leaks) */
 };
 
-#define Channel(v) (*((struct channel **) (Data_custom_val(v))))
+#define Channel(v) (*((struct channel **)(Data_custom_val(v))))
 
 /* End of duplicated code from caml/io.h */
 
 /* Start of duplicated code from caml/sys.h */
 #define NO_ARG Val_int(0)
-CAMLextern void caml_sys_error (value);
+CAMLextern void caml_sys_error(value);
 /* End of duplicated code from caml/sys.h */
 
 static int expect_test_collector_saved_stdout;
 static int expect_test_collector_saved_stderr;
 
-CAMLprim value expect_test_collector_before_test (value voutput, value vstdout, value vstderr) {
-  struct channel* output = Channel(voutput);
-  struct channel* cstdout = Channel(vstdout);
-  struct channel* cstderr = Channel(vstderr);
+CAMLprim value expect_test_collector_before_test(value voutput, value vstdout,
+                                                 value vstderr) {
+  struct channel *output = Channel(voutput);
+  struct channel *cstdout = Channel(vstdout);
+  struct channel *cstderr = Channel(vstderr);
   int fd, ret;
   fd = dup(cstdout->fd);
-  if(fd == -1) caml_sys_error(NO_ARG);
+  if (fd == -1)
+    caml_sys_error(NO_ARG);
   expect_test_collector_saved_stdout = fd;
   fd = dup(cstderr->fd);
-  if(fd == -1) caml_sys_error(NO_ARG);
+  if (fd == -1)
+    caml_sys_error(NO_ARG);
   expect_test_collector_saved_stderr = fd;
   ret = dup2(output->fd, cstdout->fd);
-  if(ret == -1) caml_sys_error(NO_ARG);
+  if (ret == -1)
+    caml_sys_error(NO_ARG);
   ret = dup2(output->fd, cstderr->fd);
-  if(ret == -1) caml_sys_error(NO_ARG);
+  if (ret == -1)
+    caml_sys_error(NO_ARG);
   return Val_unit;
 }
 
-CAMLprim value expect_test_collector_after_test (value vstdout, value vstderr) {
-  struct channel* cstdout = Channel(vstdout);
-  struct channel* cstderr = Channel(vstderr);
+CAMLprim value expect_test_collector_after_test(value vstdout, value vstderr) {
+  struct channel *cstdout = Channel(vstdout);
+  struct channel *cstderr = Channel(vstderr);
   int ret;
   ret = dup2(expect_test_collector_saved_stdout, cstdout->fd);
-  if(ret == -1) caml_sys_error(NO_ARG);
+  if (ret == -1)
+    caml_sys_error(NO_ARG);
   ret = dup2(expect_test_collector_saved_stderr, cstderr->fd);
-  if(ret == -1) caml_sys_error(NO_ARG);
+  if (ret == -1)
+    caml_sys_error(NO_ARG);
   ret = close(expect_test_collector_saved_stdout);
-  if(ret == -1) caml_sys_error(NO_ARG);
+  if (ret == -1)
+    caml_sys_error(NO_ARG);
   ret = close(expect_test_collector_saved_stderr);
-  if(ret == -1) caml_sys_error(NO_ARG);
+  if (ret == -1)
+    caml_sys_error(NO_ARG);
   return Val_unit;
 }
 
-CAMLprim value caml_out_channel_pos_fd (value vchan) {
-  struct channel* chan = Channel(vchan);
+CAMLprim value caml_out_channel_pos_fd(value vchan) {
+  struct channel *chan = Channel(vchan);
   file_offset ret;
   caml_enter_blocking_section();
   ret = lseek(chan->fd, 0, SEEK_CUR);
   caml_leave_blocking_section();
-  if (ret == -1) caml_sys_error(NO_ARG);
-  if (ret > Max_long) caml_failwith("caml_out_channel_pos_fd: overflow");
+  if (ret == -1)
+    caml_sys_error(NO_ARG);
+  if (ret > Max_long)
+    caml_failwith("caml_out_channel_pos_fd: overflow");
   return Val_long(ret);
 }
diff --git a/common/expectation.ml b/common/expectation.ml
@@ -94,22 +94,26 @@ let sexp_of_t : 'a. ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t =
     ; extid_location = extid_location__025_
     ; body_location = body_location__027_
     } ->
-    let bnds__020_ = [] in
+    let bnds__020_ = ([] : _ Stdlib.List.t) in
     let bnds__020_ =
       let arg__028_ = File.Location.sexp_of_t body_location__027_ in
-      Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "body_location"; arg__028_ ] :: bnds__020_
+      (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "body_location"; arg__028_ ] :: bnds__020_
+       : _ Stdlib.List.t)
     in
     let bnds__020_ =
       let arg__026_ = File.Location.sexp_of_t extid_location__025_ in
-      Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "extid_location"; arg__026_ ] :: bnds__020_
+      (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "extid_location"; arg__026_ ] :: bnds__020_
+       : _ Stdlib.List.t)
     in
     let bnds__020_ =
       let arg__024_ = Body.sexp_of_t _of_a__019_ body__023_ in
-      Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "body"; arg__024_ ] :: bnds__020_
+      (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "body"; arg__024_ ] :: bnds__020_
+       : _ Stdlib.List.t)
     in
     let bnds__020_ =
       let arg__022_ = sexp_of_option sexp_of_string tag__021_ in
-      Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "tag"; arg__022_ ] :: bnds__020_
+      (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "tag"; arg__022_ ] :: bnds__020_
+       : _ Stdlib.List.t)
     in
     Sexplib0.Sexp.List bnds__020_
 ;;