Merge pull request #431 from ocaml-multicore/io-stm-tests

Add Out_channel STM tests

src/io/dune

@@ -23,9 +23,7 @@
  (package multicoretests)
  ;(flags (:standard -w -27))
  (libraries qcheck-lin.domain lin_tests_spec_io)
- (action
-  (setenv OCAML_SYSTEM %{system}
-   (run %{test} --verbose)))
+ (action (run %{test} --verbose))
 )
 
 (test
@@ -37,3 +35,11 @@
  ; (action (run %{test} --verbose))
  (action (echo "Skipping src/io/%{test} from the test suite\n\n"))
 )
+
+(test
+ (name stm_tests)
+ (modules stm_tests)
+ (package multicoretests)
+ (libraries qcheck-stm.sequential qcheck-stm.domain)
+ (action (run %{test} --verbose))
+)

src/io/lin_tests_domain.ml

@@ -1,18 +1,10 @@
 (* ********************************************************************** *)
-(*                      Tests of in and out channels                      *)
+(*                      Tests of In_channels                              *)
 (* ********************************************************************** *)
 
 module IC_domain = Lin_domain.Make(Lin_tests_spec_io.ICConf)
-module OC_domain = Lin_domain.Make(Lin_tests_spec_io.OCConf)
 
-let tests =
-  IC_domain.neg_lin_test ~count:1000 ~name:"Lin In_channel test with Domain" ::
-  if Sys.getenv_opt "OCAML_SYSTEM" = Some "macosx"
-  then (
-    Printf.printf "Lin Out_channel test with Domain disabled under macOS\n\n%!";
-    []
-  ) else [
-    OC_domain.neg_lin_test ~count:5000 ~name:"Lin Out_channel test with Domain";
+let _ =
+  QCheck_base_runner.run_tests_main [
+    IC_domain.neg_lin_test ~count:1000 ~name:"Lin In_channel test with Domain"
   ]
-
-let _ = QCheck_base_runner.run_tests_main tests

src/io/lin_tests_spec_io.ml

@@ -61,61 +61,3 @@ module ICConf : Lin.Spec = struct
     val_ "In_channel.set_binary_mode"     In_channel.set_binary_mode       (t @-> bool @-> returning_or_exc unit) ;
   ]
 end
-
-module OCConf : Lin.Spec = struct
-  (* a path and an open channel to that file; we need to keep the path
-     to cleanup after the test run *)
-  type t = Out_channel.t
-  let path = ref ""
-
-  let init () =
-    let p,ch = Filename.open_temp_file "lin-" "" in
-    path := p;
-    ch
-
-  let cleanup chan =
-    Out_channel.close chan;
-    Sys.remove !path
-
-  open Lin
-  let int,int64 = nat_small,nat64_small
-
-  (* disable string and bytes char shrinking as too many shrinking candidates
-     triggers long Out_channel shrink runs on Mingw + Cygwin *)
-  let string =
-    let string = QCheck.(set_shrink Shrink.(string ~shrink:nil) string_small) in
-    gen_deconstructible string (print Lin.string) String.equal
-  let bytes =
-    let bytes = QCheck.(set_shrink Shrink.(bytes ~shrink:nil) bytes_small) in
-    gen_deconstructible bytes (print Lin.bytes) Bytes.equal
-
-  let api = [
-    (* Only one t is tested, so skip stdout, stderr and opening functions *)
-
-    (* val_ "Out_channel.stdout"           Out_channel.stdout           (t) ; *)
-    (* val_ "Out_channel.stderr"           Out_channel.stderr           (t) ; *)
-    (* val_ "Out_channel.open_bin"         Out_channel.open_bin         (string @-> returning t) ; *)
-    (* val_ "Out_channel.open_text"        Out_channel.open_text        (string @-> returning t) ; *)
-    (* val_ "Out_channel.open_gen"         Out_channel.open_gen         (open_flag list @-> int @-> string @-> returning t) ; *)
-    (* val_ "Out_channel.with_open_bin"    Out_channel.with_open_bin    (string @-> (t @-> 'a) @-> returning 'a) ; *)
-    (* val_ "Out_channel.with_open_text"   Out_channel.with_open_text   (string @-> (t @-> 'a) @-> returning 'a) ; *)
-    (* val_ "Out_channel.with_open_gen"    Out_channel.with_open_gen    (open_flag list @-> int @-> string @-> (t @-> 'a) @-> returning 'a) ; *)
-
-    val_freq 10 "Out_channel.seek"             Out_channel.seek             (t @-> int64 @-> returning_or_exc unit) ;
-    val_freq 20 "Out_channel.pos"              Out_channel.pos              (t @-> returning_or_exc int64) ;
-    val_freq 20 "Out_channel.length"           Out_channel.length           (t @-> returning_or_exc int64) ;
-    val_freq 10 "Out_channel.close"            Out_channel.close            (t @-> returning_or_exc unit) ;
-    val_freq 10 "Out_channel.close_noerr"      Out_channel.close_noerr      (t @-> returning unit) ;
-    val_freq 10 "Out_channel.flush"            Out_channel.flush            (t @-> returning_or_exc unit) ;
-  (*val_freq  1 "Out_channel.flush_all"        Out_channel.flush_all        (unit @-> returning_or_exc unit) ;*)
-    val_freq 10 "Out_channel.output_char"      Out_channel.output_char      (t @-> char @-> returning_or_exc unit) ;
-    val_freq 10 "Out_channel.output_byte"      Out_channel.output_byte      (t @-> int @-> returning_or_exc unit) ;
-    val_freq 10 "Out_channel.output_string"    Out_channel.output_string    (t @-> string @-> returning_or_exc unit) ;
-    val_freq 10 "Out_channel.output_bytes"     Out_channel.output_bytes     (t @-> bytes @-> returning_or_exc unit) ;
-    val_freq 10 "Out_channel.output"           Out_channel.output           (t @-> bytes @-> int @-> int @-> returning_or_exc unit) ;
-    val_freq 10 "Out_channel.output_substring" Out_channel.output_substring (t @-> string @-> int @-> int @-> returning_or_exc unit) ;
-    val_freq 10 "Out_channel.set_binary_mode"  Out_channel.set_binary_mode  (t @-> bool @-> returning_or_exc unit) ;
-    val_freq 10 "Out_channel.set_buffered"     Out_channel.set_buffered     (t @-> bool @-> returning_or_exc unit) ;
-    val_freq 10 "Out_channel.is_buffered"      Out_channel.is_buffered      (t @-> returning_or_exc bool) ;
-  ]
-end

src/io/lin_tests_thread.ml

@@ -1,12 +1,10 @@
 (* ********************************************************************** *)
-(*                      Tests of in and out channels                      *)
+(*                      Tests of In_channels                              *)
 (* ********************************************************************** *)
 
 module IC_thread = Lin_thread.Make(Lin_tests_spec_io.ICConf) [@@alert "-experimental"]
-module OC_thread = Lin_thread.Make(Lin_tests_spec_io.OCConf) [@@alert "-experimental"]
 
 let _ =
   QCheck_base_runner.run_tests_main [
     IC_thread.neg_lin_test ~count:1000 ~name:"Lin In_channel test with Thread";
-    OC_thread.neg_lin_test ~count:1000 ~name:"Lin Out_channel test with Thread";
   ]