source: trunk/source/tests/ansi-tests/ash.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 1.5 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Sep  7 08:43:03 2003
4;;;; Contains: Tests of ASH
5
6(in-package :cl-test)
7
8;;; Error tests
9
10(deftest ash.error.1
11  (signals-error (ash) program-error)
12  t)
13
14(deftest ash.error.2
15  (signals-error (ash 1 1 1) program-error)
16  t)
17
18(deftest ash.error.3
19  (signals-error (ash 1 1 nil) program-error)
20  t)
21
22(deftest ash.error.4
23  (check-type-error #'(lambda (x) (ash x 0)) #'integerp)
24  nil)
25
26(deftest ash.error.5
27  (check-type-error #'(lambda (x) (ash 0 x)) #'integerp)
28  nil)
29
30;;; Non-error tests
31
32(deftest ash.1
33  (loop for x in *integers*
34        always (eql (ash x 0) x))
35  t)
36
37(deftest ash.2
38  (loop for i = (random-fixnum)
39        for s = (random-from-interval 40)
40        for ishifted = (ash i s)
41        repeat 1000
42        always (eql (floor (* i (expt 2 s))) ishifted))
43  t)
44
45(deftest ash.3
46  (let* ((nbits 100)
47         (bound (expt 2 nbits)))
48    (loop for i = (random-from-interval bound)
49          for s = (random-from-interval (+ nbits 20))
50          for ishifted = (ash i s)
51          repeat 1000
52          always (eql (floor (* i (expt 2 s))) ishifted)))
53  t)
54
55(deftest ash.4
56  (loop for i from -1 downto -1000
57        always (eql (ash i i) -1))
58  t)
59
60(deftest ash.5
61  (loop for i from 1 to 100
62        for j = (- (ash 1 i))
63        always (eql (ash j j) -1))
64  t)
65
66(deftest ash.6
67  (macrolet
68   ((%m (z) z))
69   (values
70    (ash (expand-in-current-env (%m 3)) 1)
71    (ash 1 (expand-in-current-env (%m 3)))))
72  6 8)
73
74(deftest ash.order.1
75  (let ((i 0) x y)
76    (values (ash (progn (setf x (incf i)) 1)
77                 (progn (setf y (incf i)) 2))
78            i x y))
79  4 2 1 2)
Note: See TracBrowser for help on using the repository browser.