racket/collects/tests/srfi/1/delete-test.rkt
2011-07-02 10:37:53 -04:00

359 lines
12 KiB
Racket

;;;
;;; <delete-test.rkt> ---- List deletion function tests
;;; Time-stamp: <05/12/16 21:16:28 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 delete-test
mzscheme
(require rackunit)
(require (all-except srfi/1/delete member))
(provide delete-tests)
(define delete-tests
(test-suite
"List deletion tests"
;; DELETE
(test-case
"delete:null-list"
(check-true
(null? (delete '(Fraser . Frederic) '()))))
(test-case
"delete:in-singleton-list"
(check-true
(null?
(delete '(Fredericksburg . Frederika)
'((Fredericksburg . Frederika))))))
(test-case
"delete:not-in-singleton-list"
(check-equal?
(delete '(Fredonia . Fredsville) '((Freeman . Freeport)))
'((Freeman . Freeport))))
(test-case
"delete:at-beginning-of-longer-list"
(check-equal?
(delete '(Fremont . Froelich) '((Fremont . Froelich)
(Fruitland . Fulton)
(Furay . Galbraith)
(Galesburg . Galland)
(Galt . Galva)))
'((Fruitland . Fulton)
(Furay . Galbraith)
(Galesburg . Galland)
(Galt . Galva))))
(test-case
"delete:in-middle-of-longer-list"
(check-equal?
(delete '(Gambrill . Garber) '((Gardiner . Gardner)
(Garfield . Garland)
(Garnavillo . Garner)
(Garrison . Garwin)
(Gambrill . Garber)
(Gaza . Geneva)
(Genoa . George)))
'((Gardiner . Gardner)
(Garfield . Garland)
(Garnavillo . Garner)
(Garrison . Garwin)
(Gaza . Geneva)
(Genoa . George))))
(test-case
"delete:at-end-of-longer-list"
(check-equal?
(delete '(Georgetown . Gerled) '((Germantown . Germanville)
(Giard . Gibbsville)
(Gibson . Gifford)
(Gilbert . Gilbertville)
(Georgetown . Gerled)))
'((Germantown . Germanville)
(Giard . Gibbsville)
(Gibson . Gifford)
(Gilbert . Gilbertville))))
(test-case
"delete:not-in-longer-list"
(check-equal?
(delete '(Gilliatt . Gilman) '((Givin . Gladbrook)
(Gladstone . Gladwin)
(Glasgow . Glendon)
(Glenwood . Glidden)
(Goddard . Goldfield)))
'((Givin . Gladbrook)
(Gladstone . Gladwin)
(Glasgow . Glendon)
(Glenwood . Glidden)
(Goddard . Goldfield))))
(test-case
"delete:several-matches-in-longer-list"
(check-equal?
(delete '(Goodell . Gosport) '((Gowrie . Goddard)
(Grable . Graettinger)
(Goodell . Gosport)
(Graf . Grafton)
(Goodell . Gosport)
(Grandview . Granger)
(Goodell . Gosport)))
'((Gowrie . Goddard)
(Grable . Graettinger)
(Graf . Grafton)
(Grandview . Granger))))
;; DELETE!
(test-case
"delete!:null-list"
(check-true (null? (delete! (cons 'Henshaw 'Hentons) (list)))))
(test-case
"delete!:in-singleton-list"
(check-true
(null?
(delete! (cons 'Hepburn 'Herndon)
(list (cons 'Hepburn 'Herndon))))))
(test-case
"delete!:not-in-singleton-list"
(check-equal?
(delete! (cons 'Hesper 'Hiattsville)
(list (cons 'Hiawatha 'Hicks)))
'((Hiawatha . Hicks))))
(test-case
"delete!:at-beginning-of-longer-list"
(check-equal?
(delete! (cons 'Highland 'Highlandville)
(list (cons 'Highland 'Highlandville)
(cons 'Highview 'Hills)
(cons 'Hillsboro 'Hillsdale)
(cons 'Hilltop 'Hinton)
(cons 'Hiteman 'Hobarton)))
'((Highview . Hills)
(Hillsboro . Hillsdale)
(Hilltop . Hinton)
(Hiteman . Hobarton))))
(test-case
"delete!:in-middle-of-longer-list"
(check-equal?
(delete! (cons 'Hocking 'Holbrook)
(list (cons 'Holland 'Holmes)
(cons 'Holstein 'Homer)
(cons 'Homestead 'Hopeville)
(cons 'Hopkinton 'Hornick)
(cons 'Hocking 'Holbrook)
(cons 'Horton 'Hospers)
(cons 'Houghton 'Howardville)))
'((Holland . Holmes)
(Holstein . Homer)
(Homestead . Hopeville)
(Hopkinton . Hornick)
(Horton . Hospers)
(Houghton . Howardville))))
(test-case
"delete!:at-end-of-longer-list"
(check-equal?
(delete! (cons 'Howe 'Hubbard)
(list (cons 'Hudson 'Hugo)
(cons 'Hull 'Humboldt)
(cons 'Humeston 'Huntington)
(cons 'Hurley 'Huron)
(cons 'Howe 'Hubbard)))
'((Hudson . Hugo)
(Hull . Humboldt)
(Humeston . Huntington)
(Hurley . Huron))))
(test-case
"delete!:not-in-longer-list"
(check-equal?
(delete! (cons 'Hurstville 'Hutchins)
(list (cons 'Huxley 'Iconium)
(cons 'Illyria 'Imogene)
(cons 'Independence 'Indianapolis)
(cons 'Indianola 'Industry)
(cons 'Inwood 'Ion)))
'((Huxley . Iconium)
(Illyria . Imogene)
(Independence . Indianapolis)
(Indianola . Industry)
(Inwood . Ion))))
(test-case
"delete!:several-matches-in-longer-list"
(check-equal?
(delete! (cons 'Ionia 'Ira)
(list (cons 'Ireton 'Ironhills)
(cons 'Irving 'Irvington)
(cons 'Ionia 'Ira)
(cons 'Irwin 'Ivester)
(cons 'Ionia 'Ira)
(cons 'Iveyville 'Ivy)
(cons 'Ionia 'Ira)))
'((Ireton . Ironhills)
(Irving . Irvington)
(Irwin . Ivester)
(Iveyville . Ivy))))
;; DELETE-DUPLICATES
(test-case
"delete-duplicates:null-list"
(check-true (null? (delete-duplicates '()))))
(test-case
"delete-duplicates:singleton-list"
(check-equal?
(delete-duplicates '((Knierim . Knittel)))
'((Knierim . Knittel))))
(test-case
"delete-duplicates:in-doubleton-list"
(check-equal?
(delete-duplicates '((Knoke . Knowlton) (Knoke . Knowlton)))
'((Knoke . Knowlton))))
(test-case
"delete-duplicates:none-removed-in-longer-list"
(check-equal?
(delete-duplicates '((Knox . Knoxville)
(Konigsmark . Kossuth)
(Koszta . Lacelle)
(Lacey . Lacona)
(Ladoga . Ladora)))
'((Knox . Knoxville)
(Konigsmark . Kossuth)
(Koszta . Lacelle)
(Lacey . Lacona)
(Ladoga . Ladora))))
(test-case
"delete-duplicates:some-removed-in-longer-list"
(check-equal?
(delete-duplicates '((Lafayette . Lainsville)
(Lakeside . Lakewood)
(Lakeside . Lakewood)
(Lakonta . Lakota)
(Lafayette . Lainsville)
(Lamoille . Lamoni)
(Lakeside . Lakewood)
(Lamont . Lancaster)
(Lakeside . Lakewood)))
'((Lafayette . Lainsville)
(Lakeside . Lakewood)
(Lakonta . Lakota)
(Lamoille . Lamoni)
(Lamont . Lancaster))))
(test-case
"delete-duplicates:all-but-one-removed-in-longer-list"
(check-equal?
(delete-duplicates '((Lanesboro . Langdon)
(Lanesboro . Langdon)
(Lanesboro . Langdon)
(Lanesboro . Langdon)
(Lanesboro . Langdon)))
'((Lanesboro . Langdon))))
;; DELETE-DUPLICATES!
(test-case
"delete-duplicates!:null-list"
(check-true (null? (delete-duplicates! (list)))))
(test-case
"delete-duplicates!:singleton-list"
(check-equal?
(delete-duplicates! (list (cons 'Lester 'Letts)))
'((Lester . Letts))))
(test-case
"delete-duplicates!:in-doubleton-list"
(check-equal?
(delete-duplicates! (list (cons 'Leverette 'Levey)
(cons 'Leverette 'Levey)))
'((Leverette . Levey))))
(test-case
"delete-duplicates!:none-removed-in-longer-list"
(check-equal?
(delete-duplicates! (list (cons 'Lewis 'Lexington)
(cons 'Liberty 'Libertyville)
(cons 'Lidderdale 'Lima)
(cons 'Linby 'Lincoln)
(cons 'Linden 'Lineville)))
'((Lewis . Lexington)
(Liberty . Libertyville)
(Lidderdale . Lima)
(Linby . Lincoln)
(Linden . Lineville))))
(test-case
"delete-duplicates!:some-removed-in-longer-list"
(check-equal?
(delete-duplicates! (list (cons 'Lisbon 'Liscomb)
(cons 'Littleport 'Littleton)
(cons 'Littleport 'Littleton)
(cons 'Livermore 'Livingston)
(cons 'Lisbon 'Liscomb)
(cons 'Lockman 'Lockridge)
(cons 'Littleport 'Littleton)
(cons 'Locust 'Logan)
(cons 'Littleport 'Littleton)))
'((Lisbon . Liscomb)
(Littleport . Littleton)
(Livermore . Livingston)
(Lockman . Lockridge)
(Locust . Logan))))
(test-case
"delete-duplicates!:all-but-one-removed-in-longer-list"
(check-equal?
(delete-duplicates! (list (cons 'Logansport 'Lohrville)
(cons 'Logansport 'Lohrville)
(cons 'Logansport 'Lohrville)
(cons 'Logansport 'Lohrville)
(cons 'Logansport 'Lohrville)))
'((Logansport . Lohrville))))
))
)
;;; delete-test.rkt ends here