← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/sbit.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/sbit.lsp
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Sun Jan 26 15:30:31 2003
 
4
;;;; Contains: Tests for SBIT
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
(deftest sbit.1
 
9
  (sbit #*0010 2)
 
10
  1)
 
11
 
 
12
(deftest sbit.2
 
13
  (let ((a #*00000000))
 
14
    (loop for i from 0 below (length a)
 
15
          collect (let ((b (copy-seq a)))
 
16
                    (setf (sbit b i) 1)
 
17
                    b)))
 
18
  (#*10000000
 
19
   #*01000000
 
20
   #*00100000
 
21
   #*00010000
 
22
   #*00001000
 
23
   #*00000100
 
24
   #*00000010
 
25
   #*00000001))
 
26
 
 
27
(deftest sbit.3
 
28
  (let ((a #*11111111))
 
29
    (loop for i from 0 below (length a)
 
30
          collect (let ((b (copy-seq a)))
 
31
                    (setf (sbit b i) 0)
 
32
                    b)))
 
33
  (#*01111111
 
34
   #*10111111
 
35
   #*11011111
 
36
   #*11101111
 
37
   #*11110111
 
38
   #*11111011
 
39
   #*11111101
 
40
   #*11111110))
 
41
 
 
42
(deftest sbit.4
 
43
  (let ((a (make-array nil :element-type 'bit :initial-element 0)))
 
44
    (values
 
45
     (aref a)
 
46
     (sbit a)
 
47
     (setf (sbit a) 1)
 
48
     (aref a)
 
49
     (sbit a)))
 
50
  0 0 1 1 1)
 
51
 
 
52
(deftest sbit.5
 
53
  (let ((a (make-array '(1 1) :element-type 'bit :initial-element 0)))
 
54
    (values
 
55
     (aref a 0 0)
 
56
     (sbit a 0 0)
 
57
     (setf (sbit a 0 0) 1)
 
58
     (aref a 0 0)
 
59
     (sbit a 0 0)))
 
60
  0 0 1 1 1)
 
61
 
 
62
(deftest sbit.6
 
63
  (let ((a (make-array '(10 10) :element-type 'bit :initial-element 0)))
 
64
    (values
 
65
     (aref a 5 5)
 
66
     (sbit a 5 5)
 
67
     (setf (sbit a 5 5) 1)
 
68
     (aref a 5 5)
 
69
     (sbit a 5 5)))
 
70
  0 0 1 1 1)
 
71
 
 
72
(deftest sbit.order.1
 
73
  (let ((i 0) a b)
 
74
    (values
 
75
     (sbit (progn (setf a (incf i)) #*001001)
 
76
           (progn (setf b (incf i)) 1))
 
77
     i a b))
 
78
  0 2 1 2)
 
79
 
 
80
(deftest sbit.order.2
 
81
  (let ((i 0) a b c
 
82
        (v (copy-seq #*001001)))
 
83
    (values
 
84
     (setf (sbit (progn (setf a (incf i)) v)
 
85
                 (progn (setf b (incf i)) 1))
 
86
           (progn (setf c (incf i)) 1))
 
87
     v i a b c))
 
88
  1 #*011001 3 1 2 3)
 
89
 
 
90
(deftest sbit.error.1
 
91
  (signals-error (sbit) program-error)
 
92
  t)
 
93
 
 
94
  
 
95
  
 
 
b'\\ No newline at end of file'