diff --git a/CHANGES.md b/CHANGES.md index dc017776e..07221aaa6 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -14,6 +14,10 @@ details. ### Other changes +- Fix a bug where `Code_path.main_module_name` would not properly remove + extensions from the filename and therefore return an invalid module name. + (#512, @NathanReb) + - Add `-unused-type-warnings` flag to the driver to allow users to disable only the generation of warning 34 silencing structure items when using `[@@deriving ...]` on type declarations. (#511, @mbarbin, @NathanReb) diff --git a/src/code_path.ml b/src/code_path.ml index f76713b28..d8490d957 100644 --- a/src/code_path.ml +++ b/src/code_path.ml @@ -10,9 +10,14 @@ type t = { in_expr : bool; } +let remove_all_extensions basename = + match String.split_on_char ~sep:'.' basename with + | [] -> assert false (* split_on_char never returns the empty list *) + | name :: _ -> name + let top_level ~file_path = let main_module_name = - file_path |> Stdlib.Filename.basename |> Stdlib.Filename.remove_extension + file_path |> Stdlib.Filename.basename |> remove_all_extensions |> String.capitalize_ascii in { diff --git a/test/code_path/test.ml b/test/code_path/test.ml index c0aeff2b4..791c551c7 100644 --- a/test/code_path/test.ml +++ b/test/code_path/test.ml @@ -142,3 +142,14 @@ let _ = - : string = "(code_path(main_module_name Test)(submodule_path())(enclosing_module Test)(enclosing_value())(value())(fully_qualified_path Test))" |}] + + +let _ = + (* The main module name should properly remove all extensions *) + let code_path = + Code_path.top_level ~file_path:"some_dir/module_name.cppo.ml" + in + Code_path.main_module_name code_path +[%%expect{| +- : string = "Module_name" +|}]