Remove dependency on ppx_expect and use alcotest instead

This commit is contained in:
Denis Merigoux 2023-04-21 10:37:31 +02:00
parent f877544368
commit 107ff95dc4
No known key found for this signature in database
GPG Key ID: EE99DCFA365C3EE3
7 changed files with 62 additions and 54 deletions

View File

@ -25,7 +25,6 @@
, zarith_stubs_js , zarith_stubs_js
, ocaml-crunch , ocaml-crunch
, cohttp-lwt-unix , cohttp-lwt-unix
, ppx_expect
}: }:
buildDunePackage { buildDunePackage {
@ -63,7 +62,6 @@ buildDunePackage {
zarith zarith
zarith_stubs_js zarith_stubs_js
cohttp-lwt-unix cohttp-lwt-unix
ppx_expect
]; ];
# Currently there is no unit tests in catala and Cram tests are handled by clerk # Currently there is no unit tests in catala and Cram tests are handled by clerk

View File

@ -32,7 +32,6 @@ depends: [
"ocamlfind" {!= "1.9.5"} "ocamlfind" {!= "1.9.5"}
"ocamlgraph" {>= "1.8.8"} "ocamlgraph" {>= "1.8.8"}
"ppx_yojson_conv" {>= "0.14.0"} "ppx_yojson_conv" {>= "0.14.0"}
"ppx_expect" {>= "0.14.0"}
"re" {>= "1.9.0"} "re" {>= "1.9.0"}
"sedlex" {>= "2.4"} "sedlex" {>= "2.4"}
"uutf" {>= "1.0.3"} "uutf" {>= "1.0.3"}

View File

@ -28,6 +28,11 @@
catala.runtime_ocaml catala.runtime_ocaml
catala.runtime_jsoo)) catala.runtime_jsoo))
(executable
(name tests)
(modules tests)
(libraries catala.driver alcotest))
(rule (rule
(target custom_linking.sexp) (target custom_linking.sexp)
(mode fallback) (mode fallback)
@ -54,3 +59,9 @@
(alias (alias
(name catala) (name catala)
(deps catala.exe)) (deps catala.exe))
(rule
(alias runtest)
(package catala)
(action
(run ./tests.exe)))

View File

@ -1,10 +1,9 @@
(library (library
(name lcalc) (name lcalc)
(public_name catala.lcalc) (public_name catala.lcalc)
(libraries bindlib ubase dcalc scopelang catala.runtime_ocaml) (libraries bindlib ubase dcalc scopelang catala.runtime_ocaml alcotest)
(inline_tests)
(preprocess (preprocess
(pps visitors.ppx ppx_expect))) (pps visitors.ppx)))
(documentation (documentation
(package catala) (package catala)

View File

@ -205,23 +205,18 @@ let optimize_program (p : 'm program) : untyped program =
lift_optim peephole_expr; lift_optim peephole_expr;
]) ])
let%expect_test _ = let test_lcalc_optims1 () =
Cli.call_unstyled (fun _ -> Cli.call_unstyled (fun _ ->
let x = Var.make "x" in let x = Var.make "x" in
let enumT = EnumName.fresh ("t", Pos.no_pos) in let enumT = EnumName.fresh ("t", Pos.no_pos) in
let consA = EnumConstructor.fresh ("A", Pos.no_pos) in let consA = EnumConstructor.fresh ("A", Pos.no_pos) in
let consB = EnumConstructor.fresh ("B", Pos.no_pos) in let consB = EnumConstructor.fresh ("B", Pos.no_pos) in
let consC = EnumConstructor.fresh ("C", Pos.no_pos) in let consC = EnumConstructor.fresh ("C", Pos.no_pos) in
let consD = EnumConstructor.fresh ("D", Pos.no_pos) in let consD = EnumConstructor.fresh ("D", Pos.no_pos) in
let nomark = Untyped { pos = Pos.no_pos } in let nomark = Untyped { pos = Pos.no_pos } in
let injA = Expr.einj (Expr.evar x nomark) consA enumT nomark in let injA = Expr.einj (Expr.evar x nomark) consA enumT nomark in
(* let injB = Expr.einj (Expr.evar x nomark) consB enumT nomark in *)
let injC = Expr.einj (Expr.evar x nomark) consC enumT nomark in let injC = Expr.einj (Expr.evar x nomark) consC enumT nomark in
let injD = Expr.einj (Expr.evar x nomark) consD enumT nomark in let injD = Expr.einj (Expr.evar x nomark) consD enumT nomark in
let cases : ('a, 't) boxed_gexpr EnumConstructor.Map.t = let cases : ('a, 't) boxed_gexpr EnumConstructor.Map.t =
EnumConstructor.Map.of_seq EnumConstructor.Map.of_seq
@@ List.to_seq @@ List.to_seq
@ -230,26 +225,20 @@ let%expect_test _ =
consB, Expr.eabs (Expr.bind [| x |] injD) [TAny, Pos.no_pos] nomark; consB, Expr.eabs (Expr.bind [| x |] injD) [TAny, Pos.no_pos] nomark;
] ]
in in
let matchA = Expr.ematch injA enumT cases nomark in let matchA = Expr.ematch injA enumT cases nomark in
Alcotest.(check string)
Format.printf "before=%a\n" "same string"
"before=match (A x)\n\
\ with\n\
\ | A (λ (x: any) C x)\n\
\ | B (λ (x: any) D x)\n\
after=C\n\
x"
(Format.asprintf "before=%a\nafter=%a"
(Print.expr_debug ~debug:false) (Print.expr_debug ~debug:false)
(Expr.unbox matchA); (Expr.unbox matchA)
Format.print_flush ();
Format.printf "after=%a\n"
(Print.expr_debug ~debug:false) (Print.expr_debug ~debug:false)
(Expr.unbox (iota_expr (Expr.unbox matchA))); (Expr.unbox (iota_expr (Expr.unbox matchA)))))
[%expect
{|
before=match (A x)
with
| A (λ (x: any) C x)
| B (λ (x: any) D x)
after=C
x
|}])
let cases_of_list l : ('a, 't) boxed_gexpr EnumConstructor.Map.t = let cases_of_list l : ('a, 't) boxed_gexpr EnumConstructor.Map.t =
EnumConstructor.Map.of_seq EnumConstructor.Map.of_seq
@ -262,7 +251,7 @@ let cases_of_list l : ('a, 't) boxed_gexpr EnumConstructor.Map.t =
[TAny, Pos.no_pos] [TAny, Pos.no_pos]
(Untyped { pos = Pos.no_pos }) )) (Untyped { pos = Pos.no_pos }) ))
let%expect_test _ = let test_lcalc_optims2 () =
Cli.call_unstyled (fun _ -> Cli.call_unstyled (fun _ ->
let enumT = EnumName.fresh ("t", Pos.no_pos) in let enumT = EnumName.fresh ("t", Pos.no_pos) in
let consA = EnumConstructor.fresh ("A", Pos.no_pos) in let consA = EnumConstructor.fresh ("A", Pos.no_pos) in
@ -297,25 +286,22 @@ let%expect_test _ =
(cases_of_list [consA, injC; consB, injD]) (cases_of_list [consA, injC; consB, injD])
nomark nomark
in in
Alcotest.(check string)
Format.printf "before=@[%a@]@." "same string "
"before=match\n\
\ (match 1\n\
\ with\n\
\ | A (λ (x: any) A 20)\n\
\ | B (λ (x: any) B B x))\n\
\ with\n\
\ | A (λ (x: any) C x)\n\
\ | B (λ (x: any) D x)\n\
after=match 1\n\
\ with\n\
\ | A (λ (x: any) C 20)\n\
\ | B (λ (x: any) D B x)\n"
(Format.asprintf "before=@[%a@]@.after=%a@."
(Print.expr_debug ~debug:false) (Print.expr_debug ~debug:false)
(Expr.unbox matchA); (Expr.unbox matchA)
Format.printf "after=%a@."
(Print.expr_debug ~debug:false) (Print.expr_debug ~debug:false)
(Expr.unbox (iota2_expr (Expr.unbox matchA))); (Expr.unbox (iota2_expr (Expr.unbox matchA)))))
[%expect
{|
before=match
(match 1
with
| A (λ (x: any) A 20)
| B (λ (x: any) B B x))
with
| A (λ (x: any) C x)
| B (λ (x: any) D x)
after=match 1
with
| A (λ (x: any) C 20)
| B (λ (x: any) D B x) |}])

View File

@ -43,3 +43,8 @@ open Ast
val optimize_program : 'm program -> Shared_ast.untyped program val optimize_program : 'm program -> Shared_ast.untyped program
(** Warning/todo: no effort was yet made to ensure correct propagation of type (** Warning/todo: no effort was yet made to ensure correct propagation of type
annotations in the typed case *) annotations in the typed case *)
(**{1 Tests}*)
val test_lcalc_optims2 : unit -> unit
val test_lcalc_optims1 : unit -> unit

10
compiler/tests.ml Normal file
View File

@ -0,0 +1,10 @@
let _ =
let open Alcotest in
run "Optimizations"
[
( "Lcalc",
[
test_case "#1" `Quick Lcalc.Optimizations.test_lcalc_optims1;
test_case "#2" `Quick Lcalc.Optimizations.test_lcalc_optims2;
] );
]