commit: Declare labels as line where appropriate; use #'labels, not #'flet, tests.

changeset: 5576:071b810ceb18 tag: tip user: Aidan Kehoe <kehoea(a)parhasard.net&gt; date: Mon Oct 03 20:16:14 2011 +0100 files: lisp/ChangeLog lisp/faces.el lisp/keymap.el lisp/lisp-mode.el lisp/loadhist.el lisp/mouse.el lisp/mule/mule-cmds.el lisp/mule/mule-x-init.el lisp/simple.el lisp/specifier.el tests/ChangeLog tests/automated/case-tests.el tests/automated/database-tests.el tests/automated/hash-table-tests.el tests/automated/lisp-tests.el tests/automated/mule-tests.el tests/automated/os-tests.el tests/automated/symbol-tests.el tests/automated/syntax-tests.el description: Declare labels as line where appropriate; use #'labels, not #'flet, tests. lisp/ChangeLog addition: 2011-10-03 Aidan Kehoe <kehoea(a)parhasard.net&gt; * simple.el (handle-pre-motion-command-current-command-is-motion): Implement #'keysyms-equal with #'labels + (declare (inline ...)), instead of abusing macrolet to the same end. * specifier.el (let-specifier): * mule/mule-cmds.el (describe-language-environment): * mule/mule-cmds.el (set-language-environment-coding-systems): * mule/mule-x-init.el (x-use-halfwidth-roman-font): * faces.el (Face-frob-property): * keymap.el (key-sequence-list-description): * lisp-mode.el (construct-lisp-mode-menu): * loadhist.el (unload-feature): * mouse.el (default-mouse-track-check-for-activation): Declare various labels inline in dumped files when that reduces the size of the dumped image. Declaring labels inline is normally only worthwhile for inner loops and so on, but it's reasonable exercise of the related code to have these changes in core. tests/ChangeLog addition: 2011-10-03 Aidan Kehoe <kehoea(a)parhasard.net&gt; * automated/case-tests.el (uni-mappings): * automated/database-tests.el (delete-database-files): * automated/hash-table-tests.el (iterations): * automated/lisp-tests.el (test1): * automated/lisp-tests.el (a): * automated/lisp-tests.el (cl-floor): * automated/lisp-tests.el (foo): * automated/lisp-tests.el (list-nreverse): * automated/lisp-tests.el (needs-lexical-context): * automated/mule-tests.el (featurep): * automated/os-tests.el (original-string): * automated/os-tests.el (with): * automated/symbol-tests.el (check-weak-list-unique): Replace #'flet with #'labels where appropriate in these tests, following my own advice on style in the docstrings of those functions. diff -r 89cb6a66a61f -r 071b810ceb18 lisp/ChangeLog --- a/lisp/ChangeLog Mon Oct 03 19:39:01 2011 +0100 +++ b/lisp/ChangeLog Mon Oct 03 20:16:14 2011 +0100 ＠＠ -1,3 +1,22 ＠＠ +2011-10-03 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * simple.el (handle-pre-motion-command-current-command-is-motion): + Implement #'keysyms-equal with #'labels + (declare (inline ...)), + instead of abusing macrolet to the same end. + * specifier.el (let-specifier): + * mule/mule-cmds.el (describe-language-environment): + * mule/mule-cmds.el (set-language-environment-coding-systems): + * mule/mule-x-init.el (x-use-halfwidth-roman-font): + * faces.el (Face-frob-property): + * keymap.el (key-sequence-list-description): + * lisp-mode.el (construct-lisp-mode-menu): + * loadhist.el (unload-feature): + * mouse.el (default-mouse-track-check-for-activation): + Declare various labels inline in dumped files when that reduces + the size of the dumped image. Declaring labels inline is normally + only worthwhile for inner loops and so on, but it's reasonable + exercise of the related code to have these changes in core. + 2011-10-03 Aidan Kehoe <kehoea(a)parhasard.net&gt; * bytecomp.el (byte-compile-funcall): diff -r 89cb6a66a61f -r 071b810ceb18 lisp/faces.el --- a/lisp/faces.el Mon Oct 03 19:39:01 2011 +0100 +++ b/lisp/faces.el Mon Oct 03 20:16:14 2011 +0100 ＠＠ -1142,6 +1142,7 ＠＠ ;; end of labels ) + (declare (inline global-locale nil-instantiator-ok)) ;; the function itself (let* ((ffpdev Face-frob-property-device-considered-current) diff -r 89cb6a66a61f -r 071b810ceb18 lisp/keymap.el --- a/lisp/keymap.el Mon Oct 03 19:39:01 2011 +0100 +++ b/lisp/keymap.el Mon Oct 03 20:16:14 2011 +0100 ＠＠ -419,6 +419,7 ＠＠ (vector keys))))) (labels ((event-to-list (ev) (append (event-modifiers ev) (list (event-key ev))))) + (declare (inline event-to-list)) (mapvector #'(lambda (key) (let* ((full-key diff -r 89cb6a66a61f -r 071b810ceb18 lisp/lisp-mode.el --- a/lisp/lisp-mode.el Mon Oct 03 19:39:01 2011 +0100 +++ b/lisp/lisp-mode.el Mon Oct 03 20:16:14 2011 +0100 ＠＠ -45,6 +45,7 ＠＠ (defun construct-lisp-mode-menu (popup-p emacs-lisp-p) (labels ((popup-wrap (form) (if popup-p `(menu-call-at-event ',form) form))) + (declare (inline popup-wrap)) `(,＠(if emacs-lisp-p `(["%_Byte-Compile This File" ,(popup-wrap 'emacs-lisp-byte-compile)] diff -r 89cb6a66a61f -r 071b810ceb18 lisp/loadhist.el --- a/lisp/loadhist.el Mon Oct 03 19:39:01 2011 +0100 +++ b/lisp/loadhist.el Mon Oct 03 20:16:14 2011 +0100 ＠＠ -178,6 +178,7 ＠＠ (labels ((reset-aload (x) (let ((aload (get x 'autoload))) (if aload (fset x (cons 'autoload aload)))))) + (declare (inline reset-aload)) (mapc #'(lambda (x) (cond ((stringp x) nil) diff -r 89cb6a66a61f -r 071b810ceb18 lisp/mouse.el --- a/lisp/mouse.el Mon Oct 03 19:39:01 2011 +0100 +++ b/lisp/mouse.el Mon Oct 03 20:16:14 2011 +0100 ＠＠ -1251,6 +1251,7 ＠＠ (when ex (funcall (extent-property ex property) event ex) t)))) + (declare (inline do-activate)) (or (and (some #'(lambda (count button) (and (= click-count count) diff -r 89cb6a66a61f -r 071b810ceb18 lisp/mule/mule-cmds.el --- a/lisp/mule/mule-cmds.el Mon Oct 03 19:39:01 2011 +0100 +++ b/lisp/mule/mule-cmds.el Mon Oct 03 20:16:14 2011 +0100 ＠＠ -838,6 +838,7 ＠＠ (labels ((princ-list (&rest args) (while args (princ (car args)) (setq args (cdr args))) (princ "\n"))) + (declare (inline princ-list)) (with-output-to-temp-buffer "*Help*" (princ-list language-name " language environment" "\n") (if (stringp doc) ＠＠ -1347,7 +1348,7 ＠＠ (if (memq eol-type '(lf crlf cr unix dos mac)) (coding-system-change-eol-conversion codesys eol-type) codesys))) - + (declare (inline maybe-change-coding-system-with-eol)) ;; initialize category mappings and priority list. (let* ((priority (get-language-info language-name 'coding-priority)) (default-coding (car priority))) diff -r 89cb6a66a61f -r 071b810ceb18 lisp/mule/mule-x-init.el --- a/lisp/mule/mule-x-init.el Mon Oct 03 19:39:01 2011 +0100 +++ b/lisp/mule/mule-x-init.el Mon Oct 03 20:16:14 2011 +0100 ＠＠ -47,7 +47,7 ＠＠ (let ((width1 (charset-font-width cs1)) (width2 (charset-font-width cs2))) (and width1 width2 (eq (+ width1 width1) width2))))) - + (declare (inline charset-font-width)) (when (eq 'x (device-type)) (let ((original-registries (charset-registries 'ascii))) (condition-case nil diff -r 89cb6a66a61f -r 071b810ceb18 lisp/simple.el --- a/lisp/simple.el Mon Oct 03 19:39:01 2011 +0100 +++ b/lisp/simple.el Mon Oct 03 20:16:14 2011 +0100 ＠＠ -2084,20 +2084,19 ＠＠ (defun handle-pre-motion-command-current-command-is-motion () (and (key-press-event-p last-input-event) - (macrolet - ((keysyms-equal (&rest args) - `((lambda (a b) - (when (and - ;; As of now, none of the elements of - ;; motion-keys-for-shifted-motion are non-symbols; - ;; this redundant check saves a few hundred - ;; funcalls on startup. - (not (symbolp b)) - (characterp b)) - (setf (car char-list) b - b (intern (concat char-list nil)))) - (eq a b)) - ,＠args))) + (labels + ((keysyms-equal (a b) + (when (and + ;; As of now, none of the elements of + ;; motion-keys-for-shifted-motion are non-symbols; + ;; this redundant check saves a few hundred + ;; funcalls on startup. + (not (symbolp b)) + (characterp b)) + (setf (car char-list) b + b (intern (concat char-list nil)))) + (eq a b))) + (declare (inline keysyms-equal) (special char-list)) (loop for keysym in motion-keys-for-shifted-motion with key = (event-key last-input-event) diff -r 89cb6a66a61f -r 071b810ceb18 lisp/specifier.el --- a/lisp/specifier.el Mon Oct 03 19:39:01 2011 +0100 +++ b/lisp/specifier.el Mon Oct 03 20:16:14 2011 +0100 ＠＠ -488,6 +488,7 ＠＠ (if (or (atom x) (eq (car x) 'quote)) (list x) (list (gensym name) x)))) + (declare (inline gensym-frob)) ;; VARLIST is a list of ;; ((SPECIFIERSYM SPECIFIER) (VALUE) (LOCALESYM LOCALE) ;; (TAG-SET) (HOW-TO-ADD)) diff -r 89cb6a66a61f -r 071b810ceb18 tests/ChangeLog --- a/tests/ChangeLog Mon Oct 03 19:39:01 2011 +0100 +++ b/tests/ChangeLog Mon Oct 03 20:16:14 2011 +0100 ＠＠ -1,3 +1,22 ＠＠ +2011-10-03 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * automated/case-tests.el (uni-mappings): + * automated/database-tests.el (delete-database-files): + * automated/hash-table-tests.el (iterations): + * automated/lisp-tests.el (test1): + * automated/lisp-tests.el (a): + * automated/lisp-tests.el (cl-floor): + * automated/lisp-tests.el (foo): + * automated/lisp-tests.el (list-nreverse): + * automated/lisp-tests.el (needs-lexical-context): + * automated/mule-tests.el (featurep): + * automated/os-tests.el (original-string): + * automated/os-tests.el (with): + * automated/symbol-tests.el (check-weak-list-unique): + Replace #'flet with #'labels where appropriate in these tests, + following my own advice on style in the docstrings of those + functions. + 2011-10-02 Aidan Kehoe <kehoea(a)parhasard.net&gt; * automated/lisp-tests.el: diff -r 89cb6a66a61f -r 071b810ceb18 tests/automated/case-tests.el --- a/tests/automated/case-tests.el Mon Oct 03 19:39:01 2011 +0100 +++ b/tests/automated/case-tests.el Mon Oct 03 20:16:14 2011 +0100 ＠＠ -1464,8 +1464,8 ＠＠ ;; finally, make the new mapping. (put-case-table-pair uc lc case-table)) finally return case-table))) - (flet ((ismulti (uc lc) - (or (gethash uc multi-hash) (gethash lc multi-hash)))) + (labels ((ismulti (uc lc) + (or (gethash uc multi-hash) (gethash lc multi-hash)))) (let ( ;; All lowercase (lowermulti (with-output-to-string diff -r 89cb6a66a61f -r 071b810ceb18 tests/automated/database-tests.el --- a/tests/automated/database-tests.el Mon Oct 03 19:39:01 2011 +0100 +++ b/tests/automated/database-tests.el Mon Oct 03 20:16:14 2011 +0100 ＠＠ -34,12 +34,12 ＠＠ (push (file-name-directory load-file-name) load-path) (require 'test-harness)))) -(flet ((delete-database-files (filename) - (dolist (fn (list filename - (concat filename ".db") - (concat filename ".pag") - (concat filename ".dir"))) - (ignore-file-errors (delete-file fn)))) +(labels ((delete-database-files (filename) + (dolist (fn (list filename + (concat filename ".db") + (concat filename ".pag") + (concat filename ".dir"))) + (ignore-file-errors (delete-file fn)))) (test-database (db) (Assert (databasep db)) diff -r 89cb6a66a61f -r 071b810ceb18 tests/automated/hash-table-tests.el --- a/tests/automated/hash-table-tests.el Mon Oct 03 19:39:01 2011 +0100 +++ b/tests/automated/hash-table-tests.el Mon Oct 03 20:16:14 2011 +0100 ＠＠ -145,16 +145,21 ＠＠ (Assert (= (hash-table-count ht) (decf count)))))) (let ((iterations 5) (one 1.0) (two 2.0)) - (flet ((check-copy - (ht) - (let ((copy-of-ht (copy-hash-table ht))) - (Assert (equal ht copy-of-ht)) - (Assert (not (eq ht copy-of-ht))) - (Assert (eq (hash-table-count ht) (hash-table-count copy-of-ht))) - (Assert (eq (hash-table-type ht) (hash-table-type copy-of-ht))) - (Assert (eq (hash-table-size ht) (hash-table-size copy-of-ht))) - (Assert (eql (hash-table-rehash-size ht) (hash-table-rehash-size copy-of-ht))) - (Assert (eql (hash-table-rehash-threshold ht) (hash-table-rehash-threshold copy-of-ht)))))) + (labels ((check-copy + (ht) + (let ((copy-of-ht (copy-hash-table ht))) + (Assert (equal ht copy-of-ht)) + (Assert (not (eq ht copy-of-ht))) + (Assert (eq (hash-table-count ht) + (hash-table-count copy-of-ht))) + (Assert (eq (hash-table-type ht) + (hash-table-type copy-of-ht))) + (Assert (eq (hash-table-size ht) + (hash-table-size copy-of-ht))) + (Assert (eql (hash-table-rehash-size ht) + (hash-table-rehash-size copy-of-ht))) + (Assert (eql (hash-table-rehash-threshold ht) + (hash-table-rehash-threshold copy-of-ht)))))) (let ((ht (make-hash-table :size 100 :rehash-threshold .6 :test 'eq))) (dotimes (j iterations) diff -r 89cb6a66a61f -r 071b810ceb18 tests/automated/lisp-tests.el --- a/tests/automated/lisp-tests.el Mon Oct 03 19:39:01 2011 +0100 +++ b/tests/automated/lisp-tests.el Mon Oct 03 20:16:14 2011 +0100 ＠＠ -570,11 +570,11 ＠＠ (Check-Error wrong-type-argument (% 10.0 2)) (Check-Error wrong-type-argument (% 10 2.0)) -(flet ((test1 (x) (Assert (eql x (+ (% x 17) (* (/ x 17) 17))) x)) - (test2 (x) (Assert (eql (- x) (+ (% (- x) 17) (* (/ (- x) 17) 17))) x)) - (test3 (x) (Assert (eql x (+ (% (- x) 17) (* (/ (- x) 17) 17))) x)) - (test4 (x) (Assert (eql (% x -17) (- (% (- x) 17))) x)) - (test5 (x) (Assert (eql (% x -17) (% (- x) 17))) x)) +(labels ((test1 (x) (Assert (eql x (+ (% x 17) (* (/ x 17) 17))) x)) + (test2 (x) (Assert (eql (- x) (+ (% (- x) 17) (* (/ (- x) 17) 17))) x)) + (test3 (x) (Assert (eql x (+ (% (- x) 17) (* (/ (- x) 17) 17))) x)) + (test4 (x) (Assert (eql (% x -17) (- (% (- x) 17))) x)) + (test5 (x) (Assert (eql (% x -17) (% (- x) 17))) x)) (test1 most-negative-fixnum) (if (featurep 'bignum) (progn ＠＠ -859,7 +859,7 ＠＠ (Assert (eq (rassoc "6" x) nil)) (Assert (eq (rassq "6" x) nil))) -(flet ((a () (list '(1 . 2) 3 '(4 . 5)))) +(labels ((a () (list '(1 . 2) 3 '(4 . 5)))) (Assert (let* ((x (a)) (y (remassoc 1 x))) (and (not (eq x y)) (equal y '(3 (4 . 5)))))) (Assert (let* ((x (a)) (y (remassq 1 x))) (and (not (eq x y)) (equal y '(3 (4 . 5)))))) (Assert (let* ((x (a)) (y (remrassoc 1 x))) (and (eq x y) (equal y (a))))) ＠＠ -899,7 +899,7 ＠＠ (Assert (let* ((x (a)) (y (old-delete 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5)))))) (Assert (let* ((x (a)) (y (old-delq 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5)))))))) -(flet ((a () (list '("1" . "2") "3" '("4" . "5")))) +(labels ((a () (list '("1" . "2") "3" '("4" . "5")))) (Assert (let* ((x (a)) (y (remassoc "1" x))) (and (not (eq x y)) (equal y '("3" ("4" . "5")))))) (Assert (let* ((x (a)) (y (remassq "1" x))) (and (eq x y) (equal y (a))))) (Assert (let* ((x (a)) (y (remrassoc "1" x))) (and (eq x y) (equal y (a))))) ＠＠ -1528,31 +1528,31 ＠＠ (load test-file-name nil t nil) (delete-file test-file-name)) -(flet ((cl-floor (x &optional y) - (let ((q (floor x y))) - (list q (- x (if y (* y q) q))))) - (cl-ceiling (x &optional y) - (let ((res (cl-floor x y))) - (if (= (car (cdr res)) 0) res - (list (1+ (car res)) (- (car (cdr res)) (or y 1)))))) - (cl-truncate (x &optional y) - (if (eq (>= x 0) (or (null y) (>= y 0))) - (cl-floor x y) (cl-ceiling x y))) - (cl-round (x &optional y) - (if y - (if (and (integerp x) (integerp y)) - (let* ((hy (/ y 2)) - (res (cl-floor (+ x hy) y))) - (if (and (= (car (cdr res)) 0) - (= (+ hy hy) y) - (/= (% (car res) 2) 0)) - (list (1- (car res)) hy) - (list (car res) (- (car (cdr res)) hy)))) - (let ((q (round (/ x y)))) - (list q (- x (* q y))))) - (if (integerp x) (list x 0) - (let ((q (round x))) - (list q (- x q)))))) +(labels ((cl-floor (x &optional y) + (let ((q (floor x y))) + (list q (- x (if y (* y q) q))))) + (cl-ceiling (x &optional y) + (let ((res (cl-floor x y))) + (if (= (car (cdr res)) 0) res + (list (1+ (car res)) (- (car (cdr res)) (or y 1)))))) + (cl-truncate (x &optional y) + (if (eq (>= x 0) (or (null y) (>= y 0))) + (cl-floor x y) (cl-ceiling x y))) + (cl-round (x &optional y) + (if y + (if (and (integerp x) (integerp y)) + (let* ((hy (/ y 2)) + (res (cl-floor (+ x hy) y))) + (if (and (= (car (cdr res)) 0) + (= (+ hy hy) y) + (/= (% (car res) 2) 0)) + (list (1- (car res)) hy) + (list (car res) (- (car (cdr res)) hy)))) + (let ((q (round (/ x y)))) + (list q (- x (* q y))))) + (if (integerp x) (list x 0) + (let ((q (round x))) + (list q (- x q)))))) (Assert-rounding (first second &key one-floor-result two-floor-result one-ffloor-result two-ffloor-result ＠＠ -2099,24 +2099,24 ＠＠ ;; Multiple value tests. -(flet ((foo (x y) - (floor (+ x y) y)) - (foo-zero (x y) - (values (floor (+ x y) y))) - (multiple-value-function-returning-t () - (values t pi e degrees-to-radians radians-to-degrees)) - (multiple-value-function-returning-nil () - (values nil pi e radians-to-degrees degrees-to-radians)) - (function-throwing-multiple-values () - (let* ((listing '(0 3 4 nil "string" symbol)) - (tail listing) - elt) - (while t - (setq tail (cdr listing) - elt (car listing) - listing tail) - (when (null elt) - (throw 'VoN61Lo4Y (multiple-value-function-returning-t))))))) +(labels ((foo (x y) + (floor (+ x y) y)) + (foo-zero (x y) + (values (floor (+ x y) y))) + (multiple-value-function-returning-t () + (values t pi e degrees-to-radians radians-to-degrees)) + (multiple-value-function-returning-nil () + (values nil pi e radians-to-degrees degrees-to-radians)) + (function-throwing-multiple-values () + (let* ((listing '(0 3 4 nil "string" symbol)) + (tail listing) + elt) + (while t + (setq tail (cdr listing) + elt (car listing) + listing tail) + (when (null elt) + (throw 'VoN61Lo4Y (multiple-value-function-returning-t))))))) (Assert (= (+ (floor 5 3) (floor 19 4)) (+ 1 4) 5) "Checking that multiple values are discarded correctly as func args") ＠＠ -2509,10 +2509,10 ＠＠ (Assert (equal expected (merge 'list list '(1) #'<)) "checking merge's circularity checks are sane")) -(flet ((list-nreverse (list) - (do ((list1 list (cdr list1)) - (list2 nil (prog1 list1 (setcdr list1 list2)))) - ((atom list1) list2)))) +(labels ((list-nreverse (list) + (do ((list1 list (cdr list1)) + (list2 nil (prog1 list1 (setcdr list1 list2)))) + ((atom list1) list2)))) (let* ((integers (loop for i from 0 to 6000 collect i)) (characters (mapcan #'(lambda (integer) (if (char-int-p integer) ＠＠ -2898,16 +2898,17 ＠＠ ;; behave incorrectly when compiled for the contorted-example function of ;; CLTL2, whence the following test: -(flet ((needs-lexical-context (first second third) - (if (eql 0 first) - (funcall second) - (block awkward - (+ 5 (needs-lexical-context - (1- first) - third - #'(lambda () (return-from awkward 0))) - first))))) - (if (compiled-function-p (symbol-function 'needs-lexical-context)) +(labels ((needs-lexical-context (first second third) + (if (eql 0 first) + (funcall second) + (block awkward + (+ 5 (needs-lexical-context + (1- first) + third + #'(lambda () (return-from awkward 0))) + first))))) + (if (compiled-function-p + (ignore-errors (indirect-function #'needs-lexical-context))) (Known-Bug-Expect-Failure (Assert (eql 0 (needs-lexical-context 2 nil nil)) "the function special operator doesn't create a lexical context.")) diff -r 89cb6a66a61f -r 071b810ceb18 tests/automated/mule-tests.el --- a/tests/automated/mule-tests.el Mon Oct 03 19:39:01 2011 +0100 +++ b/tests/automated/mule-tests.el Mon Oct 03 20:16:14 2011 +0100 ＠＠ -647,7 +647,7 ＠＠ finally (set-language-environment original-language-environment)) (with-temp-buffer - (flet + (labels ((Assert-elc-is-escape-quoted () "Assert the current buffer has an escape-quoted cookie if compiled." (save-excursion diff -r 89cb6a66a61f -r 071b810ceb18 tests/automated/os-tests.el --- a/tests/automated/os-tests.el Mon Oct 03 19:39:01 2011 +0100 +++ b/tests/automated/os-tests.el Mon Oct 03 20:16:14 2011 +0100 ＠＠ -62,13 +62,13 ＠＠ (while cases (setq case (car cases) cases (cdr cases)) - (flet ((do-test (pos result) - (erase-buffer) - (insert original-string) - (goto-char pos) - (call-process-region 3 7 "tac" t t) - (goto-char (point-min)) - (Assert (looking-at result)))) + (labels ((do-test (pos result) + (erase-buffer) + (insert original-string) + (goto-char pos) + (call-process-region 3 7 "tac" t t) + (goto-char (point-min)) + (Assert (looking-at result)))) (do-test (car case) (cdr case))))) ;; if you're in that much of a hurry you can blow cat off ;; if you've done tac, but I'm not going to bother ＠＠ -80,13 +80,13 ＠＠ (while cases (setq case (car cases) cases (cdr cases)) - (flet ((do-test (pos result) - (erase-buffer) - (insert original-string) - (goto-char pos) - (call-process-region 3 7 "cat" t t) - (goto-char (point-min)) - (Assert (looking-at result)))) + (labels ((do-test (pos result) + (erase-buffer) + (insert original-string) + (goto-char pos) + (call-process-region 3 7 "cat" t t) + (goto-char (point-min)) + (Assert (looking-at result)))) (do-test (car case) (cdr case))))))) (loop diff -r 89cb6a66a61f -r 071b810ceb18 tests/automated/symbol-tests.el --- a/tests/automated/symbol-tests.el Mon Oct 03 19:39:01 2011 +0100 +++ b/tests/automated/symbol-tests.el Mon Oct 03 20:16:14 2011 +0100 ＠＠ -66,20 +66,20 ＠＠ (Assert (not (eq interned uninterned))) (Assert (not (equal interned uninterned))))) -(flet ((check-weak-list-unique (weak-list &optional reversep) - "Check that elements of WEAK-LIST are referenced only there." - (let ((len (length (weak-list-list weak-list)))) - (if (string-match "Using the new GC algorithms." - Installation-string) - (Implementation-Incomplete-Expect-Failure - (Assert (not (zerop len))) - (garbage-collect) - (Assert (eq (length (weak-list-list weak-list)) - (if (not reversep) 0 len)))) - (Assert (not (zerop len))) - (garbage-collect) - (Assert (eq (length (weak-list-list weak-list)) - (if (not reversep) 0 len))))))) +(labels ((check-weak-list-unique (weak-list &optional reversep) + "Check that elements of WEAK-LIST are referenced only there." + (let ((len (length (weak-list-list weak-list)))) + (if (string-match "Using the new GC algorithms." + Installation-string) + (Implementation-Incomplete-Expect-Failure + (Assert (not (zerop len))) + (garbage-collect) + (Assert (eq (length (weak-list-list weak-list)) + (if (not reversep) 0 len)))) + (Assert (not (zerop len))) + (garbage-collect) + (Assert (eq (length (weak-list-list weak-list)) + (if (not reversep) 0 len))))))) (let ((weak-list (make-weak-list)) (gc-cons-threshold most-positive-fixnum)) ;; Symbols created with `make-symbol' and `gensym' should be fresh diff -r 89cb6a66a61f -r 071b810ceb18 tests/automated/syntax-tests.el --- a/tests/automated/syntax-tests.el Mon Oct 03 19:39:01 2011 +0100 +++ b/tests/automated/syntax-tests.el Mon Oct 03 20:16:14 2011 +0100 ＠＠ -179,10 +179,10 ＠＠ (insert "a ( \"b (c\" (\"defg\") \")\") h\n") ;; #### This test should check *every* position. - (flet ((backward-up-list-moves-point-from-to (start expected-end) - (goto-char start) - (backward-up-list 1) - (= (point) expected-end))) + (labels ((backward-up-list-moves-point-from-to (start expected-end) + (goto-char start) + (backward-up-list 1) + (= (point) expected-end))) (Known-Bug-Expect-Failure ;; Evgeny's case (Assert (backward-up-list-moves-point-from-to 16 12))) _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches