diff --git a/NEWS b/NEWS index 05f9f5c..6967144 100644 --- a/NEWS +++ b/NEWS @@ -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 diff --git a/card-games-bridge.el b/card-games-bridge.el index 2884ac8..357b3fc 100644 --- a/card-games-bridge.el +++ b/card-games-bridge.el @@ -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))))))))))) diff --git a/card-games-trick-ext.el b/card-games-trick-ext.el index f2b4319..f0fc4bb 100644 --- a/card-games-trick-ext.el +++ b/card-games-trick-ext.el @@ -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)))))) diff --git a/test/card-games-tests.el b/test/card-games-tests.el index e43adee..11788a2 100644 --- a/test/card-games-tests.el +++ b/test/card-games-tests.el @@ -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 ()