Link the SRFI 4 tests into the main test suite and fix a number of tests so they work with the changes to 3.99. The hash table tests are still broken and I don't know why.
svn: r8919
This commit is contained in:
Noel Welsh
parent
a53d243e99
commit
d71f913097
|
|
@ -1,6 +1,6 @@
|
|||
;;;
|
||||
;;; <alist-test.ss> ---- Association list tests
|
||||
;;; Time-stamp: <05/12/16 21:14:22 noel>
|
||||
;;; Time-stamp: <2008-03-07 16:36:15 nhw>
|
||||
;;;
|
||||
;;; Copyright (C) 2002 by Noel Welsh.
|
||||
;;;
|
||||
|
|
@ -203,55 +203,6 @@
|
|||
|
||||
;; 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
|
||||
|
||||
|
|
@ -351,107 +302,6 @@
|
|||
|
||||
;; 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))))
|
||||
|
||||
))
|
||||
)
|
||||
|
|
|
|||
|
|
@ -66,7 +66,7 @@
|
|||
|
||||
(test-case
|
||||
"vector-map!"
|
||||
(let ((vec '#(1 2 3 4)))
|
||||
(let ((vec (vector 1 2 3 4)))
|
||||
(check-equal?
|
||||
(begin (vector-map! (lambda (i x) (* x x))
|
||||
vec)
|
||||
|
|
@ -79,7 +79,7 @@
|
|||
vec1 vec2)
|
||||
vec1)
|
||||
'#(5 8 9 8 5)))
|
||||
(let ((vec '#(1 2 3 4)))
|
||||
(let ((vec (vector 1 2 3 4)))
|
||||
(check-equal?
|
||||
(begin (vector-map! (lambda (i elt) (+ i elt))
|
||||
vec)
|
||||
|
|
@ -88,7 +88,7 @@
|
|||
|
||||
(test-case
|
||||
"vector-for-each"
|
||||
(let ((vec1 '#(1 2 3 4))
|
||||
(let ((vec1 (vector 1 2 3 4))
|
||||
(vec2 (make-vector 4)))
|
||||
(check-equal?
|
||||
(begin (vector-for-each (lambda (i elt)
|
||||
|
|
|
|||
|
|
@ -10,12 +10,12 @@
|
|||
"All tests for mutator"
|
||||
(test-case
|
||||
"vector-swap!"
|
||||
(let ((vec '#(a b c d e)))
|
||||
(let ((vec (vector 'a 'b 'c 'd 'e)))
|
||||
(check-equal?
|
||||
(begin (vector-swap! vec 1 3)
|
||||
vec)
|
||||
'#(a d c b e)))
|
||||
(let ((vec '#(0 1 2)))
|
||||
(let ((vec (vector 0 1 2)))
|
||||
(check-equal?
|
||||
(begin (vector-swap! vec 1 1)
|
||||
vec)
|
||||
|
|
@ -23,17 +23,17 @@
|
|||
|
||||
(test-case
|
||||
"vector-fill!"
|
||||
(let ((vec '#(1 2 3 4 5)))
|
||||
(let ((vec (vector 1 2 3 4 5)))
|
||||
(check-equal?
|
||||
(begin (s:vector-fill! vec 0)
|
||||
vec)
|
||||
'#(0 0 0 0 0)))
|
||||
(let ((vec '#(1 2 3 4 5)))
|
||||
(let ((vec (vector 1 2 3 4 5)))
|
||||
(check-equal?
|
||||
(begin (s:vector-fill! vec 0 1)
|
||||
vec)
|
||||
'#(1 0 0 0 0)))
|
||||
(let ((vec '#(1 2 3 4 5)))
|
||||
(let ((vec (vector 1 2 3 4 5)))
|
||||
(check-equal?
|
||||
(begin (s:vector-fill! vec 0 1 4)
|
||||
vec)
|
||||
|
|
@ -41,17 +41,17 @@
|
|||
|
||||
(test-case
|
||||
"vector-reverse!"
|
||||
(let ((vec '#(1 2 3 4 5)))
|
||||
(let ((vec (vector 1 2 3 4 5)))
|
||||
(check-equal?
|
||||
(begin (vector-reverse! vec)
|
||||
vec)
|
||||
'#(5 4 3 2 1)))
|
||||
(let ((vec '#(1 2 3 4 5)))
|
||||
(let ((vec (vector 1 2 3 4 5)))
|
||||
(check-equal?
|
||||
(begin (vector-reverse! vec 1)
|
||||
vec)
|
||||
'#(1 5 4 3 2)))
|
||||
(let ((vec '#(1 2 3 4 5)))
|
||||
(let ((vec (vector 1 2 3 4 5)))
|
||||
(check-equal?
|
||||
(begin (vector-reverse! vec 1 4)
|
||||
vec)
|
||||
|
|
@ -59,20 +59,20 @@
|
|||
|
||||
(test-case
|
||||
"vector-copy!"
|
||||
(let ((source '#(1 2 3 4 5))
|
||||
(target '#(0 0 0 0 0)))
|
||||
(let ((source (vector 1 2 3 4 5))
|
||||
(target (vector 0 0 0 0 0)))
|
||||
(check-equal?
|
||||
(begin (vector-copy! target 0 source)
|
||||
target)
|
||||
source))
|
||||
(let ((source '#(1 2 3 4 5))
|
||||
(target '#(0 0 0 0 0)))
|
||||
(let ((source (vector 1 2 3 4 5))
|
||||
(target (vector 0 0 0 0 0)))
|
||||
(check-equal?
|
||||
(begin (vector-copy! target 1 source 1)
|
||||
target)
|
||||
'#(0 2 3 4 5)))
|
||||
(let ((source '#(1 2 3 4 5))
|
||||
(target '#(0 0 0 0 0)))
|
||||
(let ((source (vector 1 2 3 4 5))
|
||||
(target (vector 0 0 0 0 0)))
|
||||
(check-equal?
|
||||
(begin (vector-copy! target 1 source 1 4)
|
||||
target)
|
||||
|
|
@ -80,20 +80,20 @@
|
|||
|
||||
(test-case
|
||||
"vector-reverse-copy!"
|
||||
(let ((source '#(1 2 3 4 5))
|
||||
(target '#(0 0 0 0 0)))
|
||||
(let ((source (vector 1 2 3 4 5))
|
||||
(target (vector 0 0 0 0 0)))
|
||||
(check-equal?
|
||||
(begin (vector-reverse-copy! target 0 source)
|
||||
target)
|
||||
'#(5 4 3 2 1)))
|
||||
(let ((source '#(1 2 3 4 5))
|
||||
(target '#(0 0 0 0 0)))
|
||||
(let ((source (vector 1 2 3 4 5))
|
||||
(target (vector 0 0 0 0 0)))
|
||||
(check-equal?
|
||||
(begin (vector-reverse-copy! target 1 source 1)
|
||||
target)
|
||||
'#(0 5 4 3 2)))
|
||||
(let ((source '#(1 2 3 4 5))
|
||||
(target '#(0 0 0 0 0)))
|
||||
(let ((source (vector 1 2 3 4 5))
|
||||
(target (vector 0 0 0 0 0)))
|
||||
(check-equal?
|
||||
(begin (vector-reverse-copy! target 1 source 1 4)
|
||||
target)
|
||||
|
|
|
|||
|
|
@ -3,6 +3,7 @@
|
|||
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2)))
|
||||
(require "1/all-1-tests.ss"
|
||||
"2/and-let-test.ss"
|
||||
"4/srfi-4-test.ss"
|
||||
"13/string-test.ss"
|
||||
"14/char-set-test.ss"
|
||||
"26/cut-test.ss"
|
||||
|
|
@ -22,5 +23,6 @@
|
|||
all-srfi-40-tests
|
||||
all-srfi-43-tests
|
||||
hash-tests
|
||||
srfi-4-tests
|
||||
))
|
||||
)
|
||||
|
|
|
|||
|
|
@ -1,3 +1,5 @@
|
|||
#lang scheme/base
|
||||
|
||||
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2)))
|
||||
(require (planet "text-ui.ss" ("schematics" "schemeunit.plt" 2)))
|
||||
(require "all-srfi-tests.ss")
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user