Ajout du mot-clé "evenement"

.github/workflows/binary-releases.yml

@@ -22,16 +22,16 @@ jobs:
 
   linux-build:
     # The type of runner that the job will run on
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-22.04
     needs: create-release
 
     # Steps represent a sequence of tasks that will be executed as part of the job
     steps:
       # Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v4
 
       - name: Opam modules cache
-        uses: actions/cache@v1
+        uses: actions/cache@v4
         env:
           cache-name: cache-opam-modules
         with:

.github/workflows/check_correctness.yml

@@ -16,15 +16,15 @@ jobs:
   # This workflow contains a single job called "build"
   build:
     # The type of runner that the job will run on
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-22.04
 
     # Steps represent a sequence of tasks that will be executed as part of the job
     steps:
       # Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v4
 
       - name: Opam modules cache
-        uses: actions/cache@v1
+        uses: actions/cache@v4
         env:
           cache-name: cache-opam-modules
         with:

.github/workflows/publish_doc.yml

@@ -7,12 +7,12 @@ on:
 
 jobs:
   deploy:
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-22.04
     steps:
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v4
 
       - name: Opam modules cache
-        uses: actions/cache@v1
+        uses: actions/cache@v4
         env:
           cache-name: cache-opam-modules
         with:

Makefile

@@ -34,7 +34,7 @@ default: FORCE build
 
 all: FORCE quick_test tests test_dgfip_c_backend
 
-clean: FORCE
+clean: FORCE remise_a_zero_versionnage
 	$(call make_in,$(DGFIP_DIR),clean_backend_all)
 	rm -f doc/doc.html
 	dune clean

dune-project

@@ -2,7 +2,7 @@
 
 (name mlang)
 
-(version 1.1.0)
+(version %%VERSION%%)
 
 (generate_opam_files true)
 

examples/dgfip_c/ml_primitif/ml_driver/common.ml

@@ -1,3 +1,14 @@
 module StrSet = Set.Make(String)
 module StrMap = Map.Make(String)
 
+type rappel =
+  float
+  * float
+  * string
+  * float
+  * float
+  * float option
+  * float option
+  * float
+  * float option
+

examples/dgfip_c/ml_primitif/ml_driver/m.ml

@@ -148,4 +148,19 @@ external get_err_list : TGV.t -> string list = "ml_get_err_list"
 external annee_calc : unit -> int = "ml_annee_calc"
 external export_errs : TGV.t -> unit = "ml_export_errs"
 external enchainement_primitif : TGV.t -> unit = "ml_enchainement_primitif"
+external set_evt_list :
+  TGV.t
+  -> (
+      float
+      * float
+      * string
+      * float
+      * float
+      * float option
+      * float option
+      * float
+      * float option
+    ) list
+  -> unit
+= "ml_set_evt_list" 
 

examples/dgfip_c/ml_primitif/ml_driver/main.ml

@@ -1,31 +1,72 @@
 open Common
 
+type instance = {
+  nom : string;
+  label : string;
+  vars : float StrMap.t;
+  events : rappel list;
+  expectedVars : float StrMap.t;
+  expectedAnos : StrSet.t;
+}
+
+let new_instance nom = {
+  nom;
+  label = "";
+  vars = StrMap.empty;
+  events = [];
+  expectedVars = StrMap.empty;
+  expectedAnos = StrSet.empty;
+}
+
 let read_test filename =
   let test = Read_test.read_test filename in
