Ajout de tests de bachotage

.gitattributes

@@ -1 +1,2 @@
-tests/**/* binary
+tests/*0*/**/* binary
+tests/cram/**/* -binary

.github/workflows/check_correctness.yml

@@ -58,6 +58,11 @@ jobs:
           eval $(opam env)
           make build
 
+      - name: Cram tests
+        run: |
+          eval $(opam env)
+          make test_cram
+
       - name: Test interpreter
         run: |
           eval $(opam env)
@@ -72,4 +77,3 @@ jobs:
         run: |
           eval $(opam env)
           make test_dgfip_c_backend
-

Makefile

@@ -21,7 +21,7 @@ include $(ROOT_DIR)/makefiles/c_backend.mk
   create-switch init-without-switch init deps \
   format dune build build-static \
   doc \
-  test tests quick_test test_one \
+  test tests quick_test test_one test_cram \
   calc_dir info_c calc_o dgfip_c_backend compile_dgfip_c_backend \
   backend_tests test_dgfip_c_backend \
   clean_backend clean_backend_c clean_backend_exe clean_backend_tmp clean_backend_res clean_backend_all

dune-project

@@ -1,9 +1,11 @@
-(lang dune 2.5)
+(lang dune 2.7)
 
 (name mlang)
 
 (version %%VERSION%%)
 
