Mercurial > hg > xemacs-beta

diff tests/automated/lisp-tests.el @ 5915:1af53d35dd53

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Avoid allocation in #'integer-length; add #'logcount. lisp/ChangeLog addition: 2015-05-29 Aidan Kehoe <kehoea@parhasard.net> * byte-optimize.el (side-effect-free-fns): Add #'integer-length, #'logcount here. * cl-extra.el: * cl-extra.el (integer-length): Update this to avoid allocating memory. * cl-extra.el (logcount): New. Return the number of one bits in INTEGER, if non-negative. Function from Common Lisp. tests/ChangeLog addition: 2015-05-29 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: Test #'integer-length, #'logcount in this file.
author Aidan Kehoe <kehoea@parhasard.net>
date Fri, 29 May 2015 17:06:24 +0100
parents 47ffa085a9ad
children ffb5abc8dc4e
line wrap: on
line diff
--- a/tests/automated/lisp-tests.el	Fri May 15 18:11:47 2015 +0100
+++ b/tests/automated/lisp-tests.el	Fri May 29 17:06:24 2015 +0100
@@ -564,6 +564,56 @@
     (Assert (eq 2 (logxor one three)) (list one three))))
 
 ;;-----------------------------------------------------
+;; Test `integer-length', `logcount'
+;;-----------------------------------------------------
+
+(Check-Error wrong-type-argument (integer-length 0.0))
+(Check-Error wrong-type-argument (integer-length 'symbol))
+(Assert (eql (integer-length 0) 0))
+(Assert (eql (integer-length -1) 0))
+(Assert (eql (integer-length 1) 1))
+(Assert (eql (integer-length #x-F) 4))
+(Assert (eql (integer-length #xF) 4))
+(Assert (eql (integer-length #x-10) 4))
+(Assert (eql (integer-length #x10) 5))
+
+(Check-Error wrong-type-argument (logcount 0.0))
+(Check-Error wrong-type-argument (logcount 'symbol))
+(Assert (eql (logcount 0) 0))
+(Assert (eql (logcount 1) 1))
+(Assert (eql (logcount -1) 0))
+(Assert (eql (logcount #x-F) 3))
+(Assert (eql (logcount #xF) 4))
+(Assert (eql (logcount #x-10) 4))
+(Assert (eql (logcount #x10) 1))
+
+(macrolet
+    ((random-sample-n () 10) ;; Increase this to get a bigger sample.
+     (test-integer-length-random-sample ()
+       (cons
+        'progn
+        (loop for index from 0 to (random-sample-n)
+              nconc (let* ((value (random (if (featurep 'bignum)
+                                              (lsh most-positive-fixnum 4)
+                                            most-positive-fixnum)))
+                           (length (length (format "%b" value))))
+                      `((Assert (eql (integer-length ,value) ,length))
+                        (Assert (eql (integer-length ,(1- (- value)))
+                                                     ,length)))))))
+     (test-logcount-random-sample ()
+       (cons
+        'progn
+        (loop for index from 0 to (random-sample-n)
+              nconc (let* ((value (random (if (featurep 'bignum)
+                                              (lsh most-positive-fixnum 4)
+                                            most-positive-fixnum)))
+                           (count (count ?1 (format "%b" value))))
+                      `((Assert (eql (logcount ,value) ,count))
+                        (Assert (eql (logcount ,(lognot value)) ,count))))))))
+  (test-integer-length-random-sample)
+  (test-logcount-random-sample))
+
+;;-----------------------------------------------------
 ;; Test `%', mod
 ;;-----------------------------------------------------
 (Check-Error wrong-number-of-arguments (%))