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

classes.tuple: Save slot name and tuple in no-slot error.

db4
Doug Coleman 2012-07-24 14:05:58 -07:00
parent fe457b5773
commit 178f79decf
2 changed files with 43 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
core/classes/tuple/tuple-tests.factor
View File

@ -6,7 +6,8 @@ io.streams.string kernel kernel.private math math.constants
math.order namespaces parser parser.notes prettyprint math.order namespaces parser parser.notes prettyprint
quotations random see sequences sequences.private slots quotations random see sequences sequences.private slots
slots.private splitting strings summary threads tools.test slots.private splitting strings summary threads tools.test
vectors vocabs words words.symbol fry literals memory ; vectors vocabs words words.symbol fry literals memory
combinators.short-circuit ;
IN: classes.tuple.tests IN: classes.tuple.tests
TUPLE: rect x y w h ; TUPLE: rect x y w h ;
@ -837,3 +838,41 @@ DEFER: initial-slot
[ "IN: classes.tuple.tests USE: math TUPLE: foo < foo ;" eval( -- ) ] [ error>> bad-superclass? ] must-fail-with [ "IN: classes.tuple.tests USE: math TUPLE: foo < foo ;" eval( -- ) ] [ error>> bad-superclass? ] must-fail-with
[ "IN: classes.tuple.tests USE: math TUPLE: foo < + ;" eval( -- ) ] [ error>> bad-superclass? ] must-fail-with [ "IN: classes.tuple.tests USE: math TUPLE: foo < + ;" eval( -- ) ] [ error>> bad-superclass? ] must-fail-with
! Test no-slot error and get/set-slot-named
TUPLE: no-slot-tuple0 a b c ;
C: <no-slot-tuple0> no-slot-tuple0
[ 1 2 3 <no-slot-tuple0> "d" over get-slot-named ]
[
{
[ no-slot? ]
[ tuple>> no-slot-tuple0? ]
[ name>> "d" = ]
} 1&&
] must-fail-with
{ 1 }
[ 1 2 3 <no-slot-tuple0> "a" swap get-slot-named ] unit-test
{ 2 }
[ 1 2 3 <no-slot-tuple0> "b" swap get-slot-named ] unit-test
{ 3 }
[ 1 2 3 <no-slot-tuple0> "c" swap get-slot-named ] unit-test
{ 4 } [
1 2 3 <no-slot-tuple0> 4 "a" pick set-slot-named
"a" swap get-slot-named
] unit-test
[ 1 2 3 <no-slot-tuple0> 4 "d" pick set-slot-named ]
[
{
[ no-slot? ]
[ tuple>> no-slot-tuple0? ]
[ name>> "d" = ]
} 1&&
] must-fail-with

5
core/classes/tuple/tuple.factor
View File

@ -16,10 +16,11 @@ ERROR: not-a-tuple object ;
: all-slots ( class -- slots ) : all-slots ( class -- slots )
superclasses [ "slots" word-prop ] map concat ; superclasses [ "slots" word-prop ] map concat ;
ERROR: no-slot ; ERROR: no-slot name tuple ;
: offset-of-slot ( name tuple -- n ) : offset-of-slot ( name tuple -- n )
class-of all-slots slot-named dup [ no-slot ] unless offset>> ; 2dup class-of all-slots slot-named
[ 2nip offset>> ] [ no-slot ] if* ;
: get-slot-named ( name tuple -- value ) : get-slot-named ( name tuple -- value )
[ nip ] [ offset-of-slot ] 2bi slot ; [ nip ] [ offset-of-slot ] 2bi slot ;