460 lines
17 KiB
Scheme
460 lines
17 KiB
Scheme
;;;
|
|
;;; <alist-test.ss> ---- Association list tests
|
|
;;; Time-stamp: <05/12/16 21:14:22 noel>
|
|
;;;
|
|
;;; Copyright (C) 2002 by Noel Welsh.
|
|
;;;
|
|
;;; This file is part of SRFI-1.
|
|
|
|
;;; SRFI-1 is free software; you can redistribute it and/or
|
|
;;; modify it under the terms of the GNU Lesser General Public
|
|
;;; License as published by the Free Software Foundation; either
|
|
;;; version 2.1 of the License, or (at your option) any later version.
|
|
|
|
;;; SRFI-1 is distributed in the hope that it will be useful,
|
|
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
;;; Lesser General Public License for more details.
|
|
|
|
;;; You should have received a copy of the GNU Lesser General Public
|
|
;;; License along with SRFI-1; if not, write to the Free Software
|
|
;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
|
|
;;; Author: Noel Welsh <noelwelsh@yahoo.com>
|
|
;;
|
|
;;
|
|
;; Commentary:
|
|
|
|
;; Originally created by:
|
|
|
|
;; John David Stone
|
|
;; Department of Mathematics and Computer Science
|
|
;; Grinnell College
|
|
;; stone@math.grin.edu
|
|
|
|
(module alist-test mzscheme
|
|
|
|
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
|
(all-except (lib "alist.ss" "srfi" "1") assoc)
|
|
(rename (lib "alist.ss" "srfi" "1") s:assoc assoc))
|
|
|
|
(provide alist-tests)
|
|
|
|
(define alist-tests
|
|
(test-suite
|
|
"Association list tests"
|
|
|
|
;; ALIST-CONS
|
|
|
|
(test-case
|
|
"alist-cons:null-list"
|
|
(check-equal? (alist-cons 'Manawa 'Manchester '())
|
|
'((Manawa . Manchester))))
|
|
|
|
(test-case
|
|
"alist-cons:singleton-list"
|
|
(let* ((base '((Manilla . Manly)))
|
|
(result (alist-cons 'Manning 'Manson base)))
|
|
(check-equal? result '((Manning . Manson)
|
|
(Manilla . Manly)))
|
|
(check-eq? (cdr result) base)))
|
|
|
|
(test-case
|
|
"alist-cons:longer-list"
|
|
(let* ((base '((Manteno . Mapleside)
|
|
(Mapleton . Maquoketa)
|
|
(Marathon . Marcus)
|
|
(Marengo . Marietta)
|
|
(Marion . Mark)))
|
|
(result (alist-cons 'Marne 'Marquette base)))
|
|
(check-equal? result
|
|
'((Marne . Marquette)
|
|
(Manteno . Mapleside)
|
|
(Mapleton . Maquoketa)
|
|
(Marathon . Marcus)
|
|
(Marengo . Marietta)
|
|
(Marion . Mark)))
|
|
(check-eq? (cdr result) base)))
|
|
|
|
(test-case
|
|
"alist-cons:longer-list-with-duplicate-key"
|
|
(let* ((base '((Marquisville . Marsh)
|
|
(Marshalltown . Martelle)
|
|
(Martensdale . Martinsburg)
|
|
(Martinstown . Marysville)
|
|
(Masonville . Massena)
|
|
(Massey . Massilon)
|
|
(Matlock . Maud)))
|
|
(result (alist-cons 'Masonville 'Maurice base)))
|
|
(check-equal? result '((Masonville . Maurice)
|
|
(Marquisville . Marsh)
|
|
(Marshalltown . Martelle)
|
|
(Martensdale . Martinsburg)
|
|
(Martinstown . Marysville)
|
|
(Masonville . Massena)
|
|
(Massey . Massilon)
|
|
(Matlock . Maud)))
|
|
(check-eq? (cdr result) base)))
|
|
|
|
;; ALIST-COPY
|
|
|
|
(test-case
|
|
"alist-copy:null-list"
|
|
(check-true (null? (alist-copy '()))))
|
|
|
|
(test-case
|
|
"alist-copy:flat-list"
|
|
(let* ((original '((Maxon . Maxwell)
|
|
(Maynard . Maysville)
|
|
(McCallsburg . McCausland)
|
|
(McClelland . McGregor)
|
|
(McIntire . McNally)))
|
|
(result (alist-copy original)))
|
|
(check-true
|
|
(and (equal? result original)
|
|
(not (eq? result original))
|
|
(not (eq? (car result) (car original)))
|
|
(not (eq? (cdr result) (cdr original)))
|
|
(not (eq? (cadr result) (cadr original)))
|
|
(not (eq? (cddr result) (cddr original)))
|
|
(not (eq? (caddr result) (caddr original)))
|
|
(not (eq? (cdddr result) (cdddr original)))
|
|
(not (eq? (cadddr result) (cadddr original)))
|
|
(not (eq? (cddddr result) (cddddr original)))
|
|
(not (eq? (car (cddddr result))
|
|
(car (cddddr original))))))))
|
|
|
|
(test-case
|
|
"alist-copy:bush"
|
|
(let* ((first '(McPaul))
|
|
(second '(McPherson
|
|
Mechanicsville
|
|
Mederville
|
|
(Mediapolis Medora)
|
|
((Mekee Melbourne Melcher))))
|
|
(third 'Melrose)
|
|
(original (list (cons 'Meltonville first)
|
|
(cons 'Melvin second)
|
|
(cons 'Menlo third)))
|
|
(result (alist-copy original)))
|
|
(check-true
|
|
(and (equal? result original)
|
|
(not (eq? result original))
|
|
(not (eq? (car result) (car original)))
|
|
(eq? (cdar result) first)
|
|
(not (eq? (cdr result) (cdr original)))
|
|
(not (eq? (cadr result) (cadr original)))
|
|
(eq? (cdadr result) second)
|
|
(not (eq? (cddr result) (cddr original)))
|
|
(not (eq? (caddr result) (caddr original)))
|
|
(eq? (cdaddr result) third)))))
|
|
|
|
;; ALIST-DELETE
|
|
|
|
(test-case
|
|
"alist-delete:null-list"
|
|
(check-true (null? (alist-delete 'Mercer '() (lambda (x y) #t)))))
|
|
|
|
(test-case
|
|
"alist-delete:singleton-list"
|
|
(check-equal?
|
|
(alist-delete 'Meriden
|
|
'((Merrill . Merrimac)))
|
|
'((Merrill . Merrimac))))
|
|
|
|
(test-case
|
|
"alist-delete:all-elements-removed"
|
|
(check-true
|
|
(null? (alist-delete 'Meservey
|
|
'((Metz . Meyer)
|
|
(Middleburg . Middletwon)
|
|
(Midvale . Midway)
|
|
(Miles . Milford)
|
|
(Miller . Millersburg))
|
|
(lambda (x y) #t)))))
|
|
|
|
(test-case
|
|
"alist-delete:some-elements-removed"
|
|
(check-equal?
|
|
(alist-delete 561
|
|
'((562 . 563)
|
|
(565 . 564)
|
|
(566 . 567)
|
|
(569 . 568)
|
|
(570 . 571))
|
|
(lambda (x y) (odd? (+ x y))))
|
|
'((565 . 564) (569 . 568))))
|
|
|
|
(test-case
|
|
"alist-delete:no-elements-removed"
|
|
(check-equal?
|
|
(alist-delete 'Millerton
|
|
'((Millman . Millnerville)
|
|
(Millville . Milo)
|
|
(Milton . Minburn)
|
|
(Minden . Mineola)
|
|
(Minerva . Mingo))
|
|
(lambda (x y) #f))
|
|
'((Millman . Millnerville)
|
|
(Millville . Milo)
|
|
(Milton . Minburn)
|
|
(Minden . Mineola)
|
|
(Minerva . Mingo))))
|
|
|
|
;; ALIST-DELETE!
|
|
|
|
(test-case
|
|
"alist-delete!:null-list"
|
|
(check-true (null? (alist-delete! 'Mitchell '() (lambda (x y) #t)))))
|
|
|
|
(test-case
|
|
"alist-delete!:singleton-list"
|
|
(check-equal?
|
|
(alist-delete! 'Mitchellville
|
|
(list (cons 'Modale 'Moingona)))
|
|
'((Modale . Moingona))))
|
|
|
|
(test-case
|
|
"alist-delete!:all-elements-removed"
|
|
(check-true
|
|
(null?
|
|
(alist-delete! 'Mona
|
|
(list (cons 'Mondamin 'Moneta)
|
|
(cons 'Moningers 'Monmouth)
|
|
(cons 'Monona 'Monroe)
|
|
(cons 'Monteith 'Monterey)
|
|
(cons 'Montezuma 'Montgomery))
|
|
(lambda (x y) #t)))))
|
|
|
|
(test-case
|
|
"alist-delete!:some-elements-removed"
|
|
(check-equal?
|
|
(alist-delete! 572
|
|
(list (cons 573 574)
|
|
(cons 576 575)
|
|
(cons 577 578)
|
|
(cons 580 579)
|
|
(cons 581 582))
|
|
(lambda (x y) (even? (+ x y))))
|
|
'((573 . 574) (577 . 578) (581 . 582))))
|
|
|
|
(test-case
|
|
"alist-delete!:no-elements-removed"
|
|
(check-equal?
|
|
(alist-delete! 'Monti
|
|
(list (cons 'Monticello 'Montour)
|
|
(cons 'Montpelier 'Montrose)
|
|
(cons 'Mooar 'Moorhead)
|
|
(cons 'Moorland 'Moran)
|
|
(cons 'Moravia 'Morley)))
|
|
'((Monticello . Montour)
|
|
(Montpelier . Montrose)
|
|
(Mooar . Moorhead)
|
|
(Moorland . Moran)
|
|
(Moravia . Morley))))
|
|
|
|
;; ALIST-DELETE
|
|
|
|
(test-case
|
|
"alist-delete:null-list"
|
|
(check-true (null? (alist-delete '(Reasnor . Redding) '()))))
|
|
|
|
(test-case
|
|
"alist-delete:in-singleton-list"
|
|
(check-true (null?
|
|
(alist-delete '(Redfield . Reeceville)
|
|
'(((Redfield . Reeceville) . Reinbeck))))))
|
|
|
|
(test-case
|
|
"alist-delete:not-in-singleton-list"
|
|
(check-equal?
|
|
(alist-delete '(Rembrandt . Remsen)
|
|
'(((Renwick . Republic) . Rhodes)))
|
|
'(((Renwick . Republic) . Rhodes))))
|
|
|
|
(test-case
|
|
"alist-delete:at-beginning-of-longer-list"
|
|
(check-equal?
|
|
(alist-delete '(Riceville . Richard)
|
|
'(((Riceville . Richard) . Richfield)
|
|
((Richland . Richmond) . Rickardsville)
|
|
((Ricketts . Rider) . Ridgeport)
|
|
((Ridgeway . Riggs) . Rinard)
|
|
((Ringgold . Ringsted) . Rippey)))
|
|
'(((Richland . Richmond) . Rickardsville)
|
|
((Ricketts . Rider) . Ridgeport)
|
|
((Ridgeway . Riggs) . Rinard)
|
|
((Ringgold . Ringsted) . Rippey))))
|
|
|
|
(test-case
|
|
"alist-delete:in-middle-of-longer-list"
|
|
(check-equal?
|
|
(alist-delete '(Ritter . Riverdale)
|
|
'(((Riverside . Riverton) . Roberts)
|
|
((Robertson . Robins) . Robinson)
|
|
((Rochester . Rockdale) . Rockford)
|
|
((Rockville . Rockwell) . Rodman)
|
|
((Ritter . Riverdale) . Rodney)
|
|
((Roelyn . Rogers) . Roland)
|
|
((Rolfe . Rome) . Roscoe)))
|
|
'(((Riverside . Riverton) . Roberts)
|
|
((Robertson . Robins) . Robinson)
|
|
((Rochester . Rockdale) . Rockford)
|
|
((Rockville . Rockwell) . Rodman)
|
|
((Roelyn . Rogers) . Roland)
|
|
((Rolfe . Rome) . Roscoe))))
|
|
|
|
(test-case
|
|
"alist-delete:at-end-of-longer-list"
|
|
(check-equal?
|
|
(alist-delete '(Rose . Roselle)
|
|
'(((Roseville . Ross) . Rosserdale)
|
|
((Rossie . Rossville) . Rowan)
|
|
((Rowley . Royal) . Rubio)
|
|
((Ruble . Rudd) . Runnells)
|
|
((Rose . Roselle) . Russell)))
|
|
'(((Roseville . Ross) . Rosserdale)
|
|
((Rossie . Rossville) . Rowan)
|
|
((Rowley . Royal) . Rubio)
|
|
((Ruble . Rudd) . Runnells))))
|
|
|
|
(test-case
|
|
"alist-delete:not-in-longer-list"
|
|
(check-equal?
|
|
(alist-delete '(Ruthven . Rutland)
|
|
'(((Rutledge . Ryan) . Sabula)
|
|
((Sageville . Salem) . Salina)
|
|
((Salix . Sanborn) . Sandusky)
|
|
((Sandyville . Santiago) . Saratoga)
|
|
((Sattre . Saude) . Savannah)))
|
|
'(((Rutledge . Ryan) . Sabula)
|
|
((Sageville . Salem) . Salina)
|
|
((Salix . Sanborn) . Sandusky)
|
|
((Sandyville . Santiago) . Saratoga)
|
|
((Sattre . Saude) . Savannah))))
|
|
|
|
(test-case
|
|
"alist-delete:several-matches-in-longer-list"
|
|
(check-equal?
|
|
(alist-delete '(Sawyer . Saylor)
|
|
'(((Saylorville . Scarville) . Schaller)
|
|
((Schleswig . Schley) . Sciola)
|
|
((Sawyer . Saylor) . Scranton)
|
|
((Searsboro . Sedan) . Selma)
|
|
((Sawyer . Saylor) . Seneca)
|
|
((Seney . Sewal) . Sexton)
|
|
((Sawyer . Saylor) . Seymour)))
|
|
'(((Saylorville . Scarville) . Schaller)
|
|
((Schleswig . Schley) . Sciola)
|
|
((Searsboro . Sedan) . Selma)
|
|
((Seney . Sewal) . Sexton))))
|
|
|
|
;; ALIST-DELETE!
|
|
|
|
(test-case
|
|
"alist-delete!:null-list"
|
|
(check-true (null? (alist-delete! (cons 'Unionville 'Unique) (list)))))
|
|
|
|
(test-case
|
|
"alist-delete!:in-singleton-list"
|
|
(check-true
|
|
(null?
|
|
(alist-delete! (cons 'Updegraff 'Urbana)
|
|
(list (cons (cons 'Updegraff 'Urbana)
|
|
'Summitville))))))
|
|
|
|
(test-case
|
|
"alist-delete!:not-in-singleton-list"
|
|
(check-equal?
|
|
(alist-delete! (cons 'Urbandale 'Ute)
|
|
(list (cons (cons 'Utica 'Vail) 'Valeria)))
|
|
'(((Utica . Vail) . Valeria))))
|
|
|
|
(test-case
|
|
"alist-delete!:at-beginning-of-longer-list"
|
|
(check-equal?
|
|
(alist-delete! (cons 'Valley 'Vandalia)
|
|
(list (cons (cons 'Valley 'Vandalia) 'Varina)
|
|
(cons (cons 'Ventura 'Vernon) 'Victor)
|
|
(cons (cons 'Viele 'Villisca) 'Vincennes)
|
|
(cons (cons 'Vincent 'Vining) 'Vinje)
|
|
(cons (cons 'Vinton 'Viola) 'Volga)))
|
|
'(((Ventura . Vernon) . Victor)
|
|
((Viele . Villisca) . Vincennes)
|
|
((Vincent . Vining) . Vinje)
|
|
((Vinton . Viola) . Volga))))
|
|
|
|
(test-case
|
|
"alist-delete!:in-middle-of-longer-list"
|
|
(check-equal?
|
|
(alist-delete! (cons 'Volney 'Voorhies)
|
|
(list (cons (cons 'Wadena 'Wahpeton) 'Walcott)
|
|
(cons (cons 'Wald 'Wales) 'Walford)
|
|
(cons (cons 'Walker 'Wallin) 'Wallingford)
|
|
(cons (cons 'Walnut 'Wapello) 'Ward)
|
|
(cons (cons 'Volney 'Voorhies) 'Ware)
|
|
(cons (cons 'Washburn 'Washington) 'Washta)
|
|
(cons (cons 'Waterloo 'Waterville)
|
|
'Watkins)))
|
|
'(((Wadena . Wahpeton) . Walcott)
|
|
((Wald . Wales) . Walford)
|
|
((Walker . Wallin) . Wallingford)
|
|
((Walnut . Wapello) . Ward)
|
|
((Washburn . Washington) . Washta)
|
|
((Waterloo . Waterville) . Watkins))))
|
|
|
|
(test-case
|
|
"alist-delete!:at-end-of-longer-list"
|
|
(check-equal?
|
|
(alist-delete! (cons 'Watson 'Watterson)
|
|
(list (cons (cons 'Waubeek 'Waucoma) 'Waukee)
|
|
(cons (cons 'Waukon 'Waupeton) 'Waverly)
|
|
(cons (cons 'Wayland 'Webb) 'Webster)
|
|
(cons (cons 'Weldon 'Weller) 'Wellman)
|
|
(cons (cons 'Watson 'Watterson) 'Wellsburg)))
|
|
'(((Waubeek . Waucoma) . Waukee)
|
|
((Waukon . Waupeton) . Waverly)
|
|
((Wayland . Webb) . Webster)
|
|
((Weldon . Weller) . Wellman))))
|
|
|
|
(test-case
|
|
"alist-delete!:not-in-longer-list"
|
|
(check-equal?
|
|
(alist-delete! (cons 'Welton 'Wesley)
|
|
(list (cons (cons 'Western 'Westerville)
|
|
'Westfield)
|
|
(cons (cons 'Westgate 'Weston) 'Westphalia)
|
|
(cons (cons 'Westside 'Westview) 'Wever)
|
|
(cons (cons 'Wheatland 'Whiting)
|
|
'Whittemore)
|
|
(cons (cons 'Whitten 'Whittier) 'Wichita)))
|
|
'(((Western . Westerville) . Westfield)
|
|
((Westgate . Weston) . Westphalia)
|
|
((Westside . Westview) . Wever)
|
|
((Wheatland . Whiting) . Whittemore)
|
|
((Whitten . Whittier) . Wichita))))
|
|
|
|
(test-case
|
|
"alist-delete!:several-matches-in-longer-list"
|
|
(check-equal?
|
|
(alist-delete! (cons 'Wick 'Wightman)
|
|
(list (cons (cons 'Wilke 'Willey) 'Williams)
|
|
(cons (cons 'Williamsburg 'Williamson)
|
|
'Williamstown)
|
|
(cons (cons 'Wick 'Wightman) 'Wilmar)
|
|
(cons (cons 'Wilton 'Winchester) 'Windham)
|
|
(cons (cons 'Wick 'Wightman) 'Winfield)
|
|
(cons (cons 'Winkelmans 'Winterset)
|
|
'Winthrop)
|
|
(cons (cons 'Wick 'Wightman) 'Wiota)))
|
|
'(((Wilke . Willey) . Williams)
|
|
((Williamsburg . Williamson)
|
|
. Williamstown)
|
|
((Wilton . Winchester) . Windham)
|
|
((Winkelmans . Winterset) . Winthrop))))
|
|
|
|
))
|
|
)
|
|
|
|
;;; alist-test.ss ends here
|