diff --git a/basis/delegate/delegate-tests.factor b/basis/delegate/delegate-tests.factor index 2651a44f32..4b02407735 100644 --- a/basis/delegate/delegate-tests.factor +++ b/basis/delegate/delegate-tests.factor @@ -119,4 +119,28 @@ PROTOCOL: silly-protocol do-me ; CONSULT: silly-protocol a-tuple drop f ; "> "delegate-test" parse-stream ] unit-test -[ ] [ T{ a-tuple } do-me ] unit-test \ No newline at end of file +[ ] [ 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>> ;"> + "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 ;"> + "delegate-test-1" parse-stream +] unit-test + +[ t ] [ \ y>> \ slot-protocol-test-3 method >boolean ] unit-test \ No newline at end of file diff --git a/basis/delegate/delegate.factor b/basis/delegate/delegate.factor index c88c99384f..37277685d5 100644 --- a/basis/delegate/delegate.factor +++ b/basis/delegate/delegate.factor @@ -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>>