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