diff --git a/basis/alien/parser/parser-tests.factor b/basis/alien/parser/parser-tests.factor index bd299e0a14..de2d3bc303 100644 --- a/basis/alien/parser/parser-tests.factor +++ b/basis/alien/parser/parser-tests.factor @@ -1,38 +1,47 @@ ! (c)2009 Joe Groff bsd license -USING: accessors alien.c-types alien.parser alien.syntax -compiler.units continuations debugger eval kernel namespaces parser -sequences sets tools.test vocabs.parser words ; +USING: accessors alien.c-types alien.parser alien.parser.private +alien.syntax compiler.units continuations debugger eval fry kernel +lexer namespaces parser sequences sets tools.test vocabs.parser words +; IN: alien.parser.tests +: with-parsing ( lines quot -- ) + [ ] [ '[ _ with-compilation-unit ] ] bi* with-lexer ; inline + ! (CREATE-C-TYPE) { "hello" } [ - [ "hello" (CREATE-C-TYPE) ] with-compilation-unit - name>> + { "hello" } [ CREATE-C-TYPE name>> ] with-parsing ] 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 + ] with-parsing ] unit-test ! make-callback-type { "what-type" } [ - [ f void "what-type" { } { } make-callback-type ] with-compilation-unit - 2drop name>> + { } [ + void "what-type" f { } { } make-callback-type 2drop name>> + ] with-parsing ] unit-test { 0 } [ - [ + { } [ "hello" current-vocab create-word old-definitions get first adjoin - f void "hello" { } { } make-callback-type 3drop + void "hello" f { } { } make-callback-type 3drop old-definitions get first cardinality - ] with-compilation-unit + ] with-parsing +] unit-test + +! parse-enum-name +{ t } [ + { "ayae" } [ parse-enum-name new-definitions get first in? ] with-parsing ] unit-test TYPEDEF: char char2 diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor index aff4ce00af..2ada0714d8 100755 --- a/basis/alien/parser/parser.factor +++ b/basis/alien/parser/parser.factor @@ -145,16 +145,15 @@ PRIVATE> : callback-quot ( return types abi -- quot ) '[ [ _ _ _ ] dip alien-callback ] ; -:: make-callback-type ( lib return type-name types names -- word quot effect ) - type-name (CREATE-C-TYPE) :> type-word +:: make-callback-type ( return function library types names -- word quot effect ) + function (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 - type-word return types lib library-abi callback-quot ( quot -- alien ) ; + type-word library "callback-library" set-word-prop + type-word return types library library-abi callback-quot ( quot -- alien ) ; : (CALLBACK:) ( -- word quot effect ) - current-library get - scan-function-name scan-c-args make-callback-type ; + (FUNCTION:) make-callback-type ; PREDICATE: alien-function-alias-word < word def>> { diff --git a/basis/gobject-introspection/ffi/ffi.factor b/basis/gobject-introspection/ffi/ffi.factor index 6909285a57..c501958c93 100644 --- a/basis/gobject-introspection/ffi/ffi.factor +++ b/basis/gobject-introspection/ffi/ffi.factor @@ -180,9 +180,9 @@ M: type type>data-type : def-callback-type ( callback -- ) { - [ drop current-library get ] [ return>> return-c-type ] [ c-type>> ] + [ drop current-library get ] [ ?suffix-parameters-with-error parameter-names&types ] } cleave make-callback-type define-inline ; @@ -258,9 +258,9 @@ M: array-type field-type>c-type type>c-type ; :: def-signal ( signal type -- ) signal { - [ drop current-library get ] [ return>> return-c-type ] [ type signal-name ] + [ drop current-library get ] [ parameters>> type type>parameter prefix user-data-parameter suffix parameter-names&types