Unit test fixes

db4
Slava Pestov 2008-03-27 05:13:52 -05:00
parent 868189e847
commit febcd88459
10 changed files with 19 additions and 22 deletions

View File

@ -99,8 +99,8 @@ unit-test
3
H{ } clone
2 [
2dup [ , f ] cache
2dup [ , f ] cache drop
] times
2drop
] make
] { } make
] unit-test

View File

@ -30,7 +30,7 @@ HELP: class-types
{ $description "Outputs a sequence of builtin type numbers whose instances can possibly be instances of the given class." } ;
HELP: class<
{ $values { "class1" "a class" } { "class2" "a class" } { "?" "a boolean" } }
{ $values { "first" "a class" } { "second" "a class" } { "?" "a boolean" } }
{ $description "Tests if all instances of " { $snippet "class1" } " are also instances of " { $snippet "class2" } "." }
{ $notes "Classes are partially ordered. This means that if " { $snippet "class1 <= class2" } " and " { $snippet "class2 <= class1" } ", then " { $snippet "class1 = class2" } ". Also, if " { $snippet "class1 <= class2" } " and " { $snippet "class2 <= class3" } ", then " { $snippet "class1 <= class3" } "." } ;

View File

@ -81,8 +81,8 @@ unit-test
-12 -13 [ [ 0 swap fixnum- ] 2apply ] compile-call
] unit-test
[ 2 ] [
SBUF" " [ 2 slot 2 [ slot ] keep ] compile-call nip
[ 1 ] [
SBUF" " [ 1 slot 1 [ slot ] keep ] compile-call nip
] unit-test
! Test slow shuffles

View File

@ -5,7 +5,7 @@ TUPLE: foo bar baz ;
C: <foo> foo
[ { "bar" "baz" } ] [ 1 2 <foo> <mirror> keys ] unit-test
[ { "delegate" "bar" "baz" } ] [ 1 2 <foo> <mirror> keys ] unit-test
[ 1 t ] [ "bar" 1 2 <foo> <mirror> at* ] unit-test

View File

@ -5,13 +5,11 @@ arrays classes slots slots.private tuples math vectors
quotations sorting prettyprint ;
IN: mirrors
GENERIC: object-slots ( obj -- seq )
: all-slots ( class -- slots )
superclasses [ "slots" word-prop ] map concat ;
M: object object-slots class "slots" word-prop ;
M: tuple object-slots
dup class superclasses [ "slots" word-prop ] map concat
swap delegate [ 1 tail-slice ] unless ;
: object-slots ( obj -- seq )
class all-slots ;
TUPLE: mirror object slots ;

View File

@ -191,7 +191,7 @@ HELP: define-tuple-predicate
$low-level-note ;
HELP: redefine-tuple-class
{ $values { "class" class } { "superclass" class } { "newslots" "a sequence of strings" } }
{ $values { "class" class } { "superclass" class } { "slots" "a sequence of strings" } }
{ $description "If the new slot layout differs from the existing one, updates all existing instances of this tuple class, and forgets any slot accessor words which are no longer needed."
$nl
"If the class is not a tuple class word, this word does nothing." }

View File

@ -36,7 +36,7 @@ PRIVATE>
[ layout-size swap [ array-nth ] curry map ] keep
layout-class add* ;
: >tuple ( sequence -- tuple )
: >tuple ( seq -- tuple )
dup first tuple-layout <tuple> [
>r 1 tail-slice dup length r>
[ tuple-size min ] keep

View File

@ -1,7 +1,7 @@
USING: kernel words inspector slots quotations sequences assocs
math arrays inference effects shuffle continuations debugger
tuples namespaces vectors bit-arrays byte-arrays strings sbufs
math.functions macros sequences.private combinators ;
math.functions macros sequences.private combinators mirrors ;
IN: inverse
TUPLE: fail ;
@ -191,7 +191,7 @@ MACRO: undo ( quot -- ) [undo] ;
"predicate" word-prop [ dupd call assure ] curry ;
: slot-readers ( class -- quot )
"slots" word-prop 1 tail ! tail gets rid of delegate
all-slots 1 tail ! tail gets rid of delegate
[ slot-spec-reader 1quotation [ keep ] curry ] map concat
[ ] like [ drop ] compose ;

View File

@ -1,5 +1,5 @@
USING: kernel sequences slots parser words classes
slots.private ;
slots.private mirrors ;
IN: tuple-syntax
! TUPLE: foo bar baz ;
@ -10,8 +10,7 @@ IN: tuple-syntax
: parse-slot-writer ( tuple -- slot# )
scan dup "}" = [ 2drop f ] [
1 head* swap class "slots" word-prop
[ slot-spec-name = ] with find nip slot-spec-offset
1 head* swap object-slots slot-named slot-spec-offset
] if ;
: parse-slots ( accum tuple -- accum tuple )

6
extra/tuples/lib/lib.factor Normal file → Executable file
View File

@ -1,16 +1,16 @@
! Copyright (C) 2007 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel macros sequences slots words ;
USING: kernel macros sequences slots words mirrors ;
IN: tuples.lib
: reader-slots ( seq -- quot )
[ slot-spec-reader ] map [ get-slots ] curry ;
MACRO: >tuple< ( class -- )
"slots" word-prop 1 tail-slice reader-slots ;
all-slots 1 tail-slice reader-slots ;
MACRO: >tuple*< ( class -- )
"slots" word-prop
all-slots
[ slot-spec-name "*" tail? ] subset
reader-slots ;