test-suite/tests/srfi-1.test

   1 ;;;; srfi-1.test --- Test suite for Guile's SRFI-1 functions. -*- scheme -*-
   2 ;;;;
   3 ;;;; Copyright 2003 Free Software Foundation, Inc.
   4 ;;;;
   5 ;;;; This program is free software; you can redistribute it and/or modify
   6 ;;;; it under the terms of the GNU General Public License as published by
   7 ;;;; the Free Software Foundation; either version 2, or (at your option)
   8 ;;;; any later version.
   9 ;;;;
  10 ;;;; This program is distributed in the hope that it will be useful,
  11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 ;;;; GNU General Public License for more details.
  14 ;;;;
  15 ;;;; You should have received a copy of the GNU General Public License
  16 ;;;; along with this software; see the file COPYING.  If not, write to
  17 ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  18 ;;;; Boston, MA 02111-1307 USA
  19
  20 (use-modules (srfi srfi-1)
  21              (test-suite lib))
  22
  23
  24 ;;
  25 ;; drop
  26 ;;
  27
  28 (with-test-prefix "drop"
  29
  30   (pass-if "'() 0"
  31     (null? (drop '() 0)))
  32
  33   (pass-if "'(a) 0"
  34     (let ((lst '(a)))
  35       (eq? lst
  36            (drop lst 0))))
  37
  38   (pass-if "'(a b) 0"
  39     (let ((lst '(a b)))
  40       (eq? lst
  41            (drop lst 0))))
  42
  43   (pass-if "'(a) 1"
  44     (let ((lst '(a)))
  45       (eq? (cdr lst)
  46            (drop lst 1))))
  47
  48   (pass-if "'(a b) 1"
  49     (let ((lst '(a b)))
  50       (eq? (cdr lst)
  51            (drop lst 1))))
  52
  53   (pass-if "'(a b) 2"
  54     (let ((lst '(a b)))
  55       (eq? (cddr lst)
  56            (drop lst 2))))
  57
  58   (pass-if "'(a b c) 1"
  59     (let ((lst '(a b c)))
  60       (eq? (cddr lst)
  61            (drop lst 2))))
  62
  63   (pass-if "circular '(a) 0"
  64     (let ((lst (circular-list 'a)))
  65       (eq? lst
  66            (drop lst 0))))
  67
  68   (pass-if "circular '(a) 1"
  69     (let ((lst (circular-list 'a)))
  70       (eq? lst
  71            (drop lst 1))))
  72
  73   (pass-if "circular '(a) 2"
  74     (let ((lst (circular-list 'a)))
  75       (eq? lst
  76            (drop lst 1))))
  77
  78   (pass-if "circular '(a b) 1"
  79     (let ((lst (circular-list 'a)))
  80       (eq? (cdr lst)
  81            (drop lst 0))))
  82
  83   (pass-if "circular '(a b) 2"
  84     (let ((lst (circular-list 'a)))
  85       (eq? lst
  86            (drop lst 1))))
  87
  88   (pass-if "circular '(a b) 5"
  89     (let ((lst (circular-list 'a)))
  90       (eq? (cdr lst)
  91            (drop lst 5))))
  92
  93   (pass-if "'(a . b) 1"
  94     (eq? 'b
  95          (drop '(a . b) 1)))
  96
  97   (pass-if "'(a b . c) 1"
  98     (equal? 'c
  99             (drop '(a b . c) 2))))
 100
 101 ;;
 102 ;; take
 103 ;;
 104
 105 (with-test-prefix "take"
 106
 107   (pass-if "'() 0"
 108     (null? (take '() 0)))
 109
 110   (pass-if "'(a) 0"
 111     (null? (take '(a) 0)))
 112
 113   (pass-if "'(a b) 0"
 114     (null? (take '() 0)))
 115
 116   (pass-if "'(a b c) 0"
 117     (null? (take '() 0)))
 118
 119   (pass-if "'(a) 1"
 120     (let* ((lst '(a))
 121            (got (take lst 1)))
 122       (and (equal? '(a) got)
 123            (not (eq? lst got)))))
 124
 125   (pass-if "'(a b) 1"
 126     (equal? '(a)
 127             (take '(a b) 1)))
 128
 129   (pass-if "'(a b c) 1"
 130     (equal? '(a)
 131             (take '(a b c) 1)))
 132
 133   (pass-if "'(a b) 2"
 134     (let* ((lst '(a b))
 135            (got (take lst 2)))
 136       (and (equal? '(a b) got)
 137            (not (eq? lst got)))))
 138
 139   (pass-if "'(a b c) 2"
 140     (equal? '(a b)
 141             (take '(a b c) 2)))
 142
 143   (pass-if "circular '(a) 0"
 144     (equal? '()
 145             (take (circular-list 'a) 0)))
 146
 147   (pass-if "circular '(a) 1"
 148     (equal? '(a)
 149             (take (circular-list 'a) 1)))
 150
 151   (pass-if "circular '(a) 2"
 152     (equal? '(a a)
 153             (take (circular-list 'a) 2)))
 154
 155   (pass-if "circular '(a b) 5"
 156     (equal? '(a b a b a)
 157             (take (circular-list 'a 'b) 5)))
 158
 159   (pass-if "'(a . b) 1"
 160     (equal? '(a)
 161             (take '(a . b) 1)))
 162
 163   (pass-if "'(a b . c) 1"
 164     (equal? '(a)
 165             (take '(a b . c) 1)))
 166
 167   (pass-if "'(a b . c) 2"
 168     (equal? '(a b)
 169             (take '(a b . c) 2))))