+(cram enable)
+
 (generate_opam_files true)
 
 (source

irj_checker.opam

@@ -1,6 +1,6 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-version: "186-15-ga4a1d1ff"
+version: "%%VERSION%%"
 synopsis: "IRJ test validation tool"
 description:
   "This standalone module performs a syntactic validation of the DGFiP IRJ test format"
@@ -11,12 +11,12 @@ homepage: "https://github.com/MLanguage/mlang"
 bug-reports: "https://github.com/MLanguage/mlang/issues"
 depends: [
   "ocaml" {>= "4.11.2"}
-  "dune" {build}
+  "dune" {>= "2.7" & build}
   "odoc" {>= "1.5.3"}
   "ocamlformat" {= "0.24.1"}
 ]
 build: [
-  ["dune" "subst"] {pinned}
+  ["dune" "subst"] {dev}
   [
     "dune"
     "build"

makefiles/mlang.mk

@@ -120,6 +120,9 @@ test_irj: FORCE build-dev
 		fi; \
 	done;
 
+test_cram:
+	dune build @runtest
+
 ##################################################
 # Doc
 ##################################################

mlang.opam

@@ -1,6 +1,6 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-version: "186-15-ga4a1d1ff"
+version: "%%VERSION%%"
 synopsis: "Compiler for DGFiP's M language"
 description: """
 The Direction Générale des Finances Publiques (DGFiP)
@@ -16,7 +16,7 @@ homepage: "https://github.com/MLanguage/mlang"
 bug-reports: "https://github.com/MLanguage/mlang/issues"
 depends: [
   "ocaml" {>= "4.13.0"}
-  "dune" {build}
+  "dune" {>= "2.7" & build}
   "ANSITerminal" {= "0.8.2"}
   "cmdliner" {= "1.3.0"}
   "re" {= "1.11.0"}
@@ -29,7 +29,7 @@ depends: [
   "parmap" {= "1.2.3"}
 ]
 build: [
-  ["dune" "subst"] {pinned}
+  ["dune" "subst"] {dev}
   [
     "dune"
     "build"

src/irj_checker/backend_irj/pas_calc.ml

@@ -14,6 +14,7 @@ let format_value fmt (value : literal) =
   match value with
   | I i -> Format.fprintf fmt "%d" i
   | F f -> Format.fprintf fmt "%f" f
+  | U -> Format.fprintf fmt "indefini"
 
 let format_code_revenu fmt
     ((Pos.Mark (var, _), Pos.Mark (value, _)) : var_value) =

src/mlang/driver.ml

@@ -185,12 +185,13 @@ let set_opts (files : string list) (application_names : string list)
     (mpp_function : string option) (optimize_unsafe_float : bool)
     (precision : string option) (roundops : string option)
     (comparison_error_margin : float option) (income_year : int)
-    (m_clean_calls : bool) (dgfip_options : string list option) =
+    (m_clean_calls : bool) (dgfip_options : string list option)
+    (no_nondet_display : bool) =
   Config.set_opts ~files ~application_names ~without_dgfip_m ~debug
     ~var_info_debug ~display_time ~print_cycles ~backend ~output ~run_tests
     ~dgfip_test_filter ~run_test ~mpp_function ~optimize_unsafe_float ~precision
     ~roundops ~comparison_error_margin ~income_year ~m_clean_calls
-    ~dgfip_options
+    ~dgfip_options ~no_nondet_display
 
 let run () =
   let eval_cli =

src/mlang/test_framework/irj_ast.ml

@@ -16,7 +16,7 @@
 
 let mk_position sloc : Pos.t = Pos.make (fst sloc).Lexing.pos_fname sloc
 
-type literal = I of int | F of float
+type literal = I of int | F of float | U
 
 type var_value = string Pos.marked * literal Pos.marked
 

src/mlang/test_framework/irj_parser.mly

@@ -107,7 +107,7 @@ rappels:
 
 variable_and_value:
 | var = SYMBOL SLASH value = value NL { (Pos.mark var (mk_position $loc(var)), Pos.mark value (mk_position $loc(value))) }
-| var = SYMBOL SLASH? NL { (Pos.mark var (mk_position $loc(var)), Pos.without (F 0.0)) }
+| var = SYMBOL SLASH? NL { (Pos.mark var (mk_position $loc(var)), Pos.without U) }
 
 calc_error:
 | error = SYMBOL NL { Pos.mark error (mk_position $sloc) }

src/mlang/test_framework/test_interpreter.ml

@@ -26,27 +26,32 @@ type instance = {
   label : string;
   vars : Com.literal Com.Var.Map.t;
   events : (Com.literal, Com.Var.t) Com.event_value StrMap.t list;
-  expectedVars : float StrMap.t;
+  expectedVars : Com.literal StrMap.t;
   expectedAnos : StrSet.t;
 }
 
+let irj_lit_to_com_lit = function
+  | Irj_ast.I i -> Com.Float (float i)
+  | F f -> Com.Float f
+  | U -> Com.Undefined
+
 let to_MIR_function_and_inputs (program : Mir.program) (t : Irj_ast.irj_file) :
     instance list =
   let add_var name value map =
     try
       let var = find_var_of_name program (Pos.without name) in
-      Com.Var.Map.add var (Com.Float value) map
+      Com.Var.Map.add var value map
     with _ -> map
   in
   let vars =
     let map_init =
       Com.Var.Map.empty
-      |> add_var "V_ANCSDED" (float (!Config.income_year + 1))
-      |> add_var "V_MILLESIME" (float !Config.income_year)
+      |> add_var "V_ANCSDED" (Com.Float (float (!Config.income_year + 1)))
+      |> add_var "V_MILLESIME" (Com.Float (float !Config.income_year))
     in
     List.fold_left
       (fun in_f (Pos.Mark (var, _var_pos), Pos.Mark (value, _value_pos)) ->
-        add_var var (match value with Irj_ast.I i -> float i | F f -> f) in_f)
+        add_var var (irj_lit_to_com_lit value) in_f)
       map_init t.prim.entrees
   in
   let eventsList rappels =
@@ -72,7 +77,10 @@ let to_MIR_function_and_inputs (program : Mir.program) (t : Irj_ast.irj_file) :
           raise (Errors.StructuredError ("Fichier de test incorrect", [], None))
     in
     let toNum p = Com.Numeric (Com.Float (float p)) in
-    let optToNum op = toNum (Option.value ~default:0 op) in
+    let optToNum = function
+      | Some p -> Com.Numeric (Com.Float (float p))
+      | None -> Com.Numeric Com.Undefined
+    in
     let toEvent (rappel : Irj_ast.rappel) =
       StrMap.empty
       |> StrMap.add "numero" (toNum rappel.event_nb)
@@ -92,7 +100,12 @@ let to_MIR_function_and_inputs (program : Mir.program) (t : Irj_ast.irj_file) :
   in
   let expVars vars_init =
     let fold res (Pos.Mark (var, _), Pos.Mark (value, _)) =
-      let fVal = match value with Irj_ast.I i -> float i | Irj_ast.F f -> f in
+      let fVal =
+        match value with
+        | Irj_ast.I i -> Com.Float (float i)
+        | Irj_ast.F f -> Com.Float f
+        | Irj_ast.U -> Com.Undefined
+      in
       StrMap.add var fVal res
     in
     List.fold_left fold StrMap.empty vars_init
@@ -107,7 +120,7 @@ let to_MIR_function_and_inputs (program : Mir.program) (t : Irj_ast.irj_file) :
       let expectedAnos = expAnos t.prim.controles_attendus in
       [ { label = "primitif"; vars; events = []; expectedVars; expectedAnos } ]
   | Some rapp ->
-      let vars = add_var "MODE_CORR" 1.0 vars in
+      let vars = add_var "MODE_CORR" (Com.Float 1.0) vars in
       let events = eventsList rapp.entrees_rappels in
       let expectedVars = expVars rapp.resultats_attendus in
       let expectedAnos = expAnos rapp.controles_attendus in
@@ -120,7 +133,7 @@ let check_test (program : Mir.program) (test_name : string)
     (ign_vars : StrSet.t) : unit =
   let check_vars exp vars =
     let test_error_margin = 0.01 in
-    let fold vname f nb =
+    let fold vname expected nb =
       if StrSet.mem vname ign_vars then (
         Cli.warning_print "OK | %s ignoree" vname;
         nb)
@@ -129,16 +142,27 @@ let check_test (program : Mir.program) (test_name : string)
         | Some var ->
             if Com.Var.is_tgv var then
               if Com.Var.is_given_back var then
-                let f' =
+                let calc =
                   match Com.Var.Map.find_opt var vars with
-                  | Some (Com.Float f') -> f'
-                  | _ -> 0.0
+                  | Some f' -> f'
+                  | None -> Com.Undefined
+                in
+                let ok =
+                  match (expected, calc) with
+                  | Com.Undefined, Com.Undefined -> true
+                  | Com.Float 0., Com.Undefined ->
+                      (* For compatibility with fuzzer tests *)
+                      true
+                  | Com.Float _, Com.Undefined | Com.Undefined, Com.Float _ ->
+                      false
+                  | Com.Float e, Com.Float c ->
+                      abs_float (e -. c) <= test_error_margin
                 in
-                if abs_float (f -. f') > test_error_margin then (
-                  Cli.error_print "KO | %s attendue: %f - evaluee: %f" vname f
-                    f';
+                if ok then nb
+                else (
+                  Cli.error_print "KO | %s attendue: %a - evaluee: %a" vname
+                    Com.format_literal expected Com.format_literal calc;
                   nb + 1)
-                else nb
               else (
                 Cli.warning_print "OK | %s ignoree car non-restituee" vname;
                 nb)

src/mlang/utils/cli.ml

@@ -176,13 +176,21 @@ let dgfip_options =
           "Specify DGFiP options (use --dgfip_options=--help to display DGFiP \
            specific options)")
 
+let no_nondet_display =
+  Arg.(
+    value & flag
+    & info [ "no_nondet_display" ] ~docv:""
+        ~doc:
+          "Hides all non deterministic displays (display time, progress bar). \
+           Used for cram tests.")
+
 let mlang_t f =
   Term.(
     const f $ files $ applications $ without_dgfip_m $ debug $ var_info_debug
     $ display_time $ no_print_cycles $ backend $ output $ run_all_tests
     $ dgfip_test_filter $ run_test $ mpp_function $ optimize_unsafe_float
     $ precision $ roundops $ comparison_error_margin_cli $ income_year_cli
-    $ m_clean_calls $ dgfip_options)
+    $ m_clean_calls $ dgfip_options $ no_nondet_display)
 
 let info =
   let doc =
@@ -335,34 +343,36 @@ let error_print kont =
     kont
 
 let create_progress_bar (task : string) : (string -> unit) * (string -> unit) =
-  let step_ticks = 5 in
-  let ticks = ref 0 in
-  let msg = ref task in
-  let stop = ref false in
-  let timer () =
-    while true do
-      if !stop then Thread.exit ();
-      ticks := !ticks + 1;
-      clock_marker (!ticks / step_ticks);
-      Format.printf "%s" !msg;
-      flush_all ();
-      flush_all ();
-      ANSITerminal.erase ANSITerminal.Below;
-      ANSITerminal.move_bol ();
-      Unix.sleepf 0.05
-    done
-  in
-  let _ = Thread.create timer () in
-  ( (fun current_progress_msg ->
-      msg := Format.sprintf "%s: %s" task current_progress_msg),
-    fun finish_msg ->
-      stop := true;
-      debug_marker false;
-      Format.printf "%s: %s" task finish_msg;
-      ANSITerminal.erase ANSITerminal.Below;
-      ANSITerminal.move_bol ();
-      Format.printf "\n";
-      time_marker () )
+  if !Config.no_nondet_display then (ignore, ignore)
+  else
+    let step_ticks = 5 in
+    let ticks = ref 0 in
+    let msg = ref task in
+    let stop = ref false in
+    let timer () =
+      while true do
+        if !stop then Thread.exit ();
+        ticks := !ticks + 1;
+        if !Config.display_time then clock_marker (!ticks / step_ticks);
+        Format.printf "%s" !msg;
+        flush_all ();
+        flush_all ();
+        ANSITerminal.erase ANSITerminal.Below;
+        ANSITerminal.move_bol ();
+        Unix.sleepf 0.05
+      done
+    in
+    let _ = Thread.create timer () in
+    ( (fun current_progress_msg ->
+        msg := Format.sprintf "%s: %s" task current_progress_msg),
+      fun finish_msg ->
+        stop := true;
+        result_marker ();
+        Format.printf "%s: %s" task finish_msg;
+        ANSITerminal.erase ANSITerminal.Below;
+        ANSITerminal.move_bol ();
+        Format.printf "\n";
+        time_marker () )
 
 let warning_print kont =
   ANSITerminal.erase ANSITerminal.Eol;

src/mlang/utils/cli.mli

@@ -39,6 +39,7 @@ val mlang_t :
   int ->
   bool ->
   string list option ->
+  bool ->
   'a) ->
   'a Cmdliner.Term.t
 (** Mlang binary command-line arguments parsing function *)