source: trunk/source/tests/ansi-tests/ldb.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.9 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Thu Sep 11 20:45:17 2003
4;;;; Contains: Tests of LDB
5
6(in-package :cl-test)
7
8;;; Error tests
9
10(deftest ldb.error.1
11  (signals-error (ldb) program-error)
12  t)
13
14(deftest ldb.error.2
15  (signals-error (ldb (byte 1 1)) program-error)
16  t)
17
18(deftest ldb.error.3
19  (signals-error (ldb (byte 1 1) -1 0) program-error)
20  t)
21
22;;; Non-error tests
23
24(deftest ldb.1
25  (loop for x = (random-fixnum)
26        for pos = (random 30)
27        for size = (random 30)
28        repeat 10000
29        unless (eql (ldb (byte size pos) x)
30                    (logand (1- (ash 1 size))
31                            (ash x (- pos))))
32        collect (list x pos size))
33  nil)
34
35
36(deftest ldb.2
37  (let ((bound (ash 1 300)))
38    (loop for x = (random-from-interval bound)
39          for pos = (random 300)
40          for size = (random 300)
41          repeat 1000
42          unless (eql (ldb (byte size pos) x)
43                      (logand (1- (ash 1 size))
44                              (ash x (- pos))))
45          collect (list x pos size)))
46  nil)
47
48(deftest ldb.3
49  (loop for i of-type fixnum from -1000 to 1000
50        always (eql (ldb (byte 0 0) i) 0))
51  t)
52
53(deftest ldb.order.1
54  (let ((i 0) a b c d)
55    (values
56     (ldb (progn (setf a (incf i))
57                 (byte (progn (setf b (incf i)) 3)
58                       (progn (setf c (incf i)) 1)))
59          (progn (setf d (incf i)) -1))
60     i a b c d))
61  7 4 1 2 3 4)
62
63;;; ldb on places
64
65(deftest ldb.place.1
66  (let ((x 0))
67    (values
68     (setf (ldb (byte 4 1) x) -1)
69     x))
70  -1 30)
71
72(deftest ldb.place.2
73  (loop for pos from 0 to 100
74        always
75        (loop for size from 0 to 100
76              always
77              (let ((x 0))
78                (and (eql (setf (ldb (byte size pos) x) -1) -1)
79                     (eql x (ash (1- (ash 1 size)) pos))))))
80  t)
81
82(deftest ldb.place.order.1
83  (let ((i 0) a b c d e f (x (copy-seq #(63))))
84    (values
85     (setf (ldb (progn (setf a (incf i))
86                       (byte (progn (setf b (incf i)) 3)
87                             (progn (setf c (incf i)) 1)))
88                (aref (progn (setf d (incf i)) x)
89                      (progn (setf e (incf i)) 0)))
90           (progn (setf f (incf i)) 0))
91     x
92     i a b c d e f))
93  0 #(49) 6 1 2 3 4 5 6)
Note: See TracBrowser for help on using the repository browser.