diff --git a/basis/alien/parser/parser-tests.factor b/basis/alien/parser/parser-tests.factor index cb1d44be87..bd299e0a14 100644 --- a/basis/alien/parser/parser-tests.factor +++ b/basis/alien/parser/parser-tests.factor @@ -1,9 +1,40 @@ ! (c)2009 Joe Groff bsd license USING: accessors alien.c-types alien.parser alien.syntax -continuations debugger eval parser tools.test vocabs.parser -words ; +compiler.units continuations debugger eval kernel namespaces parser +sequences sets tools.test vocabs.parser words ; 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 SYMBOL: not-c-type diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor index 843f0410aa..aff4ce00af 100755 --- a/basis/alien/parser/parser.factor +++ b/basis/alien/parser/parser.factor @@ -59,7 +59,7 @@ ERROR: *-in-c-type-name name ; dup "*" tail? [ *-in-c-type-name ] when ; -: (CREATE-C-TYPE) ( word -- word ) +: (CREATE-C-TYPE) ( name -- word ) validate-c-type-name current-vocab create-word { [ fake-definition ] [ set-last-word ] @@ -146,8 +146,7 @@ PRIVATE> '[ [ _ _ _ ] dip alien-callback ] ; :: make-callback-type ( lib return type-name types names -- word quot effect ) - type-name current-vocab create-word :> type-word - type-word [ reset-generic ] [ reset-c-type ] bi + type-name (CREATE-C-TYPE) :> type-word void* type-word typedef type-word names return function-effect "callback-effect" set-word-prop type-word lib "callback-library" set-word-prop