From 444168f193bcc2c48fc18105f2f459aef5705d6e Mon Sep 17 00:00:00 2001
From: Anton Bachin <antonbachin@yahoo.com>
Date: Fri, 17 Jun 2016 09:47:20 -0500
Subject: [PATCH] Test the absence of warnings

The match expression rewriter inserts expressions that can cause
spurious warnings. These warnings would be especially surprising to a
user, because they would be coming from unseen generated code.

The new tests check that these warnings are properly suppressed. We
were checking this implicitly until #92.

Closes #94.
---
 tests/test_main.ml                 |  1 +
 tests/warnings/source.ml           | 41 ++++++++++++++++++++++++++++
 tests/warnings/source.ml.reference | 14 ++++++++++
 tests/warnings/test_warnings.ml    | 43 ++++++++++++++++++++++++++++++
 4 files changed, 99 insertions(+)
 create mode 100644 tests/warnings/source.ml
 create mode 100644 tests/warnings/source.ml.reference
 create mode 100644 tests/warnings/test_warnings.ml

diff --git a/tests/test_main.ml b/tests/test_main.ml
index 5aa746a2..cfb6a986 100644
--- a/tests/test_main.ml
+++ b/tests/test_main.ml
@@ -23,6 +23,7 @@ let tests = "bisect_ppx" >::: [
   Test_report.tests;
   Test_instrument.tests;
   Test_simple_cases.tests;
+  Test_warnings.tests;
   Test_line_number_directive.tests;
   Test_comments.tests;
   Test_exclude.tests;
diff --git a/tests/warnings/source.ml b/tests/warnings/source.ml
new file mode 100644
index 00000000..ee44e0a7
--- /dev/null
+++ b/tests/warnings/source.ml
@@ -0,0 +1,41 @@
+(* Trigger at least one warning to make sure they are on. *)
+let () =
+  let f ?maybe () = ignore maybe in
+  () |> f
+
+type t = A | B | C
+type u = {a : int; b : int; c : int}
+
+(* Triggers (suppressed) warning 4 without -inexhaustive-matching: fragile
+   pattern matching (due to wildcard). *)
+(* Triggers (suppressed) warning 11 without -inexhaustive-matching: unused match
+   case (wildcard). *)
+let f x =
+  match x with
+  | A | B | C -> 42
+
+(* Triggers (suppressed) warning 8 with -inexhaustive-matching: inexhaustive
+   matching. *)
+let g x =
+  match x with
+  | A | B -> 42
+  | C -> 43
+
+(* Triggers a (suppressed) duplicate set of warning 9 (missing record
+   labels). *)
+(* Triggers (suppressed) warning 27: unused variable a. *)
+let h x =
+  match x with
+  | {a} | {a} -> ignore a
+
+(* Triggers (suppressed) warning 26: unused variable x. *)
+let i x =
+  match x with
+  | (A as x) | (B as x) -> ignore x; 42
+  | C -> 43
+
+(* Triggers (suppressed) duplicate warning 28 (wildcard given to constant
+   constructor). *)
+let j x =
+  match x with
+  | A _ | B | C -> ()
diff --git a/tests/warnings/source.ml.reference b/tests/warnings/source.ml.reference
new file mode 100644
index 00000000..c55861ce
--- /dev/null
+++ b/tests/warnings/source.ml.reference
@@ -0,0 +1,14 @@
+File "source.ml", line 4, characters 8-9:
+Warning 48: implicit elimination of optional argument ?maybe
+File "source.ml", line 29, characters 4-7:
+Warning 9: the following labels are not bound in this record pattern:
+b, c
+Either bind these labels explicitly or add '; _' to the pattern.
+File "source.ml", line 29, characters 10-13:
+Warning 9: the following labels are not bound in this record pattern:
+b, c
+Either bind these labels explicitly or add '; _' to the pattern.
+File "source.ml", line 29, characters 10-13:
+Warning 12: this sub-pattern is unused.
+File "source.ml", line 41, characters 6-7:
+Warning 28: wildcard pattern given as argument to a constant constructor
diff --git a/tests/warnings/test_warnings.ml b/tests/warnings/test_warnings.ml
new file mode 100644
index 00000000..19e14d13
--- /dev/null
+++ b/tests/warnings/test_warnings.ml
@@ -0,0 +1,43 @@
+(*
+ * This file is part of Bisect_ppx.
+ * Copyright (C) 2016 Anton Bachin.
+ *
+ * Bisect is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Bisect is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <http://www.gnu.org/licenses/>.
+ *)
+
+open OUnit2
+open Test_helpers
+
+(* OCaml 4.02 and 4.03 order output of warnings 12 and 28 differently. To get
+   around that, these tests sort the output lines. *)
+let sorted_diff () =
+  run "sort < output.raw > output";
+  run "sort < ../warnings/source.ml.reference > reference";
+  diff ~preserve_as:"warnings/source.ml.reference" "_scratch/reference"
+
+let tests = "warnings" >::: [
+  test "default" begin fun () ->
+    compile
+      ((with_bisect ()) ^ " -w +A") "warnings/source.ml" ~r:"2> output.raw";
+    sorted_diff ()
+  end;
+
+  test "inexhaustive-matching" begin fun () ->
+    compile
+      ((with_bisect_args "-inexhaustive-matching") ^ " -w +A")
+      "warnings/source.ml"
+      ~r:"2> output.raw";
+    sorted_diff ()
+  end
+]