Merge pull request #512 from NathanReb/fix-main-module-name

Fix extension removal bug in `Code_path.main_module_name`

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)

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
   {

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"
+|}]