alien.parser: better fix for #1535
These changes ensure that reset-generic is called when parsing alien words. Otherwise problems occur when you redefine generics as callbacks or typedefs.locals-and-roots
parent
69f667edc8
commit
b96077beb7
|
@ -103,3 +103,49 @@ DEFER: struct-redefined
|
||||||
]
|
]
|
||||||
[ error>> error>> redefine-error? ]
|
[ error>> error>> redefine-error? ]
|
||||||
must-fail-with
|
must-fail-with
|
||||||
|
|
||||||
|
[
|
||||||
|
"IN: alien.c-types.tests
|
||||||
|
USE: alien.syntax
|
||||||
|
USE: alien.c-types
|
||||||
|
CALLBACK: void cb987 ( )
|
||||||
|
CALLBACK: void cb987 ( )" eval( -- )
|
||||||
|
]
|
||||||
|
[ error>> error>> redefine-error? ]
|
||||||
|
must-fail-with
|
||||||
|
|
||||||
|
[
|
||||||
|
"IN: alien.c-types.tests
|
||||||
|
USE: alien.syntax
|
||||||
|
USE: alien.c-types
|
||||||
|
FUNCTION: void func987 ( )
|
||||||
|
FUNCTION: void func987 ( )" eval( -- )
|
||||||
|
]
|
||||||
|
[ error>> error>> redefine-error? ]
|
||||||
|
must-fail-with
|
||||||
|
|
||||||
|
! generic -> callback
|
||||||
|
"IN: alien.c-types.tests
|
||||||
|
USE: alien.syntax
|
||||||
|
USE: alien.c-types
|
||||||
|
GENERIC: foo-func ( x -- )
|
||||||
|
" eval( -- )
|
||||||
|
|
||||||
|
"IN: alien.c-types.tests
|
||||||
|
USE: alien.syntax
|
||||||
|
USE: alien.c-types
|
||||||
|
CALLBACK: void foo-func ( )
|
||||||
|
" eval( -- )
|
||||||
|
|
||||||
|
! generic -> typedef
|
||||||
|
"IN: alien.c-types.tests
|
||||||
|
USE: alien.syntax
|
||||||
|
USE: alien.c-types
|
||||||
|
GENERIC: foo-func ( x -- )
|
||||||
|
" eval( -- )
|
||||||
|
|
||||||
|
"IN: alien.c-types.tests
|
||||||
|
USE: alien.syntax
|
||||||
|
USE: alien.c-types
|
||||||
|
TYPEDEF: void* foo-func
|
||||||
|
" eval( -- )
|
||||||
|
|
|
@ -30,7 +30,7 @@ IN: alien.parser.tests
|
||||||
] with-parsing
|
] with-parsing
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ 0 } [
|
{ 1 } [
|
||||||
{ } [
|
{ } [
|
||||||
"hello" current-vocab create-word
|
"hello" current-vocab create-word
|
||||||
old-definitions get first adjoin
|
old-definitions get first adjoin
|
||||||
|
@ -110,3 +110,8 @@ TYPEDEF: int alien-parser-test-int ! reasonably unique name...
|
||||||
"OK!"
|
"OK!"
|
||||||
] [ :1 ] recover
|
] [ :1 ] recover
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
! Redefinitions
|
||||||
|
{ } [
|
||||||
|
[ C-TYPE: hi TYPEDEF: void* hi ] with-compilation-unit
|
||||||
|
] unit-test
|
||||||
|
|
|
@ -63,6 +63,7 @@ ERROR: *-in-c-type-name name ;
|
||||||
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 ]
|
||||||
|
[ reset-generic ]
|
||||||
[ reset-c-type ]
|
[ reset-c-type ]
|
||||||
[ ]
|
[ ]
|
||||||
} cleave ;
|
} cleave ;
|
||||||
|
@ -85,7 +86,7 @@ M: pointer return-type-name to>> return-type-name CHAR: * suffix ;
|
||||||
[ define-enum-value ]
|
[ define-enum-value ]
|
||||||
[ [ 2array suffix! ] [ enum>number 1 + ] bi ] 2bi ;
|
[ [ 2array suffix! ] [ enum>number 1 + ] bi ] 2bi ;
|
||||||
|
|
||||||
: parse-enum-name ( -- name )
|
: parse-enum-name ( -- word )
|
||||||
CREATE-C-TYPE dup save-location ;
|
CREATE-C-TYPE dup save-location ;
|
||||||
|
|
||||||
: parse-enum-base-type ( -- base-type token )
|
: parse-enum-base-type ( -- base-type token )
|
||||||
|
@ -146,7 +147,7 @@ PRIVATE>
|
||||||
'[ [ _ _ _ ] dip alien-callback ] ;
|
'[ [ _ _ _ ] dip alien-callback ] ;
|
||||||
|
|
||||||
:: make-callback-type ( return function library types names -- word quot effect )
|
:: make-callback-type ( return function library types names -- word quot effect )
|
||||||
function (CREATE-C-TYPE) :> type-word
|
function create-function :> type-word
|
||||||
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 library "callback-library" set-word-prop
|
type-word library "callback-library" set-word-prop
|
||||||
|
|
Loading…
Reference in New Issue