alien.parser: fix for #1535
(CREATE-C-TYPE) needs to be called on the word naming the callback. Otherwise the old definition remains in old-definition and you can get a no word found error.locals-and-roots
parent
d902616d12
commit
350e890a03
|
@ -1,9 +1,40 @@
|
||||||
! (c)2009 Joe Groff bsd license
|
! (c)2009 Joe Groff bsd license
|
||||||
USING: accessors alien.c-types alien.parser alien.syntax
|
USING: accessors alien.c-types alien.parser alien.syntax
|
||||||
continuations debugger eval parser tools.test vocabs.parser
|
compiler.units continuations debugger eval kernel namespaces parser
|
||||||
words ;
|
sequences sets tools.test vocabs.parser words ;
|
||||||
IN: alien.parser.tests
|
IN: alien.parser.tests
|
||||||
|
|
||||||
|
! (CREATE-C-TYPE)
|
||||||
|
{ "hello" } [
|
||||||
|
[ "hello" (CREATE-C-TYPE) ] with-compilation-unit
|
||||||
|
name>>
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
! Check that it deletes from old-definitions
|
||||||
|
{ 0 } [
|
||||||
|
[
|
||||||
|
"hello" current-vocab create-word
|
||||||
|
old-definitions get first adjoin
|
||||||
|
"hello" (CREATE-C-TYPE) drop
|
||||||
|
old-definitions get first cardinality
|
||||||
|
] with-compilation-unit
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
! make-callback-type
|
||||||
|
{ "what-type" } [
|
||||||
|
[ f void "what-type" { } { } make-callback-type ] with-compilation-unit
|
||||||
|
2drop name>>
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ 0 } [
|
||||||
|
[
|
||||||
|
"hello" current-vocab create-word
|
||||||
|
old-definitions get first adjoin
|
||||||
|
f void "hello" { } { } make-callback-type 3drop
|
||||||
|
old-definitions get first cardinality
|
||||||
|
] with-compilation-unit
|
||||||
|
] unit-test
|
||||||
|
|
||||||
TYPEDEF: char char2
|
TYPEDEF: char char2
|
||||||
|
|
||||||
SYMBOL: not-c-type
|
SYMBOL: not-c-type
|
||||||
|
|
|
@ -59,7 +59,7 @@ ERROR: *-in-c-type-name name ;
|
||||||
dup "*" tail?
|
dup "*" tail?
|
||||||
[ *-in-c-type-name ] when ;
|
[ *-in-c-type-name ] when ;
|
||||||
|
|
||||||
: (CREATE-C-TYPE) ( word -- word )
|
: (CREATE-C-TYPE) ( name -- word )
|
||||||
validate-c-type-name current-vocab create-word {
|
validate-c-type-name current-vocab create-word {
|
||||||
[ fake-definition ]
|
[ fake-definition ]
|
||||||
[ set-last-word ]
|
[ set-last-word ]
|
||||||
|
@ -146,8 +146,7 @@ PRIVATE>
|
||||||
'[ [ _ _ _ ] dip alien-callback ] ;
|
'[ [ _ _ _ ] dip alien-callback ] ;
|
||||||
|
|
||||||
:: make-callback-type ( lib return type-name types names -- word quot effect )
|
:: make-callback-type ( lib return type-name types names -- word quot effect )
|
||||||
type-name current-vocab create-word :> type-word
|
type-name (CREATE-C-TYPE) :> type-word
|
||||||
type-word [ reset-generic ] [ reset-c-type ] bi
|
|
||||||
void* type-word typedef
|
void* type-word typedef
|
||||||
type-word names return function-effect "callback-effect" set-word-prop
|
type-word names return function-effect "callback-effect" set-word-prop
|
||||||
type-word lib "callback-library" set-word-prop
|
type-word lib "callback-library" set-word-prop
|
||||||
|
|
Loading…
Reference in New Issue