delegate: add support for single-generic protocols, add failing unit test for bug

db4
Slava Pestov 2009-02-09 00:25:33 -06:00
parent cf4e0d78c3
commit 54e4e8873a
2 changed files with 32 additions and 3 deletions

View File

@ -119,4 +119,28 @@ PROTOCOL: silly-protocol do-me ;
CONSULT: silly-protocol a-tuple drop f ; "> <string-reader> "delegate-test" parse-stream
] unit-test
[ ] [ T{ a-tuple } do-me ] unit-test
[ ] [ T{ a-tuple } do-me ] unit-test
! A slot protocol issue
DEFER: slot-protocol-test-3
SLOT: y
[ f ] [ \ y>> \ slot-protocol-test-3 method >boolean ] unit-test
[ [ ] ] [
<" IN: delegate.tests
USING: accessors delegate ;
TUPLE: slot-protocol-test-3 x ;
CONSULT: y>> slot-protocol-test-3 x>> ;">
<string-reader> "delegate-test-1" parse-stream
] unit-test
[ t ] [ \ y>> \ slot-protocol-test-3 method >boolean ] unit-test
[ [ ] ] [
<" IN: delegate.tests
TUPLE: slot-protocol-test-3 x y ;">
<string-reader> "delegate-test-1" parse-stream
] unit-test
[ t ] [ \ y>> \ slot-protocol-test-3 method >boolean ] unit-test

View File

@ -1,8 +1,10 @@
! Copyright (C) 2007, 2008 Daniel Ehrenberg
! Portions copyright (C) 2009 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs classes.tuple definitions
generalizations generic hashtables kernel lexer make math parser
generic.parser sequences sets slots words words.symbol fry ;
generalizations generic generic.standard hashtables kernel
lexer make math parser generic.parser sequences sets slots
words words.symbol fry ;
IN: delegate
: protocol-words ( protocol -- words )
@ -13,6 +15,9 @@ IN: delegate
GENERIC: group-words ( group -- words )
M: standard-generic group-words
dup "combination" word-prop #>> 2array 1array ;
M: tuple-class group-words
all-slots [
name>>