Skip to content

Commit

Permalink
Remove Lin Out_channel tests
Browse files Browse the repository at this point in the history
  • Loading branch information
@jmid
jmid committed Jan 5, 2024
1 parent e1aab77 commit 2150652
Show file tree
Hide file tree
Showing 4 changed files with 6 additions and 76 deletions.
4 changes: 1 addition & 3 deletions src/io/dune
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
16 changes: 4 additions & 12 deletions src/io/lin_tests_domain.ml
View file
Original file line number Diff line number Diff line change
@@ -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
58 changes: 0 additions & 58 deletions src/io/lin_tests_spec_io.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
4 changes: 1 addition & 3 deletions src/io/lin_tests_thread.ml
View file
Original file line number Diff line number Diff line change
@@ -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";
]

0 comments on commit 2150652

Please sign in to comment.