Display a warning for bad jbuild-ignore lines (#389)

jbuild-ignore should only refer to directories in the current directory
(unlike .gitignore): referring to subdirectories doesn't work.

Signed-off-by: David Allsopp <david.allsopp@metastack.com>

CHANGES.md

@@ -65,12 +65,13 @@ next
   `META.pkg.template`. This feature was unused and was making the code
   complicated (#370)
 
-
 - Remove read-only attribute on Windows before unlink (#247)
 
 - Use /Fo instead of -o when invoking the Microsoft C compiler to eliminate
   deprecation warning when compiling C++ sources (#354)
 
+- Display a warning for invalid lines in jbuild-ignore (#389)
+
 1.0+beta16 (05/11/2017)
 -----------------------
 

src/file_tree.ml

@@ -65,8 +65,20 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) path =
     let files = String_set.of_list files in
     let ignored_sub_dirs =
       if not ignored && String_set.mem "jbuild-ignore" files then
-        String_set.of_list
-          (Io.lines_of_file (Path.to_string (Path.relative path "jbuild-ignore")))
+        let ignore_file = Path.to_string (Path.relative path "jbuild-ignore") in
+        let files =
+          Io.lines_of_file ignore_file
+        in
+        let remove_subdirs index fn =
+          if Filename.dirname fn = Filename.current_dir_name then
+            true
+          else begin
+            Loc.(warn (of_pos (ignore_file, index + 1, 0, String.length fn))
+            "subdirectory expression %s ignored" fn);
+            false
+          end
+        in
+        String_set.of_list (List.filteri ~f:remove_subdirs files)
       else
         String_set.empty
     in

src/import.ml

@@ -65,6 +65,18 @@ module List = struct
       | None -> filter_map l ~f
       | Some x -> x :: filter_map l ~f
 
+  let filteri l ~f =
+    let rec filteri l i =
+      match l with
+      | [] -> []
+      | x :: l ->
+        let i' = succ i in
+        if f i x
+        then x :: filteri l i'
+        else filteri l i'
+    in
+    filteri l 0
+
   let concat_map l ~f = concat (map l ~f)
 
   let rev_partition_map =