From 5cd10307866e6e6c44cb46b366f71d4118fa6aed Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 23 Nov 2012 23:56:01 +0100
Subject: [PATCH] Add tests for `-Wduplicate-case-datum' and
 `-Wbad-case-datum'.

* test-suite/tests/tree-il.test (%opts-w-duplicate-case-datum,
  %opts-w-bad-case-datum): New variables.
  ("warnings")["duplicate-case-datum", "bad-case-datum"]: New tests.
---
 test-suite/tests/tree-il.test | 72 ++++++++++++++++++++++++++++++++++-
 1 file changed, 71 insertions(+), 1 deletion(-)

diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 1df72e848..68dfc32c7 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -776,6 +776,12 @@
 (define %opts-w-format
   '(#:warnings (format)))
 
+(define %opts-w-duplicate-case-datum
+  '(#:warnings (duplicate-case-datum)))
+
+(define %opts-w-bad-case-datum
+  '(#:warnings (bad-case-datum)))
+
 
 (with-test-prefix "warnings"
 
@@ -1780,7 +1786,71 @@
                               #:opts %opts-w-format
                               #:to 'assembly)))))
            (and (= (length w) 1)
-                (number? (string-contains (car w) "unsupported format option"))))))))
+                (number? (string-contains (car w) "unsupported format option")))))))
+
+   (with-test-prefix "duplicate-case-datum"
+
+     (pass-if "quiet"
+       (null? (call-with-warnings
+                (lambda ()
+                  (compile '(case x ((1) 'one) ((2) 'two))
+                           #:opts %opts-w-duplicate-case-datum
+                           #:to 'assembly)))))
+
+     (pass-if "one duplicate"
+       (let ((w (call-with-warnings
+                  (lambda ()
+                    (compile '(case x
+                                ((1) 'one)
+                                ((2) 'two)
+                                ((1) 'one-again))
+                             #:opts %opts-w-duplicate-case-datum
+                             #:to 'assembly)))))
+         (and (= (length w) 1)
+              (number? (string-contains (car w) "duplicate")))))
+
+     (pass-if "one duplicate"
+       (let ((w (call-with-warnings
+                  (lambda ()
+                    (compile '(case x
+                                ((1 2 3) 'a)
+                                ((1)     'one))
+                             #:opts %opts-w-duplicate-case-datum
+                             #:to 'assembly)))))
+         (and (= (length w) 1)
+              (number? (string-contains (car w) "duplicate"))))))
+
+   (with-test-prefix "bad-case-datum"
+
+     (pass-if "quiet"
+       (null? (call-with-warnings
+                (lambda ()
+                  (compile '(case x ((1) 'one) ((2) 'two))
+                           #:opts %opts-w-bad-case-datum
+                           #:to 'assembly)))))
+
+     (pass-if "not eqv?"
+       (let ((w (call-with-warnings
+                  (lambda ()
+                    (compile '(case x
+                                ((1)     'one)
+                                (("bad") 'bad))
+                             #:opts %opts-w-bad-case-datum
+                             #:to 'assembly)))))
+         (and (= (length w) 1)
+              (number? (string-contains (car w)
+                                        "cannot be meaningfully compared")))))
+
+     (pass-if "one clause element not eqv?"
+       (let ((w (call-with-warnings
+                  (lambda ()
+                    (compile '(case x
+                                ((1 (2) 3) 'a))
+                             #:opts %opts-w-duplicate-case-datum
+                             #:to 'assembly)))))
+         (and (= (length w) 1)
+              (number? (string-contains (car w)
+                                        "cannot be meaningfully compared")))))))
 
 ;; Local Variables:
 ;; eval: (put 'pass-if-primitives-resolved 'scheme-indent-function 1)