corwin/card-game.el
1
0
Fork 0
Code Issues Pull requests Projects Releases 1 Packages Wiki Activity Actions

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

Browse source 
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
Download patch file Download diff file Expand all files Collapse all files

44
test/card-games-tests.el
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 ()