Stop the AI from sorting hands in place; unskip full-game tests

Under Emacs 28 and earlier, sort relinks a list destructively, so the
variable that held the old head can end up holding only a tail.  Four
computer-player choices sorted a list that shared structure with the
player's stored hand (cl-remove-if-not returns its argument when it
removes nothing), so Bridge, Briscola, Pitch and Euchre dropped cards
from hands mid-deal and then stopped on (= nil N).  Emacs 29's sort
reorders in place, which hid the bug there.

The previous commit skipped cgt-bridge-full and cgt-trick-ext-full
unless SVG is available, but both render text in batch; they failed
on Emacs 27 for this reason, not for want of SVG.

* card-games-bridge.el (card-games-bridge--ai-play):
* card-games-trick-ext.el (card-games-tx--ai)
(card-games-trick--ai-play) <pitch>: Sort a copy, never the hand.
* test/card-games-tests.el (cgt-bridge-full, cgt-trick-ext-full):
Drop the SVG skip.
(cgt--hands-snapshot, cgt-ai-play-leaves-hands-alone): New test; it
fails without the fix on Emacs 27 and on Emacs 29.
* NEWS: Note the fix.

Assisted-by: Mentat (for Corwin; claude-opus-5-5)
This commit is contained in:
Corwin Brust 2026-10-05 15:58:25 -05:00
parent e78fe38381
commit 74af63a089
4 changed files with 57 additions and 7 deletions

10
NEWS
View file

@ -3,6 +3,16 @@ card-games NEWS -- user-visible changes
* Version 1.0.92 (pretest3: MELPA review)
** Bug fixes
- Bridge, Briscola, Pitch and Euchre no longer lose cards from a
hand part-way through a deal under Emacs 28 and earlier. The
computer players sorted a list that shared structure with the
hand; ~sort~ before Emacs 29 relinks the list, which cut cards
out of the hand and later stopped play with a type error. Emacs
29 and later were unaffected. The full-game Bridge and trick
tests no longer skip without SVG, and a new test checks that a
computer player's choice leaves every hand unchanged.
** Packaging and internals
- card-games-net requires subr-x. It calls ~string-empty-p~, which
lives in subr-x before Emacs 29, so a fresh Emacs 27 failed every

View file

@ -417,7 +417,7 @@ vulnerability, and TRICKS the declarer side's trick count. Keys:
((and partner (>= (length trick) 1))
(car (sort (copy-sequence legal) (lambda (a b) (< (cdr a) (cdr b))))))
;; can win: take it with the cheapest winner
(winners (car (sort winners (lambda (a b) (< (cdr a) (cdr b))))))
(winners (car (sort (copy-sequence winners) (lambda (a b) (< (cdr a) (cdr b))))))
;; cannot win: discard lowest
(t (car (sort (copy-sequence legal) (lambda (a b) (< (cdr a) (cdr b)))))))))))

View file

@ -98,9 +98,9 @@ POWERFN, LEDFN rank cards; VALUEFN gives a card's point worth."
trump powerfn ledfn))
(push c winners) (push c losers)))
(if winners
(car (sort winners (lambda (a b) (< (funcall powerfn a trump led)
(car (sort (copy-sequence winners) (lambda (a b) (< (funcall powerfn a trump led)
(funcall powerfn b trump led)))))
(car (sort (or losers legal)
(car (sort (copy-sequence (or losers legal))
(lambda (a b) (< (funcall valuefn a) (funcall valuefn b))))))))))
(defun card-games-tx--plain-led (card _trump) "Return CARD's suit (the plain led suit)." (car card))
@ -236,8 +236,8 @@ SEAT plays CARD as usual once trump is fixed."
(dotimes (s 4)
(let ((v (card-games-pitch--suit-strength game seat s)))
(when (> v bestv) (setq bestv v best s))))
(car (sort (cl-remove-if-not (lambda (c) (= (car c) best))
(card-games-trick--hand game seat))
(car (sort (copy-sequence (cl-remove-if-not (lambda (c) (= (car c) best))
(card-games-trick--hand game seat)))
(lambda (a b) (> (cdr a) (cdr b))))))
(card-games-tx--ai game seat #'card-games-pitch--power #'card-games-tx--plain-led
(lambda (c) (card-games-pitch--pip (cdr c))))))

View file

@ -1570,7 +1570,6 @@ left a 15-card hand in play."
(setq s (+ s (card-games-bris--points (cons su r)))))) s))))
(ert-deftest cgt-trick-ext-full ()
(skip-unless (image-type-available-p 'svg))
(dolist (class '(card-games-briscola-game card-games-pitch-game card-games-euchre-game))
(let ((g (make-instance class)) (guard 0))
(card-games-trick--new g)
@ -1618,7 +1617,6 @@ left a 15-card hand in play."
'((0 . (0 . 12)) (1 . (3 . 0)) (2 . (0 . 2)) (3 . (0 . 5))) 3))))
(ert-deftest cgt-bridge-full ()
(skip-unless (image-type-available-p 'svg))
(let ((scored 0) (passed 0))
(dotimes (i 12)
(let ((g (card-games-bridge-game)) (guard 0))
@ -1641,6 +1639,48 @@ left a 15-card hand in play."
(should (memq (card-games-get g :phase) '(scored passed-out)))
(should (stringp (card-games-render g)))))
(should (> scored 0))))
;;;; AI choice leaves the hands alone
(defun cgt--hands-snapshot (g)
"Return a deep copy of G's :hands, for comparing before and after."
(mapcar #'copy-sequence (append (card-games-get g :hands) nil)))
(ert-deftest cgt-ai-play-leaves-hands-alone ()
"Choosing a card must neither reorder nor shorten any hand.
A destructive `sort' on a list that shares structure with a hand
drops cards from it under Emacs 28 and earlier, and reorders it in
place under Emacs 29 and later; this catches both."
;; Bridge
(dotimes (i 4)
(let ((g (card-games-bridge-game)) (guard 0))
(card-games-put g :dealer i)
(card-games-bridge--deal g)
(while (and (eq (card-games-get g :phase) 'auction) (< guard 60))
(cl-incf guard)
(let* ((s (card-games-get g :bidder)) (call (card-games-bridge--ai-call g s)))
(unless (card-games-bridge--legal-call-p g call) (setq call 'pass))
(card-games-bridge--apply-call g s call)
(card-games-bridge--auction-done-p g)))
(let ((p 0))
(while (and (eq (card-games-get g :phase) 'play) (< p 60))
(cl-incf p)
(let* ((s (card-games-get g :turn)) (before (cgt--hands-snapshot g))
(c (card-games-bridge--ai-play g s)))
(should (equal before (cgt--hands-snapshot g)))
(card-games-bridge--play-card g s c))))))
;; Briscola, Pitch, Euchre
(dolist (class '(card-games-briscola-game card-games-pitch-game card-games-euchre-game))
(let ((g (make-instance class)) (guard 0))
(card-games-trick--new g)
(while (and (not (eq (card-games-get g :phase) 'game-over)) (< guard 400))
(cl-incf guard)
(if (card-games-trick--hand-over-p g)
(card-games-trick--finish-hand g)
(let* ((s (card-games-get g :turn)) (before (cgt--hands-snapshot g))
(c (card-games-trick--ai-play g s)))
(should (equal before (cgt--hands-snapshot g)))
(card-games-trick--play g s c)))))))
;;;; Renderer registry / region keystone
(ert-deftest cgt-keystone-regions ()