Added test suite for compiled code

.github/workflows/build.yml

@@ -6,9 +6,9 @@ name: CI
 # events but only for the master branch
 on:
   push:
-    branches: [ master ]
+    branches: [master]
   pull_request:
-    branches: [ master ]
+    branches: [master]
 
 # A workflow run is made up of one or more jobs that can run sequentially or in parallel
 jobs:
@@ -19,47 +19,52 @@ jobs:
 
     # 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
+      # Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it
+      - uses: actions/checkout@v2
 
-    - name: Opam modules cache
-      uses: actions/cache@v1
-      env:
-        cache-name: cache-opam-modules
-      with:
-        # OCaml cache files are stored in `~/.opam` on Linux/macOS
-        path: ~/.opam
-        key: ${{ runner.os }}-build-${{ env.cache-name }}-${{ hashFiles('catala.opam', 'legifrance_catala.opam') }}
-        restore-keys: |
-          ${{ runner.os }}-build-${{ env.cache-name }}-
-          ${{ runner.os }}-build-
-          ${{ runner.os }}-
+      - name: Opam modules cache
+        uses: actions/cache@v1
+        env:
+          cache-name: cache-opam-modules
+        with:
+          # OCaml cache files are stored in `~/.opam` on Linux/macOS
+          path: ~/.opam
+          key: ${{ runner.os }}-build-${{ env.cache-name }}-${{ hashFiles('catala.opam', 'legifrance_catala.opam') }}
+          restore-keys: |
+            ${{ runner.os }}-build-${{ env.cache-name }}-
+            ${{ runner.os }}-build-
+            ${{ runner.os }}-
 
-    - name: Set up OCaml
-      uses: avsm/setup-ocaml@v1.1.3
-      with:
-       # Version of the OCaml compiler to initialise
-        ocaml-version: 4.09.1
+      - name: Set up OCaml
+        uses: avsm/setup-ocaml@v1.1.3
+        with:
+          # Version of the OCaml compiler to initialise
+          ocaml-version: 4.09.1
 
-    - name: Install dependencies
-      run: |
-        eval $(opam env)
-        make dependencies
-        sudo apt update
-        sudo apt install python3-dev python3-setuptools man2html rsync colordiff
-        sudo python3 -m pip install --upgrade pip
-        sudo python3 -m pip install virtualenv
+      - name: Install dependencies
+        run: |
+          eval $(opam env)
+          make dependencies
+          sudo apt update
+          sudo apt install python3-dev python3-setuptools man2html rsync colordiff
+          sudo python3 -m pip install --upgrade pip
+          sudo python3 -m pip install virtualenv
 
-    - name: Make compiler
-      run: |
-        eval $(opam env)
-        make build
-    - name: Run tests
-      run: |
-        eval $(opam env)
-        make tests
+      - name: Make compiler
+        run: |
+          eval $(opam env)
+          make build
+      - name: Run interpreter tests
+        run: |
+          eval $(opam env)
+          make tests
 
-    - name: Make assets and documentation
-      run: |
-        eval $(opam env)
-        make website-assets doc 
+      - name: Run compiled code tests
+        run: |
+          eval $(opam env)
+          make tests_ml
+
+      - name: Make assets and documentation
+        run: |
+          eval $(opam env)
+          make website-assets doc

Makefile

@@ -142,17 +142,36 @@ test_examples: .FORCE
 
 tests: test_suite test_examples
 
+tests_ml: run_french_law_library_tests
+
 ##########################################
 # French law library
 ##########################################
 
 FRENCH_LAW_LIB_DIR=src/french_law
 
-allocations_familiales_library:
-	$(MAKE) -C $(ALLOCATIONS_FAMILIALES_DIR) allocations_familiales.ml -B
+$(FRENCH_LAW_LIB_DIR)/law_source/allocations_familiales.ml:
+	$(MAKE) -C $(ALLOCATIONS_FAMILIALES_DIR) allocations_familiales.ml
 	cp -f $(ALLOCATIONS_FAMILIALES_DIR)/allocations_familiales.ml \
 		$(FRENCH_LAW_LIB_DIR)/law_source 
 