-  let tgv = M.TGV.alloc_tgv () in
-  let res_prim, ctl_prim =
-    let fold_prim (res_prim, ctl_prim) s =
-      match s with
-      | `EntreesPrimitif pl ->
-          List.iter (fun (code, montant) -> M.TGV.set tgv code montant) pl;
-          res_prim, ctl_prim
-      | `ResultatsPrimitif pl ->
-          let res_prim =
-            let fold res (code, montant) = StrMap.add code montant res in
-            List.fold_left fold res_prim pl
-          in
-          res_prim, ctl_prim
-      | `ControlesPrimitif el ->
-          let ctl_prim =
-            let fold err e = StrSet.add e err in
-            List.fold_left fold ctl_prim el
-          in
-          res_prim, ctl_prim
-      | _ -> res_prim, ctl_prim
-    in
-    List.fold_left fold_prim (StrMap.empty, StrSet.empty) test
+  let fold_prim (nom, inst, insts) s =
+    match s with
+    | `Nom noms ->
+         let nom = String.concat " " noms in
+         let inst = {inst with nom} in
+         let insts = List.map (fun i -> {i with nom}) insts in
+         (nom, inst, insts)
+    | `EntreesPrimitif pl ->
+        let vars =
+          let fold res (code, montant) = StrMap.add code montant res in
+          List.fold_left fold StrMap.empty pl
+        in
+        (nom, {inst with vars}, insts)
+    | `ControlesPrimitif el ->
+        let expectedAnos =
+          let fold err e = StrSet.add e err in
+          List.fold_left fold StrSet.empty el
+        in
+        (nom, {inst with expectedAnos}, insts)
+    | `ResultatsPrimitif pl ->
+        let expectedVars =
+          let fold res (code, montant) = StrMap.add code montant res in
+          List.fold_left fold StrMap.empty pl
+        in
+        let inst = {inst with label = "primitif"; expectedVars} in
+        (nom, new_instance nom, inst :: insts)
+    | `EntreesCorrectif _
+    | `ControlesCorrectif _
+    | `ResultatsCorrectif _ -> (nom, inst, insts)
+    | `EntreesRappels events -> (nom, {inst with events}, insts)
+    | `ControlesRappels el ->
+        let expectedAnos =
+          let fold err e = StrSet.add e err in
+          List.fold_left fold StrSet.empty el
+        in
+        (nom, {inst with expectedAnos}, insts)
+    | `ResultatsRappels pl ->
+        let expectedVars =
+          let fold res (code, montant) = StrMap.add code montant res in
+          List.fold_left fold StrMap.empty pl
+        in
+        let inst = {inst with label = "correctif"; expectedVars} in
+        (nom, new_instance nom, inst :: insts)
+    | `Skip -> (nom, inst, insts)
   in
-  tgv, res_prim, ctl_prim
+  let _, _, insts = List.fold_left fold_prim ("", new_instance "", []) test in
+  insts
 
 let check_result tgv err expected_tgv expected_err =
   let result = ref true in
@@ -130,24 +171,36 @@ let compare_dump out outexp =
 let run_test test_file annee_exec =
   Printf.printf "Testing %s...\n%!" test_file;
   let annee_calc = M.annee_calc () in
-  let tgv, res_prim, ctl_prim = read_test test_file in
-  let annee_revenu = M.TGV.get_int_def tgv "ANREV" annee_calc in
-  if annee_revenu <> annee_calc then (
-    Printf.eprintf
-      "Attention, année calculette (%d) <> année revenu (%d)\n%!"
-      annee_calc
-      annee_revenu
-  );
-  M.TGV.set_int tgv "IND_TRAIT" 4 (* = primitif *);
-  M.TGV.set_int tgv "ANCSDED" annee_exec;
-  M.init_errs tgv;
-  let _err = M.enchainement_primitif tgv in
-  M.export_errs tgv;
-  let err_set =
-    let add res e = StrSet.add e res in
-    List.fold_left add StrSet.empty (M.get_err_list tgv)
+  let insts = read_test test_file in
+  let rec run_insts res = function
+  | [] -> res
+  | inst :: insts ->
+      Printf.printf "  Running %s:%s...\n%!" inst.nom inst.label;
+      let tgv = M.TGV.alloc_tgv () in
+      StrMap.iter (M.TGV.set tgv) inst.vars;
+      M.set_evt_list tgv inst.events;
+      let annee_revenu = M.TGV.get_int_def tgv "ANREV" annee_calc in
+      if annee_revenu <> annee_calc then (
+        Printf.eprintf
+          "Attention, année calculette (%d) <> année revenu (%d)\n%!"
+          annee_calc
+          annee_revenu
+      );
+      (match inst.label with
+      | "primitif" -> M.TGV.set_int tgv "IND_TRAIT" 4
+      | "correctif" -> M.TGV.set_int tgv "IND_TRAIT" 5
+      | _ -> M.TGV.set_int tgv "IND_TRAIT" 0);
+      M.TGV.set_int tgv "ANCSDED" annee_exec;
+      M.init_errs tgv;
+      let _err = M.enchainement_primitif tgv in
+      M.export_errs tgv;
+      let err_set =
+        let add res e = StrSet.add e res in
+        List.fold_left add StrSet.empty (M.get_err_list tgv)
+      in
+      res && check_result tgv err_set inst.expectedVars inst.expectedAnos
   in
