steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Some dlists unit tests added

release
Slava Pestov 2007-11-15 21:44:10 -05:00
parent 1bd8176b4a
commit 0ef46b4234
2 changed files with 26 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
core/dlists/dlists-tests.factor Normal file → Executable file
View File

@ -1,4 +1,6 @@
USING: dlists dlists.private kernel tools.test ;
USING: dlists dlists.private kernel tools.test random assocs
hashtables sequences namespaces sorting debugger io prettyprint
math ;
IN: temporary
[ t ] [ <dlist> dlist-empty? ] unit-test
@ -59,3 +61,23 @@ IN: temporary
[ 0 ] [ <dlist> dlist-length ] unit-test
[ 1 ] [ <dlist> 1 over push-front dlist-length ] unit-test
[ 0 ] [ <dlist> 1 over push-front dup pop-front* dlist-length ] unit-test
: assert-same-elements
[ prune natural-sort ] 2apply assert= ;
: dlist-push-all [ push-front ] curry each ;
: dlist-delete-all [ dlist-delete drop ] curry each ;
: dlist>array [ [ , ] dlist-slurp ] { } make ;
[ ] [
5 [ drop 30 random >fixnum ] map prune
6 [ drop 30 random >fixnum ] map prune 2dup nl . . nl
[
<dlist>
[ dlist-push-all ] keep
[ dlist-delete-all ] keep
dlist>array
] 2keep seq-diff assert-same-elements
] unit-test

3
core/dlists/dlists.factor
View File

@ -121,6 +121,9 @@ PRIVATE>
: delete-node ( quot dlist -- obj/f )
delete-node* drop ; inline
: dlist-delete ( obj dlist -- obj/f )
>r [ eq? ] curry r> delete-node ;
: dlist-each ( dlist quot -- )
[ dlist-node-obj ] swap compose dlist-each-node ; inline