mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-29 08:20:20 +02:00
Code Activity

Add tests for -Wduplicate-case-datum' and -Wbad-case-datum'.

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2012-11-23 23:56:01 +01:00
parent 679a35567d
commit 5cd1030786
1 changed files with 71 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

72
test-suite/tests/tree-il.test
View file

@ -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)