+french_law_library:\
+	$(FRENCH_LAW_LIB_DIR)/law_source/allocations_familiales.ml
+
+run_french_law_library_benchmark: french_law_library
+	dune exec $(FRENCH_LAW_LIB_DIR)/bench.exe
+
+$(FRENCH_LAW_LIB_DIR)/law_source/unit_tests/tests_allocations_familiales.ml:
+	@$(MAKE) --no-print-directory -s -C $(ALLOCATIONS_FAMILIALES_DIR) tests/tests_allocations_familiales.ml
+	@cp -f $(ALLOCATIONS_FAMILIALES_DIR)/tests/tests_allocations_familiales.ml \
+		$(FRENCH_LAW_LIB_DIR)/law_source/unit_tests/
+
+french_law_library_tests: \
+	$(FRENCH_LAW_LIB_DIR)/law_source/unit_tests/tests_allocations_familiales.ml
+
+run_french_law_library_tests: french_law_library_tests
+	@dune exec $(FRENCH_LAW_LIB_DIR)/law_source/unit_tests/run_tests.exe
+
 build_french_law_library: format
 	dune build $(FRENCH_LAW_LIB_DIR)
 
@@ -160,9 +179,6 @@ build_french_law_library_js: format
 	dune build --profile release $(FRENCH_LAW_LIB_DIR)/api_web.bc.js
 	ln -sf $(PWD)/_build/default/$(FRENCH_LAW_LIB_DIR)/api_web.bc.js javascript/french_law.js
 
-run_french_law_library_benchmark: allocations_familiales_library
-	dune exec $(FRENCH_LAW_LIB_DIR)/bench.exe
-
 ##########################################
 # Website assets
 ##########################################

src/catala/lambda_calculus/to_ocaml.ml

@@ -197,13 +197,15 @@ let rec format_expr (ctx : Dcalc.Ast.decl_ctx) (fmt : Format.formatter) (e : exp
            (fun fmt e -> Format.fprintf fmt "%a" format_with_parens e))
         es
   | ETuple (es, Some s) ->
