ash.lsp 1.62 KB
Newer Older
1 2 3 4 5 6 7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Sep  7 08:43:03 2003
;;;; Contains: Tests of ASH

(in-package :cl-test)

8 9
;;; Error tests

10
(deftest ash.error.1
11 12
  (signals-error (ash) program-error)
  t)
13 14

(deftest ash.error.2
15 16
  (signals-error (ash 1 1 1) program-error)
  t)
17 18

(deftest ash.error.3
19 20
  (signals-error (ash 1 1 nil) program-error)
  t)
21 22

(deftest ash.error.4
23
  (check-type-error #'(lambda (x) (ash x 0)) #'integerp)
24 25 26
  nil)

(deftest ash.error.5
27
  (check-type-error #'(lambda (x) (ash 0 x)) #'integerp)
28 29
  nil)

30 31
;;; Non-error tests

32 33
(deftest ash.1
  (loop for x in *integers*
sds's avatar
sds committed
34
        always (eql (ash x 0) x))
35 36 37 38
  t)

(deftest ash.2
  (loop for i = (random-fixnum)
sds's avatar
sds committed
39 40 41 42
        for s = (random-from-interval 40)
        for ishifted = (ash i s)
        repeat 1000
        always (eql (floor (* i (expt 2 s))) ishifted))
43 44 45 46
  t)

(deftest ash.3
  (let* ((nbits 100)
sds's avatar
sds committed
47
         (bound (expt 2 nbits)))
48
    (loop for i = (random-from-interval bound)
sds's avatar
sds committed
49 50 51 52
          for s = (random-from-interval (+ nbits 20))
          for ishifted = (ash i s)
          repeat 1000
          always (eql (floor (* i (expt 2 s))) ishifted)))
53 54
  t)

55
(deftest ash.4
56
  (loop for i from -1 downto -1000
sds's avatar
sds committed
57
        always (eql (ash i i) -1))
58 59 60 61
  t)

(deftest ash.5
  (loop for i from 1 to 100
sds's avatar
sds committed
62 63
        for j = (- (ash 1 i))
        always (eql (ash j j) -1))
64 65
  t)

66 67 68 69 70 71 72 73
(deftest ash.6
  (macrolet
   ((%m (z) z))
   (values
    (ash (expand-in-current-env (%m 3)) 1)
    (ash 1 (expand-in-current-env (%m 3)))))
  6 8)

74 75 76
(deftest ash.order.1
  (let ((i 0) x y)
    (values (ash (progn (setf x (incf i)) 1)
sds's avatar
sds committed
77 78
                 (progn (setf y (incf i)) 2))
            i x y))
79
  4 2 1 2)