From 60a6a789a1e4dbac5373bc44a9aa005b618e3716 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Thu, 1 Jan 1970 00:00:00 +0000
Subject: [PATCH] Add program to test the Format module, and Sudoku program.

---
 .hgignore            |  2 ++
 ocaml/Makefile       | 17 +++++++++++++++--
 ocaml/sudoku.input   |  9 +++++++++
 ocaml/sudoku.ml      | 29 +++++++++++++++++++++++++++++
 ocaml/test_format.ml | 22 ++++++++++++++++++++++
 5 files changed, 77 insertions(+), 2 deletions(-)
 create mode 100644 ocaml/sudoku.input
 create mode 100644 ocaml/sudoku.ml
 create mode 100644 ocaml/test_format.ml

diff --git a/.hgignore b/.hgignore
index fd99d20..194037a 100644
--- a/.hgignore
+++ b/.hgignore
@@ -75,6 +75,8 @@ ocaml/test1
 ocaml/test2
 ocaml/test3
 ocaml/test4
+ocaml/test_format
+ocaml/sudoku
 ocaml/*.exe
 ocaml/*.cmi
 ocaml/*.cmx
diff --git a/ocaml/Makefile b/ocaml/Makefile
index 9cdd77e..723a526 100644
--- a/ocaml/Makefile
+++ b/ocaml/Makefile
@@ -1,7 +1,8 @@
 # -*- Makefile -*-
 # Test programs for testing out the cross-compiler.
 
-all: test1 test1.exe test2 test2.exe test3 test3.exe test4 test4.exe
+all: test1 test1.exe test2 test2.exe test3 test3.exe test4 test4.exe \
+	test_format test_format.exe sudoku sudoku.exe
 
 test1: test1.ml
 	ocamlopt $< -o $@
@@ -27,5 +28,17 @@ test4: test4.ml
 test4.exe: test4.ml
 	i686-pc-mingw32-ocamlopt graphics.cmxa $< -o $@
 
+test_format: test_format.ml
+	ocamlopt $< -o $@
+
+test_format.exe: test_format.ml
+	i686-pc-mingw32-ocamlopt $< -o $@
+
+sudoku: sudoku.ml
+	ocamlopt $< -o $@
+
+sudoku.exe: sudoku.ml
+	i686-pc-mingw32-ocamlopt $< -o $@
+
 clean:
-	rm -f test1 test2 test3 test4 *.exe *.cmi *.cmx *.o
+	rm -f test[1-4] test_format sudoku *.exe *.cmi *.cmx *.o
diff --git a/ocaml/sudoku.input b/ocaml/sudoku.input
new file mode 100644
index 0000000..d7a4043
--- /dev/null
+++ b/ocaml/sudoku.input
@@ -0,0 +1,9 @@
+001005300
+050490000
+000102064
+000000750
+600000001
+035000000
+460903000
+000024090
+003600100
\ No newline at end of file
diff --git a/ocaml/sudoku.ml b/ocaml/sudoku.ml
new file mode 100644
index 0000000..65dd3b2
--- /dev/null
+++ b/ocaml/sudoku.ml
@@ -0,0 +1,29 @@
+(* Jon Harrop's Sudoku Solver in 19 lines of code, from:
+ * http://www.ffconsultancy.com/ocaml/sudoku/index.html
+ *)
+
+let m = Array.init 9 (fun _ -> input_line stdin)
+
+let print() = Array.iter print_endline m
+
+let rec invalid ?(i=0) x y n =
+  i<9 && (m.(y).[i] = n || m.(i).[x] = n ||
+      m.(y/3*3 + i/3).[x/3*3 + i mod 3] = n || invalid ~i:(i+1) x y n)
+
+
+let rec fold f accu l u = if l=u then accu else fold f (f accu l) (l+1) u
+
+let rec search ?(x=0) ?(y=0) f accu = match x, y with
+    9, y -> search ~x:0 ~y:(y+1) f accu (* Next row *)
+  | 0, 9 -> f accu                      (* Found a solution *)
+  | x, y ->
+      if m.(y).[x] <> '0' then search ~x:(x+1) ~y f accu else
+        fold (fun accu n ->
+                let n = Char.chr (n + 48) in
+                if invalid x y n then accu else
+                  (m.(y).[x] <- n;
+                   let accu = search ~x:(x+1) ~y f accu in
+                   m.(y).[x] <- '0';
+                   accu)) accu 1 10
+
+let () = Printf.printf "%d solutions\n" (search (fun i -> print(); i+1) 0)
diff --git a/ocaml/test_format.ml b/ocaml/test_format.ml
new file mode 100644
index 0000000..3f2f128
--- /dev/null
+++ b/ocaml/test_format.ml
@@ -0,0 +1,22 @@
+(* Test the Format module, which we suspect may not be working. *)
+
+open Format
+
+let debug = false
+
+let () =
+  if debug then Printf.printf "creating buffer ...\n%!";
+  let buf = Buffer.create 100 in
+  if debug then Printf.printf "creating formatter ...\n%!";
+  let fmt = formatter_of_buffer buf in
+  if debug then Printf.printf "open box ...\n%!";
+  pp_open_box fmt 0;
+  if debug then Printf.printf "print string ...\n%!";
+  pp_print_string fmt "This is a string";
+  if debug then Printf.printf "close box ...\n%!";
+  pp_close_box fmt ();
+  if debug then Printf.printf "flush ...\n%!";
+  pp_print_flush fmt ();
+  if debug then Printf.printf "get buffer contents ...\n%!";
+  let str = Buffer.contents buf in
+  Printf.printf "contents of buffer = %S\n%!" str
-- 
1.8.3.1