From 024dd85ab25b665c284479bd52a79809e59e7237 Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Fri, 5 Jan 2024 19:08:22 +0100 Subject: [PATCH] Remove Lin Out_channel tests --- src/io/dune | 4 +-- src/io/lin_tests_domain.ml | 16 +++------- src/io/lin_tests_spec_io.ml | 58 ------------------------------------- src/io/lin_tests_thread.ml | 4 +-- 4 files changed, 6 insertions(+), 76 deletions(-) diff --git a/src/io/dune b/src/io/dune index d296546ef..942c96d27 100644 --- a/src/io/dune +++ b/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 diff --git a/src/io/lin_tests_domain.ml b/src/io/lin_tests_domain.ml index d4c372b44..b10c57751 100644 --- a/src/io/lin_tests_domain.ml +++ b/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 diff --git a/src/io/lin_tests_spec_io.ml b/src/io/lin_tests_spec_io.ml index c611aad36..6e023be38 100644 --- a/src/io/lin_tests_spec_io.ml +++ b/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 diff --git a/src/io/lin_tests_thread.ml b/src/io/lin_tests_thread.ml index 729b98511..4a2a1bf09 100644 --- a/src/io/lin_tests_thread.ml +++ b/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"; ]