common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

case: warn about duplicate keys in the same clause

Browse source
This commit is contained in:
Stas Boukarev 2026-09-09 02:12:55 +03:00
parent e019d6a878
commit 4c24ec8547
3 changed files with 14 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
src/code/macros.lisp
View file

@ -847,10 +847,11 @@ invoked. In that case it will store into PLACE and start over."
(lambda (condition stream)
(format stream
"Duplicate key ~S in ~S form, ~
occurring in~{~#[~; and~]~{ clause ~a:~%~< ~S~:>~}~^,~}."
occurring in ~{~{clause ~a:~%~< ~S~:>~}~^~#[~;, and ~:;, ~]~}"
(case-warning-key condition)
(case-warning-case-kind condition)
(duplicate-case-key-warning-occurrences condition)))))
(remove-duplicates (duplicate-case-key-warning-occurrences condition)
:test #'equal)))))
;;; Return three values:
;;; 1. an array of LAYOUT
@ -1137,16 +1138,15 @@ invoked. In that case it will store into PLACE and start over."
(case-position 1 (1+ case-position)))
((null cases) nil)
(flet ((check-clause (case-keys)
(loop for k in case-keys
for existing = (gethash k keys-seen)
do (when existing
(warn 'duplicate-case-key-warning
:key k
:case-kind name
:occurrences `(,existing (,case-position (,clause))))))
(let ((record (list case-position (list clause))))
(dolist (k case-keys)
(setf (gethash k keys-seen) record))))
(loop for k in case-keys
for existing = (gethash k keys-seen)
do (when existing
(warn 'duplicate-case-key-warning
:key k
:case-kind name
:occurrences `(,existing (,case-position (,clause)))))
(setf (gethash k keys-seen) record))))
(testify (k)
(wrap-if
(and (eq test 'typep)

3
tests/case.pure.lisp
View file

@ -29,7 +29,8 @@
("Duplicate key 2 in CASE form, occurring in clause 1: ((1 2) 1), and clause 2: ((2 3) 2)"
case ((1 2) 1)
((2 3) 2))
("Duplicate key 1 in CASE form, occurring in clause 1: ((1 1) 1)"
case ((1 1) 1))
(nil
case (#1=(1) 1)
((#1#) 2)))

2
tests/compiler.pure.lisp
View file

@ -4466,7 +4466,7 @@
(logand 254
(case x
((3) x)
((2 2 0 -2 -1 2) 9223372036854775803)
((0 -2 -1) 9223372036854775803)
(t 358458651))))
((-10470605025) 26)))