diff --git a/compiler/driver.ml b/compiler/driver.ml index e1db1de6..a4362364 100644 --- a/compiler/driver.ml +++ b/compiler/driver.ml @@ -62,8 +62,10 @@ let load_module_interfaces options includes program = (Format.pp_print_list ~pp_sep:Format.pp_print_space File.format) ms in - (* modulename * program * (id -> modulename) *) - let rec aux req_chain seen uses = + let rec aux req_chain seen uses : + (ModuleName.t * Surface.Ast.interface * ModuleName.t Ident.Map.t) option + File.Map.t + * ModuleName.t Ident.Map.t = List.fold_left (fun (seen, use_map) use -> let f = find_module req_chain use.Surface.Ast.mod_use_name in @@ -297,11 +299,14 @@ module Commands = struct let get_scope_uid (ctx : decl_ctx) (scope : string) : ScopeName.t = if String.contains scope '.' then - Message.raise_error "Only references to the top-level module are allowed"; + Message.raise_error + "Bad scope argument @{%s@}: only references to the top-level \ + module are allowed" + scope; try Ident.Map.find scope ctx.ctx_scope_index with Ident.Map.Not_found _ -> Message.raise_error - "There is no scope @{\"%s\"@} inside the program." scope + "There is no scope \"@{%s@}\" inside the program." scope (* TODO: this is very weird but I'm trying to maintain the current behaviour for now *) diff --git a/compiler/surface/lexer.cppo.ml b/compiler/surface/lexer.cppo.ml index 9107c480..b07409d6 100644 --- a/compiler/surface/lexer.cppo.ml +++ b/compiler/surface/lexer.cppo.ml @@ -819,6 +819,11 @@ let line_dir_arg_re = eol ]) +(* This is a bit cheap, but we don't want a full-fledged parser to handle these + trivial line directives. Here we extract the first uppercase argument of a + directive line, which is guaranteed to match the module name we are + interested in and nothing else (e.g. in French, the module usage "keywords" + are multiple words) *) let line_dir_arg_upcase_re = Re.(compile @@ seq [ bos; char '>'; rep space; rep1 alpha; @@ -840,23 +845,27 @@ let lex_line (lexbuf : lexbuf) : (string * L.line_token) option = Some (str, LINE_TEST id) with Not_found -> Message.emit_spanned_warning (Pos.from_lpos (lexing_positions lexbuf)) - "Ignored invalid test section, must have an explicit `{ id = \"name\" }` specification"; + "Ignored invalid test section, must have an explicit \ + `{ id = \"name\" }` specification"; Some (str, LINE_ANY)) | "```", Star hspace, ('\n' | eof) -> Some (Utf8.lexeme lexbuf, LINE_BLOCK_END) - | '>', Star hspace, MR_LAW_INCLUDE, Star hspace, ':', Plus (Compl '\n'), ('\n' | eof) -> + | '>', Star hspace, MR_LAW_INCLUDE, Star hspace, ':', Plus (Compl '\n'), + ('\n' | eof) -> let str = Utf8.lexeme lexbuf in (try let file = Re.Group.get (Re.exec line_dir_arg_re str) 1 in Some (str, LINE_INCLUDE file) with Not_found -> Some (str, LINE_ANY)) - | '>', Star hspace, MR_MODULE_DEF, Plus hspace, uppercase, Star (Compl '\n'), ('\n' | eof) -> + | '>', Star hspace, MR_MODULE_DEF, Plus hspace, uppercase, Star (Compl '\n'), + ('\n' | eof) -> let str = Utf8.lexeme lexbuf in (try let mdl = Re.Group.get (Re.exec line_dir_arg_upcase_re str) 1 in Some (str, LINE_MODULE_DEF mdl) with Not_found -> Some (str, LINE_ANY)) - | '>', Star hspace, MR_MODULE_USE, Plus hspace, uppercase, Star (Compl '\n'), ('\n' | eof) -> + | '>', Star hspace, MR_MODULE_USE, Plus hspace, uppercase, Star (Compl '\n'), + ('\n' | eof) -> let str = Utf8.lexeme lexbuf in (try let mdl = Re.Group.get (Re.exec line_dir_arg_upcase_re str) 1 in diff --git a/compiler/surface/parser_driver.ml b/compiler/surface/parser_driver.ml index 44bbaf1f..27fa32d1 100644 --- a/compiler/surface/parser_driver.ml +++ b/compiler/surface/parser_driver.ml @@ -403,8 +403,13 @@ let check_modname program source_file = (Cli.FileName file | Cli.Contents (_, file) | Cli.Stdin file) ) when not File.(equal mname Filename.(remove_extension (basename file))) -> Message.raise_spanned_error pos - "Module declared as @{%s@}, which does not match the file name %a" + "@[Module declared as@ @{%s@},@ which@ does@ not@ match@ the@ \ + file@ name@ %a.@ Rename the module to@ @{%s@}@ or@ the@ file@ to@ \ + %a.@]" mname File.format file + (String.capitalize_ascii Filename.(remove_extension (basename file))) + File.format + File.((dirname file / mname) ^ Filename.extension file) | _ -> () let load_interface source_file = diff --git a/tests/test_modules/bad/mod_badname.catala_en b/tests/test_modules/bad/mod_badname.catala_en index ba0ea1bf..52546f09 100644 --- a/tests/test_modules/bad/mod_badname.catala_en +++ b/tests/test_modules/bad/mod_badname.catala_en @@ -4,7 +4,10 @@ ```catala-test-inline $ catala typecheck [ERROR] -Module declared as This_is_not_the_file_name, which does not match the file name "tests/test_modules/bad/mod_badname.catala_en" +Module declared as This_is_not_the_file_name, which does not match the file +name "tests/test_modules/bad/mod_badname.catala_en". Rename the module to +Mod_badname or the file to +"tests/test_modules/bad/This_is_not_the_file_name.catala_en". ┌─⯈ tests/test_modules/bad/mod_badname.catala_en:1.10-1.35: └─┐