comparison tests/automated/test-harness.el @ 398:74fd4e045ea6 r21-2-29

Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 8626e4521993
children
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
20 ;; You should have received a copy of the GNU General Public License 20 ;; You should have received a copy of the GNU General Public License
21 ;; along with XEmacs; see the file COPYING. If not, write to the 21 ;; along with XEmacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA. 23 ;; Boston, MA 02111-1307, USA.
24 24
25 ;;; Synched up with: Not in FSF 25 ;;; Synched up with: Not in FSF.
26 26
27 ;;; Commentary: 27 ;;; Commentary:
28 28
29 ;;; A test suite harness for testing XEmacs. 29 ;;; A test suite harness for testing XEmacs.
30 ;;; The actual tests are in other files in this directory. 30 ;;; The actual tests are in other files in this directory.
31 ;;; Basically you just create files of emacs-lisp, and use the 31 ;;; Basically you just create files of emacs-lisp, and use the
32 ;;; Assert, Check-Error, and Check-Message functions to create tests. 32 ;;; Assert, Check-Error, and Check-Message functions to create tests.
33 ;;; You run the tests using M-x test-emacs-test-file, 33 ;;; You run the tests using M-x test-emacs-test-file,
34 ;;; or $(EMACS) -l .../test-harness.el -f batch-test-emacs file ... 34 ;;; or $(EMACS) -batch -l .../test-harness.el -f batch-test-emacs file ...
35 ;;; which is run for you by the `make check' target in the top-level Makefile. 35 ;;; which is run for you by the `make check' target in the top-level Makefile.
36 36
37 (require 'bytecomp) 37 (require 'bytecomp)
38 38
39 (defvar test-harness-verbose 39 (defvar test-harness-verbose
40 (and (not noninteractive) (> (device-baud-rate) search-slow-speed)) 40 (and (not noninteractive) (> (device-baud-rate) search-slow-speed))
41 "*Non-nil means print messages describing progress of emacs-tester.") 41 "*Non-nil means print messages describing progress of emacs-tester.")
42 42
43 (defvar test-harness-current-file nil) 43 (defvar test-harness-current-file nil)
44 44
45 (defvar emacs-lisp-file-regexp (purecopy "\\.el$") 45 (defvar emacs-lisp-file-regexp (purecopy "\\.el\\'")
46 "*Regexp which matches Emacs Lisp source files.") 46 "*Regexp which matches Emacs Lisp source files.")
47 47
48 ;;;###autoload 48 ;;;###autoload
49 (defun test-emacs-test-file (filename) 49 (defun test-emacs-test-file (filename)
50 "Test a file of Lisp code named FILENAME. 50 "Test a file of Lisp code named FILENAME.
340 (defvar command-line-args-left) ;Avoid 'free variable' warning 340 (defvar command-line-args-left) ;Avoid 'free variable' warning
341 (defvar debug-issue-ebola-notices) 341 (defvar debug-issue-ebola-notices)
342 (if (not noninteractive) 342 (if (not noninteractive)
343 (error "`batch-test-emacs' is to be used only with -batch")) 343 (error "`batch-test-emacs' is to be used only with -batch"))
344 (let ((error nil)) 344 (let ((error nil))
345 (loop for file in command-line-args-left 345 (dolist (file command-line-args-left)
346 do 346 (if (file-directory-p file)
347 (if (file-directory-p (expand-file-name file)) 347 (dolist (file-in-dir (directory-files file t))
348 (let ((files (directory-files file)) 348 (when (and (string-match emacs-lisp-file-regexp file-in-dir)
349 source) 349 (not (or (auto-save-file-name-p file-in-dir)
350 (while files 350 (backup-file-name-p file-in-dir)
351 (if (and (string-match emacs-lisp-file-regexp (car files)) 351 (equal (file-name-nondirectory file-in-dir)
352 (not (auto-save-file-name-p (car files))) 352 "test-harness.el"))))
353 (setq source (expand-file-name 353 (or (batch-test-emacs-1 file-in-dir)
354 (car files) 354 (setq error t))))
355 file)) 355 (or (batch-test-emacs-1 file)
356 (if (null (batch-test-emacs-1 source))
357 (setq error t)))
358 (setq files (cdr files)))))
359 (if (null (batch-test-emacs-1 file))
360 (setq error t)))) 356 (setq error t))))
361 ;;(message "%s" (buffer-string nil nil "*Test-Log*")) 357 ;;(message "%s" (buffer-string nil nil "*Test-Log*"))
362 (message "Done") 358 (message "Done")
363 (kill-emacs (if error 1 0)))) 359 (kill-emacs (if error 1 0))))
364 360