cgit.sxemacs.org Git - sxemacs/blob - tests/automated/map-tests.el

   1 ;;;  map-tests.el -- Regression Tests for the map* functions
   2 ;; Copyright (C) 2006 Sebastian Freundt
   3 ;;
   4 ;; Author: Sebastian Freundt <hroptatyr@sxemacs.org>
   5 ;; Keywords: tests
   6 ;;
   7 ;; This file is part of SXEmacs.
   8 ;;
   9 ;; SXEmacs is free software: you can redistribute it and/or modify it
  10 ;; under the terms of the GNU General Public License as published by the
  11 ;; Free Software Foundation, either version 3 of the License, or (at your
  12 ;; option) any later version.
  13
  14 ;; SXEmacs is distributed in the hope that it will be
  15 ;; useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 ;; General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  21 ;;
  22 ;;; Synched up with: Not in FSF.
  23 ;;
  24 ;;; Commentary:
  25 ;;
  26 ;; See test-harness.el for instructions on how to run these tests.
  27
  28 (eval-when-compile
  29   (condition-case nil
  30       (require 'test-harness)
  31     (file-error
  32      (push "." load-path)
  33      (when (and (boundp 'load-file-name) (stringp load-file-name))
  34        (push (file-name-directory load-file-name) load-path))
  35      (require 'test-harness))))
  36
  37 (defmacro Assert-set-equality (s1 s2)
  38   (let* ((m1 (if (arrayp s1) 'across 'in))
  39          (m2 (if (arrayp s2) 'across 'in)))
  40     `(progn
  41        (Assert (equal (type-of ,s1) (type-of ,s2)))
  42        (Assert (= (length ,s1) (length ,s2)))
  43        (Assert
  44         (loop
  45           for i ,m1 ,s1
  46           always (loop
  47                    for j ,m2 ,s2
  48                    thereis (equal i j)))))))
  49
  50 (defmacro Assert-tup-equality (s1 s2)
  51   (let* ((m1 (if (arrayp s1) 'across 'in))
  52          (m2 (if (arrayp s2) 'across 'in)))
  53     `(progn
  54        (Assert (equal (type-of ,s1) (type-of ,s2)))
  55        (Assert
  56         (loop
  57           for i ,m1 ,s1
  58           for j ,m2 ,s2
  59           always (equal i j))))))
  60
  61 \f
  62 ;; test trivial cases
  63 (Assert
  64  (null (mapfam nil)))
  65 (Assert
  66  (null (mapfam #'cons :arity 0 '(1 2) '(3 4))))
  67 (Assert
  68  (null (mapfam nil :mode 'void '(1 2) '(3 4))))
  69 (Assert
  70  (null (mapfam #'cons)))
  71
  72 ;; test glues first
  73 (Assert
  74  (equal
  75   (mapfam nil [1 2 3 4 5 6])
  76   '(1 2 3 4 5 6)))
  77 (Assert
  78  (equal
  79   (mapfam nil :mode 'pntw [1 2 3 4 5 6])
  80   '(1 2 3 4 5 6)))
  81 (Assert
  82  (equal
  83   (mapfam nil :mode 'pntw [1 2 3 4 5 6] :arity 2)
  84   '((1 2) (3 4) (5 6))))
  85 (Assert
  86  (equal
  87   (mapfam nil :mode 'pntw [1 2 3 4 5 6] :arity 3)
  88   '((1 2 3) (4 5 6))))
  89 ;; same on vectors
  90 (Assert
  91  (equal
  92   (mapfam nil :mode 'pntw :glue #'vector [1 2 3 4 5 6])
  93   '(1 2 3 4 5 6)))
  94 (Assert
  95  (equal
  96   (mapfam nil :mode 'pntw :glue #'vector [1 2 3 4 5 6] :arity 2)
  97   '([1 2] [3 4] [5 6])))
  98 (Assert
  99  (equal
 100   (mapfam nil :mode 'pntw :glue #'vector [1 2 3 4 5 6] :arity 3)
 101   '([1 2 3] [4 5 6])))
 102 ;; same on vectors/vectors
 103 (Assert
 104  (equal
 105   (mapfam nil :mode 'pntw :result-type #'vector :glue #'vector [1 2 3 4 5 6])
 106   [1 2 3 4 5 6]))
 107 (Assert
 108  (equal
 109   (mapfam nil :mode 'pntw :result-type #'vector :glue #'vector [1 2 3 4 5 6] :arity 2)
 110   [[1 2] [3 4] [5 6]]))
 111 (Assert
 112  (equal
 113   (mapfam nil :mode 'pntw :result-type #'vector :glue #'vector [1 2 3 4 5 6] :arity 3)
 114   [[1 2 3] [4 5 6]]))
 115 ;; mismatching sizes
 116 (Assert
 117  (equal
 118   (mapfam nil :mode 'pntw :arity 2 [1 2 3 4 5 6 7])
 119   '((1 2) (3 4) (5 6))))
 120 (Assert
 121  (equal
 122   (mapfam nil :mode 'pntw :arity 3 [1 2 3 4 5 6 7])
 123   '((1 2 3) (4 5 6))))
 124 (Assert
 125  (equal
 126   (mapfam nil :mode 'pntw :glue #'vector :arity 2 [1 2 3 4 5 6 7])
 127   '([1 2] [3 4] [5 6])))
 128 (Assert
 129  (equal
 130   (mapfam nil :mode 'pntw :glue #'vector :arity 3 [1 2 3 4 5 6 7])
 131   '([1 2 3] [4 5 6])))
 132 (Assert
 133  (equal
 134   (mapfam nil :mode 'pntw :result-type #'vector :glue #'vector :arity 2
 135           [1 2 3 4 5 6 7])
 136   [[1 2] [3 4] [5 6]]))
 137 (Assert
 138  (equal
 139   (mapfam nil :mode 'pntw :result-type #'vector :glue #'vector :arity 3
 140           [1 2 3 4 5 6 7])
 141   [[1 2 3] [4 5 6]]))
 142 ;; larger glue than sequence
 143 (Assert
 144  (equal
 145   (mapfam nil :mode 'pntw [1 2 3 4 5 6] :arity 8)
 146   nil))
 147 (Assert
 148  (equal
 149   (mapfam nil :mode 'pntw [1 2 3 4 5 6] :glue #'vector :arity 8)
 150   nil))
 151 (Assert
 152  (equal
 153   (mapfam nil :mode 'pntw [1 2 3 4 5 6] :result-type #'vector :arity 8)
 154   []))
 155 (Assert
 156  (equal
 157   (mapfam nil :mode 'pntw [1 2 3 4 5 6] :result-type #'dllist :arity 8)
 158   (dllist)))
 159 ;; glueing dicts
 160 ;; prepare a hash-table
 161 (setq test-ht (make-hash-table))
 162 (puthash 12 'a test-ht)
 163 (puthash 14 'b test-ht)
 164 (puthash 13 'c test-ht)
 165 (puthash 16 'e test-ht)
 166 (puthash 15 'd test-ht)
 167 ;; ... and a skiplist
 168 (setq test-sl (make-skiplist))
 169 (put-skiplist test-sl 12 'a)
 170 (put-skiplist test-sl 14 'b)
 171 (put-skiplist test-sl 13 'c)
 172 (put-skiplist test-sl 16 'e)
 173 (put-skiplist test-sl 15 'd)
 174 ;; test the ht
 175 (Assert-set-equality
 176  (mapfam nil test-ht)
 177  '((12 a) (13 c) (14 b) (16 e) (15 d)))
 178 (Assert-set-equality
 179  (mapfam nil test-ht :arity '(1 1))
 180  '((12 a) (13 c) (14 b) (16 e) (15 d)))
 181 (Assert-set-equality
 182  (mapfam nil test-ht :arity 1)
 183  '(12 13 14 16 15))
 184 (Assert-set-equality
 185  (mapfam nil test-ht :mode 'keyw)
 186  '(12 13 14 16 15))
 187 (Assert-set-equality
 188  (mapfam nil test-ht :glue #'vector)
 189  '([12 a] [13 c] [14 b] [16 e] [15 d]))
 190 ;; ... and the sl
 191 (Assert-set-equality
 192  (mapfam nil test-sl)
 193  '((12 a) (13 c) (14 b) (16 e) (15 d)))
 194 (Assert-set-equality
 195  (mapfam nil test-sl :arity '(1 1))
 196  '((12 a) (13 c) (14 b) (16 e) (15 d)))
 197 (Assert-set-equality
 198  (mapfam nil test-sl :arity 1)
 199  '(12 13 14 16 15))
 200 (Assert-set-equality
 201  (mapfam nil test-sl :mode 'keyw)
 202  '(12 13 14 16 15))
 203 (Assert-set-equality
 204  (mapfam nil test-sl :glue #'vector)
 205  '([12 a] [13 c] [14 b] [16 e] [15 d]))
 206
 207 ;; combinations
 208 (Assert-set-equality
 209  (mapfam nil :mode 'comb [1 2 3 4] :arity 2)
 210  '((1 2) (1 3) (1 4) (2 3) (2 4) (3 4)))
 211 (Assert-tup-equality                    ;; we're sure that this is the order
 212  (mapfam nil :mode 'comb [1 2 3 4] :arity 2)
 213  '((1 2) (1 3) (1 4) (2 3) (2 4) (3 4)))
 214 (Assert-set-equality
 215  (mapfam nil :mode 'comb [1 2 3 4] :arity 2 :glue #'vector)
 216  '([1 2] [1 3] [1 4] [2 3] [2 4] [3 4]))
 217 (Assert-tup-equality                    ;; we're sure that this is the order
 218  (mapfam nil :mode 'comb [1 2 3 4] :arity 2 :glue #'vector)
 219  '([1 2] [1 3] [1 4] [2 3] [2 4] [3 4]))
 220 ;; arity 3 tests
 221 (Assert-set-equality
 222  (mapfam nil :mode 'comb [1 2 3 4] :arity 3)
 223  '((1 2 3) (1 2 4) (1 3 4) (2 3 4)))
 224 (Assert-tup-equality                    ;; we're sure that this is the order
 225  (mapfam nil :mode 'comb [1 2 3 4] :arity 3)
 226  '((1 2 3) (1 2 4) (1 3 4) (2 3 4)))
 227 (Assert-set-equality
 228  (mapfam nil :mode 'comb [1 2 3 4] :arity 3 :glue 'vector)
 229  '([1 2 3] [1 2 4] [1 3 4] [2 3 4]))
 230 (Assert-tup-equality
 231  (mapfam nil :mode 'comb [1 2 3 4] :arity 3 :glue 'vector)
 232  '([1 2 3] [1 2 4] [1 3 4] [2 3 4]))
 233 (Assert-set-equality
 234  (mapfam nil :mode 'comb [1 2 3 4] :arity 4)
 235  '((1 2 3 4)))
 236 (Assert-tup-equality
 237  (mapfam nil :mode 'comb [1 2 3 4] :arity 4)
 238  '((1 2 3 4)))
 239 (Assert-set-equality
 240  (mapfam nil :mode 'comb [1 2 3 4] :arity 4 :glue 'vector)
 241  '([1 2 3 4]))
 242 (Assert-tup-equality
 243  (mapfam nil :mode 'comb [1 2 3 4] :arity 4 :glue 'vector)
 244  '([1 2 3 4]))
 245 ;; a bit larger now
 246 (Assert-set-equality
 247  (mapfam nil :mode 'comb [1 2 3 4 5 6] :arity 2)
 248  '((1 2) (1 3) (1 4) (1 5) (1 6)
 249    (2 3) (2 4) (2 5) (2 6)
 250    (3 4) (3 5) (3 6)
 251    (4 5) (4 6)
 252    (5 6)))
 253 (Assert-tup-equality
 254  (mapfam nil :mode 'comb [1 2 3 4 5 6] :arity 2)
 255  '((1 2) (1 3) (1 4) (1 5) (1 6)
 256    (2 3) (2 4) (2 5) (2 6)
 257    (3 4) (3 5) (3 6)
 258    (4 5) (4 6)
 259    (5 6)))
 260 (Assert-set-equality
 261  (mapfam nil :mode 'comb [1 2 3 4 5 6] :arity 2 :glue 'dllist)
 262  (list
 263   (dllist 1 2) (dllist 1 3) (dllist 1 4) (dllist 1 5) (dllist 1 6)
 264    (dllist 2 3) (dllist 2 4) (dllist 2 5) (dllist 2 6)
 265    (dllist 3 4) (dllist 3 5) (dllist 3 6)
 266    (dllist 4 5) (dllist 4 6)
 267    (dllist 5 6)))
 268 (Assert-tup-equality
 269  (mapfam nil :mode 'comb [1 2 3 4 5 6] :arity 2 :glue 'dllist)
 270  (list
 271   (dllist 1 2) (dllist 1 3) (dllist 1 4) (dllist 1 5) (dllist 1 6)
 272    (dllist 2 3) (dllist 2 4) (dllist 2 5) (dllist 2 6)
 273    (dllist 3 4) (dllist 3 5) (dllist 3 6)
 274    (dllist 4 5) (dllist 4 6)
 275    (dllist 5 6)))
 276 (Assert-set-equality
 277  (mapfam nil :mode 'comb [1 2 3 4 5 6] :arity 3)
 278  '((1 2 3) (1 2 4) (1 2 5) (1 2 6)
 279    (1 3 4) (1 3 5) (1 3 6)
 280    (1 4 5) (1 4 6)
 281    (1 5 6)
 282    (2 3 4) (2 3 5) (2 3 6)
 283    (2 4 5) (2 4 6)
 284    (2 5 6)
 285    (3 4 5) (3 4 6)
 286    (3 5 6)
 287    (4 5 6)))
 288 (Assert-tup-equality
 289  (mapfam nil :mode 'comb [1 2 3 4 5 6] :arity 3)
 290  '((1 2 3) (1 2 4) (1 2 5) (1 2 6)
 291    (1 3 4) (1 3 5) (1 3 6)
 292    (1 4 5) (1 4 6)
 293    (1 5 6)
 294    (2 3 4) (2 3 5) (2 3 6)
 295    (2 4 5) (2 4 6)
 296    (2 5 6)
 297    (3 4 5) (3 4 6)
 298    (3 5 6)
 299    (4 5 6)))
 300 (Assert-tup-equality
 301  (mapfam nil :mode 'comb [1 2 3 4 5 6] :arity 3 :glue #'dllist)
 302  (list
 303   (dllist 1 2 3) (dllist 1 2 4) (dllist 1 2 5) (dllist 1 2 6)
 304   (dllist 1 3 4) (dllist 1 3 5) (dllist 1 3 6)
 305   (dllist 1 4 5) (dllist 1 4 6)
 306   (dllist 1 5 6)
 307   (dllist 2 3 4) (dllist 2 3 5) (dllist 2 3 6)
 308   (dllist 2 4 5) (dllist 2 4 6)
 309   (dllist 2 5 6)
 310   (dllist 3 4 5) (dllist 3 4 6)
 311   (dllist 3 5 6)
 312   (dllist 4 5 6)))
 313 (Assert-tup-equality
 314  (mapfam nil :mode 'comb [1 2 3 4 5 6] :arity 4)
 315  '((1 2 3 4) (1 2 3 5) (1 2 3 6) (1 2 4 5) (1 2 4 6) (1 2 5 6)
 316    (1 3 4 5) (1 3 4 6) (1 3 5 6)
 317    (1 4 5 6)
 318    (2 3 4 5) (2 3 4 6) (2 3 5 6) (2 4 5 6)
 319    (3 4 5 6)))
 320 ;; a f'lot larger
 321 (Assert-tup-equality
 322  (mapfam nil :mode 'comb [1 2 3 4 5 6 7 8 9] :arity 4)
 323  '((1 2 3 4) (1 2 3 5) (1 2 3 6) (1 2 3 7) (1 2 3 8) (1 2 3 9)
 324    (1 2 4 5) (1 2 4 6) (1 2 4 7) (1 2 4 8) (1 2 4 9)
 325    (1 2 5 6) (1 2 5 7) (1 2 5 8) (1 2 5 9)
 326    (1 2 6 7) (1 2 6 8) (1 2 6 9)
 327    (1 2 7 8) (1 2 7 9)
 328    (1 2 8 9)
 329    (1 3 4 5) (1 3 4 6) (1 3 4 7) (1 3 4 8) (1 3 4 9)
 330    (1 3 5 6) (1 3 5 7) (1 3 5 8) (1 3 5 9)
 331    (1 3 6 7) (1 3 6 8) (1 3 6 9)
 332    (1 3 7 8) (1 3 7 9)
 333    (1 3 8 9)
 334    (1 4 5 6) (1 4 5 7) (1 4 5 8) (1 4 5 9)
 335    (1 4 6 7) (1 4 6 8) (1 4 6 9)
 336    (1 4 7 8) (1 4 7 9)
 337    (1 4 8 9)
 338    (1 5 6 7) (1 5 6 8) (1 5 6 9)
 339    (1 5 7 8) (1 5 7 9)
 340    (1 5 8 9)
 341    (1 6 7 8) (1 6 7 9)
 342    (1 6 8 9)
 343    (1 7 8 9)
 344    (2 3 4 5) (2 3 4 6) (2 3 4 7) (2 3 4 8) (2 3 4 9)
 345    (2 3 5 6) (2 3 5 7) (2 3 5 8) (2 3 5 9)
 346    (2 3 6 7) (2 3 6 8) (2 3 6 9)
 347    (2 3 7 8) (2 3 7 9)
 348    (2 3 8 9)
 349    (2 4 5 6) (2 4 5 7) (2 4 5 8) (2 4 5 9)
 350    (2 4 6 7) (2 4 6 8) (2 4 6 9)
 351    (2 4 7 8) (2 4 7 9)
 352    (2 4 8 9)
 353    (2 5 6 7) (2 5 6 8) (2 5 6 9)
 354    (2 5 7 8) (2 5 7 9)
 355    (2 5 8 9)
 356    (2 6 7 8) (2 6 7 9)
 357    (2 6 8 9)
 358    (2 7 8 9)
 359    (3 4 5 6) (3 4 5 7) (3 4 5 8) (3 4 5 9)
 360    (3 4 6 7) (3 4 6 8) (3 4 6 9)
 361    (3 4 7 8) (3 4 7 9)
 362    (3 4 8 9)
 363    (3 5 6 7) (3 5 6 8) (3 5 6 9)
 364    (3 5 7 8) (3 5 7 9)
 365    (3 5 8 9)
 366    (3 6 7 8) (3 6 7 9)
 367    (3 6 8 9)
 368    (3 7 8 9)
 369    (4 5 6 7) (4 5 6 8) (4 5 6 9)
 370    (4 5 7 8) (4 5 7 9)
 371    (4 5 8 9)
 372    (4 6 7 8) (4 6 7 9)
 373    (4 6 8 9)
 374    (4 7 8 9)
 375    (5 6 7 8) (5 6 7 9)
 376    (5 6 8 9)
 377    (5 7 8 9)
 378    (6 7 8 9)))
 379 ;; testing PHenomena
 380 (Assert (null (mapfam nil :mode 'comb :arity 2 [a])))
 381 (Assert (null (mapfam nil :mode 'comb :arity 3 [a])))
 382 (Assert (null (mapfam nil :mode 'comb :arity 4 [a])))
 383 (Assert (null (mapfam nil :mode 'comb :arity 5 [a])))
 384 (Assert (null (mapfam nil :mode 'comb :arity 6 [a])))
 385 (Assert (null (mapfam nil :mode 'comb :arity 3 [a b])))
 386 (Assert (null (mapfam nil :mode 'comb :arity 4 [a b])))
 387 (Assert (null (mapfam nil :mode 'comb :arity 5 [a b])))
 388 (Assert (null (mapfam nil :mode 'comb :arity 6 [a b])))
 389 (Assert (null (mapfam nil :mode 'comb :arity 4 [a b c])))
 390 (Assert (null (mapfam nil :mode 'comb :arity 5 [a b c])))
 391 (Assert (null (mapfam nil :mode 'comb :arity 6 [a b c])))
 392 ;; more of them phenomena
 393 (Assert
 394  (equal
 395   (mapfam nil :mode 'comb :arity 2 [a] :result-type #'vector)
 396   []))
 397 (Assert
 398  (equal
 399   (mapfam nil :mode 'comb :arity 3 [a] :result-type #'vector)
 400   []))
 401 (Assert
 402  (equal
 403   (mapfam nil :mode 'comb :arity 4 [a] :result-type #'vector)
 404   []))
 405 (Assert
 406  (equal
 407   (mapfam nil :mode 'comb :arity 5 [a] :result-type #'vector)
 408   []))
 409 (Assert
 410  (equal
 411   (mapfam nil :mode 'comb :arity 6 [a] :result-type #'vector)
 412   []))
 413 (Assert
 414  (equal
 415   (mapfam nil :mode 'comb :arity 3 [a b] :result-type #'vector)
 416   []))
 417 (Assert
 418  (equal
 419   (mapfam nil :mode 'comb :arity 4 [a b] :result-type #'vector)
 420   []))
 421 (Assert
 422  (equal
 423   (mapfam nil :mode 'comb :arity 5 [a b] :result-type #'vector)
 424   []))
 425 (Assert
 426  (equal
 427   (mapfam nil :mode 'comb :arity 6 [a b] :result-type #'vector)
 428   []))
 429 (Assert
 430  (equal
 431   (mapfam nil :mode 'comb :arity 4 [a b c] :result-type #'vector)
 432   []))
 433 (Assert
 434  (equal
 435   (mapfam nil :mode 'comb :arity 5 [a b c] :result-type #'vector)
 436   []))
 437 (Assert
 438  (equal
 439   (mapfam nil :mode 'comb :arity 6 [a b c] :result-type #'vector)
 440   []))
 441 ;; yet more
 442 (Assert
 443  (equal
 444   (mapfam nil :mode 'comb :arity 2 [a] :result-type #'dllist)
 445   (dllist)))
 446 (Assert
 447  (equal
 448   (mapfam nil :mode 'comb :arity 3 [a] :result-type #'dllist)
 449   (dllist)))
 450 (Assert
 451  (equal
 452   (mapfam nil :mode 'comb :arity 4 [a] :result-type #'dllist)
 453   (dllist)))
 454 (Assert
 455  (equal
 456   (mapfam nil :mode 'comb :arity 5 [a] :result-type #'dllist)
 457   (dllist)))
 458 (Assert
 459  (equal
 460   (mapfam nil :mode 'comb :arity 6 [a] :result-type #'dllist)
 461   (dllist)))
 462 (Assert
 463  (equal
 464   (mapfam nil :mode 'comb :arity 3 [a b] :result-type #'dllist)
 465   (dllist)))
 466 (Assert
 467  (equal
 468   (mapfam nil :mode 'comb :arity 4 [a b] :result-type #'dllist)
 469   (dllist)))
 470 (Assert
 471  (equal
 472   (mapfam nil :mode 'comb :arity 5 [a b] :result-type #'dllist)
 473   (dllist)))
 474 (Assert
 475  (equal
 476   (mapfam nil :mode 'comb :arity 6 [a b] :result-type #'dllist)
 477   (dllist)))
 478 (Assert
 479  (equal
 480   (mapfam nil :mode 'comb :arity 4 [a b c] :result-type #'dllist)
 481   (dllist)))
 482 (Assert
 483  (equal
 484   (mapfam nil :mode 'comb :arity 5 [a b c] :result-type #'dllist)
 485   (dllist)))
 486 (Assert
 487  (equal
 488   (mapfam nil :mode 'comb :arity 6 [a b c] :result-type #'dllist)
 489   (dllist)))
 490 ;; not enough yet
 491 (Assert
 492  (equal
 493   (mapfam nil :mode 'comb :arity 2 [a] :result-type #'string)
 494   ""))
 495 (Assert
 496  (equal
 497   (mapfam nil :mode 'comb :arity 3 [a] :result-type #'string)
 498   ""))
 499 (Assert
 500  (equal
 501   (mapfam nil :mode 'comb :arity 4 [a] :result-type #'string)
 502   ""))
 503 (Assert
 504  (equal
 505   (mapfam nil :mode 'comb :arity 5 [a] :result-type #'string)
 506   ""))
 507 (Assert
 508  (equal
 509   (mapfam nil :mode 'comb :arity 6 [a] :result-type #'string)
 510   ""))
 511 (Assert
 512  (equal
 513   (mapfam nil :mode 'comb :arity 3 [a b] :result-type #'string)
 514   ""))
 515 (Assert
 516  (equal
 517   (mapfam nil :mode 'comb :arity 4 [a b] :result-type #'string)
 518   ""))
 519 (Assert
 520  (equal
 521   (mapfam nil :mode 'comb :arity 5 [a b] :result-type #'string)
 522   ""))
 523 (Assert
 524  (equal
 525   (mapfam nil :mode 'comb :arity 6 [a b] :result-type #'string)
 526   ""))
 527 (Assert
 528  (equal
 529   (mapfam nil :mode 'comb :arity 4 [a b c] :result-type #'string)
 530   ""))
 531 (Assert
 532  (equal
 533   (mapfam nil :mode 'comb :arity 5 [a b c] :result-type #'string)
 534   ""))
 535 (Assert
 536  (equal
 537   (mapfam nil :mode 'comb :arity 6 [a b c] :result-type #'string)
 538   ""))
 539
 540 ;; glue carts
 541 (Assert
 542  (equal
 543   (mapfam nil [0 1 2] :mode 'cart :arity 1)
 544   '(0 1 2)))
 545 (Assert
 546  (equal
 547   (mapfam nil [0 1 2] :mode 'cart :arity 2)
 548   '((0 0) (0 1) (0 2) (1 0) (1 1) (1 2) (2 0) (2 1) (2 2))))
 549 (Assert
 550  (equal
 551   (mapfam nil [0 1 2] :mode 'cart :arity 3)
 552   '((0 0 0) (0 0 1) (0 0 2) (0 1 0) (0 1 1) (0 1 2) (0 2 0) (0 2 1) (0 2 2)
 553     (1 0 0) (1 0 1) (1 0 2) (1 1 0) (1 1 1) (1 1 2) (1 2 0) (1 2 1) (1 2 2)
 554     (2 0 0) (2 0 1) (2 0 2) (2 1 0) (2 1 1) (2 1 2) (2 2 0) (2 2 1) (2 2 2))))
 555 (Assert
 556  (equal
 557   (mapfam nil [0 1 2] :mode 'cart :arity 4)
 558   '((0 0 0 0) (0 0 0 1) (0 0 0 2) (0 0 1 0) (0 0 1 1) (0 0 1 2)
 559     (0 0 2 0) (0 0 2 1) (0 0 2 2) (0 1 0 0) (0 1 0 1) (0 1 0 2)
 560     (0 1 1 0) (0 1 1 1) (0 1 1 2) (0 1 2 0) (0 1 2 1) (0 1 2 2)
 561     (0 2 0 0) (0 2 0 1) (0 2 0 2) (0 2 1 0) (0 2 1 1) (0 2 1 2)
 562     (0 2 2 0) (0 2 2 1) (0 2 2 2)
 563     (1 0 0 0) (1 0 0 1) (1 0 0 2) (1 0 1 0) (1 0 1 1) (1 0 1 2)
 564     (1 0 2 0) (1 0 2 1) (1 0 2 2) (1 1 0 0) (1 1 0 1) (1 1 0 2)
 565     (1 1 1 0) (1 1 1 1) (1 1 1 2) (1 1 2 0) (1 1 2 1) (1 1 2 2)
 566     (1 2 0 0) (1 2 0 1) (1 2 0 2) (1 2 1 0) (1 2 1 1) (1 2 1 2)
 567     (1 2 2 0) (1 2 2 1) (1 2 2 2)
 568     (2 0 0 0) (2 0 0 1) (2 0 0 2) (2 0 1 0) (2 0 1 1) (2 0 1 2)
 569     (2 0 2 0) (2 0 2 1) (2 0 2 2) (2 1 0 0) (2 1 0 1) (2 1 0 2)
 570     (2 1 1 0) (2 1 1 1) (2 1 1 2) (2 1 2 0) (2 1 2 1) (2 1 2 2)
 571     (2 2 0 0) (2 2 0 1) (2 2 0 2) (2 2 1 0) (2 2 1 1) (2 2 1 2)
 572     (2 2 2 0) (2 2 2 1) (2 2 2 2))))
 573 ;; for the next one we just pick 20 random elements out of 243
 574 ;; ... this assumes that #'random works
 575 (let ((5c (mapfam nil [0 1 2] :mode 'cart :arity 5)))
 576   (Assert (= (length 5c) 243))
 577   (dotimes (i 20)
 578     (Assert
 579      (member
 580       (list (random 3) (random 3) (random 3) (random 3) (random 3))
 581       5c))))
 582 ;; to use something other than ints ...
 583 (let ((6c (mapfam nil [1.4142 1.4142 1.4142] :mode 'cart :arity 6)))
 584   (Assert (= (length 6c) 729))
 585   ;; all elements must look the same
 586   (dotimes (i 729)
 587     (Assert (equal (car 6c) '(1.4142 1.4142 1.4142 1.4142 1.4142 1.4142)))
 588     (setq 6c (cdr 6c))))
 589 ;; test invariance of input sequence type
 590 (Assert
 591  (equal
 592   (mapfam nil '(0 1 2) :mode 'cart :arity 1)
 593   (mapfam nil (dllist 0 1 2) :mode 'cart :arity 1)))
 594 (Assert
 595  (equal
 596   (mapfam nil '(0 1 2) :mode 'cart :arity 2)
 597   (mapfam nil (dllist 0 1 2) :mode 'cart :arity 2)))
 598 (Assert
 599  (equal
 600   (mapfam nil '(0 1 2) :mode 'cart :arity 3)
 601   (mapfam nil (dllist 0 1 2) :mode 'cart :arity 3)))
 602 (Assert
 603  (equal
 604   (mapfam nil '(0 1 2) :mode 'cart :arity 4)
 605   (mapfam nil (dllist 0 1 2) :mode 'cart :arity 4)))
 606 (Assert
 607  (equal
 608   (mapfam nil '(0 1 2) :mode 'cart :arity 5)
 609   (mapfam nil (dllist 0 1 2) :mode 'cart :arity 5)))
 610 (Assert
 611  (equal
 612   (mapfam nil '(0 1 2) :mode 'cart :arity 9)
 613   (mapfam nil (dllist 0 1 2) :mode 'cart :arity 9)))
 614
 615 ;; testing perms
 616 (Assert-set-equality
 617  (mapfam nil '(0 1) :mode 'perm)
 618  '((0 1) (1 0)))
 619 (Assert
 620  (equal
 621   (mapfam nil '(0 1) :mode 'perm :arity 1)
 622   '(0 1)))
 623 (Assert-set-equality
 624  (mapfam nil '(0 1) :mode 'perm :arity 2)
 625  '((0 1) (1 0)))
 626 (Assert
 627  (null (mapfam nil '(0 1) :mode 'perm :arity 3)))
 628
 629 (Assert-set-equality
 630  (mapfam nil '(0 1 2) :mode 'perm)
 631  '((0 1 2) (1 2 0) (2 0 1) (2 1 0) (1 0 2) (0 2 1)))
 632 (Assert
 633  (equal
 634   (mapfam nil '(0 1 2) :mode 'perm :arity 1)
 635   '(0 1 2)))
 636 (Assert-set-equality
 637  (mapfam nil '(0 1 2) :mode 'perm :arity 2)
 638  '((0 1) (1 0) (0 2) (2 0) (1 2) (2 1)))
 639 (Assert-set-equality
 640  (mapfam nil '(0 1 2) :mode 'perm :arity 3)
 641  '((0 1 2) (1 2 0) (2 0 1) (2 1 0) (1 0 2) (0 2 1)))
 642 (Assert
 643  (null (mapfam nil '(0 1 2) :mode 'perm :arity 4)))
 644
 645 (Assert-set-equality
 646  (mapfam nil '(1 2 3 4) :mode 'perm)
 647  '((1 2 3 4) (1 2 4 3) (1 4 2 3) (1 4 3 2) (1 3 4 2) (1 3 2 4)
 648    (2 3 1 4) (2 3 4 1) (2 4 3 1) (2 4 1 3) (2 1 4 3) (2 1 3 4)
 649    (3 1 2 4) (3 1 4 2) (3 4 1 2) (3 4 2 1) (3 2 4 1) (3 2 1 4)
 650    (4 2 1 3) (4 2 3 1) (4 3 2 1) (4 3 1 2) (4 1 3 2) (4 1 2 3)))
 651 (Assert
 652  (equal
 653   (mapfam nil '(1 2 3 4) :mode 'perm :arity 1)
 654   '(1 2 3 4)))
 655 (Assert-set-equality
 656  (mapfam nil '(1 2 3 4) :mode 'perm :arity 2)
 657  '((1 2) (2 1) (1 3) (3 1) (1 4) (4 1)
 658    (2 3) (3 2) (2 4) (4 2)
 659    (3 4) (4 3)))
 660 (Assert-set-equality
 661  (mapfam nil '(1 2 3 4) :mode 'perm :arity 3)
 662  ;; we've checked S_3 perms already, so just use them
 663  (append
 664   (mapfam nil '(1 2 3) :mode 'perm)
 665   (mapfam nil '(1 2 4) :mode 'perm)
 666   (mapfam nil '(1 3 4) :mode 'perm)
 667   (mapfam nil '(2 3 4) :mode 'perm)))
 668 (Assert-set-equality
 669  (mapfam nil '(1 2 3 4) :mode 'perm :arity 4)
 670  '((1 2 3 4) (1 2 4 3) (1 4 2 3) (1 4 3 2) (1 3 4 2) (1 3 2 4)
 671    (2 3 1 4) (2 3 4 1) (2 4 3 1) (2 4 1 3) (2 1 4 3) (2 1 3 4)
 672    (3 1 2 4) (3 1 4 2) (3 4 1 2) (3 4 2 1) (3 2 4 1) (3 2 1 4)
 673    (4 2 1 3) (4 2 3 1) (4 3 2 1) (4 3 1 2) (4 1 3 2) (4 1 2 3)))
 674 (Assert
 675  (null (mapfam nil '(1 2 3 4) :mode 'perm :arity 5)))
 676
 677 (Assert-set-equality
 678  (mapfam nil [0 1] :mode 'perm)
 679  (mapfam nil (dllist 0 1) :mode 'perm))
 680 (Assert
 681  (equal
 682   (mapfam nil (dllist 0 1) :mode 'perm :arity 1)
 683   (mapfam nil [0 1] :mode 'perm :arity 1)))
 684 (Assert-set-equality
 685  (mapfam nil [0 1] :mode 'perm :arity 2)
 686  (mapfam nil (dllist 0 1) :mode 'perm :arity 2))
 687 (Assert
 688  (null (mapfam nil [0 1] :mode 'perm :arity 3)))
 689 (Assert
 690  (null (mapfam nil (dllist 0 1) :mode 'perm :arity 3)))
 691
 692 (Assert-set-equality
 693  (mapfam nil [0 1 2] :mode 'perm)
 694  (mapfam nil (dllist 0 1 2) :mode 'perm))
 695 (Assert
 696  (equal
 697   (mapfam nil [0 1 2] :mode 'perm :arity 1)
 698   (mapfam nil (dllist 0 1 2) :mode 'perm :arity 1)))
 699 (Assert-set-equality
 700  (mapfam nil (dllist 0 1 2) :mode 'perm :arity 2)
 701  (mapfam nil [0 1 2] :mode 'perm :arity 2))
 702 (Assert-set-equality
 703  (mapfam nil [0 1 2] :mode 'perm :arity 3)
 704  (mapfam nil (dllist 0 1 2) :mode 'perm :arity 3))
 705 (Assert
 706  (null (mapfam nil [0 1 2] :mode 'perm :arity 4)))
 707 (Assert
 708  (null (mapfam nil (dllist 0 1 2) :mode 'perm :arity 4)))
 709
 710 (Assert-set-equality
 711  (mapfam nil [1 2 3 4] :mode 'perm)
 712  (mapfam nil (dllist 1 2 3 4) :mode 'perm))
 713 (Assert
 714  (equal
 715   (mapfam nil [1 2 3 4] :mode 'perm :arity 1)
 716   (mapfam nil (dllist 1 2 3 4) :mode 'perm :arity 1)))
 717 (Assert-set-equality
 718  (mapfam nil [1 2 3 4] :mode 'perm :arity 2)
 719  (mapfam nil (dllist 1 2 3 4) :mode 'perm :arity 2))
 720 (Assert-set-equality
 721  (mapfam nil [1 2 3 4] :mode 'perm :arity 3)
 722  (mapfam nil (dllist 1 2 3 4) :mode 'perm :arity 3))
 723 (Assert-set-equality
 724  (mapfam nil (dllist 1 2 3 4) :mode 'perm :arity 4)
 725  (mapfam nil [1 2 3 4] :mode 'perm :arity 4))
 726 (Assert
 727  (null (mapfam nil [1 2 3 4] :mode 'perm :arity 5)))
 728 (Assert
 729  (null (mapfam nil (dllist 1 2 3 4) :mode 'perm :arity 5)))
 730
 731 ;;; just some things that caused problems in the past
 732 (Assert-set-equality
 733  (mapfam nil :glue #'string :mode 'perm "ab")
 734  '("ab" "ba"))
 735 (Assert-set-equality
 736  (mapfam #'sxhash :glue #'string :mode 'perm "ab")
 737  (list (sxhash "ab") (sxhash "ba")))
 738 (Assert-set-equality
 739  (mapfam #'string :mode 'perm "ab")
 740  '("ab" "ba"))
 741
 742 (Assert-set-equality
 743  (mapfam nil :glue #'string :mode 'perm "abc")
 744  '("abc" "acb" "cab" "cba" "bca" "bac"))
 745 (Assert-set-equality
 746  (mapfam #'sxhash :glue #'string :mode 'perm "abc")
 747  (list (sxhash "abc") (sxhash "acb") (sxhash "cab")
 748        (sxhash "cba") (sxhash "bca") (sxhash "bac")))
 749 (Assert-set-equality
 750  (mapfam #'string :mode 'perm "abc")
 751  '("abc" "acb" "cab" "cba" "bca" "bac"))
 752
 753 (Assert-set-equality
 754  (mapfam nil :glue #'string :mode 'perm "abcd")
 755  '("abcd" "abdc" "adbc" "adcb" "acdb" "acbd"
 756    "cabd" "cadb" "cdab" "cdba" "cbda" "cbad"
 757    "bcad" "bcda" "bdca" "bdac" "badc" "bacd"
 758    "dbac" "dbca" "dcba" "dcab" "dacb" "dabc"))
 759 (Assert-set-equality
 760  (mapfam #'sxhash :glue #'string :mode 'perm "abcd")
 761  (list (sxhash "abcd") (sxhash "abdc") (sxhash "adbc")
 762        (sxhash "adcb") (sxhash "acdb") (sxhash "acbd")
 763        (sxhash "cabd") (sxhash "cadb") (sxhash "cdab")
 764        (sxhash "cdba") (sxhash "cbda") (sxhash "cbad")
 765        (sxhash "bcad") (sxhash "bcda") (sxhash "bdca")
 766        (sxhash "bdac") (sxhash "badc") (sxhash "bacd")
 767        (sxhash "dbac") (sxhash "dbca") (sxhash "dcba")
 768        (sxhash "dcab") (sxhash "dacb") (sxhash "dabc")))
 769 (Assert-set-equality
 770  (mapfam #'string :mode 'perm "abcd")
 771  '("abcd" "abdc" "adbc" "adcb" "acdb" "acbd"
 772    "cabd" "cadb" "cdab" "cdba" "cbda" "cbad"
 773    "bcad" "bcda" "bdca" "bdac" "badc" "bacd"
 774    "dbac" "dbca" "dcba" "dcab" "dacb" "dabc"))
 775
 776 (mapfam nil :glue #'string :mode 'perm "abcde" :arity 4)
 777 (mapfam #'sxhash :glue #'string :mode 'perm "abcde" :arity 4)
 778 (mapfam #'string :mode 'perm "abcde" :arity 4)
 779
 780
 781 ;; now with real funs aboard
 782 (Assert
 783  (equal
 784   (mapfam #'1- [1 2 3 4 5 6])
 785   '(0 1 2 3 4 5)))
 786 (Assert
 787  (equal
 788   (mapfam #'1+ :mode 'pntw [1 2 3 4 5 6])
 789   '(2 3 4 5 6 7)))
 790
 791 (let* ((l ''(1 2 3 4 5 6))
 792        (v [1 2 3 4 5 6])
 793        (d (dllist 1 2 3 4 5 6))
 794        ;; a sequence of coprime length
 795        (l2 ''(1 2 3 4 5 6 7))
 796        (v2 [1 2 3 4 5 6 7])
 797        (d2 (dllist 1 2 3 4 5 6 7))
 798        ;; arity 2 results
 799        (rl '(list . '(3 7 11)))
 800        (rv '(vector . [3 7 11]))
 801        (rd '(dllist . (dllist 3 7 11)))
 802        ;; arity 3 results
 803        (rl2 '(list . '(6 15)))
 804        (rv2 '(vector . [6 15]))
 805        (rd2 '(dllist . (dllist 6 15))))
 806   (loop for i in (list l v d) do
 807     (loop for j in (list rl rv rd) do
 808       (eval
 809        `(Assert
 810          (equal
 811           (mapfam #'+ ,i :arity 2 :result-type #',(car j))
 812           ,(cdr j))))))
 813   ;; seq length coprime to arity
 814   (loop for i in (list l2 v2 d2) do
 815     (loop for j in (list rl rv rd) do
 816       (eval
 817        `(Assert
 818          (equal
 819           (mapfam #'+ ,i :arity 2 :result-type #',(car j))
 820           ,(cdr j))))))
 821   ;; arity 3
 822   (loop for i in (list l v d) do
 823     (loop for j in (list rl2 rv2 rd2) do
 824       (eval
 825        `(Assert
 826          (equal
 827           (mapfam #'+ ,i :arity 3 :result-type #',(car j))
 828           ,(cdr j))))))
 829   ;; seq length coprime to arity
 830   (loop for i in (list l2 v2 d2) do
 831     (loop for j in (list rl2 rv2 rd2) do
 832       (eval
 833        `(Assert
 834          (equal
 835           (mapfam #'+ ,i :arity 3 :result-type #',(car j))
 836           ,(cdr j)))))))
 837
 838 (Assert
 839  (equal
 840   (mapfam #'+ [1 2 3 4 5 6 7 8] :arity 4)
 841   '(10 26)))
 842 (Assert
 843  (equal
 844   (mapfam #'+ [1 2 3 4 5 6 7 8] :arity 4 :result-type #'vector)
 845   [10 26]))
 846 (Assert
 847  (equal
 848   (mapfam #'+ [1 2 3 4 5 6 7 8] :arity 4 :result-type #'dllist)
 849   (dllist 10 26)))
 850
 851 (Assert
 852  (equal
 853   (mapfam #'+ [1 2 3 4 5 6 7 8 9 10 11] :arity 4)
 854   '(10 26)))
 855 (Assert
 856  (equal
 857   (mapfam #'+ '(1 2 3 4 5 6 7 8 9 10 11) :arity 4 :result-type #'vector)
 858   [10 26]))
 859 (Assert
 860  (equal
 861   (mapfam #'+ (dllist 1 2 3 4 5 6 7 8 9 10 11) :arity 4 :result-type #'dllist)
 862   (dllist 10 26)))
 863
 864 ;; wreck the sequence during traversal
 865 ;; (setq foo (dllist 1 2 3 4 5 6 7 8))
 866 ;; (defun wreck-1 (a)
 867 ;;   (dllist-pop-car foo)
 868 ;;   (1+ a))
 869 ;; (Assert
 870 ;;  (equal
 871 ;;   (mapfam #'wreck-1 foo)
 872 ;;   '(2 3 4 5 6 7 8 9)))
 873 ;; (Assert (= (dllist-size foo) 0))
 874
 875 ;; ;; wreck the sequence during traversal, arity 2
 876 ;; (setq foo (dllist 1 2 3 4 5 6 7 8))
 877 ;; (defun wreck-2 (a b)
 878 ;;   (dllist-pop-rac foo)
 879 ;;   (+ a b))
 880 ;; (Assert
 881 ;;  (equal
 882 ;;   (mapfam #'wreck-2 foo :arity 2)
 883 ;;   '(3 7 11 15)))
 884 ;; ;; foo was called 4 times, so should be (dllist 1 2 3 4) now
 885 ;; (Assert
 886 ;;  (equal
 887 ;;   (mapfam #'wreck-2 foo :arity 2)
 888 ;;   '(3 7)))
 889 ;; ;; foo was called twice, so should be (dllist 1 2) now
 890 ;; (Assert
 891 ;;  (equal
 892 ;;   (mapfam #'wreck-2 foo :arity 2)
 893 ;;   '(3)))
 894 ;; foo was called once, so should be (dllist 1) now,
 895 ;; however just one element is below the requested arity, so
 896 ;; we expect nil now
 897 ;; (Assert
 898 ;;  (null (mapfam #'wreck-2 foo :arity 2)))
 899 ;; ;; foo should still have this one element
 900 ;; (Assert (= (dllist-size foo) 1))
 901
 902 ;; ;; wreck the sequence during traversal, arity 3
 903 ;; (setq foo (dllist 1 2 3 4 5 6 7 8))
 904 ;; (defun wreck-3 (a b c)
 905 ;;   (dllist-pop-rac foo)
 906 ;;   (+ a b c))
 907 ;; (Assert
 908 ;;  (equal
 909 ;;   (mapfam #'wreck-3 foo :arity 3)
 910 ;;   '(6 15)))
 911 ;; ;; foo was called 2 times, so should be (dllist 1 2 3 4 5 6) now
 912 ;; (Assert
 913 ;;  (equal
 914 ;;   (mapfam #'wreck-3 foo :arity 3)
 915 ;;   '(6 15)))
 916 ;; ;; foo was called twice, so should be (dllist 1 2 3 4) now
 917 ;; (Assert
 918 ;;  (equal
 919 ;;   (mapfam #'wreck-3 foo :arity 3)
 920 ;;   '(6)))
 921 ;; ;; foo was called once, so should be (dllist 1 2 3) now,
 922 ;; (Assert
 923 ;;  (equal
 924 ;;   (mapfam #'wreck-3 foo :arity 3)
 925 ;;   '(6)))
 926 ;; ;; again, foo was called once, so should be (dllist 1 2) now,
 927 ;; ;; however that's less elements than arity so we expect nil now
 928 ;; (Assert
 929 ;;  (null (mapfam #'wreck-3 foo :arity 3)))
 930 ;; ;; foo should still have these two elements
 931 ;; (Assert (= (dllist-size foo) 2))
 932 ;; (Assert (equal foo (dllist 1 2)))
 933
 934 ;; dicts
 935 (setq test-ht (make-hash-table)
 936       test-sl (make-skiplist))
 937
 938 (puthash '1 'a test-ht)
 939 (puthash '2 'b test-ht)
 940 (puthash '3 'c test-ht)
 941 (puthash '4 'd test-ht)
 942 (puthash '5 'e test-ht)
 943 (puthash '6 'f test-ht)
 944 (puthash '7 'g test-ht)
 945
 946 (put-skiplist test-sl '1 'a)
 947 (put-skiplist test-sl '2 'b)
 948 (put-skiplist test-sl '3 'c)
 949 (put-skiplist test-sl '4 'd)
 950 (put-skiplist test-sl '5 'e)
 951 (put-skiplist test-sl '6 'f)
 952 (put-skiplist test-sl '7 'g)
 953
 954 ;; initialise a summing variable
 955 (setq sum 0)
 956
 957 (defun sum-2 (key val)
 958   (setq sum (+ sum key)))
 959 ;; we can't use the output of this one for it is uncertain in which
 960 ;; order the keys are passed
 961 (mapfam #'sum-2 test-ht)
 962 ;; however, sum should be 28 (= 7 + 3 + 6 + 4 + 5 + 2 + 1) now
 963 (Assert (= sum 28))
 964 ;; reset sum
 965 (setq sum 0)
 966 (Assert (= sum 0))
 967 ;; skiplists always iterate in hash-order and hashes of ints are
 968 ;; order preserving, so we are able to check the outcome
 969 (Assert
 970  (equal
 971   (setq bar (mapfam #'sum-2 test-sl))
 972   '(1 3 6 10 15 21 28)))
 973 (Assert (= sum 28))
 974
 975
 976 ;;; testing on 2 sequences
 977 (Assert
 978  (equal
 979   (mapfam nil '(a b c) '(1 2 3))
 980   '((a 1) (b 2) (c 3))))
 981 (Assert
 982  (equal
 983   (mapfam nil '(a b c) '(1 2 3 4))
 984   ;; the 4 doesnt count since another sequence has finished traversal by then
 985   '((a 1) (b 2) (c 3))))
 986 ;; the same with list and vector
 987 (Assert
 988  (equal
 989   (mapfam nil '(a b c) [1 2 3])
 990   '((a 1) (b 2) (c 3))))
 991 (Assert
 992  (equal
 993   (mapfam nil [a b c] '(1 2 3 4))
 994   ;; the 4 doesnt count since another sequence has finished traversal by then
 995   '((a 1) (b 2) (c 3))))
 996 ;; list and dllist
 997 (Assert
 998  (equal
 999   (mapfam nil '(a b c) (dllist 1 2 3))
1000   '((a 1) (b 2) (c 3))))
1001 (Assert
1002  (equal
1003   (mapfam nil (dllist 'a 'b 'c) '(1 2 3 4))
1004   ;; the 4 doesnt count since another sequence has finished traversal by then
1005   '((a 1) (b 2) (c 3))))
1006 ;; dllist and vector
1007 (Assert
1008  (equal
1009   (mapfam nil (dllist 'a 'b 'c) [1 2 3])
1010   '((a 1) (b 2) (c 3))))
1011 (Assert
1012  (equal
1013   (mapfam nil [a b c] (dllist 1 2 3 4))
1014   ;; the 4 doesnt count since another sequence has finished traversal by then
1015   '((a 1) (b 2) (c 3))))
1016 ;; string and vector
1017 (Assert
1018  (equal
1019   (mapfam nil "abc" [1 2 3])
1020   '((?a 1) (?b 2) (?c 3))))
1021 (Assert
1022  (equal
1023   (mapfam nil [a b c] "1234")
1024   ;; the 4 doesnt count since another sequence has finished traversal by then
1025   '((a ?1) (b ?2) (c ?3))))
1026 ;; more than 2 sequences
1027 (Assert
1028  (equal
1029   (mapfam nil '(a b c) [1 2 3] (dllist ?x ?y ?z))
1030   '((a 1 ?x) (b 2 ?y) (c 3 ?z))))
1031 (Assert
1032  (equal
1033   (mapfam nil '(a b c) [1 2 3 4] (dllist ?x ?y ?z))
1034   '((a 1 ?x) (b 2 ?y) (c 3 ?z))))
1035
1036 ;; all of the above using a different glue
1037 (Assert
1038  (equal
1039   (mapfam nil :glue #'vector '(a b c) '(1 2 3))
1040   '([a 1] [b 2] [c 3])))
1041 (Assert
1042  (equal
1043   (mapfam nil :glue #'vector '(a b c) '(1 2 3 4))
1044   ;; the 4 doesnt count since another sequence has finished traversal by then
1045   '([a 1] [b 2] [c 3])))
1046 ;; the same with list and vector
1047 (Assert
1048  (equal
1049   (mapfam nil :glue #'vector '(a b c) [1 2 3])
1050   '([a 1] [b 2] [c 3])))
1051 (Assert
1052  (equal
1053   (mapfam nil :glue #'vector [a b c] '(1 2 3 4))
1054   ;; the 4 doesnt count since another sequence has finished traversal by then
1055   '([a 1] [b 2] [c 3])))
1056 ;; list and dllist
1057 (Assert
1058  (equal
1059   (mapfam nil :glue #'vector '(a b c) (dllist 1 2 3))
1060   '([a 1] [b 2] [c 3])))
1061 (Assert
1062  (equal
1063   (mapfam nil :glue #'vector (dllist 'a 'b 'c) '(1 2 3 4))
1064   ;; the 4 doesnt count since another sequence has finished traversal by then
1065   '([a 1] [b 2] [c 3])))
1066 ;; dllist and vector
1067 (Assert
1068  (equal
1069   (mapfam nil :glue #'vector (dllist 'a 'b 'c) [1 2 3])
1070   '([a 1] [b 2] [c 3])))
1071 (Assert
1072  (equal
1073   (mapfam nil :glue #'vector [a b c] (dllist 1 2 3 4))
1074   ;; the 4 doesnt count since another sequence has finished traversal by then
1075   '([a 1] [b 2] [c 3])))
1076 ;; string and vector
1077 (Assert
1078  (equal
1079   (mapfam nil :glue #'vector "abc" [1 2 3])
1080   '([?a 1] [?b 2] [?c 3])))
1081 (Assert
1082  (equal
1083   (mapfam nil :glue #'vector [a b c] "1234")
1084   ;; the 4 doesnt count since another sequence has finished traversal by then
1085   '([a ?1] [b ?2] [c ?3])))
1086 ;; more than 2 sequences
1087 (Assert
1088  (equal
1089   (mapfam nil :glue #'vector '(a b c) [1 2 3] (dllist ?x ?y ?z))
1090   '([a 1 ?x] [b 2 ?y] [c 3 ?z])))
1091 (Assert
1092  (equal
1093   (mapfam nil :glue #'vector '(a b c) [1 2 3 4] (dllist ?x ?y ?z))
1094   '([a 1 ?x] [b 2 ?y] [c 3 ?z])))
1095
1096
1097 ;;; combinations with more than 1 family
1098 (Assert-set-equality
1099  (mapfam nil :mode 'comb [a b c] "1234")
1100  ;; the 4 doesnt count since another sequence has finished traversal by then
1101  '((a ?1) (a ?2) (a ?3) (a ?4)
1102    (b ?1) (b ?2) (b ?3) (b ?4)
1103    (c ?1) (c ?2) (c ?3) (c ?4)))
1104
1105 (Assert-set-equality
1106  (mapfam nil :glue #'vector :mode 'comb [a b c] "1234")
1107  ;; the 4 doesnt count since another sequence has finished traversal by then
1108  '([a ?1] [a ?2] [a ?3] [a ?4]
1109    [b ?1] [b ?2] [b ?3] [b ?4]
1110    [c ?1] [c ?2] [c ?3] [c ?4]))
1111
1112 (Assert-set-equality
1113  (mapfam #'cons :mode 'comb [a b c] "1234")
1114  ;; the 4 doesnt count since another sequence has finished traversal by then
1115  '((a . ?1) (a . ?2) (a . ?3) (a . ?4)
1116    (b . ?1) (b . ?2) (b . ?3) (b . ?4)
1117    (c . ?1) (c . ?2) (c . ?3) (c . ?4)))
1118
1119 ;;; cartesians with more than 1 family
1120 (Assert-set-equality
1121  (mapfam nil :mode 'cart [a b c] "1234")
1122  ;; the 4 doesnt count since another sequence has finished traversal by then
1123  '((a ?1) (a ?2) (a ?3) (a ?4)
1124    (b ?1) (b ?2) (b ?3) (b ?4)
1125    (c ?1) (c ?2) (c ?3) (c ?4)))
1126
1127 (Assert-set-equality
1128  (mapfam nil :glue #'vector :mode 'cart [a b c] "1234")
1129  ;; the 4 doesnt count since another sequence has finished traversal by then
1130  '([a ?1] [a ?2] [a ?3] [a ?4]
1131    [b ?1] [b ?2] [b ?3] [b ?4]
1132    [c ?1] [c ?2] [c ?3] [c ?4]))
1133
1134 (Assert-set-equality
1135  (mapfam #'cons :mode 'cart [a b c] "1234")
1136  ;; the 4 doesnt count since another sequence has finished traversal by then
1137  '((a . ?1) (a . ?2) (a . ?3) (a . ?4)
1138    (b . ?1) (b . ?2) (b . ?3) (b . ?4)
1139    (c . ?1) (c . ?2) (c . ?3) (c . ?4)))
1140
1141 (Assert-set-equality
1142  (mapfam nil :mode 'cart [?a ?b] "12" (dllist ?X))
1143  '((?a ?1 ?X) (?a ?2 ?X) (?b ?1 ?X) (?b ?2 ?X)))
1144
1145 (Assert-set-equality
1146  (mapfam nil :glue #'vector :mode 'cart [?a ?b] "12" (dllist ?X))
1147  '([?a ?1 ?X] [?a ?2 ?X] [?b ?1 ?X] [?b ?2 ?X]))
1148
1149 (Assert-set-equality
1150  (mapfam #'concat :glue #'vector :mode 'cart [?a ?b] "12" (dllist ?X))
1151  '("a1X" "a2X" "b1X" "b2X"))
1152
1153 (Assert-set-equality
1154  (mapfam #'string :mode 'cart [?a ?b] "12" (dllist ?X))
1155  '("a1X" "a2X" "b1X" "b2X"))
1156
1157 ;;; perms with more than 1 family
1158 (Assert-set-equality
1159  (mapfam nil :mode 'perm [?a ?b] "12")
1160  '((?a ?1) (?1 ?a)
1161    (?a ?2) (?2 ?a)
1162    (?b ?1) (?1 ?b)
1163    (?b ?2) (?2 ?b)))
1164
1165 (Assert-set-equality
1166  (mapfam nil :mode 'perm [?a ?b] "12" (dllist ?X))
1167  '((?a ?1 ?X) (?a ?X ?1) (?X ?a ?1) (?X ?1 ?a) (?1 ?X ?a) (?1 ?a ?X)
1168    (?a ?2 ?X) (?a ?X ?2) (?X ?a ?2) (?X ?2 ?a) (?2 ?X ?a) (?2 ?a ?X)
1169    (?b ?1 ?X) (?b ?X ?1) (?X ?b ?1) (?X ?1 ?b) (?1 ?X ?b) (?1 ?b ?X)
1170    (?b ?2 ?X) (?b ?X ?2) (?X ?b ?2) (?X ?2 ?b) (?2 ?X ?b) (?2 ?b ?X)))
1171
1172 (Assert-set-equality
1173  (mapfam #'string :mode 'perm [?a ?b] "12" (dllist ?X))
1174  '("a1X" "aX1" "Xa1" "X1a" "1Xa" "1aX"
1175    "a2X" "aX2" "Xa2" "X2a" "2Xa" "2aX"
1176    "b1X" "bX1" "Xb1" "X1b" "1Xb" "1bX"
1177    "b2X" "bX2" "Xb2" "X2b" "2Xb" "2bX"))
1178
1179 (Assert-set-equality
1180  (mapfam #'string :mode 'perm [?a ?b] "12" (dllist ?X) [?A])
1181  '("a1XA" "a1AX" "aA1X" "aAX1" "aXA1" "aX1A"
1182    "1aXA" "1aAX" "1AaX" "1AXa" "1XAa" "1XaA"
1183    "X1aA" "X1Aa" "XA1a" "XAa1" "XaA1" "Xa1A"
1184    "A1Xa" "A1aX" "Aa1X" "AaX1" "AXa1" "AX1a"
1185
1186    "a2XA" "2aXA" "2XaA" "X2aA" "Xa2A" "aX2A"
1187    "aXA2" "XaA2" "XAa2" "AXa2" "AaX2" "aAX2"
1188    "2AXa" "A2Xa" "AX2a" "XA2a" "X2Aa" "2XAa"
1189    "2aAX" "a2AX" "aA2X" "Aa2X" "A2aX" "2AaX"
1190
1191    "b1XA" "1bXA" "1XbA" "X1bA" "Xb1A" "bX1A"
1192    "bXA1" "XbA1" "XAb1" "AXb1" "AbX1" "bAX1"
1193    "1AXb" "A1Xb" "AX1b" "XA1b" "X1Ab" "1XAb"
1194    "1bAX" "b1AX" "bA1X" "Ab1X" "A1bX" "1AbX"
1195
1196    "b2XA" "2bXA" "2XbA" "X2bA" "Xb2A" "bX2A"
1197    "bXA2" "XbA2" "XAb2" "AXb2" "AbX2" "bAX2"
1198    "2AXb" "A2Xb" "AX2b" "XA2b" "X2Ab" "2XAb"
1199    "2bAX" "b2AX" "bA2X" "Ab2X" "A2bX" "2AbX"))
1200
1201
1202 ;;; testing over multiple sequences with strange arities
1203 (Assert-set-equality
1204  (mapfam nil :glue #'string "abcd" "1234" :arity 1)
1205  '(?a ?b ?c ?d))
1206
1207 (Assert-set-equality
1208  (mapfam nil :glue #'string "abcd" "1234" :arity '(1))
1209  '(?a ?b ?c ?d))
1210
1211 (Assert-set-equality
1212  (mapfam nil :glue #'string "abcd" "1234" :arity '(2))
1213  '("ab" "cd"))
1214
1215 (Assert-set-equality
1216  (mapfam nil :glue #'string "abcd" "1234" :arity '(1 1))
1217  '("a1" "b2" "c3" "d4"))
1218
1219 ;; (Assert-set-equality
1220 ;;  (mapfam nil :glue #'string "abcd" "1234" "another" :arity '(1 1))
1221 ;;  '("a1" "b2" "c3" "d4"))
1222
1223 (Assert-set-equality
1224  (mapfam nil :glue #'string "abcd" "1234" :arity '(1 1 1))
1225  '("a1" "b2" "c3" "d4"))
1226
1227 (Assert-set-equality
1228  (mapfam nil :glue #'string "abcd" "1234" :arity '(1 1 2))
1229  '("a1" "b2" "c3" "d4"))
1230
1231 (Assert-set-equality
1232  (mapfam nil :glue #'string "abcd" "1234" :arity '(1 2))
1233  '("a12" "b34"))
1234
1235 (Assert-set-equality
1236  (mapfam nil :glue #'string "abcd" "1234" :arity '(2 1))
1237  '("ab1" "cd2"))
1238
1239 (Assert-set-equality
1240  (mapfam nil :glue #'string "abcd" "1234" :arity '(2 1 1))
1241  '("ab1" "cd2"))
1242
1243 (Assert-set-equality
1244  (mapfam nil :glue #'string "abcd" "1234" :arity '(2 2))
1245  '("ab12" "cd34"))
1246
1247 (Assert-set-equality
1248  (mapfam nil :glue #'string "abcd" "1234" :arity '(3 1))
1249  '("abc1"))
1250
1251 (Assert-set-equality
1252  (mapfam nil :glue #'string "abcd" "1234" :arity '(1 3))
1253  '("a123"))
1254
1255 (Assert-set-equality
1256  (mapfam nil :glue #'string "abcd" "1234" :arity '(3 2))
1257  '("abc12"))
1258
1259 (Assert-set-equality
1260  (mapfam nil :glue #'string "abcd" "1234" :arity '(2 3))
1261  '("ab123"))
1262
1263 (Assert-set-equality
1264  (mapfam nil :glue #'string "abcd" "1234" :arity '(3 3))
1265  '("abc123"))
1266
1267 (Assert-set-equality
1268  (mapfam nil :glue #'string "abcd" "1234" :arity '(4 1))
1269  '("abcd1"))
1270
1271 (Assert-set-equality
1272  (mapfam nil :glue #'string "abcd" "1234" :arity '(1 4))
1273  '("a1234"))
1274
1275 (Assert-set-equality
1276  (mapfam nil :glue #'string "abcd" "1234" :arity '(4 2))
1277  '("abcd12"))
1278
1279 (Assert-set-equality
1280  (mapfam nil :glue #'string "abcd" "1234" :arity '(2 4))
1281  '("ab1234"))
1282
1283 (Assert-set-equality
1284  (mapfam nil :glue #'string "abcd" "1234" :arity '(4 3))
1285  '("abcd123"))
1286
1287 (Assert-set-equality
1288  (mapfam nil :glue #'string "abcd" "1234" :arity '(3 4))
1289  '("abc1234"))
1290
1291 (Assert-set-equality
1292  (mapfam nil :glue #'string "abcd" "1234" :arity '(4 4))
1293  '("abcd1234"))
1294
1295 (Assert
1296  (null
1297   (mapfam nil :glue #'string "abcd" "1234" :arity '(5 1))))
1298
1299 (Assert
1300  (null
1301   (mapfam nil :glue #'string "abcd" "1234" :arity '(1 5))))
1302
1303 (Assert
1304  (null
1305   (mapfam nil :glue #'string "abcd" "1234" :arity '(5 5))))
1306
1307 ;; carts
1308 (Assert-set-equality
1309  (mapfam nil :mode 'cart :glue #'string "abc" "123" :arity '(2 1))
1310  '("aa1" "aa2" "aa3" "ab1" "ab2" "ab3" "ac1" "ac2" "ac3"
1311    "ba1" "ba2" "ba3" "bb1" "bb2" "bb3" "bc1" "bc2" "bc3"
1312    "ca1" "ca2" "ca3" "cb1" "cb2" "cb3" "cc1" "cc2" "cc3"))
1313 (Assert-set-equality
1314  (mapfam nil :mode 'cart :glue #'string "abc" "123" :arity '(2 2))
1315  '("aa11" "aa12" "aa13" "aa21" "aa22" "aa23" "aa31" "aa32" "aa33"
1316    "ab11" "ab12" "ab13" "ab21" "ab22" "ab23" "ab31" "ab32" "ab33"
1317    "ac11" "ac12" "ac13" "ac21" "ac22" "ac23" "ac31" "ac32" "ac33"
1318
1319    "ba11" "ba12" "ba13" "ba21" "ba22" "ba23" "ba31" "ba32" "ba33"
1320    "bb11" "bb12" "bb13" "bb21" "bb22" "bb23" "bb31" "bb32" "bb33"
1321    "bc11" "bc12" "bc13" "bc21" "bc22" "bc23" "bc31" "bc32" "bc33"
1322
1323    "ca11" "ca12" "ca13" "ca21" "ca22" "ca23" "ca31" "ca32" "ca33"
1324    "cb11" "cb12" "cb13" "cb21" "cb22" "cb23" "cb31" "cb32" "cb33"
1325    "cc11" "cc12" "cc13" "cc21" "cc22" "cc23" "cc31" "cc32" "cc33"))
1326
1327 ;; combs
1328 (Assert-set-equality
1329  (mapfam nil :mode 'comb :glue #'string "abcd" "123" :arity '(2 2))
1330  '("ab12" "ab13" "ab23" "ac12" "ac13" "ac23" "ad12" "ad13" "ad23"
1331    "bc12" "bc13" "bc23" "bd12" "bd13" "bd23"
1332    "cd12" "cd13" "cd23"))
1333
1334 (Assert-set-equality
1335  (mapfam nil :mode 'comb :glue #'string "abcd" "123" :arity '(2 1))
1336  '("ab1" "ab2" "ab3" "ac1" "ac2" "ac3" "ad1" "ad2" "ad3"
1337    "bc1" "bc2" "bc3" "bd1" "bd2" "bd3"
1338    "cd1" "cd2" "cd3"))
1339
1340 (Assert-set-equality
1341  (mapfam nil :mode 'comb :glue #'string "abcd" "1234" :arity '(2 3))
1342  '("ab123" "ab124" "ab134" "ab234"
1343    "ac123" "ac124" "ac134" "ac234"
1344    "ad123" "ad124" "ad134" "ad234"
1345    "bc123" "bc124" "bc134" "bc234"
1346    "bd123" "bd124" "bd134" "bd234"
1347    "cd123" "cd124" "cd134" "cd234"))
1348
1349 (Assert
1350  (null (mapfam nil :mode 'comb :glue #'string "abcd" "1234" :arity '(2 5))))
1351
1352 ;; the same but with #'string being the mapper
1353 (Assert-set-equality
1354  (mapfam #'string :mode 'comb "abcd" "123" :arity '(2 2))
1355  '("ab12" "ab13" "ab23" "ac12" "ac13" "ac23" "ad12" "ad13" "ad23"
1356    "bc12" "bc13" "bc23" "bd12" "bd13" "bd23"
1357    "cd12" "cd13" "cd23"))
1358
1359 (Assert-set-equality
1360  (mapfam #'string :mode 'comb "abcd" "123" :arity '(2 1))
1361  '("ab1" "ab2" "ab3" "ac1" "ac2" "ac3" "ad1" "ad2" "ad3"
1362    "bc1" "bc2" "bc3" "bd1" "bd2" "bd3"
1363    "cd1" "cd2" "cd3"))
1364
1365 (Assert-set-equality
1366  (mapfam #'string :mode 'comb "abcd" "1234" :arity '(2 3))
1367  '("ab123" "ab124" "ab134" "ab234"
1368    "ac123" "ac124" "ac134" "ac234"
1369    "ad123" "ad124" "ad134" "ad234"
1370    "bc123" "bc124" "bc134" "bc234"
1371    "bd123" "bd124" "bd134" "bd234"
1372    "cd123" "cd124" "cd134" "cd234"))
1373
1374 (Assert
1375  (null (mapfam #'string :mode 'comb "abcd" "1234" :arity '(2 5))))
1376
1377 ;; the same but with #'concat being the mapper and #'string being glue
1378 (Assert-set-equality
1379  (mapfam #'concat :mode 'comb :glue #'string "abcd" "123" :arity '(2 2))
1380  '("ab12" "ab13" "ab23" "ac12" "ac13" "ac23" "ad12" "ad13" "ad23"
1381    "bc12" "bc13" "bc23" "bd12" "bd13" "bd23"
1382    "cd12" "cd13" "cd23"))
1383
1384 (Assert-set-equality
1385  (mapfam #'concat :mode 'comb :glue #'string "abcd" "123" :arity '(2 1))
1386  '("ab1" "ab2" "ab3" "ac1" "ac2" "ac3" "ad1" "ad2" "ad3"
1387    "bc1" "bc2" "bc3" "bd1" "bd2" "bd3"
1388    "cd1" "cd2" "cd3"))
1389
1390 (Assert-set-equality
1391  (mapfam #'concat :mode 'comb :glue #'string "abcd" "1234" :arity '(2 3))
1392  '("ab123" "ab124" "ab134" "ab234"
1393    "ac123" "ac124" "ac134" "ac234"
1394    "ad123" "ad124" "ad134" "ad234"
1395    "bc123" "bc124" "bc134" "bc234"
1396    "bd123" "bd124" "bd134" "bd234"
1397    "cd123" "cd124" "cd134" "cd234"))
1398
1399 (Assert
1400  (null (mapfam #'concat :mode 'comb :glue #'string "abcd" "1234" :arity '(2 5))))
1401
1402 ;; perms
1403 (Assert-set-equality
1404  (mapfam nil :mode 'perm :glue #'string "abcd" "123" :arity '(2 2))
1405  (append
1406   (mapfam nil :mode 'perm :glue #'string "ab12")
1407   (mapfam nil :mode 'perm :glue #'string "ab13")
1408   (mapfam nil :mode 'perm :glue #'string "ab23")
1409   (mapfam nil :mode 'perm :glue #'string "ac12")
1410   (mapfam nil :mode 'perm :glue #'string "ac13")
1411   (mapfam nil :mode 'perm :glue #'string "ac23")
1412   (mapfam nil :mode 'perm :glue #'string "ad12")
1413   (mapfam nil :mode 'perm :glue #'string "ad13")
1414   (mapfam nil :mode 'perm :glue #'string "ad23")
1415   (mapfam nil :mode 'perm :glue #'string "bc12")
1416   (mapfam nil :mode 'perm :glue #'string "bc13")
1417   (mapfam nil :mode 'perm :glue #'string "bc23")
1418   (mapfam nil :mode 'perm :glue #'string "bd12")
1419   (mapfam nil :mode 'perm :glue #'string "bd13")
1420   (mapfam nil :mode 'perm :glue #'string "bd23")
1421   (mapfam nil :mode 'perm :glue #'string "cd12")
1422   (mapfam nil :mode 'perm :glue #'string "cd13")
1423   (mapfam nil :mode 'perm :glue #'string "cd23")))
1424
1425 (Assert-set-equality
1426  (mapfam nil :mode 'perm :glue #'string "abcd" "123" :arity '(1 1))
1427  '("a1" "1a" "a2" "2a" "a3" "3a" "b1" "1b" "b2" "2b" "b3" "3b"
1428    "c1" "1c" "c2" "2c" "c3" "3c" "d1" "1d" "d2" "2d" "d3" "3d"))
1429
1430 ;;; test Steve's favourite
1431 ;;
1432 ;; (mapconcat #'concat (split-string "unsplit this split string") " ")
1433 ;;  => "unsplit this split string"
1434 ;;
1435 ;; Now with #'mapfam...
1436 ;;
1437 ;; First, with the exact same syntax as we did with #'mapconcat (because it is
1438 ;; our plan to replace all of our #'map* functions with aliases to #'mapfam)
1439 ;;
1440 ;; (mapfam #'concat (split-string "unsplit this split string") " ")
1441 ;;  => Wrong type argument: sequencep, ?\  <- it's a space character
1442 ;;
1443 ;; hrop: Yes, that's exactly what happens!  Let's make a test ...
1444
1445 (Check-Error wrong-type-argument
1446  (mapfam #'concat (split-string "unsplit this split string") " "))
1447
1448 ;; ... why that you ask?
1449 ;; By design #'mapfam operates like CL's #'map, i.e. takes any number of
1450 ;; sequences as input.  Because of this there is no way to tell whether you
1451 ;; actually meant the third arg of the above mapfam call to act as separator
1452 ;; or as a sequence (a string is a sequence too), well, it is simply assumed
1453 ;; that you mean the sequence which is why the above call throws the
1454 ;; wrong-type-argument error.
1455 ;;
1456 ;; Now lets try to wing it with more fancy syntax...
1457 ;;
1458 ;; (mapfam nil :separator " " :result-type #'concat
1459 ;;         (split-string "unsplit this split string"))
1460 ;;  => "unsplitthissplitstring"
1461 ;;
1462 ;; hrop: That's a bug ... here's the test
1463
1464 (Assert
1465  (string= (mapfam nil :separator " " :result-type #'concat
1466                   (split-string "unsplit this split string"))
1467           "unsplit this split string"))
1468
1469 ;; here's the proof that it really inserts the separator element
1470 (Assert
1471  (equal (mapfam nil :separator " " :result-type #'list
1472                 (split-string "unsplit this split string"))
1473         '("unsplit" " " "this" " " "split" " " "string")))
1474
1475 ;; (mapfam #'concat :result-type #'concat
1476 ;;         (split-string "unsplit this split string") " ")
1477 ;;  => Wrong type argument: sequencep, ?\
1478 ;;
1479 ;; hrop: um, I can't see what that is supposed to do, but yes, the wrong-type
1480 ;;       error is because of the second sequence (" ") which is kinda like [?\ ]
1481 ;;       let's do some fancy tests insteads
1482
1483 (Assert
1484  (string=
1485   (mapfam nil :initiator "!" :separator " " :terminator "?"
1486           :result-type #'concat ["uuuuh" "yeeeeah"])
1487   "!uuuuh yeeeeah?"))
1488
1489 ;; here to prove that the separator can be anything really
1490 (Assert
1491  (equal
1492   (mapfam nil :initiator ?! :separator (cons 'foo 'bar) :terminator ??
1493           :result-type #'vector ["does" "this" "work"])
1494   [?! "does" (foo . bar) "this" (foo . bar) "work" ?\?]))
1495
1496 ;; and it is the same element actually ... which is an undocumented feature :)
1497
1498 (setq bar
1499       (mapfam nil :separator (cons 'foo 'bar) :result-type #'vector
1500               ["a" "b" "c"]))
1501 (setcar (aref bar 1) 'bar)
1502 (Assert (eq (car (aref bar 3)) 'bar))
1503
1504 ;; Oh, here's a way...
1505 ;; (mapfam #'concat :result-type #'concat
1506 ;;         (split-string "unsplit this split string") '(" " " " " " ""))
1507 ;;  => "unsplit this split string"
1508 ;;
1509 ;; hrop: yipp :) that works of course ...
1510
1511 ;; (Assert
1512 ;;  (string=
1513 ;;   (mapfam #'concat :result-type #'concat
1514 ;;        (split-string "unsplit this split string") '(" " " " " " ""))
1515 ;;   "unsplit this split string"))
1516 ;;
1517 ;; (when-fboundp #'divisiblep
1518 ;;   (Assert-set-equality
1519 ;;    (let ((divisors))
1520 ;;      (mapfam :result-type 'void
1521 ;;           #'(lambda (p)
1522 ;;               (garbage-collect)
1523 ;;               (if (divisiblep 5041 p) (push p divisors))
1524 ;;               (garbage-collect))
1525 ;;           '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
1526 ;;               21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
1527 ;;               38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54
1528 ;;               55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 69 70
1529 ;;               71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87
1530 ;;               88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103
1531 ;;               104 105 106 107 108 109 110 111 112 113 114 115 116
1532 ;;               117 118 119 120 121 122 123 124 125 126 127 128 129
1533 ;;               130 131 132 133 134 135 136 137 138 139 140 141 142
1534 ;;               143 144 145 146 147 148 149 150 151 152 153 154 155
1535 ;;               156 157 158 159 160 161 162 163 164 165 166 167 168
1536 ;;               169 170 171 172 173 174 175 176 177 178 179 180 181
1537 ;;               182 183 184 185 186 187 188 189 190 191 192 193 194
1538 ;;               195 196 197 198 199 200 201 202 203 204 205 206 207
1539 ;;               208 209 210 211 212 213 214 215 216 217 218 219 220
1540 ;;               221 222 223 224 225 226 227 228 229 230 231 232 233
1541 ;;               234 235 236 237 238 239 240 241 242 243 244 245 246
1542 ;;               247 248 249 250 251 252 253 254 255 256 257 258 259
1543 ;;               260 261 262 263 264 265 266 267 268 269 270 271 272
1544 ;;               273 274 275 276 277 278 279 280 281 282 283 284 285
1545 ;;               ))
1546 ;;      divisors)
1547 ;;    '(1 71))
1548 ;;
1549 ;;   (Assert-set-equality
1550 ;;    (let ((divisors))
1551 ;;      (mapfam #'(lambda (p)
1552 ;;               (garbage-collect)
1553 ;;               (if (divisiblep 5041 p) (push p divisors))
1554 ;;               (garbage-collect))
1555 ;;           '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
1556 ;;               21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
1557 ;;               38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54
1558 ;;               55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 69 70
1559 ;;               71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87
1560 ;;               88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103
1561 ;;               104 105 106 107 108 109 110 111 112 113 114 115 116
1562 ;;               117 118 119 120 121 122 123 124 125 126 127 128 129
1563 ;;               130 131 132 133 134 135 136 137 138 139 140 141 142
1564 ;;               143 144 145 146 147 148 149 150 151 152 153 154 155
1565 ;;               156 157 158 159 160 161 162 163 164 165 166 167 168
1566 ;;               169 170 171 172 173 174 175 176 177 178 179 180 181
1567 ;;               182 183 184 185 186 187 188 189 190 191 192 193 194
1568 ;;               195 196 197 198 199 200 201 202 203 204 205 206 207
1569 ;;               208 209 210 211 212 213 214 215 216 217 218 219 220
1570 ;;               221 222 223 224 225 226 227 228 229 230 231 232 233
1571 ;;               234 235 236 237 238 239 240 241 242 243 244 245 246
1572 ;;               247 248 249 250 251 252 253 254 255 256 257 258 259
1573 ;;               260 261 262 263 264 265 266 267 268 269 270 271 272
1574 ;;               273 274 275 276 277 278 279 280 281 282 283 284 285
1575 ;;               ))
1576 ;;      divisors)
1577 ;;    '(1 71)))
1578
1579
1580 (Assert (null (mapfam #'identity nil)))
1581 (Assert (null (mapfam nil nil)))
1582 (Assert (null (mapfam #'identity [])))
1583 (Assert (null (mapfam nil [])))
1584 (Assert (null (mapfam #'identity (dllist))))
1585 (Assert (null (mapfam nil (dllist))))
1586 (Assert (null (mapfam #'identity "")))
1587 (Assert (null (mapfam nil "")))
1588
1589 (Assert (vectorp (mapfam #'identity nil :result-type #'vector)))
1590 (Assert (vectorp (mapfam nil nil :result-type #'vector)))
1591 (Assert (vectorp (mapfam #'identity [] :result-type #'vector)))
1592 (Assert (vectorp (mapfam nil [] :result-type #'vector)))
1593 (Assert (vectorp (mapfam #'identity (dllist) :result-type #'vector)))
1594 (Assert (vectorp (mapfam nil (dllist) :result-type #'vector)))
1595 (Assert (vectorp (mapfam #'identity "" :result-type #'vector)))
1596 (Assert (vectorp (mapfam nil "" :result-type #'vector)))
1597
1598 (Assert (zerop (length (mapfam #'identity nil :result-type #'vector))))
1599 (Assert (zerop (length (mapfam nil nil :result-type #'vector))))
1600 (Assert (zerop (length (mapfam #'identity [] :result-type #'vector))))
1601 (Assert (zerop (length (mapfam nil [] :result-type #'vector))))
1602 (Assert (zerop (length (mapfam #'identity (dllist) :result-type #'vector))))
1603 (Assert (zerop (length (mapfam nil (dllist) :result-type #'vector))))
1604 (Assert (zerop (length (mapfam #'identity "" :result-type #'vector))))
1605 (Assert (zerop (length (mapfam nil "" :result-type #'vector))))
1606
1607 ;;; map-tests.el ends here