mirror of
https://github.com/CatalaLang/catala.git
synced 2024-09-19 16:28:12 +03:00
Tests and fixes on structures across modules
This commit is contained in:
parent
e9a028c5f2
commit
22045a2f06
@ -747,7 +747,7 @@ let test_cmd =
|
|||||||
[
|
[
|
||||||
Nj.binding Var.post_test
|
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; }";
|
fi; }";
|
||||||
";";
|
";";
|
||||||
"test_reset";
|
"test_reset";
|
||||||
|
@ -474,7 +474,8 @@ let rec translate_expr
|
|||||||
(* This type will be resolved in Scopelang.Desambiguation *)
|
(* This type will be resolved in Scopelang.Desambiguation *)
|
||||||
let fn = Expr.make_abs [| v |] (rec_helper ~local_vars e2) [tau] pos in
|
let fn = Expr.make_abs [| v |] (rec_helper ~local_vars e2) [tau] pos in
|
||||||
Expr.eapp fn [rec_helper e1] emark
|
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 =
|
let s_uid =
|
||||||
match Ident.Map.find_opt (Mark.remove s_name) ctxt.typedefs with
|
match Ident.Map.find_opt (Mark.remove s_name) ctxt.typedefs with
|
||||||
| Some (Name_resolution.TStruct s_uid) -> s_uid
|
| Some (Name_resolution.TStruct s_uid) -> s_uid
|
||||||
@ -515,8 +516,6 @@ let rec translate_expr
|
|||||||
expected_s_fields;
|
expected_s_fields;
|
||||||
|
|
||||||
Expr.estruct ~name:s_uid ~fields:s_fields emark
|
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) -> (
|
| EnumInject (((path, (constructor, pos_constructor)), _), payload) -> (
|
||||||
let get_possible_c_uids ctxt =
|
let get_possible_c_uids ctxt =
|
||||||
try Ident.Map.find constructor ctxt.Name_resolution.constructor_idmap
|
try Ident.Map.find constructor ctxt.Name_resolution.constructor_idmap
|
||||||
@ -1425,6 +1424,7 @@ let init_scope_defs
|
|||||||
(** Main function of this module *)
|
(** Main function of this module *)
|
||||||
let translate_program (ctxt : Name_resolution.context) (surface : S.program) :
|
let translate_program (ctxt : Name_resolution.context) (surface : S.program) :
|
||||||
Ast.program =
|
Ast.program =
|
||||||
|
let top_ctx = ctxt in
|
||||||
let desugared =
|
let desugared =
|
||||||
let get_program_scopes ctxt =
|
let get_program_scopes ctxt =
|
||||||
ScopeName.Map.mapi
|
ScopeName.Map.mapi
|
||||||
@ -1455,7 +1455,7 @@ let translate_program (ctxt : Name_resolution.context) (surface : S.program) :
|
|||||||
{
|
{
|
||||||
Ast.scope_vars;
|
Ast.scope_vars;
|
||||||
scope_sub_scopes;
|
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_assertions = Ast.AssertionName.Map.empty;
|
||||||
scope_meta_assertions = [];
|
scope_meta_assertions = [];
|
||||||
scope_options = [];
|
scope_options = [];
|
||||||
|
@ -112,9 +112,10 @@ let detect_unused_struct_fields (p : program) : unit =
|
|||||||
let rec structs_fields_used_expr e struct_fields_used =
|
let rec structs_fields_used_expr e struct_fields_used =
|
||||||
match Mark.remove e with
|
match Mark.remove e with
|
||||||
| EDStructAccess { name_opt = Some name; e = e_struct; field } ->
|
| EDStructAccess { name_opt = Some name; e = e_struct; field } ->
|
||||||
|
let ctx = Program.module_ctx p.program_ctx (StructName.path name) in
|
||||||
let field =
|
let field =
|
||||||
StructName.Map.find name
|
StructName.Map.find name
|
||||||
(Ident.Map.find field p.program_ctx.ctx_struct_fields)
|
(Ident.Map.find field ctx.ctx_struct_fields)
|
||||||
in
|
in
|
||||||
StructField.Set.add field
|
StructField.Set.add field
|
||||||
(structs_fields_used_expr e_struct struct_fields_used)
|
(structs_fields_used_expr e_struct struct_fields_used)
|
||||||
|
@ -105,9 +105,10 @@ let rec translate_expr (ctx : ctx) (e : D.expr) : untyped Ast.expr boxed =
|
|||||||
| EDStructAccess { e; field; name_opt = Some name } ->
|
| EDStructAccess { e; field; name_opt = Some name } ->
|
||||||
let e' = translate_expr ctx e in
|
let e' = translate_expr ctx e in
|
||||||
let field =
|
let field =
|
||||||
|
let decl_ctx = Program.module_ctx ctx.decl_ctx (StructName.path name) in
|
||||||
try
|
try
|
||||||
StructName.Map.find name
|
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 _ ->
|
with StructName.Map.Not_found _ | Ident.Map.Not_found _ ->
|
||||||
(* Should not happen after disambiguation *)
|
(* Should not happen after disambiguation *)
|
||||||
Message.raise_spanned_error (Expr.mark_pos m)
|
Message.raise_spanned_error (Expr.mark_pos m)
|
||||||
|
@ -533,6 +533,7 @@ and typecheck_expr_top_down :
|
|||||||
A.StructName.format name
|
A.StructName.format name
|
||||||
in
|
in
|
||||||
let field =
|
let field =
|
||||||
|
let ctx = Program.module_ctx ctx (A.StructName.path name) in
|
||||||
let candidate_structs =
|
let candidate_structs =
|
||||||
try A.Ident.Map.find field ctx.ctx_struct_fields
|
try A.Ident.Map.find field ctx.ctx_struct_fields
|
||||||
with A.Ident.Map.Not_found _ ->
|
with A.Ident.Map.Not_found _ ->
|
||||||
|
@ -8,6 +8,10 @@ declaration enumeration Enum1:
|
|||||||
-- No
|
-- No
|
||||||
-- Maybe
|
-- Maybe
|
||||||
|
|
||||||
|
declaration structure Str1:
|
||||||
|
data fld1 content Enum1
|
||||||
|
data fld2 content integer
|
||||||
|
|
||||||
declaration scope S:
|
declaration scope S:
|
||||||
output sr content money
|
output sr content money
|
||||||
output e1 content Enum1
|
output e1 content Enum1
|
||||||
|
@ -6,15 +6,16 @@
|
|||||||
declaration scope S:
|
declaration scope S:
|
||||||
input x content integer
|
input x content integer
|
||||||
output o1 content Mod_def.S
|
output o1 content Mod_def.S
|
||||||
# context -- this should work
|
|
||||||
output o2 content money
|
output o2 content money
|
||||||
|
# context -- this should work
|
||||||
|
output o3 content money
|
||||||
```
|
```
|
||||||
|
|
||||||
```catala
|
```catala
|
||||||
scope S:
|
scope S:
|
||||||
definition o1 equals output of Mod_def.S
|
definition o1 equals output of Mod_def.S
|
||||||
# definition o2 equals o1.Mod_def.S.sr * 2 -- this should work ?
|
definition o2 equals o1.Mod_def.S.sr * 2. + o1.sr / 2.
|
||||||
definition o2 equals $44 * (decimal of x)
|
definition o3 equals $44 * (decimal of x)
|
||||||
```
|
```
|
||||||
|
|
||||||
```catala-test-inline
|
```catala-test-inline
|
||||||
|
@ -16,6 +16,7 @@ scope T2:
|
|||||||
definition o2 equals t1.e1
|
definition o2 equals t1.e1
|
||||||
definition o3 equals t1.sr
|
definition o3 equals t1.sr
|
||||||
definition o4 equals Mod_def.half of 10
|
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 o1 = Mod_def.Enum1.No
|
||||||
assertion o2 = Mod_def.Enum1.Maybe
|
assertion o2 = Mod_def.Enum1.Maybe
|
||||||
assertion o3 = $1000
|
assertion o3 = $1000
|
||||||
|
@ -6,20 +6,25 @@ declaration scope T:
|
|||||||
# input i content Enum1
|
# input i content Enum1
|
||||||
output o1 content Mod_def.S
|
output o1 content Mod_def.S
|
||||||
output o2 content money
|
output o2 content money
|
||||||
|
output o3 content money
|
||||||
|
|
||||||
scope T:
|
scope T:
|
||||||
definition t1.x equals 3
|
definition t1.x equals 3
|
||||||
definition o1 equals t1.o1
|
definition o1 equals t1.o1
|
||||||
definition o2 equals t1.o2
|
definition o2 equals t1.o2
|
||||||
|
definition o3 equals t1.o3
|
||||||
```
|
```
|
||||||
|
|
||||||
```catala-test-inline
|
```catala-test-inline
|
||||||
$ catala interpret -s T
|
$ catala interpret -s T
|
||||||
[RESULT] Computation successful! Results:
|
[RESULT] Computation successful! Results:
|
||||||
[RESULT] o1 = Mod_def.S { -- sr: $1,000.00 -- e1: Maybe () }
|
[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
|
> Include: mod_use.catala_en
|
||||||
|
|
||||||
```catala-test-inline
|
```catala-test-inline
|
||||||
|
@ -16,6 +16,10 @@ module S = struct
|
|||||||
type t = {sr: money; e1: Enum1.t}
|
type t = {sr: money; e1: Enum1.t}
|
||||||
end
|
end
|
||||||
|
|
||||||
|
module Str1 = struct
|
||||||
|
type t = {fld1: Enum1.t; fld2: integer}
|
||||||
|
end
|
||||||
|
|
||||||
module S_in = struct
|
module S_in = struct
|
||||||
type t = unit
|
type t = unit
|
||||||
end
|
end
|
||||||
@ -32,8 +36,8 @@ let s (s_in: S_in.t) : S.t =
|
|||||||
(fun (_: unit) -> money_of_cents_string "100000"))
|
(fun (_: unit) -> money_of_cents_string "100000"))
|
||||||
with
|
with
|
||||||
EmptyError -> (raise (NoValueProvided
|
EmptyError -> (raise (NoValueProvided
|
||||||
{filename = "tests/test_modules/good/mod_def.catala_en"; start_line=12;
|
{filename = "tests/test_modules/good/mod_def.catala_en"; start_line=16;
|
||||||
start_column=10; end_line=12; end_column=12;
|
start_column=10; end_line=16; end_column=12;
|
||||||
law_headings=["Test modules + inclusions 1"]})) in
|
law_headings=["Test modules + inclusions 1"]})) in
|
||||||
let e1_: Enum1.t =
|
let e1_: Enum1.t =
|
||||||
try
|
try
|
||||||
@ -43,8 +47,8 @@ let s (s_in: S_in.t) : S.t =
|
|||||||
(fun (_: unit) -> true) (fun (_: unit) -> Enum1.Maybe ()))
|
(fun (_: unit) -> true) (fun (_: unit) -> Enum1.Maybe ()))
|
||||||
with
|
with
|
||||||
EmptyError -> (raise (NoValueProvided
|
EmptyError -> (raise (NoValueProvided
|
||||||
{filename = "tests/test_modules/good/mod_def.catala_en"; start_line=13;
|
{filename = "tests/test_modules/good/mod_def.catala_en"; start_line=17;
|
||||||
start_column=10; end_line=13; end_column=12;
|
start_column=10; end_line=17; end_column=12;
|
||||||
law_headings=["Test modules + inclusions 1"]})) in
|
law_headings=["Test modules + inclusions 1"]})) in
|
||||||
{S.sr = sr_; S.e1 = e1_}
|
{S.sr = sr_; S.e1 = e1_}
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user