;ELC ;;; Compiled by mwolson@grepfind.mwolson.org on Thu Jan 24 00:15:31 2008 ;;; from file /stuff/proj/emacs/dvc/mwolson/lisp/tla-tests.el ;;; in Emacs version 23.0.50.2 ;;; with all optimizations. ;;; This file uses dynamic docstrings, first added in Emacs 19.29. (if (and (boundp 'emacs-version) (< (aref emacs-version (1- (length emacs-version))) ?A) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`tla-tests.el' was compiled for Emacs 19.29 or later")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (byte-code "\300\301!\210\300\302!\207" [require tla tla-autoconf] 2) #@96 Directory where the test can write. WARNING: This directory will be deleted before each test. (defvar tla-tests-scratch-dir (expand-file-name "~/tmp/arch-test") (#$ . 666)) #@94 Location of the archive used for xtla testing. Must be a subdir of `tla-tests-scratch-dir'. (defvar tla-tests-archive-location (concat tla-tests-scratch-dir "/archive") (#$ . 846)) #@110 Location of a possible working directory used for xtla testing. Must be a subdir of `tla-tests-scratch-dir'. (defvar tla-tests-wd-location (concat tla-tests-scratch-dir "/wd") (#$ . 1035)) #@46 Buffer where the tests will output messages. (defvar tla-tests-log-buffer nil (#$ . 1230)) #@38 The name of the test archive to use. (defvar tla-tests-archive-name "foo@bar.com--2004" (#$ . 1327)) #@38 The name of the test project to use. (defvar tla-tests-project-name "xtla--test--1.0" (#$ . 1434)) #@64 List of tla/baz commands that should be executed by each test. (defconst tla-tests-command-alist (byte-code "\301\302\303P\304BB\305BB\207" [tla-tests-archive-location (tla-test-my-id "my-id" "my-id" "my-id John\\ Smith\\ \\" "my-id") tla-test-make-archive "make-archive foo\\@bar.com--2004 " ("archives --all-locations" "my-default-archive") ((tla-test-changes-what-changed-original-file) (tla-test-changes "inventory --nested --trees" "inventory --nested --trees" "changes --diffs" "changes --diffs") (tla-test-changes-baz "diff" "inventory --nested --trees" "inventory --nested --trees" "diff"))] 4) (#$ . 1539)) #@504 Alist used by the initialization phase of each test. Each element must be of the form (testcase list-of-features). The list of feature can contain the symbols * noid: Don't fix tla my-id * noarch: Don't create an archive * noproject: Otherwise, create a project in the archive with a base-0 and a patch-1 * nocmdcheck: Don't check which tla commands are run * get: Runs tla get on the project in the archive TODO * changes: do some modifications in the working directory after tla get TODO (defconst tla-tests-init-alist '((tla-test-my-id noid noarch noproject) (tla-test-make-archive noarch noproject) (tla-test-changes-what-changed-original-file noid noarch noproject) (tla-test-changes) (tla-test-revision-lessp noid noarch noproject) (tla-test-recursive-update noproject nocmdcheck) (tla-test--position) (tla-test--digit-char-p)) (#$ . 2183)) #@49 Run all the available test-cases in batch mode. (defalias 'tla-tests-batch #[nil "\303\304!\210\303\305!\210\303\304!\210\306\211\307\310\311\"\2030\312@!\203& T\202)\nTA\211\204\303\313!\210\303\314!\210\303\315 \"\210\303\316\n\"\210\303\313!+\207" [list-tests ok failed tla-tests-log "***************************" "* Starting new batch test *" 0 apropos-internal "^tla-test-" fboundp tla-tests-run "**********************" "* Batch test report: *" "* Passed: %3d *" "* Failed: %3d *"] 6 (#$ . 3049) nil]) #@101 Logs the message (format MESSAGE FORMAT-PARAMS). Log messages are written to the tests log buffer. (defalias 'tla-tests-log #[(message &rest format-params) "\303!\204\n\304\305!\306\307 \n#rq\210db\210 c\210\310 \210\301 !*\207" [tla-tests-log-buffer message format-params buffer-live-p get-buffer-create "*tla-tests*" apply format newline] 4 (#$ . 3592)]) #@72 In buffer visiting FILENAME, evaluate FORMS, save and kill the buffer. (defalias 'tla-write-to-file '(macro . #[(filename &rest forms) "\303 \304\305 DDC\306\307\310\n\311\"BB\312DEE)\207" [buf filename forms dvc-gensym let find-file-noselect unwind-protect with-current-buffer append ((save-buffer)) kill-buffer] 8 (#$ . 3961)])) (put 'tla-write-to-file 'lisp-indent-function 1) #@62 Create a dummy project, import and commit it to the archive. (defalias 'tla-tests-make-dummy-project #[nil "\306\307!\310\216rq\210\311 !\210\312\n!\210\311\n!\210\313\314\315\316 \n#D!\210\313\317\320 \205(\321D!\210\322\323!\324\216r\fq\210\325\326 Pc\210\327 \210+\330\331\323\"\210\313\332\333\334E!\210\335 !+\207" [#1=#:temp-buffer tla-tests-scratch-dir tla-tests-project-name tla-tests-archive-name #2=#:dvc-gensym-uniq-48 default-directory generate-new-buffer " *temp*" ((byte-code "\301!\203\n\302!\210\301\207" [#1# buffer-name kill-buffer] 2)) cd make-directory tla--run-tla-sync "init-tree" format "%s/%s" "import" tla-import-has-setup-option "--setup" find-file-noselect "hello" ((kill-buffer #2#)) "Current time is " current-time-string save-buffer tla-add nil "commit" "-L" "Test commit" expand-file-name] 6 (#$ . 4351)]) (byte-code "\301B\302\301!\204\303\301\304\305!\"\210\301\207" [current-load-list tla-tests-real-home default-boundp set-default getenv "HOME"] 4) #@128 Initialization function called before launching a testcase. FEATURES is the list of features got from `tla-tests-init-alist'. (defalias 'tla-tests-initialize #[(tfeatures) "\301!\210\302\303P!\210\302\304P!\210\305\306\307\217\207" [tla-tests-scratch-dir dvc-sethome shell-command "rm -rf " "mkdir -p " err (byte-code "\303\235\204 \304\305\306\"\210\307\235\204\310 \n\"\210\311 !\210\312\235\204%\313\314 !\210\315 \207" [tfeatures tla-tests-archive-name tla-tests-archive-location noid tla-my-id 1 "Xtla tester " noarch tla--make-archive tla-my-default-archive noproject cd tla-tests-make-dummy-project dvc-clear-log-buffer] 3) ((error (byte-code "\302 \210\303\211A@)!\207" [err x tla-tests-terminate error] 3)))] 3 (#$ . 5353)]) #@59 Terminates the execution of a testcase and restores HOME. (defalias 'tla-tests-terminate #[nil "\301!\207" [tla-tests-real-home dvc-sethome] 2 (#$ . 6123) nil]) #@56 Waits for all asynchronous tla processes to terminate. (defalias 'tla-tests-wait-end-of-process #[nil "\205\301\302\"\210\303\304!\210\202\207" [dvc-process-running message "Processes: %s" sit-for 0.2] 3 (#$ . 6291)]) #@235 Run the testcase TEST. Switch HOME to the test directory, clear the log buffer, call the function TEST, and check that the list of tla commands ran by calling TEST is the same as the one expected, stored in `tla-tests-command-alist' (defalias 'tla-tests-run #[(test) "\306 \210\307 \n\"A\310\311!\312\216r q\210\313 !\210\314\315\316 !\"\210\317\320\321\216\322\323\324\217\210)\325!\210\314\326\316 !\"\210\314\327\203E\330\202F\331\203S\332\333\"\202T\330#\210\205^?.\207" [tla-tests-scratch-dir test tla-tests-init-alist init-features default-directory #1=#:temp-buffer tla-autoconf-compute assoc generate-new-buffer " *temp*" ((byte-code "\301!\203\n\302!\210\301\207" [#1# buffer-name kill-buffer] 2)) tla-tests-initialize tla-tests-log "\n*** running test %s\n" symbol-name t nil ((tla-tests-terminate)) condition-error (byte-code " \210\306 \210\307 \235\204>\310 \311\312\313\314\315!\316\317 Q!\n\"\206#\313\n\"A\"\211 \232\204=\320\321!\210\320\322 \"\210\320\323\f\"\210\324*\324\207" [test init-features tla-tests-command-alist expected list-cmds commands-ok tla-tests-wait-end-of-process nocmdcheck tla-tests-get-list-cmds mapcar #[(x) "\301 \302Q\207" [x tla-arch-branch-name " "] 3] assoc intern symbol-name "-" tla-arch-branch-name tla-tests-log "Different list of commands" "Expected: %S" "Got: %S" nil] 9) ((error (byte-code "\302\303!\210\206 \304\302\207" [condition-error errors tla-tests-log "Error running tests" t] 2))) dvc-switch-to-buffer "*** Report for test %s:" "Commands: %s\nErrors: %s" "OK" "ERROR" format "ERROR - %s" errors commands-ok tla-tests-log-buffer] 6 (#$ . 6522) (list (intern (dvc-completing-read "Test to run: " (mapcar (lambda (x) (list (symbol-name x))) (apropos-internal "^tla-test-")))))]) #@90 Get the list of commands ran since the log buffer was cleared. Returns a list of strings (defalias 'tla-tests-get-list-cmds #[nil "\302!q\210db\210\303\304\305\303\306#\203%\307\305!\210\310`\311 \" B\312\313!\210\202\n )\207" [dvc-log-buffer list-cmds get-buffer-create nil re-search-backward "^Command: " t re-search-forward buffer-substring-no-properties line-end-position previous-line 1] 4 (#$ . 8315)]) #@56 Directory where non-regression tests should be stored. (defvar tla-tests-nonreg-dir (byte-code "\300\301\302\303!!\304P!\207" [expand-file-name file-name-directory locate-library "tla" "../tests"] 4) (#$ . 8735)) #@260 Perform a non-regression script on BUFFER. When called for the first time, stores the content of BUFFER in `tla-tests-nonreg-dir'/ID.txt. Afterwards, compares the content of BUFFER with the previously archived one. Raise an error when there is a difference. (defalias 'tla-tests-buffer-nonreg #[(buffer id) "\306\307\"\210\310! \311Qr q\210\312\n!\203V\313r\314\n!q\210\315 )!\316P\313\317\320\321\322!!\323\315 #!\316P\211\f\230\203@\324\325 \"\202R\324\326 \"\210\324\327 \"\210\324\330\f\"\210\331\332!*\202\221\315 %r\333\334!q\210\335 \210%c\210eb\210\336\321\322!\337\307#\203}\340\323\337\307#\210\202j\324\341 \"\210\324\342\n\"\210\343\n!\210\344p!\210*\307*\207" [tla-tests-nonreg-dir id filename buffer new old make-directory t file-name-as-directory ".txt" file-exists-p dvc-strip-final-newline find-file-noselect buffer-string "\n" replace-regexp-in-string regexp-quote getenv "HOME" "$HOME" tla-tests-log "non-reg %s OK" "Non regression failed for %s failed" "Expected:\n\"%s\"\n" "Got:\n\"%s\"\n" error "Non regression failed" get-buffer-create " *tla-tmp*" erase-buffer search-forward nil replace-match "Archiving %s for non-regression." "please check %s for errors." write-file kill-buffer content] 7 (#$ . 8955)]) #@34 Test that my-id works correctly. (defalias 'tla-test-my-id #[nil "\302\303\304\217\210\305\306!\211\205\306K\307\216\306\310M\210\311\312!\210+\311 \313\230?\205&\314\315!\207" [#1=#:--cl-letf-bound-- #2=#:--cl-letf-save-- nil (tla-my-id) ((error)) fboundp read-string ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#1# #2# read-string fmakunbound] 2)) #[(prompt x y z) "\300\207" ["John Smith "] 1] tla-my-id t "John Smith " error "Wrong id"] 4 (#$ . 10207)]) #@41 Test that make-archive works correctly. (defalias 'tla-test-make-archive #[nil "\301\302\"\210\303!\204\304\305!\210\306 \210\307\310!\210\311p\312\"\207" [tla-tests-archive-location tla--make-archive "foo@bar.com--2004" file-directory-p error "Archive not created" tla-archives tla-tests-log "archive created. Testing tla-archives." tla-tests-buffer-nonreg "make-archive-archives"] 3 (#$ . 10724)]) #@57 Test that changes-what-changed-original-file correctly. (defalias 'tla-test-changes-what-changed-original-file #[nil "\301\302\303!\302\304!!\232?\205\305\306!)\207" [what-changed "/home/jet/projects/pook/,,what-changed.pookx--prototype--0.1--base-0--jet@gyve.org--test/new-files-archive/./pook.h" expand-file-name "/home/jet/projects/pook/pook.h" tla--changes-what-changed-original-file error "Unexpected file name is returned"] 4 (#$ . 11134)]) #@39 Test that tla-changes runs correctly. (defalias 'tla-test-changes #[nil "\300 \210\301 \210\302p\303\"\207" [tla-changes tla-tests-wait-end-of-process tla-tests-buffer-nonreg "changes-nochange"] 3 (#$ . 11591)]) #@63 Check that `tla--name-split' and `tla--name-construct' works. (defalias 'tla-test-name-split-construct #[nil "\304\211\305\211\2038\n@\211@\306 \211A@)!\232\204\307\310!\210\311 @! \211A@)\232\2041\307\310!\210\nA\211\204\n+\305\207" [name-alist pair #1=#:--cl-dolist-temp-- x (("archive@name--year" ("archive@name--year" nil nil nil nil)) ("archive@name--year/category" ("archive@name--year" "category" nil nil nil)) ("archive@name--year/category--branch" ("archive@name--year" "category" "branch" nil nil)) ("archive@name--year/category--1" ("archive@name--year" "category" #2="" "1" nil)) ("archive@name--year/category--1.0--patch-42" ("archive@name--year" "category" #2# "1.0" "patch-42")) ("archive@name--year/category--branch" ("archive@name--year" "category" "branch" nil nil)) ("archive@name--year/category--branch--1.0" ("archive@name--year" "category" "branch" "1.0" nil)) ("archive@name--year/category--branch--1.0--version-0" ("archive@name--year" "category" "branch" "1.0" "version-0"))) nil tla--name-construct error "Bug in tla--name-construct" tla--name-split] 5 (#$ . 11809)]) #@41 Checks that `tla-revision-lessp' works. (defalias 'tla-test-revision-lessp #[nil "\304\211\305\211\203F\n@\306 @ \211A@)\"\204&\307\310 @ \211A@)#\210\306 \211A@) @\"\203?\307\310 \211A@) @#\210\nA\211\204\n+\305\207" [rev-alist pair #1=#:--cl-dolist-temp-- x (("archive@name--year/cat--br--0--patch-3" "archive@name--year/cat--br--0--patch-12") ("archive@name--year/cat--br--0--patch-3" "archive@name--year/cat--br--1--patch-1") ("base-0" "patch-1") ("patch-1" "version-0") ("patch-1" "version-1") ("version-1" "version-2") ("12" "13") ("12x" "12y") ("a1y" "a2y") ("a12x" "ax") ("aa" "aaa") ("babbb" "bb")) nil tla-revision-lessp error "Bug in (tla-revision-lessp %S %S)"] 6 (#$ . 12921)]) #@45 Test that update can be applied recursively (defalias 'tla-test-recursive-update #[nil "\306!\210\307\310 )\311\312\313\"\306 !\210\314\315!\316\216r\fq\210\317c\210\320c\210\321 \210+\322\323\315D!\210\322\324\325\326E!\210*\327\330!\331 !\210\306 !\210 \332P+\322\333\307+E!\210\306+!\210\322\334\315D!\210\335\336\337!\340\",\341\342,\"\210\343\344!\211-\205r\344K.\345\216\344\346M\210\347+\350\351#\210+\341\352,\"+\207" [tla-tests-scratch-dir tla-tests-project-name subprojects mainproject #1=#:dvc-gensym-uniq-49 dist-directory cd "mainproject--test--1.0" tla-tests-make-dummy-project mapcar #[(tla-tests-project-name) "\301 \302\303\304\305\306\257!\210)\207" [dir tla-tests-make-dummy-project tla--run-tla-sync "commit" "-L" "Test commit" "-d"] 6] ("subproject--test--1.0" "subproject--test--2.0") find-file-noselect "config" ((kill-buffer #1#)) "subproject-1 subproject--test--1.0--patch-1\n" "subproject-2 subproject--test--2.0--patch-1\n" save-buffer tla--run-tla-sync "add" "commit" "-L" "new build config" expand-file-name "~/dist" make-directory "/mainproject" "get" "build-config" split-string shell-command-to-string "tla inventory -t" "\n" mapc #[(dir) "\302\303 #\210\304! P\305\306\307\310#)\207" [default-directory dir dvc-trace "default=%S dir=%S" file-name-as-directory tla--run-tla-sync ("missing") :finished #[(output error status arguments) "\301!\302\230\205 \303\304!\207" [output dvc-buffer-content #2="" error "There should have been missing patches"] 2]] 4] fboundp tla--run-tla-async ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#3=#:--cl-letf-bound-- #4=#:--cl-letf-save-- tla--run-tla-async fmakunbound] 2)) #[(&rest args) "\301\302\"\207" [args apply tla--run-tla-sync] 3 "Not documented\n\n(fn &rest ARGS)"] tla-update nil t #[(dir) "\302\303 #\210\304! P\305\306\307\310#)\207" [default-directory dir dvc-trace "default=%S dir=%S" file-name-as-directory tla--run-tla-sync ("missing") :finished #[(output error status arguments) "\301!\302\230?\205\f\303\304!\207" [output dvc-buffer-content #2# error "There should have been no missing patches"] 2]] 4] project-dir dirs #3# #4#] 5 (#$ . 13631)]) #@22 Test `dvc-position'. (defalias 'tla-test--position #[nil "\301\302\303\304#\305=\204\306\307!\210\302\310\311#\312=\204\306\307!\210\302\313\314#\315=?\205,\306\307!)\207" [list (0.0 1.0 2.0 3.0) dvc-position 0.0 #[(x y) " U\207" [x y] 2] 0 error "Wrong position" 1.0 #[(x y) " U\207" [x y] 2] 1 4.0 #[(x y) " U\207" [x y] 2] nil] 4 (#$ . 15816)]) #@26 Test `dvc-digit-char-p'. (defalias 'tla-test--digit-char-p #[nil "\300\301\302!\301\303!\301\304!\301\305!\301\306!?\301\307!?\301\310!?\301\311!?\257\235\205&\312\313!\207" [nil dvc-digit-char-p 53 57 48 49 97 65 33 89 error "Failed"] 10 (#$ . 16182)]) (provide 'tla-tests)