-  check_result tgv err_set res_prim ctl_prim
+  run_insts true insts
 
 let main () =
   if Array.length Sys.argv < 2 then (
@@ -175,7 +228,7 @@ let main () =
   let rec loop = function
   | [] -> true
   | test_file :: files ->
-      run_test test_file annee_exec && ((* Gc.minor ();*) loop files)
+      run_test test_file annee_exec && (Gc.minor (); loop files)
   in
   match loop test_files with
   | true -> exit 0

examples/dgfip_c/ml_primitif/ml_driver/read_test.ml

@@ -1,3 +1,5 @@
+open Common
+
 type file = {
   c: in_channel;
   mutable lines: string list;
@@ -21,14 +23,17 @@ let convert_int s = try int_of_string s with _ -> 0
 
 let convert_float s =
   try Float.of_string s
-  (* with _ -> 0.0 *)
   with _ -> (* to cope with badly formatted tests *)
     try Float.of_string
           (String.sub s 0
              (String.index_from s
                 ((String.index s '.') + 1) '.'))
     with _ -> 0.0
 
+let convert_float_opt s =
+  let rec isSpc i = i < 0 || (s.[i] = ' ' && isSpc (i - 1)) in
+  if isSpc (String.length s - 1) then None else Some (convert_float s)
+
 let parse_generic s =
   let sl = String.split_on_char '/' s in
   match sl with
@@ -55,16 +60,33 @@ let parse_entree_corr s =
   | _ -> failwith (Printf.sprintf "Ligne entree correctif invalide: '%s'" s)
 
 let parse_entree_rap s =
+  let err () = failwith (Printf.sprintf "Ligne entree rappel invalide: '%s'" s) in
   let sl = String.split_on_char '/' s in
   match sl with
   | [ num_evt; num_rappel; code; montant; sens;
       penalite; base_tl; date_evt; ind20 ] ->
-      let date_evt = convert_int date_evt in
-      (convert_int num_evt, convert_int num_rappel,
-       code, convert_float montant, sens.[0],
-       convert_int penalite, convert_float base_tl,
-       (date_evt mod 10000, date_evt / 10000), String.equal ind20 "1") (* TODO: improve *)
-  | _ -> failwith (Printf.sprintf "Ligne entree rappel invalide: '%s'" s)
+      if String.length code = 0 then err ();
+      let sens_float =
+        if String.length sens = 0 then err ();
+        match sens.[0] with
+        | 'R' -> 0.0
+        | 'C' -> 1.0
+        | 'M' -> 2.0
+        | 'P' -> 3.0
+        | _ -> err ()
+      in
+      (
+        convert_float num_evt,
+        convert_float num_rappel,
+        code,
+        convert_float montant,
+        sens_float,
+        convert_float_opt penalite,
+        convert_float_opt base_tl,
+        convert_float date_evt,
+        convert_float_opt ind20
+      ) (* TODO: improve *)
+  | _ -> err ()
 
 let read_section_contents f parsefun =
   let rec aux contents =