]> code.delx.au - gnu-emacs-elpa/commitdiff
Wrote a testing function for emacs-chess, which computes the legality of plies
authorJohn Wiegley <johnw@newartisans.com>
Mon, 1 Sep 2008 04:23:05 +0000 (00:23 -0400)
committerJohn Wiegley <johnw@newartisans.com>
Mon, 1 Sep 2008 04:23:05 +0000 (00:23 -0400)
for a database of known legal games.

chess-test.el

index 2afd7cd6d2f50f8c8b5465b2b0af524d44d8908e..1e59566e884af8d8c75a1248436cc3647b4f6034 100644 (file)
@@ -1,3 +1,47 @@
 ;; Soon: Put Emacs Chess through an enormous battery of tests.
 
-(defun chess-test () t)
+(eval-when-compile
+  (require 'cl))
+
+(require 'chess-database)
+(require 'chess-game)
+
+(defun chess-test (&optional file)
+  (unless file
+    (setq file (car command-line-args-left)))
+  (message "Opening chess database '%s'" file)
+  (let ((database (chess-database-open file)))
+    (if database
+       (progn
+         (message "Running chess unit tests...")
+         (condition-case err
+             (let ((count (chess-database-count database))
+                   (ply-count 0)
+                   (index 1)
+                   (begin (current-time)))
+               (while (< index count)
+                 ;; Reading in the game will cause it to be converted from PGN
+                 ;; (this is true currently) to a chess-game, during which time
+                 ;; every move will be tested for legality.
+                 ;;
+                 ;; jww (2008-08-31): We should add some extra checks here, if we
+                 ;; want to verify the final position and such.
+                 (let ((game (chess-database-read database index)))
+                   (when game
+                     (setq ply-count
+                           (+ ply-count (length (chess-game-plies game))))
+                     (if (= 0 (mod index 1000))
+                         (message "Read %d games: %d total plies (%.2f ply/sec)"
+                                  index ply-count
+                                  (/ (float ply-count)
+                                     (float
+                                      (time-to-seconds
+                                       (subtract-time (current-time)
+                                                      begin))))))))
+                 (setq index (1+ index)))
+               (message "Running chess unit tests...done"))
+           (t
+            (error "Failed to open chess database '%s'" file)))
+         (chess-database-close database)))))
+
+;;; chess-test.el ends here