diff --git a/basis/compiler/tree/cleanup/cleanup-tests.factor b/basis/compiler/tree/cleanup/cleanup-tests.factor index 4947cb365d..2c5c469201 100644 --- a/basis/compiler/tree/cleanup/cleanup-tests.factor +++ b/basis/compiler/tree/cleanup/cleanup-tests.factor @@ -526,3 +526,18 @@ USING: alien alien.c-types ; [ int { } cdecl [ 2 2 + ] alien-callback ] { + } inlined? ] unit-test + +[ t ] [ + [ double { double double } cdecl [ + ] alien-callback ] + \ + inlined? +] unit-test + +[ f ] [ + [ double { double double } cdecl [ + ] alien-callback ] + \ float+ inlined? +] unit-test + +[ f ] [ + [ char { char char } cdecl [ + ] alien-callback ] + \ fixnum+fast inlined? +] unit-test diff --git a/basis/stack-checker/alien/alien.factor b/basis/stack-checker/alien/alien.factor index 5489db00ab..6e9314792f 100644 --- a/basis/stack-checker/alien/alien.factor +++ b/basis/stack-checker/alien/alien.factor @@ -6,6 +6,7 @@ alien.private alien.c-types fry quotations strings stack-checker.backend stack-checker.errors stack-checker.visitor stack-checker.dependencies stack-checker.state compiler.utilities effects ; +FROM: kernel.private => declare ; IN: stack-checker.alien TUPLE: alien-node-params @@ -113,13 +114,16 @@ TUPLE: alien-callback-params < alien-node-params xt ; : callback-return-quot ( ctype -- quot ) return>> [ [ ] ] [ c-type c-type-unboxer-quot ] if-void ; -: callback-prep-quot ( params -- quot ) - parameters>> [ c-type c-type-boxer-quot ] map spread>quot ; +: callback-parameter-quot ( params -- quot ) + parameters>> [ c-type ] map + [ [ c-type-class ] map '[ _ declare ] ] + [ [ c-type-boxer-quot ] map spread>quot ] + bi append ; GENERIC: wrap-callback-quot ( params quot -- quot' ) M: callable wrap-callback-quot - swap [ callback-prep-quot ] [ callback-return-quot ] bi surround + swap [ callback-parameter-quot ] [ callback-return-quot ] bi surround yield-hook get '[ _ _ do-callback ] >quotation ;