! (c)2009 Joe Groff bsd license
USING: accessors alien.c-types alien.parser alien.syntax
- tools.test vocabs.parser parser eval vocabs.parser debugger
- continuations ;
+ tools.test vocabs.parser parser eval debugger kernel
+ continuations words ;
IN: alien.parser.tests
TYPEDEF: char char2
[ { int 5 } ] [ "int[5]" parse-c-type ] unit-test
[ { int 5 10 11 } ] [ "int[5][10][11]" parse-c-type ] unit-test
[ { int 5 10 eleven } ] [ "int[5][10][eleven]" parse-c-type ] unit-test
- [ void* ] [ "int*" parse-c-type ] unit-test
- [ void* ] [ "int**" parse-c-type ] unit-test
- [ void* ] [ "int***" parse-c-type ] unit-test
- [ void* ] [ "int****" parse-c-type ] unit-test
- [ char* ] [ "char*" parse-c-type ] unit-test
- [ void* ] [ "char**" parse-c-type ] unit-test
- [ void* ] [ "char***" parse-c-type ] unit-test
- [ void* ] [ "char****" parse-c-type ] unit-test
+ [ pointer: void ] [ "void*" parse-c-type ] unit-test
+ [ pointer: int ] [ "int*" parse-c-type ] unit-test
+ [ pointer: int* ] [ "int**" parse-c-type ] unit-test
+ [ pointer: int** ] [ "int***" parse-c-type ] unit-test
+ [ pointer: int*** ] [ "int****" parse-c-type ] unit-test
+ [ pointer: char ] [ "char*" parse-c-type ] unit-test
[ char2 ] [ "char2" parse-c-type ] unit-test
- [ char* ] [ "char2*" parse-c-type ] unit-test
+ [ pointer: char2 ] [ "char2*" parse-c-type ] unit-test
- [ "not-c-type" parse-c-type ] [ no-c-type? ] must-fail-with
[ "not-word" parse-c-type ] [ error>> no-word-error? ] must-fail-with
-
] with-file-vocabs
+ FUNCTION: void* alien-parser-effect-test ( int *arg1 float arg2 ) ;
+ [ (( arg1 arg2 -- void* )) ] [
+ \ alien-parser-effect-test "declared-effect" word-prop
+ ] unit-test
+
! Reported by mnestic
TYPEDEF: int alien-parser-test-int ! reasonably unique name...
{
{ [ dup "void" = ] [ drop void ] }
{ [ CHAR: ] over member? ] [ parse-array-type parse-c-type-name prefix ] }
+ { [ "*" ?tail ] [ (parse-c-type) <pointer> ] }
{ [ dup search ] [ parse-c-type-name ] }
- { [ "**" ?tail ] [ drop void* ] }
- { [ "*" ?tail ] [ parse-c-type-name resolve-pointer-type ] }
[ dup search [ ] [ no-word ] ?if ]
} cond ;
: valid-c-type? ( c-type -- ? )
- { [ array? ] [ c-type-name? ] [ void? ] } 1|| ;
+ { [ array? ] [ c-type-word? ] [ pointer? ] [ void? ] } 1|| ;
: parse-c-type ( string -- type )
(parse-c-type) dup valid-c-type? [ no-c-type ] unless ;
: scan-c-type ( -- c-type )
- scan dup "{" =
- [ drop \ } parse-until >array ]
- [ parse-c-type ] if ;
+ scan {
+ { [ dup "{" = ] [ drop \ } parse-until >array ] }
+ { [ dup "pointer:" = ] [ drop scan-c-type <pointer> ] }
+ [ parse-c-type ]
+ } cond ;
: reset-c-type ( word -- )
dup "struct-size" word-prop
: function-quot ( return library function types -- quot )
'[ _ _ _ _ alien-invoke ] ;
- :: make-function ( return! library function! parameters -- word quot effect )
- return function normalize-c-arg function! return!
+ :: make-function ( return library function parameters -- word quot effect )
+ return function normalize-c-arg :> ( return-c-type function )
function create-in dup reset-generic
- return library function
+ return-c-type library function
parameters return parse-arglist [ function-quot ] dip ;
: parse-arg-tokens ( -- tokens )