From 9f48725a064d5a9b3e22ab8612d32e69a84d3cfb Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Tue, 30 Jan 2018 20:32:35 -0600
Subject: [PATCH] remove qtest makefile and use a script instead

---
 .gitignore     |  1 -
 qtest/Makefile | 31 -------------------------
 qtest/jbuild   | 12 +++++++---
 qtest/make.ml  | 63 ++++++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 72 insertions(+), 35 deletions(-)
 delete mode 100644 qtest/Makefile
 create mode 100644 qtest/make.ml

diff --git a/.gitignore b/.gitignore
index 40f0e259..ce9ae90c 100644
--- a/.gitignore
+++ b/.gitignore
@@ -7,6 +7,5 @@ _build
 TAGS
 *.docdir
 setup.*
-qtest*
 *.html
 .merlin
diff --git a/qtest/Makefile b/qtest/Makefile
deleted file mode 100644
index 8e41bb67..00000000
--- a/qtest/Makefile
+++ /dev/null
@@ -1,31 +0,0 @@
-
-
-QTEST_PREAMBLE='open CCFun;;'
-DONTTEST=$(wildcard ../src/**/*.cppo.*) $(wildcard ../src/**/*Labels*)
-QTESTABLE=$(filter-out $(DONTTEST), \
-	$(wildcard ../src/core/*.ml) \
-	$(wildcard ../src/core/*.mli) \
-	$(wildcard ../src/data/*.ml) \
-	$(wildcard ../src/data/*.mli) \
-	$(wildcard ../src/string/*.ml) \
-	$(wildcard ../src/string/*.mli) \
-	$(wildcard ../src/unix/*.ml) \
-	$(wildcard ../src/unix/*.mli) \
-	$(wildcard ../src/sexp/*.ml) \
-	$(wildcard ../src/sexp/*.mli) \
-	$(wildcard ../src/iter/*.ml) \
-	$(wildcard ../src/iter/*.mli) \
-	$(wildcard ../src/bigarray/*.ml) \
-	$(wildcard ../src/bigarray/*.mli) \
-	$(wildcard ../src/threads/*.ml) \
-	$(wildcard ../src/threads/*.mli) \
-	)
-
-qtest-gen:
-	@if which qtest > /dev/null ; then \
-	  	echo "generate qtest"; \
-		qtest extract --preamble $(QTEST_PREAMBLE) \
-			-o run_qtest.ml \
-			$(QTESTABLE) 2> /dev/null ; \
-	else touch qtest/run_qtest.ml ; \
-	fi
diff --git a/qtest/jbuild b/qtest/jbuild
index 124f3061..e6bae520 100644
--- a/qtest/jbuild
+++ b/qtest/jbuild
@@ -1,15 +1,21 @@
 
+(executable
+  ((name make)
+   (modules (make))
+   ))
+
 (rule
   ((targets (run_qtest.ml))
-   (deps ((file Makefile)))
-   (fallback)
+   (deps (make.bc))
    ;(libraries (qtest qcheck))
    (action
-     (run make qtest-gen))
+     (run ${exe:make.bc} -target ${@}))
   ))
 
 (executable
   ((name run_qtest)
+   (modes (native))
+   (modules (run_qtest))
    (libraries (sequence gen qcheck containers containers.unix
                containers.data containers.thread containers.iter
                containers.sexp))
diff --git a/qtest/make.ml b/qtest/make.ml
new file mode 100644
index 00000000..22c8a5da
--- /dev/null
+++ b/qtest/make.ml
@@ -0,0 +1,63 @@
+
+let str_sub ?(offset=0) ~sub:s' s =
+  let open String in
+  let rec aux i =
+    i<length s && (aux_sub i 0 || aux (i+1))
+  and aux_sub i j =
+    if j = length s' then true
+    else if i+j >= length s then false
+    else get s (i+j) = get s' j && aux_sub i (j+1)
+  in
+  aux offset
+
+let is_suffix ~sub s =
+  str_sub ~offset:(String.length s - String.length sub) ~sub s
+
+let is_code file = is_suffix ~sub:".ml" file || is_suffix ~sub:".mli" file
+
+let do_not_test file =
+  assert (not (is_suffix ~sub:"make.ml" file));
+  str_sub ~sub:"Label" file ||
+  is_suffix ~sub:"containers.ml" file ||
+  is_suffix ~sub:"containers_top.ml" file ||
+  is_suffix ~sub:"mkflags.ml" file
+
+let prefix = "src"
+let dirs = List.map (fun s-> Filename.concat prefix s)
+
+let list_files dir : string list =
+  let rec f ~prefix acc file =
+    let file = Filename.concat prefix file in
+    if Sys.is_directory file then (
+      Array.fold_left (f ~prefix:file) acc (Sys.readdir file)
+    ) else (
+      if is_code file && not (do_not_test file) then file :: acc else acc
+    )
+  in
+  f ~prefix:"" [] dir
+
+let run_qtest target =
+  let files =
+    list_files "../src/"
+    |> List.map (Printf.sprintf "'%s'")
+    |> String.concat " "
+  in
+  let cmd =
+    Printf.sprintf "qtest extract --preamble 'open CCFun;;' -o %S %s 2>/dev/null"
+      target files
+  in
+  exit (Sys.command cmd)
+
+let () =
+  let target = ref "" in
+  Arg.parse ["-target", Arg.Set_string target, " set target"]
+    (fun _ -> ()) "make.ml -target file";
+  if !target="" then failwith "please specify a target";
+  if Sys.command "which qtest > /dev/null" <> 0 then (
+    (* create empty file *)
+    let out = open_out !target in
+    output_string out "";
+    close_out out;
+  ) else (
+    run_qtest !target
+  )