test-suite/tests/srfi-4.test

   1 ;;;; srfi-4.test --- Test suite for Guile's SRFI-4 functions. -*- scheme -*-
   2 ;;;; Martin Grabmueller, 2001-06-26
   3 ;;;;
   4 ;;;; Copyright (C) 2001, 2006 Free Software Foundation, Inc.
   5 ;;;;
   6 ;;;; This library is free software; you can redistribute it and/or
   7 ;;;; modify it under the terms of the GNU Lesser General Public
   8 ;;;; License as published by the Free Software Foundation; either
   9 ;;;; version 3 of the License, or (at your option) any later version.
  10 ;;;;
  11 ;;;; This library is distributed in the hope that it will be useful,
  12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14 ;;;; Lesser General Public License for more details.
  15 ;;;;
  16 ;;;; You should have received a copy of the GNU Lesser General Public
  17 ;;;; License along with this library; if not, write to the Free Software
  18 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  19
  20 (use-modules (srfi srfi-4)
  21              (test-suite lib))
  22
  23 (with-test-prefix "u8 vectors"
  24
  25   (pass-if "u8vector? success"
  26     (u8vector? (u8vector)))
  27
  28   (pass-if "u8vector? failure"
  29     (not (u8vector? (s8vector))))
  30
  31   (pass-if "u8vector-length success 1"
  32     (= (u8vector-length (u8vector)) 0))
  33
  34   (pass-if "u8vector-length success 2"
  35     (= (u8vector-length (u8vector 3)) 1))
  36
  37   (pass-if "u8vector-length failure"
  38     (not (= (u8vector-length (u8vector 3)) 3)))
  39
  40   (pass-if "u8vector-ref"
  41     (= (u8vector-ref (u8vector 1 2 3) 1) 2))
  42
  43   (pass-if "u8vector-set!/ref"
  44     (= (let ((s (make-u8vector 10 0)))
  45          (u8vector-set! s 4 33)
  46          (u8vector-ref s 4)) 33))
  47
  48   (pass-if "u8vector->list/list->u8vector"
  49     (equal? (u8vector->list (u8vector 1 2 3 4))
  50             (u8vector->list (list->u8vector '(1 2 3 4))))))
  51
  52 (with-test-prefix "s8 vectors"
  53
  54   (pass-if "s8vector? success"
  55     (s8vector? (s8vector)))
  56
  57   (pass-if "s8vector? failure"
  58     (not (s8vector? (u8vector))))
  59
  60   (pass-if "s8vector-length success 1"
  61     (= (s8vector-length (s8vector)) 0))
  62
  63   (pass-if "s8vector-length success 2"
  64     (= (s8vector-length (s8vector -3)) 1))
  65
  66   (pass-if "s8vector-length failure"
  67     (not (= (s8vector-length (s8vector 3)) 3)))
  68
  69   (pass-if "s8vector-ref"
  70     (= (s8vector-ref (s8vector 1 2 3) 1) 2))
  71
  72   (pass-if "s8vector-set!/ref"
  73     (= (let ((s (make-s8vector 10 0)))
  74          (s8vector-set! s 4 33)
  75          (s8vector-ref s 4)) 33))
  76
  77   (pass-if "s8vector->list/list->s8vector"
  78     (equal? (s8vector->list (s8vector 1 2 3 4))
  79             (s8vector->list (list->s8vector '(1 2 3 4))))))
  80
  81
  82 (with-test-prefix "u16 vectors"
  83
  84   (pass-if "u16vector? success"
  85     (u16vector? (u16vector)))
  86
  87   (pass-if "u16vector? failure"
  88     (not (u16vector? (s16vector))))
  89
  90   (pass-if "u16vector-length success 1"
  91     (= (u16vector-length (u16vector)) 0))
  92
  93   (pass-if "u16vector-length success 2"
  94     (= (u16vector-length (u16vector 3)) 1))
  95
  96   (pass-if "u16vector-length failure"
  97     (not (= (u16vector-length (u16vector 3)) 3)))
  98
  99   (pass-if "u16vector-ref"
 100     (= (u16vector-ref (u16vector 1 2 3) 1) 2))
 101
 102   (pass-if "u16vector-set!/ref"
 103     (= (let ((s (make-u16vector 10 0)))
 104          (u16vector-set! s 4 33)
 105          (u16vector-ref s 4)) 33))
 106
 107   (pass-if "u16vector->list/list->u16vector"
 108     (equal? (u16vector->list (u16vector 1 2 3 4))
 109             (u16vector->list (list->u16vector '(1 2 3 4))))))
 110
 111 (with-test-prefix "s16 vectors"
 112
 113   (pass-if "s16vector? success"
 114     (s16vector? (s16vector)))
 115
 116   (pass-if "s16vector? failure"
 117     (not (s16vector? (u16vector))))
 118
 119   (pass-if "s16vector-length success 1"
 120     (= (s16vector-length (s16vector)) 0))
 121
 122   (pass-if "s16vector-length success 2"
 123     (= (s16vector-length (s16vector -3)) 1))
 124
 125   (pass-if "s16vector-length failure"
 126     (not (= (s16vector-length (s16vector 3)) 3)))
 127
 128   (pass-if "s16vector-ref"
 129     (= (s16vector-ref (s16vector 1 2 3) 1) 2))
 130
 131   (pass-if "s16vector-set!/ref"
 132     (= (let ((s (make-s16vector 10 0)))
 133          (s16vector-set! s 4 33)
 134          (s16vector-ref s 4)) 33))
 135
 136   (pass-if "s16vector->list/list->s16vector"
 137     (equal? (s16vector->list (s16vector 1 2 3 4))
 138             (s16vector->list (list->s16vector '(1 2 3 4))))))
 139
 140 (with-test-prefix "u32 vectors"
 141
 142   (pass-if "u32vector? success"
 143     (u32vector? (u32vector)))
 144
 145   (pass-if "u32vector? failure"
 146     (not (u32vector? (s32vector))))
 147
 148   (pass-if "u32vector-length success 1"
 149     (= (u32vector-length (u32vector)) 0))
 150
 151   (pass-if "u32vector-length success 2"
 152     (= (u32vector-length (u32vector 3)) 1))
 153
 154   (pass-if "u32vector-length failure"
 155     (not (= (u32vector-length (u32vector 3)) 3)))
 156
 157   (pass-if "u32vector-ref"
 158     (= (u32vector-ref (u32vector 1 2 3) 1) 2))
 159
 160   (pass-if "u32vector-set!/ref"
 161     (= (let ((s (make-u32vector 10 0)))
 162          (u32vector-set! s 4 33)
 163          (u32vector-ref s 4)) 33))
 164
 165   (pass-if "u32vector->list/list->u32vector"
 166     (equal? (u32vector->list (u32vector 1 2 3 4))
 167             (u32vector->list (list->u32vector '(1 2 3 4))))))
 168
 169 (with-test-prefix "s32 vectors"
 170
 171   (pass-if "s32vector? success"
 172     (s32vector? (s32vector)))
 173
 174   (pass-if "s32vector? failure"
 175     (not (s32vector? (u32vector))))
 176
 177   (pass-if "s32vector-length success 1"
 178     (= (s32vector-length (s32vector)) 0))
 179
 180   (pass-if "s32vector-length success 2"
 181     (= (s32vector-length (s32vector -3)) 1))
 182
 183   (pass-if "s32vector-length failure"
 184     (not (= (s32vector-length (s32vector 3)) 3)))
 185
 186   (pass-if "s32vector-ref"
 187     (= (s32vector-ref (s32vector 1 2 3) 1) 2))
 188
 189   (pass-if "s32vector-set!/ref"
 190     (= (let ((s (make-s32vector 10 0)))
 191          (s32vector-set! s 4 33)
 192          (s32vector-ref s 4)) 33))
 193
 194   (pass-if "s32vector->list/list->s32vector"
 195     (equal? (s32vector->list (s32vector 1 2 3 4))
 196             (s32vector->list (list->s32vector '(1 2 3 4))))))
 197
 198 (with-test-prefix "u64 vectors"
 199
 200   (pass-if "u64vector? success"
 201     (u64vector? (u64vector)))
 202
 203   (pass-if "u64vector? failure"
 204     (not (u64vector? (s64vector))))
 205
 206   (pass-if "u64vector-length success 1"
 207     (= (u64vector-length (u64vector)) 0))
 208
 209   (pass-if "u64vector-length success 2"
 210     (= (u64vector-length (u64vector 3)) 1))
 211
 212   (pass-if "u64vector-length failure"
 213     (not (= (u64vector-length (u64vector 3)) 3)))
 214
 215   (pass-if "u64vector-ref"
 216     (= (u64vector-ref (u64vector 1 2 3) 1) 2))
 217
 218   (pass-if "u64vector-set!/ref"
 219     (= (let ((s (make-u64vector 10 0)))
 220          (u64vector-set! s 4 33)
 221          (u64vector-ref s 4)) 33))
 222
 223   (pass-if "u64vector->list/list->u64vector"
 224     (equal? (u64vector->list (u64vector 1 2 3 4))
 225             (u64vector->list (list->u64vector '(1 2 3 4))))))
 226
 227 (with-test-prefix "s64 vectors"
 228
 229   (pass-if "s64vector? success"
 230     (s64vector? (s64vector)))
 231
 232   (pass-if "s64vector? failure"
 233     (not (s64vector? (u64vector))))
 234
 235   (pass-if "s64vector-length success 1"
 236     (= (s64vector-length (s64vector)) 0))
 237
 238   (pass-if "s64vector-length success 2"
 239     (= (s64vector-length (s64vector -3)) 1))
 240
 241   (pass-if "s64vector-length failure"
 242     (not (= (s64vector-length (s64vector 3)) 3)))
 243
 244   (pass-if "s64vector-ref"
 245     (= (s64vector-ref (s64vector 1 2 3) 1) 2))
 246
 247   (pass-if "s64vector-set!/ref"
 248     (= (let ((s (make-s64vector 10 0)))
 249          (s64vector-set! s 4 33)
 250          (s64vector-ref s 4)) 33))
 251
 252   (pass-if "s64vector->list/list->s64vector"
 253     (equal? (s64vector->list (s64vector 1 2 3 4))
 254             (s64vector->list (list->s64vector '(1 2 3 4))))))
 255
 256 (with-test-prefix "f32 vectors"
 257
 258   (pass-if "f32vector? success"
 259     (f32vector? (f32vector)))
 260
 261   (pass-if "f32vector? failure"
 262     (not (f32vector? (s8vector))))
 263
 264   (pass-if "f32vector-length success 1"
 265     (= (f32vector-length (f32vector)) 0))
 266
 267   (pass-if "f32vector-length success 2"
 268     (= (f32vector-length (f32vector -3)) 1))
 269
 270   (pass-if "f32vector-length failure"
 271     (not (= (f32vector-length (f32vector 3)) 3)))
 272
 273   (pass-if "f32vector-ref"
 274     (= (f32vector-ref (f32vector 1 2 3) 1) 2))
 275
 276   (pass-if "f32vector-set!/ref"
 277     (= (let ((s (make-f32vector 10 0)))
 278          (f32vector-set! s 4 33)
 279          (f32vector-ref s 4)) 33))
 280
 281   (pass-if "f32vector->list/list->f32vector"
 282     (equal? (f32vector->list (f32vector 1 2 3 4))
 283             (f32vector->list (list->f32vector '(1 2 3 4))))))
 284
 285 (with-test-prefix "f64 vectors"
 286
 287   (pass-if "f64vector? success"
 288     (f64vector? (f64vector)))
 289
 290   (pass-if "f64vector? failure"
 291     (not (f64vector? (f32vector))))
 292
 293   (pass-if "f64vector-length success 1"
 294     (= (f64vector-length (f64vector)) 0))
 295
 296   (pass-if "f64vector-length success 2"
 297     (= (f64vector-length (f64vector -3)) 1))
 298
 299   (pass-if "f64vector-length failure"
 300     (not (= (f64vector-length (f64vector 3)) 3)))
 301
 302   (pass-if "f64vector-ref"
 303     (= (f64vector-ref (f64vector 1 2 3) 1) 2))
 304
 305   (pass-if "f64vector-set!/ref"
 306     (= (let ((s (make-f64vector 10 0)))
 307          (f64vector-set! s 4 33)
 308          (f64vector-ref s 4)) 33))
 309
 310   (pass-if "f64vector->list/list->f64vector"
 311     (equal? (f64vector->list (f64vector 1 2 3 4))
 312             (f64vector->list (list->f64vector '(1 2 3 4))))))