1; XEmacs: This file contains -*-Scheme-*- source code.
2
3;;; srfi-1-tests: a test suite for procedures in the SRFI-1
4;;; library
5
6;;; John David Stone
7;;; Department of Mathematics and Computer Science
8;;; Grinnell College
9;;; stone@math.grin.edu
10
11;;; created January 8, 1999
12;;; last revised January 13, 1999
13
14
15;; ChangeLog
16;;
17;; 2007-06-30 yamaken   - Imported from
18;;                        http://www.math.grin.edu/~stone/srfi/srfi-1-tests.ss
19;;                        and adapted to SigScheme and final SRFI-1
20;; 2007-07-18 yamaken   - Disable (make-list 5) ==> (#f #f #f #f #f)
21
22(require-extension (srfi 1))
23(require-extension (unittest))
24
25(define *test-track-progress* #f)
26
27;;; The DISPLAY-LINE procedure transmits a human-readable
28;;; representation of each of its arguments to the standard
29;;; output port and then terminates the output line.
30
31(define display-line
32  (lambda scribenda
33    (for-each display scribenda)
34    (newline)))
35
36;;; The TEST syntax takes three subexpressions.  The value of
37;;; the first should identify or describe the nature of the test
38;;; to be conducted; it is typically a symbol or a serial
39;;; number.  The second should be an expression embodying the
40;;; test: the values of the expression are the results of the test.
41;;; The value of the third subexpression of TEST should be a
42;;; predicate that can be applied to the results of the
43;;; test to determine whether it passes or fails.
44
45;;(define-syntax test
46;;  (syntax-rules ()
47;;    ((test name trial criterion)
48;;     (begin
49;;       (display-line "----------------------------------------")
50;;       (display-line "Test " name ":")
51;;       (newline)
52;;       (display-line 'trial)
53;;       (newline)
54;;       (display-line "-->")
55;;       (newline)
56;;       (call-with-values
57;;         (lambda () trial)
58;;         (lambda results
59;;           (for-each display-line results)
60;;           (newline)
61;;           (if (apply criterion results)
62;;               (display-line "Test " name " passed.")
63;;               (display-line "*** Test " name " failed."))))
64;;       (display-line "----------------------------------------")
65;;       (newline)))))
66
67;; Cannot receive multiple values as result.
68(define test
69  (lambda (name result criterion)
70    (assert-true (symbol->string name) (criterion result))))
71
72(define test/values
73  (lambda (name trial criterion)
74    (assert-true (symbol->string name)
75                 (call-with-values
76                     (lambda () (eval trial (interaction-environment)))
77                   criterion))))
78
79;;; Some procedures are defined for their side effects only.
80;;; The EFFECT-ONLY-TEST syntax invokes such procedures, with
81;;; the appropriate decorations in the style of TEST.  It takes
82;;; three subexpressions.  The value of the first should
83;;; identify or describe the nature of the test to be conducted.
84;;; The second should be an expression embodying the test and
85;;; performing the desired side effect.  It is up to the
86;;; programmer to determine whether the test succeeded or
87;;; failed; to assist her in this effort, the third
88;;; subexpression of EFFECT-ONLY-TEST is also evaluated and its
89;;; results displayed.
90
91;;(define-syntax effect-only-test
92;;  (syntax-rules ()
93;;    ((effect-only-test name trial check)
94;;     (begin
95;;       (display-line "----------------------------------------")
96;;       (display-line "Test " name ":")
97;;       (newline)
98;;       (display-line 'trial)
99;;       (newline)
100;;       trial
101;;       (display-line "Test " name " completed.")
102;;       (newline)
103;;       (display-line "Value(s) of check expression:")
104;;       (newline)
105;;       (display-line 'check)
106;;       (newline)
107;;       (display-line "-->")
108;;       (newline)
109;;       (call-with-values
110;;         (lambda () check)
111;;         (lambda results
112;;           (for-each display-line results)))
113;;       (display-line "----------------------------------------")
114;;       (newline)))))
115
116;;; The tests of CIRCULAR-LIST should not attempt to display the
117;;; result of the test expression, since some Scheme
118;;; implementations cannot print cyclic data structures.  The
119;;; NON-PRINTING-TEST syntax is used for such tests.
120
121;;(define-syntax non-printing-test
122;;  (syntax-rules ()
123;;    ((non-printing-test name trial criterion)
124;;     (begin
125;;       (display-line "----------------------------------------")
126;;       (display-line "Test " name ":")
127;;       (newline)
128;;       (display-line 'trial)
129;;       (newline)
130;;       (call-with-values
131;;         (lambda () trial)
132;;         (lambda results
133;;           (if (apply criterion results)
134;;               (display-line "Test " name " passed.")
135;;               (display-line "*** Test " name " failed."))))
136;;       (display-line "----------------------------------------")
137;;       (newline)))))
138
139(define non-printing-test test)
140
141;;; XCONS
142
143(test 'xcons:null-cdr
144  (xcons '() 'Andromeda)
145  (lambda (result) (equal? result '(Andromeda))))
146
147(let ((base '(Antlia)))
148  (test 'xcons:pair-cdr
149    (xcons base 'Apus)
150    (lambda (result)
151      (and (equal? result '(Apus Antlia))
152           (eq? (cdr result) base)))))
153
154(test 'xcons:datum-cdr
155  (xcons 'Aquarius 'Aquila)
156  (lambda (result) (equal? result '(Aquila . Aquarius))))
157
158;;; TREE-COPY
159
160;;(test 'tree-copy:null-tree
161;;  (tree-copy '())
162;;  null?)
163;;
164;;(let ((original 43/17))
165;;  (test 'tree-copy:non-pair
166;;    (tree-copy original)
167;;    (lambda (result) (equal? result original))))
168;;
169;;(let ((original '(Ara Argo Aries Auriga Bootes)))
170;;  (test 'tree-copy:flat-list
171;;    (tree-copy original)
172;;    (lambda (result)
173;;      (and (equal? result original)
174;;           (not (eq? result original))
175;;           (not (eq? (cdr result) (cdr original)))
176;;           (not (eq? (cddr result) (cddr original)))
177;;           (not (eq? (cdddr result) (cdddr original)))
178;;           (not (eq? (cddddr result) (cddddr original)))))))
179;;
180;;(let ((original '((Caelum)
181;;                  (Camelopardis Cancer Capricorn
182;;                   (Carina Cassiopeia)
183;;                   ((Centaurus Cepheus Cetus)))
184;;                  Chamaeleon)))
185;;  (test 'tree-copy:bush
186;;    (tree-copy original)
187;;    (lambda (result)
188;;      (and (equal? result original)
189;;           (not (eq? result original))
190;;           (not (eq? (car result) (car original)))
191;;           (not (eq? (cdr result) (cdr original)))
192;;           (not (eq? (cadr result) (cadr original)))
193;;           (not (eq? (cddr result) (cddr original)))
194;;           (not (eq? (cdadr result) (cdadr original)))
195;;           (not (eq? (cddadr result) (cddadr original)))
196;;           (not (eq? (cdr (cddadr result))
197;;                     (cdr (cddadr original))))
198;;           (not (eq? (cddr (cddadr result))
199;;                     (cddr (cddadr original))))
200;;           (not (eq? (cadr (cddadr result))
201;;                     (cadr (cddadr original))))
202;;           (not (eq? (cddr (cddadr result))
203;;                     (cddr (cddadr original))))
204;;           (not (eq? (caddr (cddadr result))
205;;                     (caddr (cddadr original))))
206;;           (not (eq? (caaddr (cddadr result))
207;;                     (caaddr (cddadr original))))
208;;           (not (eq? (cdr (caaddr (cddadr result)))
209;;                     (cdr (caaddr (cddadr original)))))
210;;           (not (eq? (cddr (caaddr (cddadr result)))
211;;                     (cddr (caaddr (cddadr original)))))))))
212;;
213;;(let ((original '(Arcturus Canopus Sirius . Vega)))
214;;  (test 'tree-copy:improper-list
215;;    (tree-copy original)
216;;    (lambda (result)
217;;      (and (equal? result original)
218;;           (not (eq? result original))
219;;           (not (eq? (cdr result) (cdr original)))
220;;           (not (eq? (cddr result) (cddr original)))))))
221
222;;; MAKE-LIST
223
224(test 'make-list:zero-length
225  (make-list 0)
226  null?)
227
228;; Disabled by YamaKen 2007-07-18
229;; SRFI-1: If the fill argument is not given, the elements of the list may be
230;; arbitrary values.
231;;
232;;(test 'make-list:default-element
233;;  (make-list 5)
234;;  (lambda (result) (equal? result '(#f #f #f #f #f))))
235
236(test 'make-list:fill-element
237  (make-list 7 'Circinus)
238  (lambda (result)
239    (equal? result '(Circinus Circinus Circinus Circinus
240                     Circinus Circinus Circinus))))
241
242;;; LIST-TABULATE
243
244(test 'list-tabulate:zero-length
245  (list-tabulate 0 (lambda (position) #f))
246  null?)
247
248(test 'list-tabulate:identity
249  (list-tabulate 5 (lambda (position) position))
250  (lambda (result)
251    (equal? result '(0 1 2 3 4))))
252
253(test 'list-tabulate:factorial
254  (list-tabulate 7 (lambda (position)
255                     (do ((multiplier 1 (+ multiplier 1))
256                          (product 1 (* product multiplier)))
257                         ((< position multiplier) product))))
258  (lambda (result) (equal? result '(1 1 2 6 24 120 720))))
259
260;;; CONS*
261
262(test 'cons*:one-argument
263  (cons* 'Columba)
264  (lambda (result) (eq? result 'Columba)))
265
266(test 'cons*:two-arguments
267  (cons* 'Corvus 'Crater)
268  (lambda (result) (equal? result '(Corvus . Crater))))
269
270(test 'cons*:many-arguments
271  (cons* 'Crux 'Cygnus 'Delphinus 'Dorado 'Draco)
272  (lambda (result)
273    (equal? result '(Crux Cygnus Delphinus Dorado . Draco))))
274
275(test 'cons*:last-argument-null
276  (cons* 'Equuleus 'Fornax '())
277  (lambda (result) (equal? result '(Equuleus Fornax))))
278
279(let ((base '(Gemini Grus)))
280  (test 'cons*:last-argument-non-empty-list
281    (cons* 'Hercules 'Horologium 'Hydra 'Hydrus base)
282    (lambda (result)
283      (and (equal? result '(Hercules Horologium Hydra Hydrus
284                            Gemini Grus))
285           (eq? (cddddr result) base)))))
286
287;;; LIST-COPY
288
289(test 'list-copy:null-list
290  (list-copy '())
291  null?)
292
293(let ((original '(Indus Lacerta Leo Lepus Libra)))
294  (test 'list-copy:flat-list
295    (list-copy original)
296    (lambda (result)
297      (and (equal? result original)
298           (not (eq? result original))
299           (not (eq? (cdr result) (cdr original)))
300           (not (eq? (cddr result) (cddr original)))
301           (not (eq? (cdddr result) (cdddr original)))
302           (not (eq? (cddddr result) (cddddr original)))))))
303
304(let ((first '(Lupus))
305      (second '(Lynx Malus Mensa (Microscopium Monoceros)
306                     ((Musca Norma Octans))))
307      (third 'Ophiuchus))
308  (let ((original (list first second third)))
309    (test 'list-copy:bush
310      (list-copy original)
311      (lambda (result)
312        (and (equal? result original)
313             (not (eq? result original))
314             (eq? (car result) first)
315             (not (eq? (cdr result) (cdr original)))
316             (eq? (cadr result) second)
317             (not (eq? (cddr result) (cddr original)))
318             (eq? (caddr result) third))))))
319
320;;;;; .IOTA
321;;
322;;(test '.iota:zero-count
323;;  (.iota 0)
324;;  null?)
325;;
326;;(test '.iota:upper-limit-only
327;;  (.iota 5)
328;;  (lambda (result) (equal? result '(0 1 2 3 4))))
329;;
330;;(test '.iota:non-integer-upper-limit
331;;  (.iota 43/7)
332;;  (lambda (result) (equal? result '(0 1 2 3 4 5 6))))
333;;
334;;(test '.iota:lower-and-upper-limits
335;;  (.iota 1997 2004)
336;;  (lambda (result)
337;;    (equal? result '(1997 1998 1999 2000 2001 2002 2003))))
338;;
339;;(test '.iota:non-integer-lower-and-upper-limits
340;;  (.iota -13/7 41/7)
341;;  (lambda (result)
342;;    (equal? result '(-13/7 -6/7 1/7 8/7 15/7 22/7 29/7 36/7))))
343;;
344;;(test '.iota:positive-step
345;;  (.iota 1988 2008 4)
346;;  (lambda (result) (equal? result '(1988 1992 1996 2000 2004))))
347;;
348;;(test '.iota:negative-step
349;;  (.iota 3 -13 -3)
350;;  (lambda (result) (equal? result '(3 0 -3 -6 -9 -12))))
351;;
352;;(test '.iota:non-integer-arguments
353;;  (.iota 71/3 2297/100 -1/10)
354;;  (lambda (result)
355;;    (equal? result
356;;            '(71/3 707/30 352/15 701/30 349/15 139/6 346/15))))
357;;
358;;;;; IOTA.
359;;
360;;(test 'iota.:zero-count
361;;  (iota. 0)
362;;  null?)
363;;
364;;(test 'iota.:upper-limit-only
365;;  (iota. 5)
366;;  (lambda (result) (equal? result '(1 2 3 4 5))))
367;;
368;;(test 'iota.:non-integer-upper-limit
369;;  (iota. 43/7)
370;;  (lambda (result) (equal? result '(1 2 3 4 5 6))))
371;;
372;;(test 'iota.:lower-and-upper-limits
373;;  (iota. 1997 2004)
374;;  (lambda (result)
375;;    (equal? result '(1998 1999 2000 2001 2002 2003 2004))))
376;;
377;;(test 'iota.:non-integer-lower-and-upper-limits
378;;  (iota. -13/7 41/7)
379;;  (lambda (result)
380;;    (equal? result '(-6/7 1/7 8/7 15/7 22/7 29/7 36/7))))
381;;
382;;(test 'iota.:positive-step
383;;  (iota. 1988 2008 4)
384;;  (lambda (result) (equal? result '(1992 1996 2000 2004 2008))))
385;;
386;;(test 'iota.:negative-step
387;;  (iota. 3 -13 -3)
388;;  (lambda (result) (equal? result '(0 -3 -6 -9 -12))))
389;;
390;;(test 'iota.:non-integer-arguments
391;;  (iota. 71/3 2297/100 -1/10)
392;;  (lambda (result)
393;;    (equal? result
394;;            '(707/30 352/15 701/30 349/15 139/6 346/15))))
395
396;;; CIRCULAR-LIST
397
398(non-printing-test 'circular-list:one-element
399  (circular-list 'Orion)
400  (lambda (result)
401    (and (pair? result)
402         (eq? (car result) 'Orion)
403         (eq? (cdr result) result))))
404
405(non-printing-test 'circular-list:many-elements
406  (circular-list 'Pavo 'Pegasus 'Perseus 'Phoenix 'Pictor)
407  (lambda (result)
408    (and (pair? result)
409         (eq? (car result) 'Pavo)
410         (pair? (cdr result))
411         (eq? (cadr result) 'Pegasus)
412         (pair? (cddr result))
413         (eq? (caddr result) 'Perseus)
414         (pair? (cdddr result))
415         (eq? (cadddr result) 'Phoenix)
416         (pair? (cddddr result))
417         (eq? (car (cddddr result)) 'Pictor)
418         (eq? (cdr (cddddr result)) result))))
419
420;;; ZIP
421
422(test 'zip:all-lists-empty
423  (zip '() '() '() '() '())
424  null?)
425
426(test 'zip:one-list
427  (zip '(Pisces Puppis Reticulum))
428  (lambda (result)
429    (equal? result '((Pisces) (Puppis) (Reticulum)))))
430
431(test 'zip:two-lists
432  (zip '(Sagitta Sagittarius Scorpio Scutum Serpens)
433       '(Sextans Taurus Telescopium Triangulum Tucana))
434  (lambda (result)
435    (equal? result '((Sagitta Sextans)
436                     (Sagittarius Taurus)
437                     (Scorpio Telescopium)
438                     (Scutum Triangulum)
439                     (Serpens Tucana)))))
440
441(test 'zip:short-lists
442  (zip '(Vela) '(Virgo) '(Volens) '(Vulpecula))
443  (lambda (result)
444    (equal? result '((Vela Virgo Volens Vulpecula)))))
445
446(test 'zip:several-lists
447  (zip '(actinium aluminum americium antimony argon)
448       '(arsenic astatine barium berkeleium beryllium)
449       '(bismuth boron bromine cadmium calcium)
450       '(californium carbon cerium cesium chlorine)
451       '(chromium cobalt copper curium dysprosium)
452       '(einsteinium erbium europium fermium fluorine)
453       '(francium gadolinium gallium germanium gold))
454  (lambda (result)
455    (equal? result '((actinium arsenic bismuth californium
456                      chromium einsteinium francium)
457                     (aluminum astatine boron carbon cobalt
458                      erbium gadolinium)
459                     (americium barium bromine cerium copper
460                      europium gallium)
461                     (antimony berkeleium cadmium cesium curium
462                      fermium germanium)
463                     (argon beryllium calcium chlorine
464                      dysprosium fluorine gold)))))
465
466;;; FIRST
467
468(test 'first:of-one
469  (first '(hafnium))
470  (lambda (result) (eq? result 'hafnium)))
471
472(test 'first:of-many
473  (first '(hahnium helium holmium hydrogen indium))
474  (lambda (result) (eq? result 'hahnium)))
475
476;;; SECOND
477
478(test 'second:of-two
479  (second '(iodine iridium))
480  (lambda (result) (eq? result 'iridium)))
481
482(test 'second:of-many
483  (second '(iron krypton lanthanum lawrencium lead lithium))
484  (lambda (result) (eq? result 'krypton)))
485
486;;; THIRD
487
488(test 'third:of-three
489  (third '(lutetium magnesium manganese))
490  (lambda (result) (eq? result 'manganese)))
491
492(test 'third:of-many
493  (third '(mendelevium mercury molybdenum neodymium neon
494                       neptunium nickel))
495  (lambda (result) (eq? result 'molybdenum)))
496
497;;; FOURTH
498
499(test 'fourth:of-four
500  (fourth '(niobium nitrogen nobelium osmium))
501  (lambda (result) (eq? result 'osmium)))
502
503(test 'fourth:of-many
504  (fourth '(oxygen palladium phosphorus platinum plutonium
505                   polonium potassium praseodymium))
506  (lambda (result) (eq? result 'platinum)))
507
508;;; FIFTH
509
510(test 'fifth:of-five
511  (fifth '(promethium protatctinium radium radon rhenium))
512  (lambda (result) (eq? result 'rhenium)))
513
514(test 'fifth:of-many
515  (fifth '(rhodium rubidium ruthenium rutherfordium samarium
516                   scandium selenium silicon silver))
517  (lambda (result) (eq? result 'samarium)))
518
519;;; SIXTH
520
521(test 'sixth:of-six
522  (sixth '(sodium strontium sulfur tantalum technetium
523                  tellurium))
524  (lambda (result) (eq? result 'tellurium)))
525
526(test 'sixth:of-many
527  (sixth '(terbium thallium thorium thulium tin titanium
528                   tungsten uranium vanadium xenon))
529  (lambda (result) (eq? result 'titanium)))
530
531;;; SEVENTH
532
533(test 'seventh:of-seven
534  (seventh '(ytterbium yttrium zinc zirconium acacia abele
535                       ailanthus))
536  (lambda (result) (eq? result 'ailanthus)))
537
538(test 'seventh:of-many
539  (seventh '(alder allspice almond apple apricot ash aspen
540                   avocado balsa balsam banyan))
541  (lambda (result) (eq? result 'aspen)))
542
543;;; EIGHTH
544
545(test 'eighth:of-eight
546  (eighth '(basswood bay bayberry beech birch boxwood breadfruit
547                     buckeye))
548  (lambda (result) (eq? result 'buckeye)))
549
550(test 'eighth:of-many
551  (eighth '(butternut buttonwood cacao candleberry cashew cassia
552                      catalpa cedar cherry chestnut chinaberry
553                      chinquapin))
554  (lambda (result) (eq? result 'cedar)))
555
556;;; NINTH
557
558(test 'ninth:of-nine
559  (ninth '(cinnamon citron clove coconut cork cottonwood cypress
560                    date dogwood))
561  (lambda (result) (eq? result 'dogwood)))
562
563(test 'ninth:of-many
564  (ninth '(ebony elder elm eucalyptus ficus fig fir frankincense
565                 ginkgo grapefruit guava gum hawthorn))
566  (lambda (result) (eq? result 'ginkgo)))
567
568;;; TENTH
569
570(test 'tenth:of-ten
571  (tenth '(hazel hemlock henna hickory holly hornbeam ironwood
572                 juniper kumquat laburnum))
573  (lambda (result) (eq? result 'laburnum)))
574
575(test 'tenth:of-many
576  (tenth '(lancewood larch laurel lemon lime linden litchi
577                     locust logwood magnolia mahogany mango
578                     mangrove maple))
579  (lambda (result) (eq? result 'magnolia)))
580
581;;; TAKE
582
583(test 'take:all-of-list
584  (take '(medlar mimosa mulberry nutmeg oak) 5)
585  (lambda (result)
586    (equal? result '(medlar mimosa mulberry nutmeg oak))))
587
588(test 'take:front-of-list
589  (take '(olive orange osier palm papaw peach pear) 5)
590  (lambda (result)
591    (equal? result '(olive orange osier palm papaw))))
592
593(test 'take-right:rear-of-list
594  (take-right '(pecan persimmon pine pistachio plane plum pomegranite)
595              5)
596  (lambda (result)
597    (equal? result '(pine pistachio plane plum pomegranite))))
598
599(test 'take:none-of-list
600  (take '(poplar quince redwood) 0)
601  null?)
602
603(test 'take:empty-list
604  (take '() 0)
605  null?)
606
607;;; DROP
608
609(test 'drop:all-of-list
610  (drop '(rosewood sandalwood sassfras satinwood senna) 5)
611  null?)
612
613(test 'drop:front-of-list
614  (drop '(sequoia serviceberry spruce sycamore tamarack tamarind
615                  tamarugo)
616        5)
617  (lambda (result) (equal? result '(tamarind tamarugo))))
618
619(test 'drop-right:rear-of-list
620  (drop-right '(tangerine teak thuja torchwood upas walnut wandoo) 5)
621  (lambda (result) (equal? result '(tangerine teak))))
622
623(test 'drop:none-of-list
624  (drop '(whitebeam whitethorn wicopy) 0)
625  (lambda (result)
626    (equal? result '(whitebeam whitethorn wicopy))))
627
628(test 'drop:empty-list
629  (drop '() 0)
630  null?)
631
632;;; TAKE!
633
634;;; List arguments to linear-update procedures are constructed
635;;; with the LIST procedure rather than as quoted data, since in
636;;; some implementations quoted data are not mutable.
637
638(test 'take!:all-of-list
639  (take! (list 'willow 'woollybutt 'wychelm 'yellowwood 'yew) 5)
640  (lambda (result)
641    (equal? result '(willow woollybutt wychelm yellowwood yew))))
642
643(test 'take!:front-of-list
644  (take! (list 'ylang-ylang 'zebrawood 'affenpinscher 'afghan
645               'airedale 'alsatian 'barbet)
646         5)
647  (lambda (result)
648    (equal? result '(ylang-ylang zebrawood affenpinscher afghan
649                                 airedale))))
650
651;;(test 'take!:rear-of-list
652;;  (take! (list 'basenji 'basset 'beagle 'bloodhound 'boarhound
653;;               'borzoi 'boxer)
654;;        -5)
655;;  (lambda (result)
656;;    (equal? result '(beagle bloodhound boarhound borzoi
657;;                            boxer))))
658
659(test 'take!:none-of-list
660  (take! (list 'briard 'bulldog 'chihuahua) 0)
661  null?)
662
663(test 'take!:empty-list
664  (take! '() 0)
665  null?)
666
667;;; DROP!
668
669;;(test 'drop!:all-of-list
670;;  (drop! (list 'chow 'collie 'coonhound 'clydesdale 'dachshund)
671;;         5)
672;;  null?)
673;;
674;;(test 'drop!:front-of-list
675;;  (drop! (list 'dalmatian 'deerhound 'doberman 'elkhound
676;;               'foxhound 'greyhound 'griffon)
677;;        5)
678;;  (lambda (result) (equal? result '(greyhound griffon))))
679;;
680;;(test 'drop!:rear-of-list
681;;  (drop! (list 'groenendael 'harrier 'hound 'husky 'keeshond
682;;               'komondor 'kuvasz)
683;;         -5)
684;;  (lambda (result) (equal? result '(groenendael harrier))))
685;;
686;;(test 'drop!:none-of-list
687;;  (drop! (list 'labrador 'malamute 'malinois) 0)
688;;  (lambda (result)
689;;    (equal? result '(labrador malamute malinois))))
690;;
691;;(test 'drop!:empty-list
692;;  (drop! '() 0)
693;;  null?)
694
695;;; LAST
696
697(test 'last:of-singleton
698  (last '(maltese))
699  (lambda (result) (eq? result 'maltese)))
700
701(test 'last:of-longer-list
702  (last '(mastiff newfoundland nizinny otterhound papillon))
703  (lambda (result) (eq? result 'papillon)))
704
705;;; LAST-PAIR
706
707(let ((pair '(pekingese)))
708  (test 'last-pair:of-singleton
709    (last-pair pair)
710    (lambda (result) (eq? result pair))))
711
712(let ((pair '(pointer)))
713  (test 'last-pair:of-longer-list
714    (last-pair (cons 'pomeranian
715                     (cons 'poodle
716                           (cons 'pug (cons 'puli pair)))))
717    (lambda (result) (eq? result pair))))
718
719(let ((pair '(manx . siamese)))
720  (test 'last-pair:of-improper-list
721    (last-pair (cons 'abyssinian (cons 'calico pair)))
722    (lambda (result) (eq? result pair))))
723
724;;; UNZIP2
725
726(test/values 'unzip2:empty-list-of-lists
727  '(unzip2 '())
728  (lambda (firsts seconds)
729    (and (null? firsts) (null? seconds))))
730
731(test/values 'unzip2:singleton-list-of-lists
732  '(unzip2 '((retriever rottweiler)))
733  (lambda (firsts seconds)
734    (and (equal? firsts '(retriever))
735         (equal? seconds '(rottweiler)))))
736
737(test/values 'unzip2:longer-list-of-lists
738  '(unzip2 '((saluki samoyed)
739            (shipperke schnauzer)
740            (setter shepherd)
741            (skye spaniel)
742            (spitz staghound)))
743  (lambda (firsts seconds)
744    (and (equal? firsts '(saluki shipperke setter skye spitz))
745         (equal? seconds '(samoyed schnauzer shepherd spaniel
746                                   staghound)))))
747
748(test/values 'unzip2:lists-with-extra-elements
749  '(unzip2 '((terrier turnspit vizsla wiemaraner)
750            (whippet wolfhound)
751            (bells bones bongo carillon celesta)
752            (chimes clappers conga)))
753  (lambda (firsts seconds)
754    (and (equal? firsts '(terrier whippet bells chimes))
755         (equal? seconds
756                 '(turnspit wolfhound bones clappers)))))
757
758;;; UNZIP3
759
760(test/values 'unzip3:empty-list-of-lists
761  '(unzip3 '())
762  (lambda (firsts seconds thirds)
763    (and (null? firsts) (null? seconds) (null? thirds))))
764
765(test/values 'unzip3:singleton-list-of-lists
766  '(unzip3 '((cymbals gamelan glockenspiel)))
767  (lambda (firsts seconds thirds)
768    (and (equal? firsts '(cymbals))
769         (equal? seconds '(gamelan))
770         (equal? thirds '(glockenspiel)))))
771
772(test/values 'unzip3:longer-list-of-lists
773  '(unzip3 '((gong handbells kettledrum)
774            (lyra maraca marimba)
775            (mbira membranophone metallophone)
776            (nagara naker rattle)
777            (sizzler snappers tabor)))
778  (lambda (firsts seconds thirds)
779    (and (equal? firsts '(gong lyra mbira nagara sizzler))
780         (equal? seconds '(handbells maraca membranophone naker
781                                     snappers))
782         (equal? thirds '(kettledrum marimba metallophone rattle
783                                     tabor)))))
784
785(test/values 'unzip3:lists-with-extra-elements
786  '(unzip3 '((tambourine timbrel timpani tintinnabula tonitruone)
787            (triangle vibraphone xylophone)
788            (baccarat banker bezique bingo bridge canasta)
789            (casino craps cribbage euchre)))
790  (lambda (firsts seconds thirds)
791    (and (equal? firsts '(tambourine triangle baccarat casino))
792         (equal? seconds '(timbrel vibraphone banker craps))
793         (equal? thirds
794                 '(timpani xylophone bezique cribbage)))))
795
796;;; UNZIP4
797
798(test/values 'unzip4:empty-list-of-lists
799  '(unzip4 '())
800  (lambda (firsts seconds thirds fourths)
801    (and (null? firsts)
802         (null? seconds)
803         (null? thirds)
804         (null? fourths))))
805
806(test/values 'unzip4:singleton-list-of-lists
807  '(unzip4 '((fantan faro gin hazard)))
808  (lambda (firsts seconds thirds fourths)
809    (and (equal? firsts '(fantan))
810         (equal? seconds '(faro))
811         (equal? thirds '(gin))
812         (equal? fourths '(hazard)))))
813
814(test/values 'unzip4:longer-list-of-lists
815  '(unzip4 '((hearts keno loo lottery)
816            (lotto lowball monte numbers)
817            (ombre picquet pinball pinochle)
818            (poker policy quinze romesteq)
819            (roulette rum rummy skat)))
820  (lambda (firsts seconds thirds fourths)
821    (and (equal? firsts '(hearts lotto ombre poker roulette))
822         (equal? seconds '(keno lowball picquet policy rum))
823         (equal? thirds '(loo monte pinball quinze rummy))
824         (equal? fourths
825                 '(lottery numbers pinochle romesteq skat)))))
826
827(test/values 'unzip4:lists-with-extra-elements
828  '(unzip4 '((adamant agate alexandrite amethyst aquamarine
829                     beryl)
830            (bloodstone brilliant carbuncle carnelian)
831            (chalcedony chrysoberyl chrysolite chrysoprase
832                        citrine coral demantoid)
833            (diamond emerald garnet girasol heliotrope)))
834  (lambda (firsts seconds thirds fourths)
835    (and (equal? firsts '(adamant bloodstone chalcedony diamond))
836         (equal? seconds '(agate brilliant chrysoberyl emerald))
837         (equal? thirds
838                 '(alexandrite carbuncle chrysolite garnet))
839         (equal? fourths
840                 '(amethyst carnelian chrysoprase girasol)))))
841
842;;; UNZIP5
843
844(test/values 'unzip5:empty-list-of-lists
845  '(unzip5 '())
846  (lambda (firsts seconds thirds fourths fifths)
847    (and (null? firsts)
848         (null? seconds)
849         (null? thirds)
850         (null? fourths)
851         (null? fifths))))
852
853(test/values 'unzip5:singleton-list-of-lists
854  '(unzip5 '((hyacinth jacinth jade jargoon jasper)))
855  (lambda (firsts seconds thirds fourths fifths)
856    (and (equal? firsts '(hyacinth))
857         (equal? seconds '(jacinth))
858         (equal? thirds '(jade))
859         (equal? fourths '(jargoon))
860         (equal? fifths '(jasper)))))
861
862(test/values 'unzip5:longer-list-of-lists
863  '(unzip5 '((kunzite moonstone morganite onyx opal)
864            (peridot plasma ruby sapphire sard)
865            (sardonyx spinel star sunstone topaz)
866            (tourmaline turquoise zircon Argus basilisk)
867            (Bigfoot Briareus bucentur Cacus Caliban)))
868  (lambda (firsts seconds thirds fourths fifths)
869    (and (equal? firsts
870                 '(kunzite peridot sardonyx tourmaline Bigfoot))
871         (equal? seconds
872                 '(moonstone plasma spinel turquoise Briareus))
873         (equal? thirds '(morganite ruby star zircon bucentur))
874         (equal? fourths '(onyx sapphire sunstone Argus Cacus))
875         (equal? fifths '(opal sard topaz basilisk Caliban)))))
876
877(test/values 'unzip5:lists-with-extra-elements
878  '(unzip5 '((centaur Cerberus Ceto Charybdis chimera cockatrice
879                     Cyclops)
880            (dipsas dragon drake Echidna Geryon)
881            (Gigantes Gorgon Grendel griffin Harpy hippocampus
882                      hippocentaur hippocerf)
883            (hirocervus Hydra Kraken Ladon manticore Medusa)))
884  (lambda (firsts seconds thirds fourths fifths)
885    (and (equal? firsts '(centaur dipsas Gigantes hirocervus))
886         (equal? seconds '(Cerberus dragon Gorgon Hydra))
887         (equal? thirds '(Ceto drake Grendel Kraken))
888         (equal? fourths '(Charybdis Echidna griffin Ladon))
889         (equal? fifths '(chimera Geryon Harpy manticore)))))
890
891;;; APPEND!
892
893(test 'append!:no-arguments
894  (append!)
895  null?)
896
897(test 'append!:one-argument
898  (append! (list 'mermaid 'merman 'Minotaur))
899  (lambda (result)
900    (equal? result '(mermaid merman Minotaur))))
901
902(test 'append!:several-arguments
903  (append! (list 'nixie 'ogre 'ogress 'opinicus)
904           (list 'Orthos)
905           (list 'Pegasus 'Python)
906           (list 'roc 'Sagittary 'salamander 'Sasquatch 'satyr)
907           (list 'Scylla 'simurgh 'siren))
908  (lambda (result)
909    (equal? result '(nixie ogre ogress opinicus Orthos Pegasus
910                     Python roc Sagittary salamander Sasquatch
911                     satyr Scylla simurgh siren))))
912
913(test 'append!:some-null-arguments
914  (append! (list) (list) (list 'Sphinx 'Talos 'troll) (list)
915           (list 'Typhoeus) (list) (list) (list))
916  (lambda (result)
917    (equal? result '(Sphinx Talos troll Typhoeus))))
918
919(test 'append!:all-null-arguments
920  (append! (list) (list) (list) (list) (list))
921  null?)
922
923;;; APPEND-REVERSE
924
925(test 'append-reverse:first-argument-null
926  (append-reverse '() '(Typhon unicorn vampire werewolf))
927  (lambda (result)
928    (equal? result '(Typhon unicorn vampire werewolf))))
929
930(test 'append-reverse:second-argument-null
931  (append-reverse '(windigo wivern xiphopagus yeti zombie) '())
932  (lambda (result)
933    (equal? result '(zombie yeti xiphopagus wivern windigo))))
934
935(test 'append-reverse:both-arguments-null
936  (append-reverse '() '())
937  null?)
938
939(test 'append-reverse:neither-argument-null
940  (append-reverse '(Afghanistan Albania Algeria Andorra)
941                  '(Angola Argentina Armenia))
942  (lambda (result)
943    (equal? result '(Andorra Algeria Albania Afghanistan Angola
944                     Argentina Armenia))))
945
946;;; APPEND-REVERSE!
947
948(test 'append-reverse!:first-argument-null
949  (append-reverse! (list)
950                   (list 'Australia 'Austria 'Azerbaijan))
951  (lambda (result)
952    (equal? result '(Australia Austria Azerbaijan))))
953
954(test 'append-reverse!:second-argument-null
955  (append-reverse! (list 'Bahrain 'Bangladesh 'Barbados
956                         'Belarus 'Belgium)
957                   (list))
958  (lambda (result)
959    (equal? result
960            '(Belgium Belarus Barbados Bangladesh Bahrain))))
961
962(test 'append-reverse!:both-arguments-null
963  (append-reverse! (list) (list))
964  null?)
965
966(test 'append-reverse!:neither-argument-null
967  (append-reverse! (list 'Belize 'Benin 'Bhutan 'Bolivia)
968                   (list 'Bosnia 'Botswana 'Brazil))
969  (lambda (result)
970    (equal? result '(Bolivia Bhutan Benin Belize Bosnia Botswana
971                     Brazil))))
972
973;;; REVERSE!
974
975(test 'reverse!:empty-list
976  (reverse! (list))
977  null?)
978
979(test 'reverse!:singleton-list
980  (reverse! (list 'Brunei))
981  (lambda (result)
982    (equal? result '(Brunei))))
983
984(test 'reverse!:longer-list
985  (reverse! (list 'Bulgaria 'Burundi 'Cambodia 'Cameroon
986                  'Canada))
987  (lambda (result)
988    (equal? result
989            '(Canada Cameroon Cambodia Burundi Bulgaria))))
990
991;;; UNFOLD
992
993(test 'unfold:predicate-always-satisfied
994  (unfold (lambda (seed) #t)
995          (lambda (seed) (* seed 2))
996          (lambda (seed) (* seed 3))
997          1)
998  null?)
999
1000(test 'unfold:normal-case
1001  (unfold (lambda (seed) (= seed 729))
1002          (lambda (seed) (* seed 2))
1003          (lambda (seed) (* seed 3))
1004          1)
1005  (lambda (result) (equal? result '(2 6 18 54 162 486))))
1006
1007;;; UNFOLD/TAIL
1008
1009;;(test 'unfold/tail:predicate-always-satisfied
1010;;  (unfold/tail (lambda (seed) #t)
1011;;               (lambda (seed) (* seed 2))
1012;;               (lambda (seed) (* seed 3))
1013;;               (lambda (seed) (* seed 5))
1014;;               1)
1015;;  (lambda (result) (equal? result 5)))
1016;;
1017;;(test 'unfold/tail:normal-case
1018;;  (unfold/tail (lambda (seed) (= seed 729))
1019;;               (lambda (seed) (* seed 2))
1020;;               (lambda (seed) (* seed 3))
1021;;               (lambda (seed) (* seed 5))
1022;;               1)
1023;;  (lambda (result) (equal? result '(2 6 18 54 162 486 . 3645))))
1024
1025;;; FOLD
1026
1027(test 'fold:one-null-list
1028  (fold (lambda (alpha beta) (* alpha (+ beta 1))) 13 '())
1029  (lambda (result) (= result 13)))
1030
1031(test 'fold:one-singleton-list
1032  (fold (lambda (alpha beta) (* alpha (+ beta 1))) 13 '(15))
1033  (lambda (result) (= result 210)))
1034
1035(test 'fold:one-longer-list
1036  (fold (lambda (alpha beta) (* alpha (+ beta 1)))
1037         13
1038         '(15 17 19 21 23))
1039  (lambda (result) (= result 32927582)))
1040
1041(test 'fold:several-null-lists
1042  (fold vector 'Chad '() '() '() '() '())
1043  (lambda (result) (eq? result 'Chad)))
1044
1045(test 'fold:several-singleton-lists
1046  (fold vector 'Chile '(China) '(Colombia) '(Comoros) '(Congo)
1047         '(Croatia))
1048  (lambda (result)
1049    (equal? result
1050            '#(China Colombia Comoros Congo Croatia Chile))))
1051
1052(test 'fold:several-longer-lists
1053  (fold (lambda (alpha beta gamma delta epsilon zeta)
1054           (cons (vector alpha beta gamma delta epsilon) zeta))
1055         '()
1056         '(Cuba Cyprus Denmark Djibouti Dominica Ecuador Egypt)
1057         '(Eritrea Estonia Ethiopia Fiji Finland France Gabon)
1058         '(Gambia Georgia Germany Ghana Greece Grenada
1059                  Guatemala)
1060         '(Guinea Guyana Haiti Honduras Hungary Iceland India)
1061         '(Indonesia Iran Iraq Ireland Israel Italy Jamaica))
1062  (lambda (result)
1063    (equal? result
1064            '(#(Egypt Gabon Guatemala India Jamaica)
1065              #(Ecuador France Grenada Iceland Italy)
1066              #(Dominica Finland Greece Hungary Israel)
1067              #(Djibouti Fiji Ghana Honduras Ireland)
1068              #(Denmark Ethiopia Germany Haiti Iraq)
1069              #(Cyprus Estonia Georgia Guyana Iran)
1070              #(Cuba Eritrea Gambia Guinea Indonesia)))))
1071
1072(test 'fold:lists-of-different-lengths
1073  (fold (lambda (alpha beta gamma delta)
1074           (cons (vector alpha beta gamma) delta))
1075         '()
1076         '(Japan Jordan Kazakhstan Kenya)
1077         '(Kiribati Kuwait)
1078         '(Kyrgyzstan Laos Latvia))
1079  (lambda (result)
1080    (equal? result '(#(Jordan Kuwait Laos)
1081                     #(Japan Kiribati Kyrgyzstan)))))
1082
1083;;; FOLD-RIGHT
1084
1085(test 'fold-right:one-null-list
1086  (fold-right (lambda (alpha beta) (* alpha (+ beta 1))) 13 '())
1087  (lambda (result) (= result 13)))
1088
1089(test 'fold-right:one-singleton-list
1090  (fold-right (lambda (alpha beta) (* alpha (+ beta 1))) 13 '(15))
1091  (lambda (result) (= result 210)))
1092
1093(test 'fold-right:one-longer-list
1094  (fold-right (lambda (alpha beta) (* alpha (+ beta 1)))
1095         13
1096         '(15 17 19 21 23))
1097  (lambda (result) (= result 32868750)))
1098
1099(test 'fold-right:several-null-lists
1100  (fold-right vector 'Lebanon '() '() '() '() '())
1101  (lambda (result) (eq? result 'Lebanon)))
1102
1103(test 'fold-right:several-singleton-lists
1104  (fold-right vector 'Lesotho '(Liberia) '(Libya) '(Liechtenstein)
1105         '(Lithuania) '(Luxembourg))
1106  (lambda (result)
1107    (equal? result '#(Liberia Libya Liechtenstein Lithuania
1108                             Luxembourg Lesotho))))
1109
1110(test 'fold-right:several-longer-lists
1111  (fold-right (lambda (alpha beta gamma delta epsilon zeta)
1112           (cons (vector alpha beta gamma delta epsilon) zeta))
1113         '()
1114         '(Macedonia Madagascar Malawi Malaysia Maldives Mali
1115                     Malta)
1116         '(Mauritania Mauritius Mexico Micronesia Moldova Monaco
1117                      Mongolia)
1118         '(Morocco Mozambique Myanmar Namibia Nauru Nepal
1119                   Netherlands)
1120         '(Nicaragua Niger Nigeria Norway Oman Pakistan Palau)
1121         '(Panama Paraguay Peru Philippines Poland Portugal
1122                  Qatar))
1123  (lambda (result)
1124    (equal? result
1125            '(#(Macedonia Mauritania Morocco Nicaragua Panama)
1126              #(Madagascar Mauritius Mozambique Niger Paraguay)
1127              #(Malawi Mexico Myanmar Nigeria Peru)
1128              #(Malaysia Micronesia Namibia Norway Philippines)
1129              #(Maldives Moldova Nauru Oman Poland)
1130              #(Mali Monaco Nepal Pakistan Portugal)
1131              #(Malta Mongolia Netherlands Palau Qatar)))))
1132
1133(test 'fold-right:lists-of-different-lengths
1134  (fold-right (lambda (alpha beta gamma delta)
1135           (cons (vector alpha beta gamma) delta))
1136         '()
1137         '(Romania Russia Rwanda Senegal)
1138         '(Seychelles Singapore)
1139         '(Slovakia Slovenia Somalia))
1140  (lambda (result)
1141    (equal? result '(#(Romania Seychelles Slovakia)
1142                     #(Russia Singapore Slovenia)))))
1143
1144;;; PAIR-FOLD
1145
1146(let* ((revappend (lambda (reversend base)
1147                    (do ((rest reversend (cdr rest))
1148                         (result base (cons (car rest) result)))
1149                        ((null? rest) result))))
1150       (revappall (lambda (first . rest)
1151                    (let loop ((first first) (rest rest))
1152                      (if (null? rest)
1153                          first
1154                          (revappend first
1155                                     (loop (car rest)
1156                                           (cdr rest))))))))
1157
1158  (test 'pair-fold:one-null-list
1159    (pair-fold revappend '(Spain Sudan) '())
1160    (lambda (result) (equal? result '(Spain Sudan))))
1161
1162  (test 'pair-fold:one-singleton-list
1163    (pair-fold revappend '(Suriname Swaziland) '(Sweden))
1164    (lambda (result)
1165      (equal? result '(Sweden Suriname Swaziland))))
1166
1167  (test 'pair-fold:one-longer-list
1168    (pair-fold revappend
1169                '(Switzerland Syria)
1170                '(Taiwan Tajikistan Tanzania Thailand Togo))
1171    (lambda (result)
1172      (equal? result
1173              '(Togo Togo Thailand Togo Thailand Tanzania Togo
1174                Thailand Tanzania Tajikistan Togo Thailand
1175                Tanzania Tajikistan Taiwan Switzerland Syria))))
1176
1177  (test 'pair-fold:several-null-lists
1178    (pair-fold revappall '(Tonga Tunisia) '() '() '() '() '())
1179    (lambda (result) (equal? result '(Tonga Tunisia))))
1180
1181  (test 'pair-fold:several-singleton-lists
1182    (pair-fold revappall
1183                '(Turkey Turkmenistan)
1184                '(Tuvalu)
1185                '(Uganda)
1186                '(Ukraine)
1187                '(Uruguay)
1188                '(Uzbekistan))
1189    (lambda (result)
1190      (equal? result
1191              '(Tuvalu Uganda Ukraine Uruguay Uzbekistan Turkey
1192                Turkmenistan))))
1193
1194  (test 'pair-fold:several-longer-lists
1195    (pair-fold revappall
1196                '(Vanuatu Venezuela)
1197                '(Vietnam Yemen Yugoslavia Zaire Zambia Zimbabwe
1198                  Agnon)
1199                '(Aleixandre Andric Asturias Beckett Bellow
1200                  Benavente Bergson)
1201                '(Bjornson Brodsky Buck Bunin Camus Canetti
1202                  Carducci)
1203                '(Cela Churchill Deledda Echegary Eliot Elytis
1204                  Eucken)
1205                '(Faulkner Galsworthy Gide Gjellerup Golding
1206                  Gordimer Hamsun))
1207    (lambda (result)
1208      (equal? result
1209              '(Agnon Bergson Carducci Eucken Hamsun Agnon
1210                Zimbabwe Bergson Benavente Carducci Canetti
1211                Eucken Elytis Hamsun Gordimer Agnon Zimbabwe
1212                Zambia Bergson Benavente Bellow Carducci Canetti
1213                Camus Eucken Elytis Eliot Hamsun Gordimer
1214                Golding Agnon Zimbabwe Zambia Zaire Bergson
1215                Benavente Bellow Beckett Carducci Canetti Camus
1216                Bunin Eucken Elytis Eliot Echegary Hamsun
1217                Gordimer Golding Gjellerup Agnon Zimbabwe Zambia
1218                Zaire Yugoslavia Bergson Benavente Bellow
1219                Beckett Asturias Carducci Canetti Camus Bunin
1220                Buck Eucken Elytis Eliot Echegary Deledda Hamsun
1221                Gordimer Golding Gjellerup Gide Agnon Zimbabwe
1222                Zambia Zaire Yugoslavia Yemen Bergson Benavente
1223                Bellow Beckett Asturias Andric Carducci Canetti
1224                Camus Bunin Buck Brodsky Eucken Elytis Eliot
1225                Echegary Deledda Churchill Hamsun Gordimer
1226                Golding Gjellerup Gide Galsworthy Agnon Zimbabwe
1227                Zambia Zaire Yugoslavia Yemen Vietnam Bergson
1228                Benavente Bellow Beckett Asturias Andric
1229                Aleixandre Carducci Canetti Camus Bunin Buck
1230                Brodsky Bjornson Eucken Elytis Eliot Echegary
1231                Deledda Churchill Cela Hamsun Gordimer Golding
1232                Gjellerup Gide Galsworthy Faulkner Vanuatu
1233                Venezuela))))
1234
1235  (test 'pair-fold:lists-of-different-lengths
1236    (pair-fold revappall
1237                '(Hauptmann Hemingway Hesse)
1238                '(Heyse Jensen Jimenez Johnson)
1239                '(Karlfeldt Kawabata)
1240                '(Kipling Lagerkvist Lagerlof Laxness Lewis))
1241    (lambda (result)
1242      (equal? result
1243              '(Johnson Jimenez Jensen Kawabata Lewis Laxness
1244                Lagerlof Lagerkvist Johnson Jimenez Jensen Heyse
1245                Kawabata Karlfeldt Lewis Laxness Lagerlof
1246                Lagerkvist Kipling Hauptmann Hemingway
1247                Hesse)))))
1248
1249;;; PAIR-FOLD-RIGHT
1250
1251(let* ((revappend (lambda (reversend base)
1252                    (do ((rest reversend (cdr rest))
1253                         (result base (cons (car rest) result)))
1254                        ((null? rest) result))))
1255       (revappall (lambda (first . rest)
1256                    (let loop ((first first) (rest rest))
1257                      (if (null? rest)
1258                          first
1259                          (revappend first
1260                                     (loop (car rest)
1261                                           (cdr rest))))))))
1262
1263  (test 'pair-fold-right:one-null-list
1264    (pair-fold-right revappend '(Maeterlinck Mahfouz) '())
1265    (lambda (result) (equal? result '(Maeterlinck Mahfouz))))
1266
1267  (test 'pair-fold-right:one-singleton-list
1268    (pair-fold-right revappend '(Mann Martinson) '(Mauriac))
1269    (lambda (result)
1270      (equal? result '(Mauriac Mann Martinson))))
1271
1272  (test 'pair-fold-right:one-longer-list
1273    (pair-fold-right revappend
1274                '(Milosz Mistral)
1275                '(Mommsen Montale Morrison Neruda Oe))
1276    (lambda (result)
1277      (equal? result
1278              '(Oe Neruda Morrison Montale Mommsen Oe Neruda
1279                Morrison Montale Oe Neruda Morrison Oe Neruda Oe
1280                Milosz Mistral))))
1281
1282  (test 'pair-fold-right:several-null-lists
1283    (pair-fold-right revappall '(Pasternak Paz) '() '() '() '() '())
1284    (lambda (result) (equal? result '(Pasternak Paz))))
1285
1286  (test 'pair-fold-right:several-singleton-lists
1287    (pair-fold-right revappall
1288                '(Perse Pirandello)
1289                '(Pontoppidan)
1290                '(Quasimodo)
1291                '(Reymont)
1292                '(Rolland)
1293                '(Russell))
1294    (lambda (result)
1295      (equal? result
1296              '(Pontoppidan Quasimodo Reymont Rolland Russell
1297                Perse Pirandello))))
1298
1299  (test 'pair-fold-right:several-longer-lists
1300    (pair-fold-right revappall
1301                '(Sachs Sartre)
1302                '(Seferis Shaw Sholokov Siefert Sienkiewicz
1303                  Sillanpaa Simon)
1304                '(Singer Solzhenitsyn Soyinka Spitteler
1305                  Steinbeck Tagore Undset)
1306                '(Walcott White Yeats Anderson Andrews Angelina
1307                  Aransas)
1308                '(Archer Armstrong Alascosa Austin Bailey
1309                  Bandera Bastrop)
1310                '(Baylor Bee Bell Bexar Blanco Borden Bosque
1311                  Bowie))
1312    (lambda (result)
1313      (equal? result
1314              '(Simon Sillanpaa Sienkiewicz Siefert Sholokov
1315                Shaw Seferis Undset Tagore Steinbeck Spitteler
1316                Soyinka Solzhenitsyn Singer Aransas Angelina
1317                Andrews Anderson Yeats White Walcott Bastrop
1318                Bandera Bailey Austin Alascosa Armstrong Archer
1319                Bowie Bosque Borden Blanco Bexar Bell Bee Baylor
1320                Simon Sillanpaa Sienkiewicz Siefert Sholokov
1321                Shaw Undset Tagore Steinbeck Spitteler Soyinka
1322                Solzhenitsyn Aransas Angelina Andrews Anderson
1323                Yeats White Bastrop Bandera Bailey Austin
1324                Alascosa Armstrong Bowie Bosque Borden Blanco
1325                Bexar Bell Bee Simon Sillanpaa Sienkiewicz
1326                Siefert Sholokov Undset Tagore Steinbeck
1327                Spitteler Soyinka Aransas Angelina Andrews
1328                Anderson Yeats Bastrop Bandera Bailey Austin
1329                Alascosa Bowie Bosque Borden Blanco Bexar Bell
1330                Simon Sillanpaa Sienkiewicz Siefert Undset
1331                Tagore Steinbeck Spitteler Aransas Angelina
1332                Andrews Anderson Bastrop Bandera Bailey Austin
1333                Bowie Bosque Borden Blanco Bexar Simon Sillanpaa
1334                Sienkiewicz Undset Tagore Steinbeck Aransas
1335                Angelina Andrews Bastrop Bandera Bailey Bowie
1336                Bosque Borden Blanco Simon Sillanpaa Undset
1337                Tagore Aransas Angelina Bastrop Bandera Bowie
1338                Bosque Borden Simon Undset Aransas Bastrop Bowie
1339                Bosque Sachs Sartre))))
1340
1341  (test 'pair-fold-right:lists-of-different-lengths
1342    (pair-fold-right revappall
1343                '(Brazoria Brazos Brewster)
1344                '(Briscoe Brooks Brown Burleson)
1345                '(Burnet Caldwell)
1346                '(Calhoun Callahan Cameron Camp Carson))
1347    (lambda (result)
1348      (equal? result
1349              '(Burleson Brown Brooks Briscoe Caldwell Burnet
1350                Carson Camp Cameron Callahan Calhoun Burleson
1351                Brown Brooks Caldwell Carson Camp Cameron
1352                Callahan Brazoria Brazos Brewster)))))
1353
1354;;; REDUCE
1355
1356(test 'reduce:null-list
1357  (reduce (lambda (alpha beta) (* alpha (+ beta 1))) 0 '())
1358  zero?)
1359
1360(test 'reduce:singleton-list
1361  (reduce (lambda (alpha beta) (* alpha (+ beta 1))) 0 '(25))
1362  (lambda (result) (= result 25)))
1363
1364(test 'reduce:doubleton-list
1365  (reduce (lambda (alpha beta) (* alpha (+ beta 1)))
1366           0
1367           '(27 29))
1368  (lambda (result) (= result 812)))
1369
1370;;; Fixnum overflow on SigScheme storage-compact
1371;;(test 'reduce:longer-list
1372;;  (reduce (lambda (alpha beta) (* alpha (+ beta 1)))
1373;;           0
1374;;           '(31 33 35 37 39 41 43))
1375;;  (lambda (result) (= result 94118227527)))
1376
1377;;; REDUCE-RIGHT
1378
1379(test 'reduce-right:null-list
1380  (reduce-right (lambda (alpha beta) (* alpha (+ beta 1))) 0 '())
1381  zero?)
1382
1383(test 'reduce-right:singleton-list
1384  (reduce-right (lambda (alpha beta) (* alpha (+ beta 1))) 0 '(25))
1385  (lambda (result) (= result 25)))
1386
1387(test 'reduce-right:doubleton-list
1388  (reduce-right (lambda (alpha beta) (* alpha (+ beta 1)))
1389           0
1390           '(27 29))
1391  (lambda (result) (= result 810)))
1392
1393;;; Fixnum overflow on SigScheme storage-compact
1394;;(test 'reduce-right:longer-list
1395;;  (reduce-right (lambda (alpha beta) (* alpha (+ beta 1)))
1396;;           0
1397;;           '(31 33 35 37 39 41 43))
1398;;  (lambda (result) (= result 93259601719)))
1399
1400;;; APPEND-MAP
1401
1402(test 'append-map:one-null-list
1403  (append-map (lambda (element) (list element element)) '())
1404  null?)
1405
1406(test 'append-map:one-singleton-list
1407  (append-map (lambda (element) (list element element)) '(Cass))
1408  (lambda (result) (equal? result '(Cass Cass))))
1409
1410(test 'append-map:one-longer-list
1411  (append-map (lambda (element) (list element element))
1412              '(Castro Chambers Cherokee Childress Clay))
1413  (lambda (result)
1414    (equal? result
1415            '(Castro Castro Chambers Chambers Cherokee Cherokee
1416              Childress Childress Clay Clay))))
1417
1418(test 'append-map:several-null-lists
1419  (append-map (lambda elements (reverse elements))
1420              '() '() '() '() '())
1421  null?)
1422
1423(test 'append-map:several-singleton-lists
1424  (append-map (lambda elements (reverse elements))
1425              '(Cochran)
1426              '(Coke)
1427              '(Coleman)
1428              '(Collin)
1429              '(Collingsworth))
1430  (lambda (result)
1431    (equal? result
1432            '(Collingsworth Collin Coleman Coke Cochran))))
1433
1434(test 'append-map:several-longer-lists
1435  (append-map (lambda elements (reverse elements))
1436              '(Colorado Comal Comanche Concho Cooke Coryell
1437                Cottle)
1438              '(Crane Crockett Crosby Culberson Dallam Dallas
1439                Dawson)
1440              '(Delta Denton Dewitt Dickens Dimmit Donley Duval)
1441              '(Eastland Ector Edwards Ellis Erath Falls Fannin)
1442              '(Fayette Fisher Floyd Foard Franklin Freestone
1443                Frio))
1444  (lambda (result)
1445    (equal? result
1446            '(Fayette Eastland Delta Crane Colorado Fisher Ector
1447              Denton Crockett Comal Floyd Edwards Dewitt Crosby
1448              Comanche Foard Ellis Dickens Culberson Concho
1449              Franklin Erath Dimmit Dallam Cooke Freestone Falls
1450              Donley Dallas Coryell Frio Fannin Duval Dawson
1451              Cottle))))
1452
1453;;; APPEND-MAP!
1454
1455(test 'append-map!:one-null-list
1456  (append-map! (lambda (element) (list element element))
1457               (list))
1458  null?)
1459
1460(test 'append-map!:one-singleton-list
1461  (append-map! (lambda (element) (list element element))
1462               (list 'Gaines))
1463  (lambda (result) (equal? result '(Gaines Gaines))))
1464
1465(test 'append-map!:one-longer-list
1466  (append-map! (lambda (element) (list element element))
1467               (list 'Galveston 'Garza 'Gillespie 'Glasscock
1468                     'Goliad))
1469  (lambda (result)
1470    (equal? result
1471            '(Galveston Galveston Garza Garza Gillespie
1472              Gillespie Glasscock Glasscock Goliad Goliad))))
1473
1474(test 'append-map!:several-null-lists
1475  (append-map! (lambda elements (reverse elements))
1476               (list)
1477               (list)
1478               (list)
1479               (list)
1480               (list))
1481  null?)
1482
1483(test 'append-map!:several-singleton-lists
1484  (append-map! (lambda elements (reverse elements))
1485               (list 'Gonzales)
1486               (list 'Gray)
1487               (list 'Grayson)
1488               (list 'Gregg)
1489               (list 'Grimes))
1490  (lambda (result)
1491    (equal? result
1492            '(Grimes Gregg Grayson Gray Gonzales))))
1493
1494(test 'append-map!:several-longer-lists
1495  (append-map! (lambda elements (reverse elements))
1496               (list 'Guadalupe 'Hale 'Hall 'Hamilton 'Hansford
1497                     'Hardeman 'Hardin)
1498               (list 'Harris 'Harrison 'Hartley 'Haskell 'Hays
1499                     'Hemphill 'Henderson)
1500               (list 'Hidalgo 'Hill 'Hockley 'Hood 'Hopkins
1501                     'Houston 'Howard)
1502               (list 'Hudspeth 'Hunt 'Hutchinson 'Irion 'Jack
1503                     'Jackson 'Jasper)
1504               (list 'Jefferson 'Johnson 'Jones 'Karnes 'Kaufman
1505                     'Kendall 'Kenedy))
1506  (lambda (result)
1507    (equal? result
1508            '(Jefferson Hudspeth Hidalgo Harris Guadalupe
1509              Johnson Hunt Hill Harrison Hale Jones Hutchinson
1510              Hockley Hartley Hall Karnes Irion Hood Haskell
1511              Hamilton Kaufman Jack Hopkins Hays Hansford
1512              Kendall Jackson Houston Hemphill Hardeman Kenedy
1513              Jasper Howard Henderson Hardin))))
1514
1515;;; MAP!
1516
1517(test 'map!:one-null-list
1518  (map! vector (list))
1519  null?)
1520
1521(test 'map!:one-singleton-list
1522  (map! vector (list 'Kent))
1523  (lambda (result) (equal? result '(#(Kent)))))
1524
1525(test 'map!:one-longer-list
1526  (map vector (list 'Kerr 'Kimble 'King 'Kinney 'Kleberg))
1527  (lambda (result)
1528    (equal? result
1529            '(#(Kerr) #(Kimble) #(King) #(Kinney) #(Kleberg)))))
1530
1531(test 'map!:several-null-lists
1532  (map! vector (list) (list) (list) (list) (list))
1533  null?)
1534
1535(test 'map!:several-singleton-lists
1536  (map! vector
1537        (list 'Knox)
1538        (list 'Lamar)
1539        (list 'Lamb)
1540        (list 'Lampasas)
1541        (list 'Lavaca))
1542  (lambda (result)
1543    (equal? result '(#(Knox Lamar Lamb Lampasas Lavaca)))))
1544
1545(test 'map!:several-longer-lists
1546  (map! vector
1547        (list 'Lee 'Leon 'Liberty 'Limestone 'Lipscomb 'Llano
1548              'Loving)
1549        (list 'Lubbock 'Lynn 'McCulloch 'McLennan 'McMullen
1550              'Madison 'Marion)
1551        (list 'Martin 'Mason 'Matagorda 'Maverick 'Medina
1552              'Menard 'Midland)
1553        (list 'Milam 'Mills 'Mitchell 'Montague 'Montgomery
1554              'Moore 'Morris)
1555        (list 'Motley 'Nacogdoches 'Navarro 'Newton 'Nolan
1556              'Nueces 'Ochiltree))
1557  (lambda (result)
1558    (equal? result
1559            '(#(Lee Lubbock Martin Milam Motley)
1560              #(Leon Lynn Mason Mills Nacogdoches)
1561              #(Liberty McCulloch Matagorda Mitchell Navarro)
1562              #(Limestone McLennan Maverick Montague Newton)
1563              #(Lipscomb McMullen Medina Montgomery Nolan)
1564              #(Llano Madison Menard Moore Nueces)
1565              #(Loving Marion Midland Morris Ochiltree)))))
1566
1567;;; MAP-IN-ORDER
1568
1569(test 'map-in-order:one-null-list
1570  (let ((counter 0))
1571    (map-in-order (lambda (element)
1572                    (set! counter (+ counter 1))
1573                    (cons counter element))
1574                  '()))
1575  null?)
1576
1577(test 'map-in-order:one-singleton-list
1578  (let ((counter 0))
1579    (map-in-order (lambda (element)
1580                    (set! counter (+ counter 1))
1581                    (cons counter element))
1582                  '(Oldham)))
1583  (lambda (result) (equal? result '((1 . Oldham)))))
1584
1585(test 'map-in-order:one-longer-list
1586  (let ((counter 0))
1587    (map-in-order (lambda (element)
1588                    (set! counter (+ counter 1))
1589                    (cons counter element))
1590                  '(Orange Panola Parker Parmer Pecos)))
1591  (lambda (result)
1592    (equal? result '((1 . Orange)
1593                     (2 . Panola)
1594                     (3 . Parker)
1595                     (4 . Parmer)
1596                     (5 . Pecos)))))
1597
1598(test 'map-in-order:several-null-lists
1599  (let ((counter 0))
1600    (map-in-order (lambda elements
1601                    (set! counter (+ counter 1))
1602                    (apply vector counter elements))
1603                  '() '() '() '() '()))
1604  null?)
1605
1606(test 'map-in-order:several-singleton-lists
1607  (let ((counter 0))
1608    (map-in-order (lambda elements
1609                    (set! counter (+ counter 1))
1610                    (apply vector counter elements))
1611                  '(Polk)
1612                  '(Potter)
1613                  '(Presidio)
1614                  '(Rains)
1615                  '(Randall)))
1616  (lambda (result)
1617    (equal? result '(#(1 Polk Potter Presidio Rains Randall)))))
1618
1619(test 'map-in-order:several-longer-lists
1620  (let ((counter 0))
1621    (map-in-order (lambda elements
1622                    (set! counter (+ counter 1))
1623                    (apply vector counter elements))
1624                  '(Reagan Real Reeves Refugio Roberts Robertson
1625                    Rockwall)
1626                  '(Runnels Rusk Sabine Schleicher Scurry
1627                    Shackelford Shelby)
1628                  '(Sherman Smith Somervell Starr Stephens
1629                    Sterling Stonewall)
1630                  '(Sutton Swisher Tarrant Taylor Terrell Terry
1631                    Throckmorton)
1632                  '(Titus Travis Trinity Tyler Upshur Upton
1633                    Uvalde)))
1634  (lambda (result)
1635    (equal? result
1636            '(#(1 Reagan Runnels Sherman Sutton Titus)
1637              #(2 Real Rusk Smith Swisher Travis)
1638              #(3 Reeves Sabine Somervell Tarrant Trinity)
1639              #(4 Refugio Schleicher Starr Taylor Tyler)
1640              #(5 Roberts Scurry Stephens Terrell Upshur)
1641              #(6 Robertson Shackelford Sterling Terry Upton)
1642              #(7 Rockwall Shelby Stonewall Throckmorton
1643                Uvalde)))))
1644
1645;;; PAIR-FOR-EACH
1646
1647(test 'pair-for-each:one-null-list
1648  (let ((base '()))
1649    (pair-for-each (lambda (tail)
1650                     (set! base (append tail base)))
1651                   '())
1652    base)
1653  null?)
1654
1655(test 'pair-for-each:one-singleton-list
1656  (let ((base '()))
1657    (pair-for-each (lambda (tail)
1658                     (set! base (append tail base)))
1659                   '(Victoria))
1660    base)
1661  (lambda (result) (equal? result '(Victoria))))
1662
1663(test 'pair-for-each:one-longer-list
1664  (let ((base '()))
1665    (pair-for-each (lambda (tail)
1666                     (set! base (append tail base)))
1667                   '(Walker Waller Ward Washington Webb))
1668    base)
1669  (lambda (result)
1670    (equal? result
1671            '(Webb Washington Webb Ward Washington Webb Waller
1672                   Ward Washington Webb Walker Waller Ward
1673                   Washington Webb))))
1674
1675(test 'pair-for-each:several-null-lists
1676  (let ((base '()))
1677    (pair-for-each (lambda tails
1678                     (set! base
1679                           (cons (apply vector tails) base)))
1680                   '() '() '() '() '())
1681    base)
1682  null?)
1683
1684(test 'pair-for-each:several-singleton-lists
1685  (let ((base '()))
1686    (pair-for-each (lambda tails
1687                     (set! base
1688                           (cons (apply vector tails) base)))
1689                   '(Wharton)
1690                   '(Wheeler)
1691                   '(Wichita)
1692                   '(Wilbarger)
1693                   '(Willacy))
1694    base)
1695  (lambda (result)
1696    (equal? result
1697            '(#((Wharton) (Wheeler) (Wichita) (Wilbarger)
1698                (Willacy))))))
1699
1700(test 'pair-for-each:several-longer-lists
1701  (let ((base '()))
1702    (pair-for-each (lambda tails
1703                     (set! base
1704                           (cons (apply vector tails) base)))
1705                   '(Williamson Wilson Winkler Wise Wood Yoakum
1706                     Young)
1707                   '(Zapata Zavala Admiral Advil Ajax Anacin
1708                     Arrid)
1709                   '(Arnold Ban Barbie Beech Blockbuster Bounce
1710                     Breck)
1711                   '(Budweiser Bufferin BVD Carrier Celeste
1712                     Charmin Cheer)
1713                   '(Cheerios Cinemax Clairol Clorets Combat
1714                     Comet Coppertone))
1715    base)
1716  (lambda (result)
1717    (equal? result
1718            '(#((Young) (Arrid) (Breck) (Cheer) (Coppertone))
1719              #((Yoakum Young) (Anacin Arrid) (Bounce Breck)
1720                (Charmin Cheer) (Comet Coppertone))
1721              #((Wood Yoakum Young)
1722                (Ajax Anacin Arrid)
1723                (Blockbuster Bounce Breck)
1724                (Celeste Charmin Cheer)
1725                (Combat Comet Coppertone))
1726              #((Wise Wood Yoakum Young)
1727                (Advil Ajax Anacin Arrid)
1728                (Beech Blockbuster Bounce Breck)
1729                (Carrier Celeste Charmin Cheer)
1730                (Clorets Combat Comet Coppertone))
1731              #((Winkler Wise Wood Yoakum Young)
1732                (Admiral Advil Ajax Anacin Arrid)
1733                (Barbie Beech Blockbuster Bounce Breck)
1734                (BVD Carrier Celeste Charmin Cheer)
1735                (Clairol Clorets Combat Comet Coppertone))
1736              #((Wilson Winkler Wise Wood Yoakum Young)
1737                (Zavala Admiral Advil Ajax Anacin Arrid)
1738                (Ban Barbie Beech Blockbuster Bounce Breck)
1739                (Bufferin BVD Carrier Celeste Charmin Cheer)
1740                (Cinemax Clairol Clorets Combat Comet
1741                 Coppertone))
1742              #((Williamson Wilson Winkler Wise Wood Yoakum
1743                 Young)
1744                (Zapata Zavala Admiral Advil Ajax Anacin Arrid)
1745                (Arnold Ban Barbie Beech Blockbuster Bounce
1746                 Breck)
1747                (Budweiser Bufferin BVD Carrier Celeste Charmin
1748                 Cheer)
1749                (Cheerios Cinemax Clairol Clorets Combat Comet
1750                 Coppertone))))))
1751
1752;;; FILTER-MAP
1753
1754(test 'filter-map:one-null-list
1755  (filter-map values '())
1756  null?)
1757
1758(test 'filter-map:one-singleton-list
1759  (filter-map values '(Crest))
1760  (lambda (result) (equal? result '(Crest))))
1761
1762(test 'filter-map:one-list-all-elements-removed
1763  (filter-map (lambda (x) #f)
1764              '(Crisco Degree Doritos Dristan Efferdent))
1765  null?)
1766
1767(test 'filter-map:one-list-some-elements-removed
1768  (filter-map (lambda (n) (and (even? n) n))
1769              '(44 45 46 47 48 49 50))
1770  (lambda (result) (equal? result '(44 46 48 50))))
1771
1772(test 'filter-map:one-list-no-elements-removed
1773  (filter-map values '(ESPN Everready Excedrin Fab Fantastik))
1774  (lambda (result)
1775    (equal? result '(ESPN Everready Excedrin Fab Fantastik))))
1776
1777(test 'filter-map:several-null-lists
1778  (filter-map vector '() '() '() '() '())
1779  null?)
1780
1781(test 'filter-map:several-singleton-lists
1782  (filter-map vector
1783              '(Foamy)
1784              '(Gatorade)
1785              '(Glad)
1786              '(Gleem)
1787              '(Halcion))
1788  (lambda (result)
1789    (equal? result '(#(Foamy Gatorade Glad Gleem Halcion)))))
1790
1791(test 'filter-map:several-lists-all-elements-removed
1792  (filter-map (lambda arguments #f)
1793              '(Hanes HBO Hostess Huggies Ivory Kent Kinney)
1794              '(Kleenex Knorr Lee Lenox Lerner Listerine
1795                Marlboro)
1796              '(Mazola Michelob Midas Miller NBC Newsweek
1797                Noxema)
1798              '(NutraSweet Oreo Pampers People Planters
1799                Playskool Playtex)
1800              '(Prego Prell Prozac Purex Ritz Robitussin
1801                      Rolaids))
1802  null?)
1803
1804(test 'filter-map:several-lists-some-elements-removed
1805  (filter-map (lambda arguments
1806                (let ((sum (apply + arguments)))
1807                  (and (odd? sum) sum)))
1808              '(51 52 53 54 55 56 57)
1809              '(58 59 60 61 62 63 64)
1810              '(65 66 67 68 69 70 71)
1811              '(72 73 74 75 76 77 78)
1812              '(79 80 81 82 83 84 85))
1813  (lambda (result) (equal? result '(325 335 345 355))))
1814
1815(test 'filter-map:several-lists-no-elements-removed
1816  (filter-map vector
1817              '(Ronzoni Ruffles Scotch Skippy SnackWell Snapple
1818                Spam)
1819              '(Sprite Swanson Thomas Tide Tonka Trojan
1820                Tupperware)
1821              '(Tylenol Velveeta Vicks Victory Visine Wheaties
1822                Wise)
1823              '(Wonder Ziploc Abbott Abingdon Ackley Ackworth
1824                Adair)
1825              '(Adams Adaville Adaza Adel Adelphi Adena Afton))
1826  (lambda (result)
1827    (equal? result
1828            '(#(Ronzoni Sprite Tylenol Wonder Adams)
1829              #(Ruffles Swanson Velveeta Ziploc Adaville)
1830              #(Scotch Thomas Vicks Abbott Adaza)
1831              #(Skippy Tide Victory Abingdon Adel)
1832              #(SnackWell Tonka Visine Ackley Adelphi)
1833              #(Snapple Trojan Wheaties Ackworth Adena)
1834              #(Spam Tupperware Wise Adair Afton)))))
1835
1836;;; FILTER
1837
1838(test 'filter:null-list
1839  (filter (lambda (x) #t) '())
1840  null?)
1841
1842(test 'filter:singleton-list
1843  (filter (lambda (x) #t) '(Agency))
1844  (lambda (result) (equal? result '(Agency))))
1845
1846(test 'filter:all-elements-removed
1847  (filter (lambda (x) #f)
1848          '(Ainsworth Akron Albany Albaton Albia))
1849  null?)
1850
1851(test 'filter:some-elements-removed
1852  (filter even? '(86 87 88 89 90))
1853  (lambda (result) (equal? result '(86 88 90))))
1854
1855(test 'filter:no-elements-removed
1856  (filter (lambda (x) #t)
1857          '(Albion Alburnett Alden Alexander Algona))
1858  (lambda (result)
1859    (equal? result '(Albion Alburnett Alden Alexander Algona))))
1860
1861;;; FILTER!
1862
1863(test 'filter!:null-list
1864  (filter! (lambda (x) #t) (list))
1865  null?)
1866
1867(test 'filter!:singleton-list
1868  (filter! (lambda (x) #t) (list 'Alice))
1869  (lambda (result) (equal? result '(Alice))))
1870
1871(test 'filter!:all-elements-removed
1872  (filter! (lambda (x) #f)
1873           (list 'Alleman 'Allendorf 'Allerton 'Allison 'Almont))
1874  null?)
1875
1876(test 'filter!:some-elements-removed
1877  (filter! even? (list 91 92 93 94 95))
1878  (lambda (result) (equal? result '(92 94))))
1879
1880(test 'filter!:no-elements-removed
1881  (filter! (lambda (x) #t)
1882           (list 'Almoral 'Alpha 'Alta 'Alton 'Altoona))
1883  (lambda (result)
1884    (equal? result '(Almoral Alpha Alta Alton Altoona))))
1885
1886;;; REMOVE
1887
1888(test 'remove:null-list
1889  (remove (lambda (x) #t) '())
1890  null?)
1891
1892(test 'remove:singleton-list
1893  (remove (lambda (x) #f) '(Alvord))
1894  (lambda (result) (equal? result '(Alvord))))
1895
1896(test 'remove:all-elements-removed
1897  (remove (lambda (x) #t) '(Amana Amber Ames Amish Anamosa))
1898  null?)
1899
1900(test 'remove:some-elements-removed
1901  (remove even? '(96 97 98 99 100))
1902  (lambda (result) (equal? result '(97 99))))
1903
1904(test 'remove:no-elements-removed
1905  (remove (lambda (x) #f)
1906          '(Anderson Andover Andrew Andrews Angus))
1907  (lambda (result)
1908    (equal? result '(Anderson Andover Andrew Andrews Angus))))
1909
1910;;; REMOVE!
1911
1912(test 'remove!:null-list
1913  (remove! (lambda (x) #t) (list))
1914  null?)
1915
1916(test 'remove!:singleton-list
1917  (remove! (lambda (x) #f) (list 'Anita))
1918  (lambda (result) (equal? result '(Anita))))
1919
1920(test 'remove!:all-elements-removed
1921  (remove! (lambda (x) #t)
1922           (list 'Ankeny 'Anthon 'Aplington 'Arcadia 'Archer))
1923  null?)
1924
1925(test 'remove!:some-elements-removed
1926  (remove! even? (list 101 102 103 104 105))
1927  (lambda (result) (equal? result '(101 103 105))))
1928
1929(test 'remove!:no-elements-removed
1930  (remove! (lambda (x) #f)
1931           (list 'Ardon 'Aredale 'Argo 'Argyle 'Arion))
1932  (lambda (result)
1933    (equal? result  '(Ardon Aredale Argo Argyle Arion))))
1934
1935;;; PARTITION
1936
1937(test/values 'partition:null-list
1938  '(partition (lambda (x) #f) '())
1939  (lambda (in out) (and (null? in) (null? out))))
1940
1941(test/values 'partition:singleton-list
1942  '(partition (lambda (x) #f) '(Arispe))
1943  (lambda (in out) (and (null? in) (equal? out '(Arispe)))))
1944
1945(test/values 'partition:all-satisfying
1946  '(partition (lambda (x) #t)
1947             '(Arlington Armstrong Arnold Artesian Arthur))
1948  (lambda (in out)
1949    (and (equal? in
1950                 '(Arlington Armstrong Arnold Artesian Arthur))
1951         (null? out))))
1952
1953(test/values 'partition:mixed-starting-in
1954  '(partition even? '(106 108 109 111 113 114 115 117 118 120))
1955  (lambda (in out)
1956    (and (equal? in '(106 108 114 118 120))
1957         (equal? out '(109 111 113 115 117)))))
1958
1959(test/values 'partition:mixed-starting-out
1960  '(partition even? '(121 122 124 126))
1961  (lambda (in out)
1962    (and (equal? in '(122 124 126))
1963         (equal? out '(121)))))
1964
1965(test/values 'partition:none-satisfying
1966  '(partition (lambda (x) #f)
1967             '(Asbury Ashawa Ashland Ashton Aspinwall))
1968  (lambda (in out)
1969    (and (null? in)
1970         (equal? out
1971                 '(Asbury Ashawa Ashland Ashton Aspinwall)))))
1972
1973;;; PARTITION!
1974
1975(test/values 'partition!:null-list
1976  '(partition! (lambda (x) #f) (list))
1977  (lambda (in out) (and (null? in) (null? out))))
1978
1979(test/values 'partition!:singleton-list
1980  '(partition! (lambda (x) #f) (list 'Astor))
1981  (lambda (in out) (and (null? in) (equal? out '(Astor)))))
1982
1983(test/values 'partition!:all-satisfying
1984  '(partition! (lambda (x) #t)
1985              (list 'Atalissa 'Athelstan 'Atkins 'Atlantic
1986                    'Attica))
1987  (lambda (in out)
1988    (and (equal? in
1989                 '(Atalissa Athelstan Atkins Atlantic Attica))
1990         (null? out))))
1991
1992(test/values 'partition!:mixed-starting-in
1993  '(partition! odd?
1994              (list 127 129 130 132 134 135 136 138 139 141))
1995  (lambda (in out)
1996    (and (equal? in '(127 129 135 139 141))
1997         (equal? out '(130 132 134 136 138)))))
1998
1999(test/values 'partition!:mixed-starting-out
2000  '(partition! odd? (list 142 143 145 147))
2001  (lambda (in out)
2002    (and (equal? in '(143 145 147))
2003         (equal? out '(142)))))
2004
2005(test/values 'partition!:none-satisfying
2006  '(partition! (lambda (x) #f)
2007              (list 'Auburn 'Audubon 'Augusta 'Aurelia
2008                    'Aureola))
2009  (lambda (in out)
2010    (and (null? in)
2011         (equal? out
2012                 '(Auburn Audubon Augusta Aurelia Aureola)))))
2013
2014;;; FIND
2015
2016(test 'find:in-null-list
2017  (find (lambda (x) #t) '())
2018  not)
2019
2020(test 'find:in-singleton-list
2021  (find (lambda (x) #t) '(Aurora))
2022  (lambda (result) (eq? result 'Aurora)))
2023
2024(test 'find:not-in-singleton-list
2025  (find (lambda (x) #f) '(Austinville))
2026  not)
2027
2028(test 'find:at-front-of-longer-list
2029  (find (lambda (x) #t) '(Avery Avoca Avon Ayrshire Badger))
2030  (lambda (result) (eq? result 'Avery)))
2031
2032(test 'find:in-middle-of-longer-list
2033  (find even? '(149 151 153 155 156 157 159))
2034  (lambda (result) (= result 156)))
2035
2036(test 'find:at-end-of-longer-list
2037  (find even? '(161 163 165 167 168))
2038  (lambda (result) (= result 168)))
2039
2040(test 'find:not-in-longer-list
2041  (find (lambda (x) #f)
2042        '(Bagley Bailey Badwin Balfour Balltown))
2043  not)
2044
2045;;; FIND-TAIL
2046
2047(test 'find-tail:in-null-list
2048  (find-tail (lambda (x) #t) '())
2049  not)
2050
2051(let ((source '(Ballyclough)))
2052  (test 'find-tail:in-singleton-list
2053    (find-tail (lambda (x) #t) source)
2054    (lambda (result) (eq? result source))))
2055
2056(test 'find-tail:not-in-singleton-list
2057  (find-tail (lambda (x) #f) '(Bancroft))
2058  not)
2059
2060(let ((source '(Bangor Bankston Barney Barnum Bartlett)))
2061  (test 'find-tail:at-front-of-longer-list
2062    (find-tail (lambda (x) #t) source)
2063    (lambda (result) (eq? result source))))
2064
2065(let ((source '(169 171 173 175 176 177 179)))
2066  (test 'find-tail:in-middle-of-longer-list
2067    (find-tail even? source)
2068    (lambda (result) (eq? result (cddddr source)))))
2069
2070(let ((source '(181 183 185 187 188)))
2071  (test 'find-tail:at-end-of-longer-list
2072    (find-tail even? source)
2073    (lambda (result) (eq? result (cddddr source)))))
2074
2075(test 'find-tail:not-in-longer-list
2076  (find-tail (lambda (x) #f)
2077             '(Batavia Bauer Baxter Bayard Beacon))
2078  not)
2079
2080;;; ANY
2081
2082(test 'any:in-one-null-list
2083  (any values '())
2084  not)
2085
2086(test 'any:in-one-singleton-list
2087  (any vector '(Beaconsfield))
2088  (lambda (result) (equal? result '#(Beaconsfield))))
2089
2090(test 'any:not-in-one-singleton-list
2091  (any (lambda (x) #f) '(Beaman))
2092  not)
2093
2094(test 'any:at-beginning-of-one-longer-list
2095  (any vector '(Beaver Beaverdale Beckwith Bedford Beebeetown))
2096  (lambda (result) (equal? result '#(Beaver))))
2097
2098(test 'any:in-middle-of-one-longer-list
2099  (any (lambda (x) (and (odd? x) (+ x 189)))
2100       '(190 192 194 196 197 198 200))
2101  (lambda (result) (= result 386)))
2102
2103(test 'any:at-end-of-one-longer-list
2104  (any (lambda (x) (and (odd? x) (+ x 201)))
2105       '(202 204 206 208 209))
2106  (lambda (result) (= result 410)))
2107
2108(test 'any:not-in-one-longer-list
2109  (any (lambda (x) #f)
2110       '(Beech Belinda Belknap Bellefountain Bellevue))
2111  not)
2112
2113(test 'any:in-several-null-lists
2114  (any vector '() '() '() '() '())
2115  not)
2116
2117(test 'any:in-several-singleton-lists
2118  (any vector
2119       '(Belmond)
2120       '(Beloit)
2121       '(Bennett)
2122       '(Benson)
2123       '(Bentley))
2124  (lambda (result)
2125    (equal? result '#(Belmond Beloit Bennett Benson Bentley))))
2126
2127(test 'any:not-in-several-singleton-lists
2128  (any (lambda arguments #f)
2129       '(Benton)
2130       '(Bentonsport)
2131       '(Berea)
2132       '(Berkley)
2133       '(Bernard))
2134  not)
2135
2136(test 'any:at-beginning-of-several-longer-lists
2137  (any vector
2138       '(Berne Bertram Berwick Bethesda Bethlehem Bettendorf
2139         Beulah)
2140       '(Bevington Bidwell Bingham Birmingham Bladensburg
2141         Blairsburg Blairstown)
2142       '(Blakesburg Blanchard Blencoe Bliedorn Blockton
2143         Bloomfield Bloomington)
2144       '(Bluffton Bode Bolan Bonair Bonaparte Bondurant Boone)
2145       '(Booneville Botany Botna Bouton Bowsher Boxholm Boyd))
2146  (lambda (result)
2147    (equal? result
2148            '#(Berne Bevington Blakesburg Bluffton Booneville))))
2149
2150(test 'any:in-middle-of-several-longer-lists
2151  (any (lambda arguments
2152         (let ((sum (apply + arguments)))
2153           (and (odd? sum) (+ sum 210))))
2154       '(211 212 213 214 215 216 217)
2155       '(218 219 220 221 222 223 224)
2156       '(225 226 227 228 229 230 231)
2157       '(232 233 234 235 236 237 238)
2158       '(240 242 244 246 247 248 250))
2159  (lambda (result) (= result 1359)))
2160
2161(test 'any:at-end-of-several-longer-lists
2162  (any (lambda arguments
2163         (let ((sum (apply + arguments)))
2164           (and (even? sum) (+ sum 210))))
2165       '(252 253 254 255 256 257 258)
2166       '(259 260 261 262 263 264 265)
2167       '(266 267 268 269 270 271 272)
2168       '(273 274 275 276 277 278 279)
2169       '(281 283 285 287 289 291 292))
2170  (lambda (result) (= result 1576)))
2171
2172(test 'any:not-in-several-longer-lists
2173  (any (lambda arguments #f)
2174       '(Boyden Boyer Braddyville Bradford Bradgate Brainard
2175         Brandon)
2176       '(Brayton Brazil Breda Bridgewater Brighton Bristol
2177         Bristow)
2178       '(Britt Bromley Brompton Bronson Brooklyn Brooks
2179         Brookville)
2180       '(Browns Brownville Brunsville Brushy Bryant Bryantsburg
2181         Buchanan)
2182       '(Buckeye Buckhorn Buckingham Bucknell Budd Buffalo
2183         Burchinal))
2184  not)
2185
2186(test 'any:not-in-lists-of-unequal-length
2187  (any (lambda arguments #f)
2188       '(Burdette Burlington Burnside Burt)
2189       '(Bushville Bussey)
2190       '(Buxton Cairo Calamus)
2191       '(Caledonia Clahoun Callender Calmar Caloma Calumet))
2192  not)
2193
2194;;; EVERY
2195
2196(test 'every:in-one-null-list
2197  (every values '())
2198  (lambda (result) (eq? result #t)))
2199
2200(test 'every:in-one-singleton-list
2201  (every vector '(Camanche))
2202  (lambda (result) (equal? result '#(Camanche))))
2203
2204(test 'every:not-in-one-singleton-list
2205  (every (lambda (x) #f) '(Cambria))
2206  not)
2207
2208(test 'every:failing-at-beginning-of-one-longer-list
2209  (every (lambda (x) #f)
2210         '(Cambridge Cameron Canby Canton Cantril))
2211  not)
2212
2213(test 'every:failing-in-middle-of-one-longer-list
2214  (every (lambda (x) (and (even? x) (+ x 293)))
2215         '(294 296 298 300 301 302 304))
2216  not)
2217
2218(test 'every:failing-at-end-of-one-longer-list
2219  (every (lambda (x) (and (even? x) (+ x 305)))
2220         '(306 308 310 312 313))
2221  not)
2222
2223(test 'every:in-one-longer-list
2224  (every vector
2225         '(Carbon Carbondale Carl Carlisle Carmel))
2226  (lambda (result) (equal? result '#(Carmel))))
2227
2228(test 'every:in-several-null-lists
2229  (every vector '() '() '() '() '())
2230  (lambda (result) (eq? result #t)))
2231
2232(test 'every:in-several-singleton-lists
2233  (every vector
2234         '(Carnarvon)
2235         '(Carnes)
2236         '(Carney)
2237         '(Carnforth)
2238         '(Carpenter))
2239  (lambda (result)
2240    (equal? result
2241            '#(Carnarvon Carnes Carney Carnforth Carpenter))))
2242
2243(test 'every:not-in-several-singleton-lists
2244  (every (lambda arguments #f)
2245         '(Carroll)
2246         '(Carrollton)
2247         '(Carrville)
2248         '(Carson)
2249         '(Cartersville))
2250  not)
2251
2252(test 'every:failing-at-beginning-of-several-longer-lists
2253  (every (lambda arguments #f)
2254         '(Cascade Casey Castalia Castana Cattese Cedar
2255           Centerdale)
2256         '(Centerville Centralia Ceres Chapin Chariton
2257           Charleston Charlotte)
2258         '(Chatsworth Chautauqua Chelsea Cheney Cherokee Chester
2259           Chickasaw)
2260         '(Chillicothe Churchtown Churchville Churdan Cincinnati
2261           Clare Clarence)
2262         '(Clarinda Clarion Clark Clarkdale Clarksville Clayton
2263           Clearfield))
2264  not)
2265
2266(test 'every:failing-in-middle-of-several-longer-lists
2267  (every (lambda arguments
2268           (let ((sum (apply + arguments)))
2269             (and (odd? sum) (+ sum 314))))
2270         '(315 316 317 318 319 320 321)
2271         '(322 323 324 325 326 327 328)
2272         '(329 330 331 332 333 334 335)
2273         '(336 337 338 339 340 341 342)
2274         '(343 345 347 349 350 351 353))
2275  not)
2276
2277(test 'every:failing-at-end-of-several-longer-lists
2278  (every (lambda arguments
2279         (let ((sum (apply + arguments)))
2280           (and (odd? sum) (+ sum 354))))
2281         '(355 356 357 358 359 360 361)
2282         '(362 363 364 365 366 367 368)
2283         '(369 370 371 372 373 374 375)
2284         '(376 377 378 379 380 381 382)
2285         '(383 385 387 389 391 393 394))
2286  not)
2287
2288(test 'every:in-several-longer-lists
2289  (every vector
2290         '(Cleghorn Clemons Clermont Cleves Cliffland Climax
2291           Clinton)
2292         '(Clio Clive Cloverdale Clucas Clutier Clyde Coalville)
2293         '(Coburg Coggon Coin Colesburg Colfax Collett Collins)
2294         '(Colo Columbia Colwell Commerce Communia Competine
2295           Concord)
2296         '(Conesville Confidence Cono Conover Conrad Conroy
2297           Consol))
2298  (lambda (result)
2299    (equal? result
2300            '#(Clinton Coalville Collins Concord Consol))))
2301
2302(test 'every:in-lists-of-unequal-length
2303  (every vector
2304         '(Conway Cool Cooper Coppock)
2305         '(Coralville Corley)
2306         '(Cornelia Cornell Corning)
2307         '(Correctionville Corwith Corydon Cosgrove Coster
2308           Cotter))
2309  (lambda (result)
2310    (equal? result '#(Cool Corley Cornell Corwith))))
2311
2312;;; LIST-INDEX
2313
2314(test 'list-index:in-one-null-list
2315  (list-index (lambda (x) #t) '())
2316  not)
2317
2318(test 'list-index:in-one-singleton-list
2319  (list-index (lambda (x) #t) '(Cottonville))
2320  zero?)
2321
2322(test 'list-index:not-in-one-singleton-list
2323  (list-index (lambda (x) #f) '(Coulter))
2324  not)
2325
2326(test 'list-index:at-front-of-one-longer-list
2327  (list-index (lambda (x) #t)
2328              '(Covington Craig Cranston Crathorne
2329                Crawfordsville))
2330  zero?)
2331
2332(test 'list-index:in-middle-of-one-longer-list
2333  (list-index even? '(395 397 399 401 402 403 405))
2334  (lambda (result) (= result 4)))
2335
2336(test 'list-index:at-end-of-one-longer-list
2337  (list-index odd? '(406 408 410 412 414 415))
2338  (lambda (result) (= result 5)))
2339
2340(test 'list-index:not-in-one-longer-list
2341  (list-index (lambda (x) #f)
2342              '(Crescent Cresco Creston Crocker Crombie))
2343  not)
2344
2345(test 'list-index:in-several-null-lists
2346  (list-index (lambda arguments #t) '() '() '() '() '())
2347  not)
2348
2349(test 'list-index:in-several-singleton-lists
2350  (list-index (lambda arguments #t)
2351              '(Cromwell)
2352              '(Croton)
2353              '(Cumberland)
2354              '(Cumming)
2355              '(Curlew))
2356  zero?)
2357
2358(test 'list-index:not-in-several-singleton-lists
2359  (list-index (lambda arguments #f)
2360              '(Cushing)
2361              '(Cylinder)
2362              '(Dahlonega)
2363              '(Dalby)
2364              '(Dale))
2365  not)
2366
2367(test 'list-index:at-front-of-several-longer-lists
2368  (list-index (lambda arguments #t)
2369              '(Dallas Dana Danbury Danville Darbyville
2370                Davenport Dawson)
2371              '(Dayton Daytonville Dean Decorah Dedham Deerfield
2372                Defiance)
2373              '(Delaware Delhi Delmar Deloit Delphos Delta
2374                Denhart)
2375              '(Denison Denmark Denova Denver Depew Derby Devon)
2376              '(Dewar Dexter Diagonal Dickens Dickieville Dike
2377                Dillon))
2378  zero?)
2379
2380(test 'list-index:in-middle-of-several-longer-lists
2381  (list-index (lambda arguments (odd? (apply + arguments)))
2382              '(416 417 418 419 420 421 422)
2383              '(423 424 425 426 427 428 429)
2384              '(430 431 432 433 434 435 436)
2385              '(437 438 439 440 441 442 443)
2386              '(444 446 448 450 451 452 454))
2387  (lambda (result) (= result 4)))
2388
2389(test 'list-index:at-end-of-several-longer-lists
2390  (list-index (lambda arguments (even? (apply + arguments)))
2391              '(455 456 457 458 459 460)
2392              '(461 462 463 464 465 466)
2393              '(467 468 469 470 471 472)
2394              '(473 474 475 476 477 478)
2395              '(479 481 483 485 487 488))
2396  (lambda (result) (= result 5)))
2397
2398(test 'list-index:not-in-several-longer-lists
2399  (list-index (lambda arguments #f)
2400              '(Dinsdale Dixon Dodgeville Dolliver Donahue
2401                Donnan Donnelley)
2402              '(Donnellson Doon Dorchester Doris Douds Dougherty
2403                Douglas)
2404              '(Doney Dows Drakesville Dresden Dubuque Dudley
2405                Dumfries)
2406              '(Dumont Dunbar Duncan Duncombe Dundee Dunkerton
2407                Dunlap)
2408              '(Durango Durant Durham Dutchtown Dyersville
2409                Dysart Earlham))
2410  not)
2411
2412;;; DELETE
2413
2414(test 'delete:null-list
2415  (delete 'Earling '() (lambda (x y) #t))
2416  null?)
2417
2418(test 'delete:singleton-list
2419  (delete 'Earlville '(Early) (lambda (x y) #f))
2420  (lambda (result) (equal? result '(Early))))
2421
2422(test 'delete:all-elements-removed
2423  (delete
2424       'Eckards
2425       '(Eddyville Edgewood Edinburg Edmore Edna)
2426       (lambda (x y) #t))
2427  null?)
2428
2429(test 'delete:some-elements-removed
2430  (delete
2431       489
2432       '(490 491 492 493 494)
2433       (lambda (x y) (even? (+ x y))))
2434  (lambda (result) (equal? result '(490 492 494))))
2435
2436(test 'delete:no-elements-removed
2437  (delete
2438       'Egan
2439       '(Egralharve Ehler Elberon Eldergrove Eldon)
2440       (lambda (x y) #f))
2441  (lambda (result)
2442    (equal? result '(Egralharve Ehler Elberon Eldergrove Eldon))))
2443
2444;;; DELETE!
2445
2446(test 'delete!:null-list
2447  (delete! 'Eldora (list) (lambda (x y) #t))
2448  null?)
2449
2450(test 'delete!:singleton-list
2451  (delete! 'Eldorado (list 'Eldridge) (lambda (x y) #f))
2452  (lambda (result) (equal? result '(Eldridge))))
2453
2454(test 'delete!:all-elements-removed
2455  (delete!
2456        'Eleanor
2457        (list 'Elgin 'Elkader 'Elkhart 'Elkport 'Elliott)
2458        (lambda (x y) #t))
2459  null?)
2460
2461(test 'delete!:some-elements-removed
2462  (delete!
2463        495
2464        (list 496 497 498 499 500)
2465        (lambda (x y) (odd? (+ x y))))
2466  (lambda (result) (equal? result '(497 499))))
2467
2468(test 'delete!:no-elements-removed
2469  (delete!
2470        'Ellston
2471        (list 'Ellsworth 'Elma 'Elmira 'Elon 'Elvira)
2472        (lambda (x y) #f))
2473  (lambda (result)
2474    (equal? result '(Ellsworth Elma Elmira Elon Elvira))))
2475
2476;;; DELQ
2477
2478(define delq
2479  (lambda (x lst)
2480    (delete x lst eq?)))
2481
2482(test 'delq:null-list
2483  (delq 'Elwood '())
2484  null?)
2485
2486(test 'delq:in-singleton-list
2487  (delq 'Ely '(Ely))
2488  null?)
2489
2490(test 'delq:not-in-singleton-list
2491  (delq 'Emeline '(Emerson))
2492  (lambda (result) (equal? result '(Emerson))))
2493
2494(test 'delq:at-beginning-of-longer-list
2495  (delq 'Emery '(Emery Emmetsburg Enterprise Epworth Ericson))
2496  (lambda (result)
2497    (equal? result '(Emmetsburg Enterprise Epworth Ericson))))
2498
2499(test 'delq:in-middle-of-longer-list
2500  (delq 'Essex '(Estherville Euclid Evans Evansdale Essex
2501                 Evanston Everly))
2502  (lambda (result)
2503    (equal? result '(Estherville Euclid Evans Evansdale Evanston
2504                     Everly))))
2505
2506(test 'delq:at-end-of-longer-list
2507  (delq 'Ewart '(Exira Exline Fairbank Fairfax Ewart))
2508  (lambda (result)
2509    (equal? result '(Exira Exline Fairbank Fairfax))))
2510
2511(test 'delq:not-in-longer-list
2512  (delq 'Fairfield
2513        '(Fairport Fairview Fairville Fanslers Farley))
2514  (lambda (result)
2515    (equal? result
2516            '(Fairport Fairview Fairville Fanslers Farley))))
2517
2518(test 'delq:several-matches-in-longer-list
2519  (delq 'Farlin '(Farmersburg Farmington Farlin Farnhamville
2520                  Farlin Farragut Farlin))
2521  (lambda (result)
2522    (equal? result
2523            '(Farmersburg Farmington Farnhamville Farragut))))
2524
2525;;; DELV
2526
2527(define delv
2528  (lambda (x lst)
2529    (delete x lst eqv?)))
2530
2531(test 'delv:null-list
2532  (delv 'Farrar '())
2533  null?)
2534
2535(test 'delv:in-singleton-list
2536  (delv 'Farson '(Farson))
2537  null?)
2538
2539(test 'delv:not-in-singleton-list
2540  (delv 'Faulkner '(Fayette))
2541  (lambda (result) (equal? result '(Fayette))))
2542
2543(test 'delv:at-beginning-of-longer-list
2544  (delv 'Fenton '(Fenton Fern Fernald Fertile Festina))
2545  (lambda (result)
2546    (equal? result '(Fern Fernald Fertile Festina))))
2547
2548(test 'delv:in-middle-of-longer-list
2549  (delv 'Fielding
2550        '(Fillmore Finchford Findley Fiscus Fielding Fisk Flagler))
2551  (lambda (result)
2552    (equal? result
2553            '(Fillmore Finchford Findley Fiscus Fisk Flagler))))
2554
2555(test 'delv:at-end-of-longer-list
2556  (delv 'Florence '(Florenceville Floris Floyd Flugstad Florence))
2557  (lambda (result)
2558    (equal? result '(Florenceville Floris Floyd Flugstad))))
2559
2560(test 'delv:not-in-longer-list
2561  (delv 'Folletts
2562        '(Folson Fonda Fontanelle Forbush Forestville))
2563  (lambda (result)
2564    (equal? result
2565            '(Folson Fonda Fontanelle Forbush Forestville))))
2566
2567(test 'delv:several-matches-in-longer-list
2568  (delv 'Foster '(Fostoria Frankfort Foster Franklin Foster
2569                  Frankville Foster))
2570  (lambda (result)
2571    (equal? result
2572            '(Fostoria Frankfort Franklin Frankville))))
2573
2574;;; DELETE
2575
2576(test 'delete:null-list
2577  (delete '(Fraser . Frederic) '())
2578  null?)
2579
2580(test 'delete:in-singleton-list
2581  (delete '(Fredericksburg . Frederika)
2582          '((Fredericksburg . Frederika)))
2583  null?)
2584
2585(test 'delete:not-in-singleton-list
2586  (delete '(Fredonia . Fredsville) '((Freeman . Freeport)))
2587  (lambda (result) (equal? result '((Freeman . Freeport)))))
2588
2589(test 'delete:at-beginning-of-longer-list
2590  (delete '(Fremont . Froelich) '((Fremont . Froelich)
2591                                  (Fruitland . Fulton)
2592                                  (Furay . Galbraith)
2593                                  (Galesburg . Galland)
2594                                  (Galt . Galva)))
2595  (lambda (result)
2596    (equal? result '((Fruitland . Fulton)
2597                     (Furay . Galbraith)
2598                     (Galesburg . Galland)
2599                     (Galt . Galva)))))
2600
2601(test 'delete:in-middle-of-longer-list
2602  (delete '(Gambrill . Garber) '((Gardiner . Gardner)
2603                                 (Garfield . Garland)
2604                                 (Garnavillo . Garner)
2605                                 (Garrison . Garwin)
2606                                 (Gambrill . Garber)
2607                                 (Gaza . Geneva)
2608                                 (Genoa . George)))
2609  (lambda (result)
2610    (equal? result '((Gardiner . Gardner)
2611                     (Garfield . Garland)
2612                     (Garnavillo . Garner)
2613                     (Garrison . Garwin)
2614                     (Gaza . Geneva)
2615                     (Genoa . George)))))
2616
2617(test 'delete:at-end-of-longer-list
2618  (delete '(Georgetown . Gerled) '((Germantown . Germanville)
2619                                   (Giard . Gibbsville)
2620                                   (Gibson . Gifford)
2621                                   (Gilbert . Gilbertville)
2622                                   (Georgetown . Gerled)))
2623  (lambda (result)
2624    (equal? result '((Germantown . Germanville)
2625                     (Giard . Gibbsville)
2626                     (Gibson . Gifford)
2627                     (Gilbert . Gilbertville)))))
2628
2629(test 'delete:not-in-longer-list
2630  (delete '(Gilliatt . Gilman) '((Givin . Gladbrook)
2631                                 (Gladstone . Gladwin)
2632                                 (Glasgow . Glendon)
2633                                 (Glenwood . Glidden)
2634                                 (Goddard . Goldfield)))
2635  (lambda (result)
2636    (equal? result '((Givin . Gladbrook)
2637                     (Gladstone . Gladwin)
2638                     (Glasgow . Glendon)
2639                     (Glenwood . Glidden)
2640                     (Goddard . Goldfield)))))
2641
2642(test 'delete:several-matches-in-longer-list
2643  (delete '(Goodell . Gosport) '((Gowrie . Goddard)
2644                                 (Grable . Graettinger)
2645                                 (Goodell . Gosport)
2646                                 (Graf . Grafton)
2647                                 (Goodell . Gosport)
2648                                 (Grandview . Granger)
2649                                 (Goodell . Gosport)))
2650  (lambda (result)
2651    (equal? result '((Gowrie . Goddard)
2652                     (Grable . Graettinger)
2653                     (Graf . Grafton)
2654                     (Grandview . Granger)))))
2655
2656;;; DELQ!
2657
2658(define delq!
2659  (lambda (x lst)
2660    (delete! x lst eq?)))
2661
2662(test 'delq!:null-list
2663  (delq! 'Granite (list))
2664  null?)
2665
2666(test 'delq!:in-singleton-list
2667  (delq! 'Grant (list 'Grant))
2668  null?)
2669
2670(test 'delq!:not-in-singleton-list
2671  (delq! 'Granville (list 'Gravity))
2672  (lambda (result) (equal? result '(Gravity))))
2673
2674(test 'delq!:at-beginning-of-longer-list
2675  (delq! 'Gray
2676         (list 'Gray 'Greeley 'Greenbush 'Greene 'Greenfield))
2677  (lambda (result)
2678    (equal? result '(Greeley Greenbush Greene Greenfield))))
2679
2680(test 'delq!:in-middle-of-longer-list
2681  (delq! 'Gridley (list 'Griffinsville 'Grimes 'Grinnell
2682                        'Griswold 'Gridley 'Gruver 'Guernsey))
2683  (lambda (result)
2684    (equal? result '(Griffinsville Grimes Grinnell Griswold
2685                     Gruver Guernsey))))
2686
2687(test 'delq!:at-end-of-longer-list
2688  (delq! 'Gunder
2689         (list 'Guss 'Guttenberg 'Gypsum 'Halbur 'Gunder))
2690  (lambda (result)
2691    (equal? result '(Guss Guttenberg Gypsum Halbur))))
2692
2693(test 'delq!:not-in-longer-list
2694  (delq! 'Hale
2695         (list 'Hamburg 'Hamilton 'Hamlin 'Hampton 'Hancock))
2696  (lambda (result)
2697    (equal? result
2698            '(Hamburg Hamilton Hamlin Hampton Hancock))))
2699
2700(test 'delq!:several-matches-in-longer-list
2701  (delq! 'Hanford (list 'Hanley 'Hanlontown 'Hanford 'Hanna
2702                        'Hanford 'Hanover 'Hanford))
2703  (lambda (result)
2704    (equal? result '(Hanley Hanlontown Hanna Hanover))))
2705
2706;;; DELV!
2707
2708(define delv!
2709  (lambda (x lst)
2710    (delete! x lst eqv?)))
2711
2712(test 'delv!:null-list
2713  (delv! 'Hansell (list))
2714  null?)
2715
2716(test 'delv!:in-singleton-list
2717  (delv! 'Harcourt (list 'Harcourt))
2718  null?)
2719
2720(test 'delv!:not-in-singleton-list
2721  (delv! 'Hardin (list 'Hardy))
2722  (lambda (result) (equal? result '(Hardy))))
2723
2724(test 'delv!:at-beginning-of-longer-list
2725  (delv! 'Harlan
2726         (list 'Harlan 'Harper 'Harris 'Harrisburg 'Hartford))
2727  (lambda (result)
2728    (equal? result '(Harper Harris Harrisburg Hartford))))
2729
2730(test 'delv!:in-middle-of-longer-list
2731  (delv! 'Hartley (list 'Hartwick 'Harvard 'Harvey 'Haskins
2732                        'Hartley 'Hastie 'Hastings))
2733  (lambda (result)
2734    (equal? result '(Hartwick Harvard Harvey Haskins Hastie
2735                     Hastings))))
2736
2737(test 'delv!:at-end-of-longer-list
2738  (delv! 'Hauntown
2739         (list 'Havelock 'Haven 'Haverhill 'Havre 'Hauntown))
2740  (lambda (result)
2741    (equal? result '(Havelock Haven Haverhill Havre))))
2742
2743(test 'delv!:not-in-longer-list
2744  (delv! 'Hawarden (list 'Hawkeye 'Hawleyville 'Hawthorne
2745                         'Hayesville 'Hayfield))
2746  (lambda (result)
2747    (equal? result '(Hawkeye Hawleyville Hawthorne Hayesville
2748                     Hayfield))))
2749
2750(test 'delv!:several-matches-in-longer-list
2751  (delv! 'Hazleton (list 'Hebron 'Hedrick 'Hazleton 'Helena
2752                         'Hazleton 'Henderson 'Hazleton))
2753  (lambda (result)
2754    (equal? result '(Hebron Hedrick Helena Henderson))))
2755
2756;;; DELETE!
2757
2758(test 'delete!:null-list
2759  (delete! (cons 'Henshaw 'Hentons) (list))
2760  null?)
2761
2762(test 'delete!:in-singleton-list
2763  (delete! (cons 'Hepburn 'Herndon)
2764           (list (cons 'Hepburn 'Herndon)))
2765  null?)
2766
2767(test 'delete!:not-in-singleton-list
2768  (delete! (cons 'Hesper 'Hiattsville)
2769           (list (cons 'Hiawatha 'Hicks)))
2770  (lambda (result) (equal? result '((Hiawatha . Hicks)))))
2771
2772(test 'delete!:at-beginning-of-longer-list
2773  (delete! (cons 'Highland 'Highlandville)
2774           (list (cons 'Highland 'Highlandville)
2775                 (cons 'Highview 'Hills)
2776                 (cons 'Hillsboro 'Hillsdale)
2777                 (cons 'Hilltop 'Hinton)
2778                 (cons 'Hiteman 'Hobarton)))
2779  (lambda (result)
2780    (equal? result '((Highview . Hills)
2781                     (Hillsboro . Hillsdale)
2782                     (Hilltop . Hinton)
2783                     (Hiteman . Hobarton)))))
2784
2785(test 'delete!:in-middle-of-longer-list
2786  (delete! (cons 'Hocking 'Holbrook)
2787           (list (cons 'Holland 'Holmes)
2788                 (cons 'Holstein 'Homer)
2789                 (cons 'Homestead 'Hopeville)
2790                 (cons 'Hopkinton 'Hornick)
2791                 (cons 'Hocking 'Holbrook)
2792                 (cons 'Horton 'Hospers)
2793                 (cons 'Houghton 'Howardville)))
2794  (lambda (result)
2795    (equal? result '((Holland . Holmes)
2796                     (Holstein . Homer)
2797                     (Homestead . Hopeville)
2798                     (Hopkinton . Hornick)
2799                     (Horton . Hospers)
2800                     (Houghton . Howardville)))))
2801
2802(test 'delete!:at-end-of-longer-list
2803  (delete! (cons 'Howe 'Hubbard)
2804           (list (cons 'Hudson 'Hugo)
2805                 (cons 'Hull 'Humboldt)
2806                 (cons 'Humeston 'Huntington)
2807                 (cons 'Hurley 'Huron)
2808                 (cons 'Howe 'Hubbard)))
2809  (lambda (result)
2810    (equal? result '((Hudson . Hugo)
2811                     (Hull . Humboldt)
2812                     (Humeston . Huntington)
2813                     (Hurley . Huron)))))
2814
2815(test 'delete!:not-in-longer-list
2816  (delete! (cons 'Hurstville 'Hutchins)
2817           (list (cons 'Huxley 'Iconium)
2818                 (cons 'Illyria 'Imogene)
2819                 (cons 'Independence 'Indianapolis)
2820                 (cons 'Indianola 'Industry)
2821                 (cons 'Inwood 'Ion)))
2822  (lambda (result)
2823    (equal? result '((Huxley . Iconium)
2824                     (Illyria . Imogene)
2825                     (Independence . Indianapolis)
2826                     (Indianola . Industry)
2827                     (Inwood . Ion)))))
2828
2829(test 'delete!:several-matches-in-longer-list
2830  (delete! (cons 'Ionia 'Ira)
2831           (list (cons 'Ireton 'Ironhills)
2832                 (cons 'Irving 'Irvington)
2833                 (cons 'Ionia 'Ira)
2834                 (cons 'Irwin 'Ivester)
2835                 (cons 'Ionia 'Ira)
2836                 (cons 'Iveyville 'Ivy)
2837                 (cons 'Ionia 'Ira)))
2838  (lambda (result)
2839    (equal? result '((Ireton . Ironhills)
2840                     (Irving . Irvington)
2841                     (Irwin . Ivester)
2842                     (Iveyville . Ivy)))))
2843
2844;;; DEL-DUPLICATES
2845
2846(define del-duplicates
2847  (lambda (f lst)
2848    (delete-duplicates lst f)))
2849
2850(test 'del-duplicates:null-list
2851  (del-duplicates (lambda (x y) #t) '())
2852  null?)
2853
2854(test 'del-duplicates:singleton-list
2855  (del-duplicates (lambda (x y) #t) '(Jacksonville))
2856  (lambda (result) (equal? result '(Jacksonville))))
2857
2858(test 'del-duplicates:in-doubleton-list
2859  (del-duplicates (lambda (x y) #t) '(Jamaica James))
2860  (lambda (result) (equal? result '(Jamaica))))
2861
2862(test 'del-duplicates:none-removed-in-longer-list
2863  (del-duplicates (lambda (x y) #f)
2864                  '(Jamestown Jamison Janesville Jefferson
2865                    Jerome))
2866  (lambda (result)
2867    (equal? result '(Jamestown Jamison Janesville Jefferson
2868                     Jerome))))
2869
2870(test 'del-duplicates:some-removed-in-longer-list
2871  (del-duplicates (lambda (x y) (= (+ x y) 1011))
2872                  '(501 502 503 504 508 510 511))
2873  (lambda (result) (equal? result '(501 502 503 504 511))))
2874
2875(test 'del-duplicates:all-but-one-removed-in-longer-list
2876  (del-duplicates (lambda (x y) #t)
2877                  '(Jesup Jewell Johnston Joice Jolley))
2878  (lambda (result) (equal? result '(Jesup))))
2879
2880;;; DEL-DUPLICATES!
2881
2882(define del-duplicates!
2883  (lambda (f lst)
2884    (delete-duplicates! lst f)))
2885
2886(test 'del-duplicates!:null-list
2887  (del-duplicates! (lambda (x y) #t) '())
2888  null?)
2889
2890(test 'del-duplicates!:singleton-list
2891  (del-duplicates! (lambda (x y) #t) (list 'Jordan))
2892  (lambda (result) (equal? result '(Jordan))))
2893
2894(test 'del-duplicates!:in-doubleton-list
2895  (del-duplicates! (lambda (x y) #t) (list 'Jubilee 'Judd))
2896  (lambda (result) (equal? result '(Jubilee))))
2897
2898(test 'del-duplicates!:none-removed-in-longer-list
2899  (del-duplicates! (lambda (x y) #f)
2900                   (list 'Julien 'Juniata 'Kalo 'Kalona
2901                         'Kamrar))
2902  (lambda (result)
2903    (equal? result '(Julien Juniata Kalo Kalona Kamrar))))
2904
2905(test 'del-duplicates!:some-removed-in-longer-list
2906  (del-duplicates! (lambda (x y) (= (+ x y) 1031))
2907                   (list 511 512 513 514 518 520 521))
2908  (lambda (result) (equal? result '(511 512 513 514 521))))
2909
2910(test 'del-duplicates!:all-but-one-removed-in-longer-list
2911  (del-duplicates! (lambda (x y) #t)
2912                   (list 'Kanawha 'Kellerton 'Kelley 'Kellogg
2913                         'Kendallville))
2914  (lambda (result) (equal? result '(Kanawha))))
2915
2916;;; DELQ-DUPLICATES
2917
2918(define delq-duplicates
2919  (lambda (lst)
2920    (delete-duplicates lst eq?)))
2921
2922(test 'delq-duplicates:null-list
2923  (delq-duplicates '())
2924  null?)
2925
2926(test 'delq-duplicates:singleton-list
2927  (delq-duplicates '(Kenfield))
2928  (lambda (result) (equal? result '(Kenfield))))
2929
2930(test 'delq-duplicates:in-doubleton-list
2931  (delq-duplicates '(Kennebec Kennebec))
2932  (lambda (result) (equal? result '(Kennebec))))
2933
2934(test 'delq-duplicates:none-removed-in-longer-list
2935  (delq-duplicates '(Kennedy Kensett Kent Kenwood Keokuk))
2936  (lambda (result)
2937    (equal? result '(Kennedy Kensett Kent Kenwood Keokuk))))
2938
2939(test 'delq-duplicates:some-removed-in-longer-list
2940  (delq-duplicates '(Keosauqua Keota Keota Kesley Keosauqua
2941                     Keswick Keota Keystone Keota))
2942  (lambda (result)
2943    (equal? result '(Keosauqua Keota Kesley Keswick Keystone))))
2944
2945(test 'delq-duplicates:all-but-one-removed-in-longer-list
2946  (delq-duplicates '(Kidder Kidder Kidder Kidder Kidder))
2947  (lambda (result) (equal? result '(Kidder))))
2948
2949;;; DELV-DUPLICATES
2950
2951(define delv-duplicates
2952  (lambda (lst)
2953    (delete-duplicates lst eqv?)))
2954
2955(test 'delv-duplicates:null-list
2956  (delv-duplicates '())
2957  null?)
2958
2959(test 'delv-duplicates:singleton-list
2960  (delv-duplicates '(Kilbourn))
2961  (lambda (result) (equal? result '(Kilbourn))))
2962
2963(test 'delv-duplicates:in-doubleton-list
2964  (delv-duplicates '(Killduff Killduff))
2965  (lambda (result) (equal? result '(Killduff))))
2966
2967(test 'delv-duplicates:none-removed-in-longer-list
2968  (delv-duplicates '(Kimballton King Kingsley Kingston Kinross))
2969  (lambda (result)
2970    (equal? result
2971            '(Kimballton King Kingsley Kingston Kinross))))
2972
2973(test 'delv-duplicates:some-removed-in-longer-list
2974  (delv-duplicates '(Kirkman Kirkville Kirkville Kiron Kirkman
2975                     Klemme Kirkville Klinger Kirkville))
2976  (lambda (result)
2977    (equal? result '(Kirkman Kirkville Kiron Klemme Klinger))))
2978
2979(test 'delv-duplicates:all-but-one-removed-in-longer-list
2980  (delv-duplicates '(Klondike Klondike Klondike Klondike Klondike))
2981  (lambda (result) (equal? result '(Klondike))))
2982
2983;;; DELETE-DUPLICATES
2984
2985(test 'delete-duplicates:null-list
2986  (delete-duplicates '())
2987  null?)
2988
2989(test 'delete-duplicates:singleton-list
2990  (delete-duplicates '((Knierim . Knittel)))
2991  (lambda (result) (equal? result '((Knierim . Knittel)))))
2992
2993(test 'delete-duplicates:in-doubleton-list
2994  (delete-duplicates '((Knoke . Knowlton) (Knoke . Knowlton)))
2995  (lambda (result) (equal? result '((Knoke . Knowlton)))))
2996
2997(test 'delete-duplicates:none-removed-in-longer-list
2998  (delete-duplicates '((Knox . Knoxville)
2999                       (Konigsmark . Kossuth)
3000                       (Koszta . Lacelle)
3001                       (Lacey . Lacona)
3002                       (Ladoga . Ladora)))
3003  (lambda (result)
3004    (equal? result '((Knox . Knoxville)
3005                     (Konigsmark . Kossuth)
3006                     (Koszta . Lacelle)
3007                     (Lacey . Lacona)
3008                     (Ladoga . Ladora)))))
3009
3010(test 'delete-duplicates:some-removed-in-longer-list
3011  (delete-duplicates '((Lafayette . Lainsville)
3012                       (Lakeside . Lakewood)
3013                       (Lakeside . Lakewood)
3014                       (Lakonta . Lakota)
3015                       (Lafayette . Lainsville)
3016                       (Lamoille . Lamoni)
3017                       (Lakeside . Lakewood)
3018                       (Lamont . Lancaster)
3019                       (Lakeside . Lakewood)))
3020  (lambda (result)
3021    (equal? result '((Lafayette . Lainsville)
3022                     (Lakeside . Lakewood)
3023                     (Lakonta . Lakota)
3024                     (Lamoille . Lamoni)
3025                     (Lamont . Lancaster)))))
3026
3027(test 'delete-duplicates:all-but-one-removed-in-longer-list
3028  (delete-duplicates '((Lanesboro . Langdon)
3029                       (Lanesboro . Langdon)
3030                       (Lanesboro . Langdon)
3031                       (Lanesboro . Langdon)
3032                       (Lanesboro . Langdon)))
3033  (lambda (result) (equal? result '((Lanesboro . Langdon)))))
3034
3035;;; DELQ-DUPLICATES!
3036
3037(define delq-duplicates!
3038  (lambda (lst)
3039    (delete-duplicates! lst eq?)))
3040
3041(test 'delq-duplicates!:null-list
3042  (delq-duplicates! (list))
3043  null?)
3044
3045(test 'delq-duplicates!:singleton-list
3046  (delq-duplicates! (list 'Langworthy))
3047  (lambda (result) (equal? result '(Langworthy))))
3048
3049(test 'delq-duplicates!:in-doubleton-list
3050  (delq-duplicates! (list 'Lansing 'Lansing))
3051  (lambda (result) (equal? result '(Lansing))))
3052
3053(test 'delq-duplicates!:none-removed-in-longer-list
3054  (delq-duplicates! (list 'Lanyon 'Larchwood 'Larland 'Larrabee
3055                          'Latimer))
3056  (lambda (result)
3057    (equal? result
3058            '(Lanyon Larchwood Larland Larrabee Latimer))))
3059
3060(test 'delq-duplicates!:some-removed-in-longer-list
3061  (delq-duplicates! (list 'Lattnerville 'Latty 'Latty 'Laurel
3062                          'Lattnerville 'Laurens 'Latty 'Lavinia
3063                          'Latty))
3064  (lambda (result)
3065    (equal? result
3066            '(Lattnerville Latty Laurel Laurens Lavinia))))
3067
3068(test 'delq-duplicates!:all-but-one-removed-in-longer-list
3069  (delq-duplicates! (list 'Lawler 'Lawler 'Lawler 'Lawler
3070                          'Lawler))
3071  (lambda (result) (equal? result '(Lawler))))
3072
3073;;; DELV-DUPLICATES!
3074
3075(define delv-duplicates!
3076  (lambda (lst)
3077    (delete-duplicates! lst eqv?)))
3078
3079(test 'delv-duplicates!:null-list
3080  (delv-duplicates! (list))
3081  null?)
3082
3083(test 'delv-duplicates!:singleton-list
3084  (delv-duplicates! (list 'Lawton))
3085  (lambda (result) (equal? result '(Lawton))))
3086
3087(test 'delv-duplicates!:in-doubleton-list
3088  (delv-duplicates! (list 'Leando 'Leando))
3089  (lambda (result) (equal? result '(Leando))))
3090
3091(test 'delv-duplicates!:none-removed-in-longer-list
3092  (delv-duplicates! (list 'Lebanon 'Ledyard 'Leeds 'Lehigh
3093                          'Leighton))
3094  (lambda (result)
3095    (equal? result '(Lebanon Ledyard Leeds Lehigh Leighton))))
3096
3097(test 'delv-duplicates!:some-removed-in-longer-list
3098  (delv-duplicates! (list 'Leland 'Lena 'Lena 'Lenox 'Leland
3099                          'Leon 'Lena 'LeRoy 'Lena))
3100  (lambda (result)
3101    (equal? result '(Leland Lena Lenox Leon LeRoy))))
3102
3103(test 'delv-duplicates!:all-but-one-removed-in-longer-list
3104  (delv-duplicates! (list 'Leslie 'Leslie 'Leslie 'Leslie
3105                          'Leslie))
3106  (lambda (result) (equal? result '(Leslie))))
3107
3108;;; DELETE-DUPLICATES!
3109
3110(test 'delete-duplicates!:null-list
3111  (delete-duplicates! (list))
3112  null?)
3113
3114(test 'delete-duplicates!:singleton-list
3115  (delete-duplicates! (list (cons 'Lester 'Letts)))
3116  (lambda (result) (equal? result '((Lester . Letts)))))
3117
3118(test 'delete-duplicates!:in-doubleton-list
3119  (delete-duplicates! (list (cons 'Leverette 'Levey)
3120                            (cons 'Leverette 'Levey)))
3121  (lambda (result) (equal? result '((Leverette . Levey)))))
3122
3123(test 'delete-duplicates!:none-removed-in-longer-list
3124  (delete-duplicates! (list (cons 'Lewis 'Lexington)
3125                            (cons 'Liberty 'Libertyville)
3126                            (cons 'Lidderdale 'Lima)
3127                            (cons 'Linby 'Lincoln)
3128                            (cons 'Linden 'Lineville)))
3129  (lambda (result)
3130    (equal? result '((Lewis . Lexington)
3131                     (Liberty . Libertyville)
3132                     (Lidderdale . Lima)
3133                     (Linby . Lincoln)
3134                     (Linden . Lineville)))))
3135
3136(test 'delete-duplicates!:some-removed-in-longer-list
3137  (delete-duplicates! (list (cons 'Lisbon 'Liscomb)
3138                            (cons 'Littleport 'Littleton)
3139                            (cons 'Littleport 'Littleton)
3140                            (cons 'Livermore 'Livingston)
3141                            (cons 'Lisbon 'Liscomb)
3142                            (cons 'Lockman 'Lockridge)
3143                            (cons 'Littleport 'Littleton)
3144                            (cons 'Locust 'Logan)
3145                            (cons 'Littleport 'Littleton)))
3146  (lambda (result)
3147    (equal? result '((Lisbon . Liscomb)
3148                     (Littleport . Littleton)
3149                     (Livermore . Livingston)
3150                     (Lockman . Lockridge)
3151                     (Locust . Logan)))))
3152
3153(test 'delete-duplicates!:all-but-one-removed-in-longer-list
3154  (delete-duplicates! (list (cons 'Logansport 'Lohrville)
3155                            (cons 'Logansport 'Lohrville)
3156                            (cons 'Logansport 'Lohrville)
3157                            (cons 'Logansport 'Lohrville)
3158                            (cons 'Logansport 'Lohrville)))
3159  (lambda (result)
3160    (equal? result '((Logansport . Lohrville)))))
3161
3162;;; MEM
3163
3164(define mem
3165  (lambda (elm= x lst)
3166    (srfi-1:member x lst elm=)))
3167
3168(test 'mem:null-list
3169  (mem (lambda (x y) #t) 'Lorah '())
3170  not)
3171
3172(let ((source '(Lore)))
3173  (test 'mem:in-singleton-list
3174    (mem (lambda (x y) #t) 'Lorimor source)
3175    (lambda (result) (eq? result source))))
3176
3177(test 'mem:not-in-singleton-list
3178  (mem (lambda (x y) #f) 'Loring '(Loring))
3179  not)
3180
3181(let ((source '(Lossing Louisa Lourdes Loveland Lovilla)))
3182  (test 'mem:at-beginning-of-longer-list
3183    (mem (lambda (x y) #t) 'Lovington source)
3184    (lambda (result) (eq? result source))))
3185
3186(let ((source '(521 522 523 524 528 525 526)))
3187  (test 'mem:in-middle-of-longer-list
3188    (mem < 527 source)
3189    (lambda (result) (eq? result (cddddr source)))))
3190
3191(let ((source '(529 530 531 532 534)))
3192  (test 'mem:at-end-of-longer-list
3193    (mem < 533 source)
3194    (lambda (result) (eq? result (cddddr source)))))
3195
3196(test 'mem:not-in-longer-list
3197  (mem (lambda (x y) #f)
3198       'Lowden
3199       '(Lowell Luana Lucas Ludlow Lundgren))
3200  not)
3201
3202;;; ASS
3203
3204(define ass
3205  (lambda (elm= x lst)
3206    (srfi-1:assoc x lst elm=)))
3207
3208(test 'ass:null-list
3209  (ass (lambda (x y) #t) 'Lunsford '())
3210  not)
3211
3212(let ((source '((Luray . Luther))))
3213  (test 'ass:in-singleton-list
3214    (ass (lambda (x y) #t) 'Luton source)
3215    (lambda (result) (eq? result (car source)))))
3216
3217(test 'ass:not-in-singleton-list
3218  (ass (lambda (x y) #f) 'LuVerne '((Luxemburg . Luzerne)))
3219  not)
3220
3221(let ((source '((Lycurgus . Lyman)
3222                (Lyndale . Lynnville)
3223                (Lytton . Macedonia)
3224                (Mackey . Macksburg)
3225                (Madrid . Magnolia))))
3226  (test 'ass:at-beginning-of-longer-list
3227    (ass (lambda (x y) #t) 'Maine source)
3228    (lambda (result) (eq? result (car source)))))
3229
3230(let ((source '((535 . 536)
3231                (537 . 538)
3232                (539 . 540)
3233                (541 . 542)
3234                (549 . 543)
3235                (544 . 545)
3236                (546 . 547))))
3237  (test 'ass:in-middle-of-longer-list
3238    (ass < 548 source)
3239    (lambda (result) (eq? result (car (cddddr source))))))
3240
3241(let ((source '((550 . 551)
3242                (552 . 553)
3243                (554 . 555)
3244                (556 . 557)
3245                (560 . 558))))
3246  (test 'ass:at-end-of-longer-list
3247    (ass < 559 source)
3248    (lambda (result) (eq? result (car (cddddr source))))))
3249
3250(test 'ass:not-in-longer-list
3251  (ass (lambda (x y) #f)
3252       'Malcom
3253       '((Malcom . Mallard)
3254         (Malcom . Malone)
3255         (Malcom . Maloy)
3256         (Malcom . Malvern)
3257         (Malcom . Mammon)))
3258  not)
3259
3260;;; ACONS
3261
3262(define acons alist-cons)
3263
3264(test 'acons:null-list
3265  (acons 'Manawa 'Manchester '())
3266  (lambda (result) (equal? result '((Manawa . Manchester)))))
3267
3268(let ((base '((Manilla . Manly))))
3269  (test 'acons:singleton-list
3270    (acons 'Manning 'Manson base)
3271    (lambda (result)
3272      (and (equal? result '((Manning . Manson)
3273                            (Manilla . Manly)))
3274           (eq? (cdr result) base)))))
3275
3276(let ((base '((Manteno . Mapleside)
3277              (Mapleton . Maquoketa)
3278              (Marathon . Marcus)
3279              (Marengo . Marietta)
3280              (Marion . Mark))))
3281  (test 'acons:longer-list
3282    (acons 'Marne 'Marquette base)
3283    (lambda (result)
3284      (and (equal? result '((Marne . Marquette)
3285                            (Manteno . Mapleside)
3286                            (Mapleton . Maquoketa)
3287                            (Marathon . Marcus)
3288                            (Marengo . Marietta)
3289                            (Marion . Mark)))
3290           (eq? (cdr result) base)))))
3291
3292(let ((base '((Marquisville . Marsh)
3293              (Marshalltown . Martelle)
3294              (Martensdale . Martinsburg)
3295              (Martinstown . Marysville)
3296              (Masonville . Massena)
3297              (Massey . Massilon)
3298              (Matlock . Maud))))
3299  (test 'acons:longer-list-with-duplicate-key
3300    (acons 'Masonville 'Maurice base)
3301    (lambda (result)
3302      (and (equal? result '((Masonville . Maurice)
3303                            (Marquisville . Marsh)
3304                            (Marshalltown . Martelle)
3305                            (Martensdale . Martinsburg)
3306                            (Martinstown . Marysville)
3307                            (Masonville . Massena)
3308                            (Massey . Massilon)
3309                            (Matlock . Maud)))
3310           (eq? (cdr result) base)))))
3311
3312;;; ALIST-COPY
3313
3314(test 'alist-copy:null-list
3315  (alist-copy '())
3316  null?)
3317
3318(let ((original '((Maxon . Maxwell)
3319                  (Maynard . Maysville)
3320                  (McCallsburg . McCausland)
3321                  (McClelland . McGregor)
3322                  (McIntire . McNally))))
3323  (test 'alist-copy:flat-list
3324    (alist-copy original)
3325    (lambda (result)
3326      (and (equal? result original)
3327           (not (eq? result original))
3328           (not (eq? (car result) (car original)))
3329           (not (eq? (cdr result) (cdr original)))
3330           (not (eq? (cadr result) (cadr original)))
3331           (not (eq? (cddr result) (cddr original)))
3332           (not (eq? (caddr result) (caddr original)))
3333           (not (eq? (cdddr result) (cdddr original)))
3334           (not (eq? (cadddr result) (cadddr original)))
3335           (not (eq? (cddddr result) (cddddr original)))
3336           (not (eq? (car (cddddr result))
3337                     (car (cddddr original))))))))
3338
3339(let ((first '(McPaul))
3340      (second '(McPherson
3341                Mechanicsville
3342                Mederville
3343                (Mediapolis Medora)
3344                ((Mekee Melbourne Melcher))))
3345      (third 'Melrose))
3346  (let ((original (list (cons 'Meltonville first)
3347                        (cons 'Melvin second)
3348                        (cons 'Menlo third))))
3349    (test 'alist-copy:bush
3350      (alist-copy original)
3351      (lambda (result)
3352        (and (equal? result original)
3353             (not (eq? result original))
3354             (not (eq? (car result) (car original)))
3355             (eq? (cdar result) first)
3356             (not (eq? (cdr result) (cdr original)))
3357             (not (eq? (cadr result) (cadr original)))
3358             (eq? (cdadr result) second)
3359             (not (eq? (cddr result) (cddr original)))
3360             (not (eq? (caddr result) (caddr original)))
3361             (eq? (cdaddr result) third))))))
3362
3363;;; ALIST-DELETE
3364
3365(test 'alist-delete:null-list
3366  (alist-delete 'Mercer '() (lambda (x y) #t))
3367  null?)
3368
3369(test 'alist-delete:singleton-list
3370  (alist-delete
3371                'Meriden
3372                '((Merrill . Merrimac))
3373                (lambda (x y) #f))
3374  (lambda (result) (equal? result '((Merrill . Merrimac)))))
3375
3376(test 'alist-delete:all-elements-removed
3377  (alist-delete
3378                'Meservey
3379                '((Metz . Meyer)
3380                  (Middleburg . Middletwon)
3381                  (Midvale . Midway)
3382                  (Miles . Milford)
3383                  (Miller . Millersburg))
3384                (lambda (x y) #t))
3385  null?)
3386
3387(test 'alist-delete:some-elements-removed
3388  (alist-delete
3389                561
3390                '((562 . 563)
3391                  (565 . 564)
3392                  (566 . 567)
3393                  (569 . 568)
3394                  (570 . 571))
3395                (lambda (x y) (odd? (+ x y))))
3396  (lambda (result)
3397    (equal? result '((565 . 564) (569 . 568)))))
3398
3399(test 'alist-delete:no-elements-removed
3400  (alist-delete
3401                'Millerton
3402                '((Millman . Millnerville)
3403                  (Millville . Milo)
3404                  (Milton . Minburn)
3405                  (Minden . Mineola)
3406                  (Minerva . Mingo))
3407                (lambda (x y) #f))
3408  (lambda (result)
3409    (equal? result '((Millman . Millnerville)
3410                     (Millville . Milo)
3411                     (Milton . Minburn)
3412                     (Minden . Mineola)
3413                     (Minerva . Mingo)))))
3414
3415;;; ALIST-DELETE!
3416
3417(test 'alist-delete!:null-list
3418  (alist-delete! 'Mitchell '() (lambda (x y) #t))
3419  null?)
3420
3421(test 'alist-delete!:singleton-list
3422  (alist-delete!
3423                 'Mitchellville
3424                 (list (cons 'Modale 'Moingona))
3425                 (lambda (x y) #f))
3426  (lambda (result) (equal? result '((Modale . Moingona)))))
3427
3428(test 'alist-delete!:all-elements-removed
3429  (alist-delete!
3430                'Mona
3431                (list (cons 'Mondamin 'Moneta)
3432                      (cons 'Moningers 'Monmouth)
3433                      (cons 'Monona 'Monroe)
3434                      (cons 'Monteith 'Monterey)
3435                      (cons 'Montezuma 'Montgomery))
3436                (lambda (x y) #t))
3437  null?)
3438
3439(test 'alist-delete!:some-elements-removed
3440  (alist-delete!
3441                 572
3442                 (list (cons 573 574)
3443                       (cons 576 575)
3444                       (cons 577 578)
3445                       (cons 580 579)
3446                       (cons 581 582))
3447                 (lambda (x y) (even? (+ x y))))
3448  (lambda (result)
3449    (equal? result '((573 . 574) (577 . 578) (581 . 582)))))
3450
3451(test 'alist-delete!:no-elements-removed
3452  (alist-delete!
3453                 'Monti
3454                 (list (cons 'Monticello 'Montour)
3455                       (cons 'Montpelier 'Montrose)
3456                       (cons 'Mooar 'Moorhead)
3457                       (cons 'Moorland 'Moran)
3458                       (cons 'Moravia 'Morley))
3459                 (lambda (x y) #f))
3460  (lambda (result)
3461    (equal? result '((Monticello . Montour)
3462                     (Montpelier . Montrose)
3463                     (Mooar . Moorhead)
3464                     (Moorland . Moran)
3465                     (Moravia . Morley)))))
3466
3467;;;;; DEL-ASS
3468;;
3469;;(test 'del-ass:null-list
3470;;  (del-ass (lambda (x y) #t) 'Morningside '())
3471;;  null?)
3472;;
3473;;(test 'del-ass:singleton-list
3474;;  (del-ass (lambda (x y) #f) 'Morrison '((Morse . Moscow)))
3475;;  (lambda (result) (equal? result '((Morse . Moscow)))))
3476;;
3477;;(test 'del-ass:all-elements-removed
3478;;  (del-ass (lambda (x y) #t) 'Motor '((Moulton . Moville)
3479;;                                      (Munterville . Murray)
3480;;                                      (Muscatine . Mystic)
3481;;                                      (Napier . Nashua)
3482;;                                      (Nashville . National)))
3483;;  null?)
3484;;
3485;;(test 'del-ass:some-elements-removed
3486;;  (del-ass (lambda (x y) (even? (+ x y))) 583 '((584 . 585)
3487;;                                                (587 . 586)
3488;;                                                (588 . 589)
3489;;                                                (591 . 590)
3490;;                                                (592 . 593)))
3491;;  (lambda (result)
3492;;    (equal? result '((584 . 585) (588 . 589) (592 . 593)))))
3493;;
3494;;(test 'del-ass:no-elements-removed
3495;;  (del-ass (lambda (x y) #f) 'Nemaha '((Neola . Neptune)
3496;;                                       (Nevada . Nevinville)
3497;;                                       (Newbern . Newburg)
3498;;                                       (Newell . Newhall)
3499;;                                       (Newkirk . Newport)))
3500;;  (lambda (result)
3501;;    (equal? result '((Neola . Neptune)
3502;;                     (Nevada . Nevinville)
3503;;                     (Newbern . Newburg)
3504;;                     (Newell . Newhall)
3505;;                     (Newkirk . Newport)))))
3506;;
3507;;;;; DEL-ASS!
3508;;
3509;;(test 'del-ass!:null-list
3510;;  (del-ass! (lambda (x y) #t) 'Newton '())
3511;;  null?)
3512;;
3513;;(test 'del-ass!:singleton-list
3514;;  (del-ass! (lambda (x y) #f)
3515;;            'Nichols
3516;;            (list (cons 'Nira 'Nishna)))
3517;;  (lambda (result) (equal? result '((Nira . Nishna)))))
3518;;
3519;;(test 'del-ass!:all-elements-removed
3520;;  (del-ass! (lambda (x y) #t)
3521;;            'Noble
3522;;            (list (cons 'Nodaway 'Norness)
3523;;                  (cons 'Northboro 'Northfield)
3524;;                  (cons 'Northwood 'Norwalk)
3525;;                  (cons 'Norway 'Norwich)
3526;;                  (cons 'Norwood 'Norwoodville)))
3527;;  null?)
3528;;
3529;;(test 'del-ass!:some-elements-removed
3530;;  (del-ass! (lambda (x y) (odd? (+ x y)))
3531;;            594
3532;;            (list (cons 595 596)
3533;;                  (cons 598 597)
3534;;                  (cons 599 600)
3535;;                  (cons 602 601)
3536;;                  (cons 603 604)))
3537;;  (lambda (result)
3538;;    (equal? result '((598 . 597) (602 . 601)))))
3539;;
3540;;(test 'del-ass!:no-elements-removed
3541;;  (del-ass! (lambda (x y) #f)
3542;;            'Numa
3543;;            (list (cons 'Nyman 'Oakdale)
3544;;                  (cons 'Oakley 'Oakville)
3545;;                  (cons 'Oakwood 'Oasis)
3546;;                  (cons 'Ocheyedan 'Odebolt)
3547;;                  (cons 'Oelwein 'Ogden)))
3548;;  (lambda (result)
3549;;    (equal? result '((Nyman . Oakdale)
3550;;                     (Oakley . Oakville)
3551;;                     (Oakwood . Oasis)
3552;;                     (Ocheyedan . Odebolt)
3553;;                     (Oelwein . Ogden)))))
3554;;
3555;;;;; DEL-ASSQ
3556;;
3557;;(test 'del-assq:null-list
3558;;  (del-assq 'Okoboji '())
3559;;  null?)
3560;;
3561;;(test 'del-assq:in-singleton-list
3562;;  (del-assq 'Olaf '((Olaf . Olds)))
3563;;  null?)
3564;;
3565;;(test 'del-assq:not-in-singleton-list
3566;;  (del-assq 'Olin '((Olivet . Ollie)))
3567;;  (lambda (result) (equal? result '((Olivet . Ollie)))))
3568;;
3569;;(test 'del-assq:at-beginning-of-longer-list
3570;;  (del-assq 'Olmitz '((Olmitz . Onawa)
3571;;                      (Oneida . Onslow)
3572;;                      (Ontario . Oralabor)
3573;;                      (Oran . Orange)
3574;;                      (Orchard . Orient)))
3575;;  (lambda (result)
3576;;    (equal? result '((Oneida . Onslow)
3577;;                     (Ontario . Oralabor)
3578;;                     (Oran . Orange)
3579;;                     (Orchard . Orient)))))
3580;;
3581;;(test 'del-assq:in-middle-of-longer-list
3582;;  (del-assq 'Orilla '((Orleans . Ormanville)
3583;;                      (Orson . Ortonville)
3584;;                      (Osage . Osborne)
3585;;                      (Osceola . Osgood)
3586;;                      (Orilla . Oskaloosa)
3587;;                      (Ossian . Osterdock)
3588;;                      (Oswalt . Otho)))
3589;;  (lambda (result)
3590;;    (equal? result '((Orleans . Ormanville)
3591;;                     (Orson . Ortonville)
3592;;                     (Osage . Osborne)
3593;;                     (Osceola . Osgood)
3594;;                     (Ossian . Osterdock)
3595;;                     (Oswalt . Otho)))))
3596;;
3597;;(test 'del-assq:at-end-of-longer-list
3598;;  (del-assq 'Otley '((Oto . Otranto)
3599;;                     (Ottawa . Otterville)
3600;;                     (Ottosen . Ottumwa)
3601;;                     (Owasa . Owego)
3602;;                     (Otley . Oxford)))
3603;;  (lambda (result)
3604;;    (equal? result '((Oto . Otranto)
3605;;                     (Ottawa . Otterville)
3606;;                     (Ottosen . Ottumwa)
3607;;                     (Owasa . Owego)))))
3608;;
3609;;(test 'del-assq:not-in-longer-list
3610;;  (del-assq 'Oyens '((Ozark .Packard)
3611;;                     (Packwood . Palmer)
3612;;                     (Palmyra . Palo)
3613;;                     (Panama . Panora)
3614;;                     (Panther . Paralta)))
3615;;  (lambda (result)
3616;;    (equal? result '((Ozark .Packard)
3617;;                     (Packwood . Palmer)
3618;;                     (Palmyra . Palo)
3619;;                     (Panama . Panora)
3620;;                     (Panther . Paralta)))))
3621;;
3622;;(test 'del-assq:several-matches-in-longer-list
3623;;  (del-assq 'Paris '((Parkersburg . Parkview)
3624;;                     (Parnell . Paton)
3625;;                     (Paris . Patterson)
3626;;                     (Paullina . Pekin)
3627;;                     (Paris . Pella)
3628;;                     (Peoria . Peosta)
3629;;                     (Paris . Percival)))
3630;;  (lambda (result)
3631;;    (equal? result '((Parkersburg . Parkview)
3632;;                     (Parnell . Paton)
3633;;                     (Paullina . Pekin)
3634;;                     (Peoria . Peosta)))))
3635;;
3636;;;;; DEL-ASSV
3637;;
3638;;(test 'del-assv:null-list
3639;;  (del-assv 'Perkins '())
3640;;  null?)
3641;;
3642;;(test 'del-assv:in-singleton-list
3643;;  (del-assv 'Perlee '((Perlee . Perry)))
3644;;  null?)
3645;;
3646;;(test 'del-assv:not-in-singleton-list
3647;;  (del-assv 'Pershing '((Persia . Peter)))
3648;;  (lambda (result) (equal? result '((Persia . Peter)))))
3649;;
3650;;(test 'del-assv:at-beginning-of-longer-list
3651;;  (del-assv 'Petersburg '((Petersburg . Peterson)
3652;;                          (Petersville . Philby)
3653;;                          (Pickering . Pierson)
3654;;                          (Pilotsburg . Pioneer)
3655;;                          (Piper . Pisgah)))
3656;;  (lambda (result)
3657;;    (equal? result '((Petersville . Philby)
3658;;                     (Pickering . Pierson)
3659;;                     (Pilotsburg . Pioneer)
3660;;                     (Piper . Pisgah)))))
3661;;
3662;;(test 'del-assv:in-middle-of-longer-list
3663;;  (del-assv 'Pittsburg '((Pitzer . Plainfield)
3664;;                         (Plainview . Plano)
3665;;                         (Pleasanton . Pleasantville)
3666;;                         (Plessis . Plover)
3667;;                         (Pittsburg . Plymouth)
3668;;                         (Pocahontas . Pomeroy)
3669;;                         (Popejoy . Poplar)))
3670;;  (lambda (result)
3671;;    (equal? result '((Pitzer . Plainfield)
3672;;                     (Plainview . Plano)
3673;;                     (Pleasanton . Pleasantville)
3674;;                     (Plessis . Plover)
3675;;                     (Pocahontas . Pomeroy)
3676;;                     (Popejoy . Poplar)))))
3677;;
3678;;(test 'del-assv:at-end-of-longer-list
3679;;  (del-assv 'Portland '((Portsmouth . Postville)
3680;;                        (Powersville . Prairieburg)
3681;;                        (Prescott . Preston)
3682;;                        (Primghar . Primrose)
3683;;                        (Portland . Princeton)))
3684;;  (lambda (result)
3685;;    (equal? result '((Portsmouth . Postville)
3686;;                     (Powersville . Prairieburg)
3687;;                     (Prescott . Preston)
3688;;                     (Primghar . Primrose)))))
3689;;
3690;;(test 'del-assv:not-in-longer-list
3691;;  (del-assv 'Probstel '((Prole . Protivin)
3692;;                        (Pulaski . Purdy)
3693;;                        (Quandahl . Quarry)
3694;;                        (Quasqueton . Quick)
3695;;                        (Quimby . Quincy)))
3696;;  (lambda (result)
3697;;    (equal? result '((Prole . Protivin)
3698;;                     (Pulaski . Purdy)
3699;;                     (Quandahl . Quarry)
3700;;                     (Quasqueton . Quick)
3701;;                     (Quimby . Quincy)))))
3702;;
3703;;(test 'del-assv:several-matches-in-longer-list
3704;;  (del-assv 'Radcliffe '((Rake . Raleigh)
3705;;                         (Ralston . Randalia)
3706;;                         (Radcliffe . Randall)
3707;;                         (Randolph . Rands)
3708;;                         (Radcliffe . Rathbun)
3709;;                         (Raymar . Raymond)
3710;;                         (Radcliffe . Readlyn)))
3711;;  (lambda (result)
3712;;    (equal? result '((Rake . Raleigh)
3713;;                     (Ralston . Randalia)
3714;;                     (Randolph . Rands)
3715;;                     (Raymar . Raymond)))))
3716;;
3717;;;;; DEL-ASSOC
3718;;
3719;;(test 'del-assoc:null-list
3720;;  (del-assoc '(Reasnor . Redding) '())
3721;;  null?)
3722;;
3723;;(test 'del-assoc:in-singleton-list
3724;;  (del-assoc '(Redfield . Reeceville)
3725;;             '(((Redfield . Reeceville) . Reinbeck)))
3726;;  null?)
3727;;
3728;;(test 'del-assoc:not-in-singleton-list
3729;;  (del-assoc '(Rembrandt . Remsen)
3730;;             '(((Renwick . Republic) . Rhodes)))
3731;;  (lambda (result)
3732;;    (equal? result '(((Renwick . Republic) . Rhodes)))))
3733;;
3734;;(test 'del-assoc:at-beginning-of-longer-list
3735;;  (del-assoc '(Riceville . Richard)
3736;;             '(((Riceville . Richard) . Richfield)
3737;;               ((Richland . Richmond) . Rickardsville)
3738;;               ((Ricketts . Rider) . Ridgeport)
3739;;               ((Ridgeway . Riggs) . Rinard)
3740;;               ((Ringgold . Ringsted) . Rippey)))
3741;;  (lambda (result)
3742;;    (equal? result '(((Richland . Richmond) . Rickardsville)
3743;;                     ((Ricketts . Rider) . Ridgeport)
3744;;                     ((Ridgeway . Riggs) . Rinard)
3745;;                     ((Ringgold . Ringsted) . Rippey)))))
3746;;
3747;;(test 'del-assoc:in-middle-of-longer-list
3748;;  (del-assoc '(Ritter . Riverdale)
3749;;             '(((Riverside . Riverton) . Roberts)
3750;;               ((Robertson . Robins) . Robinson)
3751;;               ((Rochester . Rockdale) . Rockford)
3752;;               ((Rockville . Rockwell) . Rodman)
3753;;               ((Ritter . Riverdale) . Rodney)
3754;;               ((Roelyn . Rogers) . Roland)
3755;;               ((Rolfe . Rome) . Roscoe)))
3756;;  (lambda (result)
3757;;    (equal? result '(((Riverside . Riverton) . Roberts)
3758;;                     ((Robertson . Robins) . Robinson)
3759;;                     ((Rochester . Rockdale) . Rockford)
3760;;                     ((Rockville . Rockwell) . Rodman)
3761;;                     ((Roelyn . Rogers) . Roland)
3762;;                     ((Rolfe . Rome) . Roscoe)))))
3763;;
3764;;(test 'del-assoc:at-end-of-longer-list
3765;;  (del-assoc '(Rose . Roselle)
3766;;             '(((Roseville . Ross) . Rosserdale)
3767;;               ((Rossie . Rossville) . Rowan)
3768;;               ((Rowley . Royal) . Rubio)
3769;;               ((Ruble . Rudd) . Runnells)
3770;;               ((Rose . Roselle) . Russell)))
3771;;  (lambda (result)
3772;;    (equal? result '(((Roseville . Ross) . Rosserdale)
3773;;                     ((Rossie . Rossville) . Rowan)
3774;;                     ((Rowley . Royal) . Rubio)
3775;;                     ((Ruble . Rudd) . Runnells)))))
3776;;
3777;;(test 'del-assoc:not-in-longer-list
3778;;  (del-assoc '(Ruthven . Rutland)
3779;;             '(((Rutledge . Ryan) . Sabula)
3780;;               ((Sageville . Salem) . Salina)
3781;;               ((Salix . Sanborn) . Sandusky)
3782;;               ((Sandyville . Santiago) . Saratoga)
3783;;               ((Sattre . Saude) . Savannah)))
3784;;  (lambda (result)
3785;;    (equal? result '(((Rutledge . Ryan) . Sabula)
3786;;                     ((Sageville . Salem) . Salina)
3787;;                     ((Salix . Sanborn) . Sandusky)
3788;;                     ((Sandyville . Santiago) . Saratoga)
3789;;                     ((Sattre . Saude) . Savannah)))))
3790;;
3791;;(test 'del-assoc:several-matches-in-longer-list
3792;;  (del-assoc '(Sawyer . Saylor)
3793;;             '(((Saylorville . Scarville) . Schaller)
3794;;               ((Schleswig . Schley) . Sciola)
3795;;               ((Sawyer . Saylor) . Scranton)
3796;;               ((Searsboro . Sedan) . Selma)
3797;;               ((Sawyer . Saylor) . Seneca)
3798;;               ((Seney . Sewal) . Sexton)
3799;;               ((Sawyer . Saylor) . Seymour)))
3800;;  (lambda (result)
3801;;    (equal? result '(((Saylorville . Scarville) . Schaller)
3802;;                     ((Schleswig . Schley) . Sciola)
3803;;                     ((Searsboro . Sedan) . Selma)
3804;;                     ((Seney . Sewal) . Sexton)))))
3805;;
3806;;;;; DEL-ASSQ!
3807;;
3808;;(test 'del-assq!:null-list
3809;;  (del-assq! 'Shaffton (list))
3810;;  null?)
3811;;
3812;;(test 'del-assq!:in-singleton-list
3813;;  (del-assq! 'Shambaugh (list (cons 'Shambaugh 'Sharon)))
3814;;  null?)
3815;;
3816;;(test 'del-assq!:not-in-singleton-list
3817;;  (del-assq! 'Sharpsburg (list (cons 'Shawondasse 'Sheffield)))
3818;;  (lambda (result)
3819;;    (equal? result '((Shawondasse . Sheffield)))))
3820;;
3821;;(test 'del-assq!:at-beginning-of-longer-list
3822;;  (del-assq! 'Shelby (list (cons 'Shelby 'Sheldahl)
3823;;                           (cons 'Sheldon 'Shellsburg)
3824;;                           (cons 'Shenandoah 'Sheridan)
3825;;                           (cons 'Sherrill 'Sherwood)
3826;;                           (cons 'Shipley 'Shueyville)))
3827;;  (lambda (result)
3828;;    (equal? result '((Sheldon . Shellsburg)
3829;;                     (Shenandoah . Sheridan)
3830;;                     (Sherrill . Sherwood)
3831;;                     (Shipley . Shueyville)))))
3832;;
3833;;(test 'del-assq!:in-middle-of-longer-list
3834;;  (del-assq! 'Siam (list (cons 'Sibley 'Sidney)
3835;;                         (cons 'Sigourney 'Sinclair)
3836;;                         (cons 'Sixmile 'Sixteen)
3837;;                         (cons 'Slater 'Slifer)
3838;;                         (cons 'Siam 'Sloan)
3839;;                         (cons 'Smithland 'Smiths)
3840;;                         (cons 'Smyrna 'Soldier)))
3841;;  (lambda (result)
3842;;    (equal? result '((Sibley . Sidney)
3843;;                     (Sigourney . Sinclair)
3844;;                     (Sixmile . Sixteen)
3845;;                     (Slater . Slifer)
3846;;                     (Smithland . Smiths)
3847;;                     (Smyrna . Soldier)))))
3848;;
3849;;(test 'del-assq!:at-end-of-longer-list
3850;;  (del-assq! 'Solomon (list (cons 'Solon 'Somers)
3851;;                            (cons 'Spaulding 'Spencer)
3852;;                            (cons 'Sperry 'Spillville)
3853;;                            (cons 'Sprague 'Spragueville)
3854;;                            (cons 'Solomon 'Springbrook)))
3855;;  (lambda (result)
3856;;    (equal? result '((Solon . Somers)
3857;;                     (Spaulding . Spencer)
3858;;                     (Sperry . Spillville)
3859;;                     (Sprague . Spragueville)))))
3860;;
3861;;(test 'del-assq!:not-in-longer-list
3862;;  (del-assq! 'Springdale (list (cons 'Springville 'Stacyville)
3863;;                               (cons 'Stanhope 'Stanley)
3864;;                               (cons 'Stanton 'Stanwood)
3865;;                               (cons 'Stanzel 'Stennett)
3866;;                               (cons 'Sterling 'Stevens)))
3867;;  (lambda (result)
3868;;    (equal? result '((Springville . Stacyville)
3869;;                     (Stanhope . Stanley)
3870;;                     (Stanton . Stanwood)
3871;;                     (Stanzel . Stennett)
3872;;                     (Sterling . Stevens)))))
3873;;
3874;;(test 'del-assq!:several-matches-in-longer-list
3875;;  (del-assq! 'Stiles (list (cons 'Stilson 'Stockport)
3876;;                           (cons 'Stockton 'Stonega)
3877;;                           (cons 'Stiles 'Stout)
3878;;                           (cons 'Strahan 'Stratford)
3879;;                           (cons 'Stiles 'Streepyville)
3880;;                           (cons 'Stringtown 'Struble)
3881;;                           (cons 'Stiles 'Stuart)))
3882;;  (lambda (result)
3883;;    (equal? result '((Stilson . Stockport)
3884;;                     (Stockton . Stonega)
3885;;                     (Strahan . Stratford)
3886;;                     (Stringtown . Struble)))))
3887;;
3888;;;;; DEL-ASSV!
3889;;
3890;;(test 'del-assv!:null-list
3891;;  (del-assv! 'Sully (list))
3892;;  null?)
3893;;
3894;;(test 'del-assv!:in-singleton-list
3895;;  (del-assv! 'Summerset (list (cons 'Summerset 'Summitville)))
3896;;  null?)
3897;;
3898;;(test 'del-assv!:not-in-singleton-list
3899;;  (del-assv! 'Sumner (list (cons 'Sunbury 'Sunshine)))
3900;;  (lambda (result)
3901;;    (equal? result '((Sunbury . Sunshine)))))
3902;;
3903;;(test 'del-assv!:at-beginning-of-longer-list
3904;;  (del-assv! 'Superior (list (cons 'Superior 'Sutherland)
3905;;                             (cons 'Sutiff 'Swaledale)
3906;;                             (cons 'Swan 'Swanwood)
3907;;                             (cons 'Swedesburg 'Swisher)
3908;;                             (cons 'Tabor 'Taintor)))
3909;;  (lambda (result)
3910;;    (equal? result '((Sutiff . Swaledale)
3911;;                     (Swan . Swanwood)
3912;;                     (Swedesburg . Swisher)
3913;;                     (Tabor . Taintor)))))
3914;;
3915;;(test 'del-assv!:in-middle-of-longer-list
3916;;  (del-assv! 'Talleyrand (list (cons 'Talmage 'Tama)
3917;;                               (cons 'Tara 'Taylor)
3918;;                               (cons 'Taylorsville 'Templeton)
3919;;                               (cons 'Tenmile 'Tennant)
3920;;                               (cons 'Talleyrand 'Tenville)
3921;;                               (cons 'Terril 'Thayer)
3922;;                               (cons 'Thirty 'Thomasville)))
3923;;  (lambda (result)
3924;;    (equal? result '((Talmage . Tama)
3925;;                     (Tara . Taylor)
3926;;                     (Taylorsville . Templeton)
3927;;                     (Tenmile . Tennant)
3928;;                     (Terril . Thayer)
3929;;                     (Thirty . Thomasville)))))
3930;;
3931;;(test 'del-assv!:at-end-of-longer-list
3932;;  (del-assv! 'Thompson (list (cons 'Thor 'Thornburg)
3933;;                             (cons 'Thornton 'Thorpe)
3934;;                             (cons 'Thurman 'Ticonic)
3935;;                             (cons 'Tiffin 'Tilton)
3936;;                             (cons 'Thompson 'Tingley)))
3937;;  (lambda (result)
3938;;    (equal? result '((Thor . Thornburg)
3939;;                     (Thornton . Thorpe)
3940;;                     (Thurman . Ticonic)
3941;;                     (Tiffin . Tilton)))))
3942;;
3943;;(test 'del-assv!:not-in-longer-list
3944;;  (del-assv! 'Tipton (list (cons 'Titonka 'Tivali)
3945;;                           (cons 'Toddville 'Toeterville)
3946;;                           (cons 'Toledo 'Toolesboro)
3947;;                           (cons 'Toronto 'Tracy)
3948;;                           (cons 'Traer 'Trenton)))
3949;;  (lambda (result)
3950;;    (equal? result '((Titonka . Tivali)
3951;;                     (Toddville . Toeterville)
3952;;                     (Toledo . Toolesboro)
3953;;                     (Toronto . Tracy)
3954;;                     (Traer . Trenton)))))
3955;;
3956;;(test 'del-assv!:several-matches-in-longer-list
3957;;  (del-assv! 'Treynor (list (cons 'Tripoli 'Troy)
3958;;                            (cons 'Truesdale 'Truro)
3959;;                            (cons 'Treynor 'Turin)
3960;;                            (cons 'Tuskeego 'Tyrone)
3961;;                            (cons 'Treynor 'Udell)
3962;;                            (cons 'Ulmer 'Underwood)
3963;;                            (cons 'Treynor 'Union)))
3964;;  (lambda (result)
3965;;    (equal? result '((Tripoli . Troy)
3966;;                     (Truesdale . Truro)
3967;;                     (Tuskeego . Tyrone)
3968;;                     (Ulmer . Underwood)))))
3969;;
3970;;;;; DEL-ASSOC!
3971;;
3972;;(test 'del-assoc!:null-list
3973;;  (del-assoc! (cons 'Unionville 'Unique) (list))
3974;;  null?)
3975;;
3976;;(test 'del-assoc!:in-singleton-list
3977;;  (del-assoc! (cons 'Updegraff 'Urbana)
3978;;              (list (cons (cons 'Updegraff 'Urbana)
3979;;                          'Summitville)))
3980;;  null?)
3981;;
3982;;(test 'del-assoc!:not-in-singleton-list
3983;;  (del-assoc! (cons 'Urbandale 'Ute)
3984;;              (list (cons (cons 'Utica 'Vail) 'Valeria)))
3985;;  (lambda (result)
3986;;    (equal? result '(((Utica . Vail) . Valeria)))))
3987;;
3988;;(test 'del-assoc!:at-beginning-of-longer-list
3989;;  (del-assoc! (cons 'Valley 'Vandalia)
3990;;              (list (cons (cons 'Valley 'Vandalia) 'Varina)
3991;;                    (cons (cons 'Ventura 'Vernon) 'Victor)
3992;;                    (cons (cons 'Viele 'Villisca) 'Vincennes)
3993;;                    (cons (cons 'Vincent 'Vining) 'Vinje)
3994;;                    (cons (cons 'Vinton 'Viola) 'Volga)))
3995;;  (lambda (result)
3996;;    (equal? result '(((Ventura . Vernon) . Victor)
3997;;                     ((Viele . Villisca) . Vincennes)
3998;;                     ((Vincent . Vining) . Vinje)
3999;;                     ((Vinton . Viola) . Volga)))))
4000;;
4001;;(test 'del-assoc!:in-middle-of-longer-list
4002;;  (del-assoc! (cons 'Volney 'Voorhies)
4003;;              (list (cons (cons 'Wadena 'Wahpeton) 'Walcott)
4004;;                    (cons (cons 'Wald 'Wales) 'Walford)
4005;;                    (cons (cons 'Walker 'Wallin) 'Wallingford)
4006;;                    (cons (cons 'Walnut 'Wapello) 'Ward)
4007;;                    (cons (cons 'Volney 'Voorhies) 'Ware)
4008;;                    (cons (cons 'Washburn 'Washington) 'Washta)
4009;;                    (cons (cons 'Waterloo 'Waterville)
4010;;                          'Watkins)))
4011;;  (lambda (result)
4012;;    (equal? result '(((Wadena . Wahpeton) . Walcott)
4013;;                     ((Wald . Wales) . Walford)
4014;;                     ((Walker . Wallin) . Wallingford)
4015;;                     ((Walnut . Wapello) . Ward)
4016;;                     ((Washburn . Washington) . Washta)
4017;;                     ((Waterloo . Waterville) . Watkins)))))
4018;;
4019;;(test 'del-assoc!:at-end-of-longer-list
4020;;  (del-assoc! (cons 'Watson 'Watterson)
4021;;              (list (cons (cons 'Waubeek 'Waucoma) 'Waukee)
4022;;                    (cons (cons 'Waukon 'Waupeton) 'Waverly)
4023;;                    (cons (cons 'Wayland 'Webb) 'Webster)
4024;;                    (cons (cons 'Weldon 'Weller) 'Wellman)
4025;;                    (cons (cons 'Watson 'Watterson) 'Wellsburg)))
4026;;  (lambda (result)
4027;;    (equal? result '(((Waubeek . Waucoma) . Waukee)
4028;;                     ((Waukon . Waupeton) . Waverly)
4029;;                     ((Wayland . Webb) . Webster)
4030;;                     ((Weldon . Weller) . Wellman)))))
4031;;
4032;;(test 'del-assoc!:not-in-longer-list
4033;;  (del-assoc! (cons 'Welton 'Wesley)
4034;;              (list (cons (cons 'Western 'Westerville)
4035;;                          'Westfield)
4036;;                    (cons (cons 'Westgate 'Weston) 'Westphalia)
4037;;                    (cons (cons 'Westside 'Westview) 'Wever)
4038;;                    (cons (cons 'Wheatland 'Whiting)
4039;;                          'Whittemore)
4040;;                    (cons (cons 'Whitten 'Whittier) 'Wichita)))
4041;;  (lambda (result)
4042;;    (equal? result '(((Western . Westerville) . Westfield)
4043;;                     ((Westgate . Weston) . Westphalia)
4044;;                     ((Westside . Westview) . Wever)
4045;;                     ((Wheatland . Whiting) . Whittemore)
4046;;                     ((Whitten . Whittier) . Wichita)))))
4047;;
4048;;(test 'del-assoc!:several-matches-in-longer-list
4049;;  (del-assoc! (cons 'Wick 'Wightman)
4050;;              (list (cons (cons 'Wilke 'Willey) 'Williams)
4051;;                    (cons (cons 'Williamsburg 'Williamson)
4052;;                          'Williamstown)
4053;;                    (cons (cons 'Wick 'Wightman) 'Wilmar)
4054;;                    (cons (cons 'Wilton 'Winchester) 'Windham)
4055;;                    (cons (cons 'Wick 'Wightman) 'Winfield)
4056;;                    (cons (cons 'Winkelmans 'Winterset)
4057;;                          'Winthrop)
4058;;                    (cons (cons 'Wick 'Wightman) 'Wiota)))
4059;;  (lambda (result)
4060;;    (equal? result '(((Wilke . Willey) . Williams)
4061;;                     ((Williamsburg . Williamson)
4062;;                      . Williamstown)
4063;;                     ((Wilton . Winchester) . Windham)
4064;;                     ((Winkelmans . Winterset) . Winthrop)))))
4065
4066
4067(total-report)
4068