Mercurial > hg > xemacs-beta
comparison tests/automated/lisp-tests.el @ 5915:1af53d35dd53
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 |
comparison
equal
deleted
inserted
replaced
| 5914:bd4d2c8ef9cc | 5915:1af53d35dd53 |
|---|---|
| 560 (Assert (eq 3 (logxor one two)) (list one two))) | 560 (Assert (eq 3 (logxor one two)) (list one two))) |
| 561 (dolist (three '(3 ?\03)) | 561 (dolist (three '(3 ?\03)) |
| 562 (Assert (eq 1 (logand one three)) (list one three)) | 562 (Assert (eq 1 (logand one three)) (list one three)) |
| 563 (Assert (eq 3 (logior one three)) (list one three)) | 563 (Assert (eq 3 (logior one three)) (list one three)) |
| 564 (Assert (eq 2 (logxor one three)) (list one three)))) | 564 (Assert (eq 2 (logxor one three)) (list one three)))) |
| 565 | |
| 566 ;;----------------------------------------------------- | |
| 567 ;; Test `integer-length', `logcount' | |
| 568 ;;----------------------------------------------------- | |
| 569 | |
| 570 (Check-Error wrong-type-argument (integer-length 0.0)) | |
| 571 (Check-Error wrong-type-argument (integer-length 'symbol)) | |
| 572 (Assert (eql (integer-length 0) 0)) | |
| 573 (Assert (eql (integer-length -1) 0)) | |
| 574 (Assert (eql (integer-length 1) 1)) | |
| 575 (Assert (eql (integer-length #x-F) 4)) | |
| 576 (Assert (eql (integer-length #xF) 4)) | |
| 577 (Assert (eql (integer-length #x-10) 4)) | |
| 578 (Assert (eql (integer-length #x10) 5)) | |
| 579 | |
| 580 (Check-Error wrong-type-argument (logcount 0.0)) | |
| 581 (Check-Error wrong-type-argument (logcount 'symbol)) | |
| 582 (Assert (eql (logcount 0) 0)) | |
| 583 (Assert (eql (logcount 1) 1)) | |
| 584 (Assert (eql (logcount -1) 0)) | |
| 585 (Assert (eql (logcount #x-F) 3)) | |
| 586 (Assert (eql (logcount #xF) 4)) | |
| 587 (Assert (eql (logcount #x-10) 4)) | |
| 588 (Assert (eql (logcount #x10) 1)) | |
| 589 | |
| 590 (macrolet | |
| 591 ((random-sample-n () 10) ;; Increase this to get a bigger sample. | |
| 592 (test-integer-length-random-sample () | |
| 593 (cons | |
| 594 'progn | |
| 595 (loop for index from 0 to (random-sample-n) | |
| 596 nconc (let* ((value (random (if (featurep 'bignum) | |
| 597 (lsh most-positive-fixnum 4) | |
| 598 most-positive-fixnum))) | |
| 599 (length (length (format "%b" value)))) | |
| 600 `((Assert (eql (integer-length ,value) ,length)) | |
| 601 (Assert (eql (integer-length ,(1- (- value))) | |
| 602 ,length))))))) | |
| 603 (test-logcount-random-sample () | |
| 604 (cons | |
| 605 'progn | |
| 606 (loop for index from 0 to (random-sample-n) | |
| 607 nconc (let* ((value (random (if (featurep 'bignum) | |
| 608 (lsh most-positive-fixnum 4) | |
| 609 most-positive-fixnum))) | |
| 610 (count (count ?1 (format "%b" value)))) | |
| 611 `((Assert (eql (logcount ,value) ,count)) | |
| 612 (Assert (eql (logcount ,(lognot value)) ,count)))))))) | |
| 613 (test-integer-length-random-sample) | |
| 614 (test-logcount-random-sample)) | |
| 565 | 615 |
| 566 ;;----------------------------------------------------- | 616 ;;----------------------------------------------------- |
| 567 ;; Test `%', mod | 617 ;; Test `%', mod |
| 568 ;;----------------------------------------------------- | 618 ;;----------------------------------------------------- |
| 569 (Check-Error wrong-number-of-arguments (%)) | 619 (Check-Error wrong-number-of-arguments (%)) |