guile18/test-suite/tests/common-list.test

   1 ;;;; common-list.test --- tests guile's common list functions -*- scheme -*-
   2 ;;;; Copyright (C) 2000, 2001, 2004, 2006 Free Software Foundation, Inc.
   3 ;;;;
   4 ;;;; This library is free software; you can redistribute it and/or
   5 ;;;; modify it under the terms of the GNU Lesser General Public
   6 ;;;; License as published by the Free Software Foundation; either
   7 ;;;; version 2.1 of the License, or (at your option) any later version.
   8 ;;;;
   9 ;;;; This library is distributed in the hope that it will be useful,
  10 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12 ;;;; Lesser General Public License for more details.
  13 ;;;;
  14 ;;;; You should have received a copy of the GNU Lesser General Public
  15 ;;;; License along with this library; if not, write to the Free Software
  16 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  17
  18 (define-module (test-suite test-common-list)
  19   #:use-module (test-suite lib)
  20   #:use-module (ice-9 documentation)
  21   #:use-module (ice-9 common-list))
  22
  23
  24 ;;;
  25 ;;; miscellaneous
  26 ;;;
  27
  28
  29 (define (documented? object)
  30   (not (not (object-documentation object))))
  31
  32
  33 ;;;
  34 ;;; intersection
  35 ;;;
  36
  37 (with-test-prefix "intersection"
  38
  39   (pass-if "documented?"
  40     (documented? intersection))
  41
  42   (pass-if "both arguments empty"
  43     (eq? (intersection '() '()) '()))
  44
  45   (pass-if "first argument empty"
  46     (eq? (intersection '() '(1)) '()))
  47
  48   (pass-if "second argument empty"
  49     (eq? (intersection '(1) '()) '()))
  50
  51   (pass-if "disjoint arguments"
  52     (eq? (intersection '(1) '(2)) '()))
  53
  54   (pass-if "equal arguments"
  55     (equal? (intersection '(1) '(1)) '(1)))
  56
  57   (pass-if "reverse argument order"
  58     (equal? (intersection '(1 2 3) '(3 2 1)) '(1 2 3)))
  59
  60   (pass-if "multiple matches in first list"
  61     (equal? (intersection '(1 1 2 2 3) '(3 2 1)) '(1 1 2 2 3)))
  62
  63   (pass-if "multiple matches in second list"
  64     (equal? (intersection '(1 2 3) '(3 3 2 2 1)) '(1 2 3)))
  65
  66   (pass-if "mixed arguments"
  67     (equal? (intersection '(1 2 3 5 7 8 10) '(1 3 4 7 8 9)) '(1 3 7 8)))
  68
  69   )
  70
  71
  72 ;;;
  73 ;;; set-difference
  74 ;;;
  75
  76 (with-test-prefix "set-difference"
  77
  78   (pass-if "documented?"
  79     (documented? set-difference))
  80
  81   (pass-if "both arguments empty"
  82     (eq? (set-difference '() '()) '()))
  83
  84   (pass-if "first argument empty"
  85     (eq? (set-difference '() '(1)) '()))
  86
  87   (pass-if "second argument empty"
  88     (equal? (set-difference '(1) '()) '(1)))
  89
  90   (pass-if "disjoint arguments"
  91     (equal? (set-difference '(1) '(2)) '(1)))
  92
  93   (pass-if "equal arguments"
  94     (eq? (set-difference '(1) '(1)) '()))
  95
  96   (pass-if "reverse argument order"
  97     (eq? (set-difference '(1 2 3) '(3 2 1)) '()))
  98
  99   (pass-if "multiple matches in first list"
 100     (eq? (set-difference '(1 1 2 2 3) '(3 2 1)) '()))
 101
 102   (pass-if "multiple matches in second list"
 103     (eq? (set-difference '(1 2 3) '(3 3 2 2 1)) '()))
 104
 105   (pass-if "mixed arguments"
 106     (equal? (set-difference '(1 2 3 5 7 8 10) '(1 3 4 7 8 9)) '(2 5 10)))
 107
 108   )
 109
 110
 111 ;;;
 112 ;;; remove-if
 113 ;;;
 114
 115 (with-test-prefix "remove-if"
 116
 117   (pass-if "documented?"
 118     (documented? remove-if))
 119
 120   (pass-if "empty list, remove all"
 121     (eq? (remove-if (lambda (x) #t) '()) '()))
 122
 123   (pass-if "empty list, remove none"
 124     (eq? (remove-if (lambda (x) #f) '()) '()))
 125
 126   (pass-if "non-empty list, remove all"
 127     (eq? (remove-if (lambda (x) #t) '(1 2 3 4)) '()))
 128
 129   (pass-if "non-empty list, remove none"
 130     (equal? (remove-if (lambda (x) #f) '(1 2 3 4)) '(1 2 3 4)))
 131
 132   (pass-if "non-empty list, remove some"
 133     (equal? (remove-if odd? '(1 2 3 4)) '(2 4)))
 134
 135   )
 136
 137
 138 ;;;
 139 ;;; remove-if-not
 140 ;;;
 141
 142
 143 (with-test-prefix "remove-if-not"
 144
 145   (pass-if "documented?"
 146     (documented? remove-if-not))
 147
 148   (pass-if "empty list, remove all"
 149     (eq? (remove-if-not (lambda (x) #f) '()) '()))
 150
 151   (pass-if "empty list, remove none"
 152     (eq? (remove-if-not (lambda (x) #t) '()) '()))
 153
 154   (pass-if "non-empty list, remove all"
 155     (eq? (remove-if-not (lambda (x) #f) '(1 2 3 4)) '()))
 156
 157   (pass-if "non-empty list, remove none"
 158     (equal? (remove-if-not (lambda (x) #t) '(1 2 3 4)) '(1 2 3 4)))
 159
 160   (pass-if "non-empty list, remove some"
 161     (equal? (remove-if-not odd? '(1 2 3 4)) '(1 3)))
 162
 163   )
 164
 165
 166 ;;;
 167 ;;; delete-if!
 168 ;;;
 169
 170
 171 (with-test-prefix "delete-if!"
 172
 173   (pass-if "documented?"
 174     (documented? delete-if!))
 175
 176   (pass-if "empty list, remove all"
 177     (eq? (delete-if! (lambda (x) #t) '()) '()))
 178
 179   (pass-if "empty list, remove none"
 180     (eq? (delete-if! (lambda (x) #f) '()) '()))
 181
 182   (pass-if "non-empty list, remove all"
 183     (eq? (delete-if! (lambda (x) #t) '(1 2 3 4)) '()))
 184
 185   (pass-if "non-empty list, remove none"
 186     (equal? (delete-if! (lambda (x) #f) '(1 2 3 4)) '(1 2 3 4)))
 187
 188   (pass-if "non-empty list, remove some"
 189     (equal? (delete-if! odd? '(1 2 3 4)) '(2 4)))
 190
 191   )
 192
 193
 194 ;;;
 195 ;;; delete-if-not!
 196 ;;;
 197
 198
 199 (with-test-prefix "delete-if-not!"
 200
 201   (pass-if "documented?"
 202     (documented? delete-if-not!))
 203
 204   (pass-if "empty list, remove all"
 205     (eq? (delete-if-not! (lambda (x) #f) '()) '()))
 206
 207   (pass-if "empty list, remove none"
 208     (eq? (delete-if-not! (lambda (x) #t) '()) '()))
 209
 210   (pass-if "non-empty list, remove all"
 211     (eq? (delete-if-not! (lambda (x) #f) '(1 2 3 4)) '()))
 212
 213   (pass-if "non-empty list, remove none"
 214     (equal? (delete-if-not! (lambda (x) #t) '(1 2 3 4)) '(1 2 3 4)))
 215
 216   (pass-if "non-empty list, remove some"
 217     (equal? (delete-if-not! odd? '(1 2 3 4)) '(1 3)))
 218
 219   )