diff --git a/compiler/dcalc/from_scopelang.ml b/compiler/dcalc/from_scopelang.ml index 58d60d2a..d9831a47 100644 --- a/compiler/dcalc/from_scopelang.ml +++ b/compiler/dcalc/from_scopelang.ml @@ -919,11 +919,11 @@ let translate_scope_decl let date_rounding : date_rounding = match List.find_opt - (function Desugared.Ast.DateRounding _ -> true) + (function Desugared.Ast.DateRounding _, _ -> true) sigma.scope_options with - | Some (Desugared.Ast.DateRounding Desugared.Ast.Increasing) -> RoundUp - | Some (DateRounding Decreasing) -> RoundDown + | Some (Desugared.Ast.DateRounding Desugared.Ast.Increasing, _) -> RoundUp + | Some (DateRounding Decreasing, _) -> RoundDown | None -> AbortOnRound in let ctx = { ctx with date_rounding } in diff --git a/compiler/desugared/ast.ml b/compiler/desugared/ast.ml index 0da37c71..a46f5a1a 100644 --- a/compiler/desugared/ast.ml +++ b/compiler/desugared/ast.ml @@ -197,7 +197,7 @@ type scope = { scope_uid : ScopeName.t; scope_defs : scope_def ScopeDefMap.t; scope_assertions : assertion list; - scope_options : catala_option list; + scope_options : catala_option Marked.pos list; scope_meta_assertions : meta_assertion list; } diff --git a/compiler/desugared/ast.mli b/compiler/desugared/ast.mli index 9429ecff..224b8cd2 100644 --- a/compiler/desugared/ast.mli +++ b/compiler/desugared/ast.mli @@ -120,7 +120,7 @@ type scope = { scope_uid : ScopeName.t; scope_defs : scope_def ScopeDefMap.t; scope_assertions : assertion list; - scope_options : catala_option list; + scope_options : catala_option Marked.pos list; scope_meta_assertions : meta_assertion list; } diff --git a/compiler/desugared/from_surface.ml b/compiler/desugared/from_surface.ml index 09097d90..6449aa49 100644 --- a/compiler/desugared/from_surface.ml +++ b/compiler/desugared/from_surface.ml @@ -1153,16 +1153,21 @@ let process_scope_use_item let new_scope = match List.find_opt - (fun scope_opt -> + (fun (scope_opt, _) -> scope_opt = Ast.DateRounding Ast.Increasing || scope_opt = Ast.DateRounding Ast.Decreasing) scope.scope_options with - | Some _ -> - Errors.raise_spanned_error (Marked.get_mark item) - "A date rounding mode has already been specified" + | Some (_, old_pos) -> + Errors.raise_multispanned_error + [None, old_pos; None, Marked.get_mark item] + "You cannot set multiple date rounding modes" | None -> - { scope with scope_options = Ast.DateRounding r :: scope.scope_options } + { + scope with + scope_options = + Marked.same_mark_as (Ast.DateRounding r) item :: scope.scope_options; + } in { prgm with diff --git a/compiler/scopelang/ast.ml b/compiler/scopelang/ast.ml index 543acb73..4355945d 100644 --- a/compiler/scopelang/ast.ml +++ b/compiler/scopelang/ast.ml @@ -49,7 +49,7 @@ type 'm scope_decl = { scope_sig : (typ * Desugared.Ast.io) ScopeVar.Map.t; scope_decl_rules : 'm rule list; scope_mark : 'm mark; - scope_options : Desugared.Ast.catala_option list; + scope_options : Desugared.Ast.catala_option Marked.pos list; } type 'm program = { diff --git a/compiler/scopelang/ast.mli b/compiler/scopelang/ast.mli index 6a5e339d..6d280abc 100644 --- a/compiler/scopelang/ast.mli +++ b/compiler/scopelang/ast.mli @@ -41,7 +41,7 @@ type 'm scope_decl = { scope_sig : (typ * Desugared.Ast.io) ScopeVar.Map.t; scope_decl_rules : 'm rule list; scope_mark : 'm mark; - scope_options : Desugared.Ast.catala_option list; + scope_options : Desugared.Ast.catala_option Marked.pos list; } type 'm program = { diff --git a/tests/test_date/bad/rounding_option_conflict.catala_en b/tests/test_date/bad/rounding_option_conflict.catala_en index 44c9f4b2..0a5217cc 100644 --- a/tests/test_date/bad/rounding_option_conflict.catala_en +++ b/tests/test_date/bad/rounding_option_conflict.catala_en @@ -25,7 +25,13 @@ scope Test: ```catala-test-inline $ catala Interpret -s Test -[ERROR] A date rounding mode has already been specified +[ERROR] You cannot set multiple date rounding modes + +┌─⯈ tests/test_date/bad/rounding_option_conflict.catala_en:10.13-23: +└──┐ +10 │ date round decreasing + │ ‾‾‾‾‾‾‾‾‾‾ + ┌─⯈ tests/test_date/bad/rounding_option_conflict.catala_en:12.13-23: └──┐