CatalaLang/catala
1
1
Fork 0
mirror of https://github.com/CatalaLang/catala.git synced 2024-11-08 07:51:43 +03:00
Code Issues Projects Releases Wiki Activity

Tests and fixes on structures across modules

Browse Source
This commit is contained in:
Louis Gesbert 2023-10-03 18:19:41 +02:00
parent e9a028c5f2
commit 22045a2f06
10 changed files with 33 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
build_system/clerk_driver.ml
View File

@ -747,7 +747,7 @@ let test_cmd =
[
Nj.binding Var.post_test
[
"test_reset() { if ! diff -q $$1 $$2; then cp -f $$2 $$1; \
"test_reset() { if ! diff -q $$1 $$2 >/dev/null; then cp -f $$2 $$1; \
fi; }";
";";
"test_reset";

8
compiler/desugared/from_surface.ml
View File

@ -474,7 +474,8 @@ let rec translate_expr
(* This type will be resolved in Scopelang.Desambiguation *)
let fn = Expr.make_abs [| v |] (rec_helper ~local_vars e2) [tau] pos in
Expr.eapp fn [rec_helper e1] emark
| StructLit ((([], s_name), _), fields) ->
| StructLit (((path, s_name), _), fields) ->
let ctxt = Name_resolution.module_ctx ctxt path in
let s_uid =
match Ident.Map.find_opt (Mark.remove s_name) ctxt.typedefs with
| Some (Name_resolution.TStruct s_uid) -> s_uid
@ -515,8 +516,6 @@ let rec translate_expr
expected_s_fields;
Expr.estruct ~name:s_uid ~fields:s_fields emark
| StructLit (((_, _s_name), _), _fields) ->
Message.raise_spanned_error pos "Qualified paths are not supported yet"
| EnumInject (((path, (constructor, pos_constructor)), _), payload) -> (
let get_possible_c_uids ctxt =
try Ident.Map.find constructor ctxt.Name_resolution.constructor_idmap
@ -1425,6 +1424,7 @@ let init_scope_defs
(** Main function of this module *)
let translate_program (ctxt : Name_resolution.context) (surface : S.program) :
Ast.program =
let top_ctx = ctxt in
let desugared =
let get_program_scopes ctxt =
ScopeName.Map.mapi
@ -1455,7 +1455,7 @@ let translate_program (ctxt : Name_resolution.context) (surface : S.program) :
{
Ast.scope_vars;
scope_sub_scopes;
scope_defs = init_scope_defs ctxt s_context.var_idmap;
scope_defs = init_scope_defs top_ctx s_context.var_idmap;
scope_assertions = Ast.AssertionName.Map.empty;
scope_meta_assertions = [];
scope_options = [];

3
compiler/desugared/linting.ml
View File

@ -112,9 +112,10 @@ let detect_unused_struct_fields (p : program) : unit =
let rec structs_fields_used_expr e struct_fields_used =
match Mark.remove e with
| EDStructAccess { name_opt = Some name; e = e_struct; field } ->
let ctx = Program.module_ctx p.program_ctx (StructName.path name) in
let field =
StructName.Map.find name
(Ident.Map.find field p.program_ctx.ctx_struct_fields)
(Ident.Map.find field ctx.ctx_struct_fields)
in
StructField.Set.add field
(structs_fields_used_expr e_struct struct_fields_used)

3
compiler/scopelang/from_desugared.ml
View File

@ -105,9 +105,10 @@ let rec translate_expr (ctx : ctx) (e : D.expr) : untyped Ast.expr boxed =
| EDStructAccess { e; field; name_opt = Some name } ->
let e' = translate_expr ctx e in
let field =
let decl_ctx = Program.module_ctx ctx.decl_ctx (StructName.path name) in
try
StructName.Map.find name
(Ident.Map.find field ctx.decl_ctx.ctx_struct_fields)
(Ident.Map.find field decl_ctx.ctx_struct_fields)
with StructName.Map.Not_found _ | Ident.Map.Not_found _ ->
(* Should not happen after disambiguation *)
Message.raise_spanned_error (Expr.mark_pos m)

1
compiler/shared_ast/typing.ml
View File

@ -533,6 +533,7 @@ and typecheck_expr_top_down :
A.StructName.format name
in
let field =
let ctx = Program.module_ctx ctx (A.StructName.path name) in
let candidate_structs =
try A.Ident.Map.find field ctx.ctx_struct_fields
with A.Ident.Map.Not_found _ ->

4
tests/test_modules/good/mod_def.catala_en
View File

@ -8,6 +8,10 @@ declaration enumeration Enum1:
-- No
-- Maybe
declaration structure Str1:
data fld1 content Enum1
data fld2 content integer
declaration scope S:
output sr content money
output e1 content Enum1

7
tests/test_modules/good/mod_middle.catala_en
View File

@ -6,15 +6,16 @@
declaration scope S:
input x content integer
output o1 content Mod_def.S
# context -- this should work
output o2 content money
# context -- this should work
output o3 content money
```
```catala
scope S:
definition o1 equals output of Mod_def.S
# definition o2 equals o1.Mod_def.S.sr * 2 -- this should work ?
definition o2 equals $44 * (decimal of x)
definition o2 equals o1.Mod_def.S.sr * 2. + o1.sr / 2.
definition o3 equals $44 * (decimal of x)
```
```catala-test-inline

1
tests/test_modules/good/mod_use.catala_en
View File

@ -16,6 +16,7 @@ scope T2:
definition o2 equals t1.e1
definition o3 equals t1.sr
definition o4 equals Mod_def.half of 10
assertion (Mod_def.Str1 { -- fld1: No -- fld2: 1 }).Mod_def.Str1.fld1 = No
assertion o1 = Mod_def.Enum1.No
assertion o2 = Mod_def.Enum1.Maybe
assertion o3 = $1000

7
tests/test_modules/good/mod_use2.catala_en
View File

@ -6,20 +6,25 @@ declaration scope T:
# input i content Enum1
output o1 content Mod_def.S
output o2 content money
output o3 content money
scope T:
definition t1.x equals 3
definition o1 equals t1.o1
definition o2 equals t1.o2
definition o3 equals t1.o3
```
```catala-test-inline
$ catala interpret -s T
[RESULT] Computation successful! Results:
[RESULT] o1 = Mod_def.S { -- sr: $1,000.00 -- e1: Maybe () }
[RESULT] o2 = $132.00
[RESULT] o2 = $2,500.00
[RESULT] o3 = $132.00
```
The following tests multiple inclusion of the same module (Mod_def is used through Mod_middle here, and also directly by mod_use.catala_en included below)
> Include: mod_use.catala_en
```catala-test-inline

12
tests/test_modules/good/output/mod_def.ml
View File

@ -16,6 +16,10 @@ module S = struct
type t = {sr: money; e1: Enum1.t}
end
module Str1 = struct
type t = {fld1: Enum1.t; fld2: integer}
end
module S_in = struct
type t = unit
end
@ -32,8 +36,8 @@ let s (s_in: S_in.t) : S.t =
(fun (_: unit) -> money_of_cents_string "100000"))
with
EmptyError -> (raise (NoValueProvided
{filename = "tests/test_modules/good/mod_def.catala_en"; start_line=12;
start_column=10; end_line=12; end_column=12;
{filename = "tests/test_modules/good/mod_def.catala_en"; start_line=16;
start_column=10; end_line=16; end_column=12;
law_headings=["Test modules + inclusions 1"]})) in
let e1_: Enum1.t =
try
@ -43,8 +47,8 @@ let s (s_in: S_in.t) : S.t =
(fun (_: unit) -> true) (fun (_: unit) -> Enum1.Maybe ()))
with
EmptyError -> (raise (NoValueProvided
{filename = "tests/test_modules/good/mod_def.catala_en"; start_line=13;
start_column=10; end_line=13; end_column=12;
{filename = "tests/test_modules/good/mod_def.catala_en"; start_line=17;
start_column=10; end_line=17; end_column=12;
law_headings=["Test modules + inclusions 1"]})) in
{S.sr = sr_; S.e1 = e1_}