]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'master' of git://factorcode.org/git/factor into new-alien-pointers
authorJoe Groff <arcata@gmail.com>
Mon, 22 Feb 2010 07:14:08 +0000 (23:14 -0800)
committerJoe Groff <arcata@gmail.com>
Mon, 22 Feb 2010 07:14:08 +0000 (23:14 -0800)
1  2 
basis/alien/parser/parser-tests.factor
basis/alien/parser/parser.factor

index b7f7b106282e6ce2300d0e02d1a7f2def911767b,2fec2d9a4ce750346a763d0ae1e6cad858949a62..d2aec71f52db0f6ce1de5af42edead1e07a629fa
@@@ -1,7 -1,7 +1,7 @@@
  ! (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
@@@ -18,18 -18,27 +18,23 @@@ CONSTANT: eleven 1
      [ { 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...
  
index dee5c6e1dd9144d8c72fa51591deeada9e38e869,d70644679901be521710a1fdf1f3051783187fc9..837c2e3bdc7f7fe7ae986b2cc609ee6b03f0590d
@@@ -18,23 -18,22 +18,23 @@@ IN: alien.parse
      {
          { [ 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 )