Mercurial > hg > xemacs-beta

diff tests/automated/lisp-tests.el @ 5576:071b810ceb18

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Declare labels as line where appropriate; use #'labels, not #'flet, tests. lisp/ChangeLog addition: 2011-10-03 Aidan Kehoe <kehoea@parhasard.net> * 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@parhasard.net> * 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.
author Aidan Kehoe <kehoea@parhasard.net>
date Mon, 03 Oct 2011 20:16:14 +0100
parents d4f334808463
children 391d809fa4e9
line wrap: on
line diff
--- 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."))