-      Format.fprintf fmt "{@[<hov 2>%a@]}"
-        (Format.pp_print_list
-           ~pp_sep:(fun fmt () -> Format.fprintf fmt ";@ ")
-           (fun fmt (e, struct_field) ->
-             Format.fprintf fmt "@[<hov 2>%a =@ %a@]" format_struct_field_name struct_field
-               format_with_parens e))
-        (List.combine es (List.map fst (Dcalc.Ast.StructMap.find s ctx.ctx_structs)))
+      if List.length es = 0 then Format.fprintf fmt "()"
+      else
+        Format.fprintf fmt "{@[<hov 2>%a@]}"
+          (Format.pp_print_list
+             ~pp_sep:(fun fmt () -> Format.fprintf fmt ";@ ")
+             (fun fmt (e, struct_field) ->
+               Format.fprintf fmt "@[<hov 2>%a =@ %a@]" format_struct_field_name struct_field
+                 format_with_parens e))
+          (List.combine es (List.map fst (Dcalc.Ast.StructMap.find s ctx.ctx_structs)))
   | EArray es ->
       Format.fprintf fmt "@[<hov 2>[|%a|]@]"
         (Format.pp_print_list
@@ -296,13 +298,16 @@ let rec format_expr (ctx : Dcalc.Ast.decl_ctx) (fmt : Format.formatter) (e : exp
 let format_ctx (type_ordering : Scopelang.Dependency.TVertex.t list) (fmt : Format.formatter)
     (ctx : D.decl_ctx) : unit =
   let format_struct_decl fmt (struct_name, struct_fields) =
-    Format.fprintf fmt "type %a = {@\n@[<hov 2>  %a@]@\n}" format_struct_name struct_name
-      (Format.pp_print_list
-         ~pp_sep:(fun fmt () -> Format.fprintf fmt "@\n")
-         (fun _fmt (struct_field, struct_field_type) ->
-           Format.fprintf fmt "%a:@ %a;" format_struct_field_name struct_field format_typ
-             struct_field_type))
-      struct_fields
+    if List.length struct_fields = 0 then
+      Format.fprintf fmt "type %a = unit" format_struct_name struct_name
+    else
+      Format.fprintf fmt "type %a = {@\n@[<hov 2>  %a@]@\n}" format_struct_name struct_name
+        (Format.pp_print_list
+           ~pp_sep:(fun fmt () -> Format.fprintf fmt "@\n")
+           (fun _fmt (struct_field, struct_field_type) ->
+             Format.fprintf fmt "%a:@ %a;" format_struct_field_name struct_field format_typ
+               struct_field_type))
+        struct_fields
   in
   let format_enum_decl fmt (enum_name, enum_cons) =
     Format.fprintf fmt "type %a =@\n@[<hov 2>  %a@]@\n" format_enum_name enum_name
@@ -340,7 +345,7 @@ let format_ctx (type_ordering : Scopelang.Dependency.TVertex.t list) (fmt : Form
 
 let format_program (fmt : Format.formatter) (p : Ast.program)
     (type_ordering : Scopelang.Dependency.TVertex.t list) : unit =
-  Format.fprintf fmt "open Catala.Runtime@\n@\n[@@@@@@ocaml.warning \"-26\"]@\n@\n%a@\n@\n%a"
+  Format.fprintf fmt "open Catala.Runtime@\n@\n[@@@@@@ocaml.warning \"-26-27\"]@\n@\n%a@\n@\n%a@?"
     (format_ctx type_ordering) p.decl_ctx
     (Format.pp_print_list
        ~pp_sep:(fun fmt () -> Format.fprintf fmt "@\n@\n")

src/french_law/law_source/allocations_familiales.ml

@@ -1,6 +1,6 @@
 open Catala.Runtime
 
-[@@@ocaml.warning "-26"]
+[@@@ocaml.warning "-26-27"]
 
 type garde_alternee =
   | OuiPartageAllocations of unit

src/french_law/law_source/unit_tests/.gitignore

@@ -0,0 +1 @@
+tests_allocations_familiales.ml

src/french_law/law_source/unit_tests/dune

@@ -0,0 +1,6 @@
+(executable
+ (name run_tests)
+ (modes native)
+ (package catala)
+ (public_name run_french_law_tests)
+ (libraries catala ANSITerminal))

src/french_law/law_source/unit_tests/run_tests.ml

@@ -0,0 +1,22 @@
+let failure = ref false
+
+let try_test msg test =
+  try
+    test ();
+    Format.printf "%s %s\n"
+      (ANSITerminal.sprintf [ ANSITerminal.green ] "PASS")
+      (ANSITerminal.sprintf [ ANSITerminal.magenta ] msg)
+  with Catala.Runtime.AssertionFailed ->
+    failure := true;
+    Format.printf "%s %s\n"
+      (ANSITerminal.sprintf [ ANSITerminal.red ] "FAIL")
+      (ANSITerminal.sprintf [ ANSITerminal.magenta ] msg)
+
+let _ =
+  try_test "Allocations familiales #1" Tests_allocations_familiales.test1;
+  try_test "Allocations familiales #2" Tests_allocations_familiales.test2;
+  try_test "Allocations familiales #3" Tests_allocations_familiales.test3;
+  try_test "Allocations familiales #4" Tests_allocations_familiales.test4;
+  try_test "Allocations familiales #5" Tests_allocations_familiales.test5;
+  try_test "Allocations familiales #6" Tests_allocations_familiales.test6;
+  exit (if !failure then -1 else 0)