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