1 USING: accessors alien alien.c-types alien.libraries
2 alien.syntax arrays classes.struct combinators
3 compiler continuations effects generalizations io
4 io.backend io.pathnames io.streams.string kernel
5 math memory namespaces namespaces.private parser
6 quotations sequences specialized-arrays stack-checker
7 stack-checker.errors system threads tools.test words
8 alien.complex concurrency.promises alien.data
10 FROM: alien.c-types => float short ;
11 SPECIALIZED-ARRAY: float
12 SPECIALIZED-ARRAY: char
13 IN: compiler.tests.alien
15 ! Make sure that invalid inputs don't pass the stack checker
16 [ [ void { } "cdecl" alien-indirect ] infer ] must-fail
17 [ [ "void" { } cdecl alien-indirect ] infer ] must-fail
18 [ [ void* 3 cdecl alien-indirect ] infer ] must-fail
19 [ [ void* { "int" } cdecl alien-indirect ] infer ] must-fail
20 [ [ void* { int } cdecl { } alien-callback ] infer ] must-fail
23 : libfactor-ffi-tests-path ( -- string )
24 "resource:" absolute-path
26 { [ os winnt? ] [ "libfactor-ffi-test.dll" ] }
27 { [ os macosx? ] [ "libfactor-ffi-test.dylib" ] }
28 { [ os unix? ] [ "libfactor-ffi-test.so" ] }
31 : mingw? ( -- ? ) os windows? vm-compiler "GCC" head? and ;
33 "f-cdecl" libfactor-ffi-tests-path mingw? mingw cdecl ? add-library
35 "f-stdcall" libfactor-ffi-tests-path stdcall add-library
37 "f-fastcall" libfactor-ffi-tests-path fastcall add-library
42 FUNCTION: void ffi_test_0 ;
43 [ ] [ ffi_test_0 ] unit-test
45 FUNCTION: int ffi_test_1 ;
46 [ 3 ] [ ffi_test_1 ] unit-test
48 FUNCTION: int ffi_test_2 int x int y ;
49 [ 5 ] [ 2 3 ffi_test_2 ] unit-test
50 [ "hi" 3 ffi_test_2 ] must-fail
52 FUNCTION: int ffi_test_3 int x int y int z int t ;
53 [ 25 ] [ 2 3 4 5 ffi_test_3 ] unit-test
55 FUNCTION: float ffi_test_4 ;
56 [ 1.5 ] [ ffi_test_4 ] unit-test
58 FUNCTION: double ffi_test_5 ;
59 [ 1.5 ] [ ffi_test_5 ] unit-test
61 FUNCTION: int ffi_test_9 int a int b int c int d int e int f int g ;
62 [ 28 ] [ 1 2 3 4 5 6 7 ffi_test_9 ] unit-test
63 [ "a" 2 3 4 5 6 7 ffi_test_9 ] must-fail
64 [ 1 2 3 4 5 6 "a" ffi_test_9 ] must-fail
66 STRUCT: FOO { x int } { y int } ;
68 : make-FOO ( x y -- FOO )
69 FOO <struct> swap >>y swap >>x ;
71 FUNCTION: int ffi_test_11 int a FOO b int c ;
73 [ 14 ] [ 1 2 3 make-FOO 4 ffi_test_11 ] unit-test
75 FUNCTION: int ffi_test_13 int a int b int c int d int e int f int g int h int i int j int k ;
77 [ 66 ] [ 1 2 3 4 5 6 7 8 9 10 11 ffi_test_13 ] unit-test
79 FUNCTION: FOO ffi_test_14 int x int y ;
81 [ 11 6 ] [ 11 6 ffi_test_14 [ x>> ] [ y>> ] bi ] unit-test
83 FUNCTION: c-string ffi_test_15 c-string x c-string y ;
85 [ "foo" ] [ "xy" "zt" ffi_test_15 ] unit-test
86 [ "bar" ] [ "xy" "xy" ffi_test_15 ] unit-test
87 [ 1 2 ffi_test_15 ] must-fail
89 STRUCT: BAR { x long } { y long } { z long } ;
91 FUNCTION: BAR ffi_test_16 long x long y long z ;
94 11 6 -7 ffi_test_16 [ x>> ] [ y>> ] [ z>> ] tri
97 STRUCT: TINY { x int } ;
99 FUNCTION: TINY ffi_test_17 int x ;
101 [ 11 ] [ 11 ffi_test_17 x>> ] unit-test
103 [ [ alien-indirect ] infer ] [ inference-error? ] must-fail-with
105 : indirect-test-1 ( ptr -- result )
106 int { } cdecl alien-indirect ;
108 { 1 1 } [ indirect-test-1 ] must-infer-as
110 [ 3 ] [ &: ffi_test_1 indirect-test-1 ] unit-test
112 : indirect-test-1' ( ptr -- )
113 int { } cdecl alien-indirect drop ;
115 { 1 0 } [ indirect-test-1' ] must-infer-as
117 [ ] [ &: ffi_test_1 indirect-test-1' ] unit-test
119 [ -1 indirect-test-1 ] must-fail
121 : indirect-test-2 ( x y ptr -- result )
122 int { int int } cdecl alien-indirect gc ;
124 { 3 1 } [ indirect-test-2 ] must-infer-as
127 [ 2 3 &: ffi_test_2 indirect-test-2 ]
130 : indirect-test-3 ( a b c d ptr -- result )
131 int { int int int int } stdcall alien-indirect
134 [ f ] [ "f-stdcall" load-library f = ] unit-test
135 [ stdcall ] [ "f-stdcall" library abi>> ] unit-test
137 : ffi_test_18 ( w x y z -- int )
138 int "f-stdcall" "ffi_test_18" { int int int int }
141 [ 25 ] [ 2 3 4 5 ffi_test_18 ] unit-test
143 : ffi_test_19 ( x y z -- BAR )
144 BAR "f-stdcall" "ffi_test_19" { long long long }
148 11 6 -7 ffi_test_19 [ x>> ] [ y>> ] [ z>> ] tri
151 : multi_ffi_test_18 ( w x y z w' x' y' z' -- int int )
152 [ int "f-stdcall" "ffi_test_18" { int int int int } alien-invoke ]
154 int "f-stdcall" "ffi_test_18" { int int int int } alien-invoke
157 [ 25 85 ] [ 2 3 4 5 6 7 8 9 multi_ffi_test_18 ] unit-test
159 FUNCTION: double ffi_test_6 float x float y ;
160 [ 6.0 ] [ 3.0 2.0 ffi_test_6 ] unit-test
161 [ "a" "b" ffi_test_6 ] must-fail
163 FUNCTION: double ffi_test_7 double x double y ;
164 [ 6.0 ] [ 3.0 2.0 ffi_test_7 ] unit-test
166 FUNCTION: double ffi_test_8 double x float y double z float t int w ;
167 [ 19.0 ] [ 3.0 2.0 1.0 6.0 7 ffi_test_8 ] unit-test
169 FUNCTION: int ffi_test_10 int a int b double c int d float e int f int g int h ;
170 [ -34 ] [ 1 2 3.0 4 5.0 6 7 8 ffi_test_10 ] unit-test
172 FUNCTION: void ffi_test_20 double x1, double x2, double x3,
173 double y1, double y2, double y3,
174 double z1, double z2, double z3 ;
176 [ ] [ 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 ffi_test_20 ] unit-test
178 ! Make sure XT doesn't get clobbered in stack frame
180 : ffi_test_31 ( a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a -- result y )
182 "f-cdecl" "ffi_test_31"
183 { int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int }
186 [ 861 3 ] [ 42 [ ] each-integer ffi_test_31 ] unit-test
188 : ffi_test_31_point_5 ( a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a -- result )
190 "f-cdecl" "ffi_test_31_point_5"
191 { float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float }
194 [ 861.0 ] [ 42 [ >float ] each-integer ffi_test_31_point_5 ] unit-test
196 FUNCTION: longlong ffi_test_21 long x long y ;
198 [ 121932631112635269 ]
199 [ 123456789 987654321 ffi_test_21 ] unit-test
201 FUNCTION: long ffi_test_22 long x longlong y longlong z ;
204 [ 1111 121932631112635269 123456789 ffi_test_22 ] unit-test
206 [ 1111 f 123456789 ffi_test_22 ] must-fail
209 { x float } { y float }
210 { w float } { h float } ;
212 : <RECT> ( x y w h -- rect )
219 FUNCTION: int ffi_test_12 int a int b RECT c int d int e int f ;
221 [ 45 ] [ 1 2 3.0 4.0 5.0 6.0 <RECT> 7 8 9 ffi_test_12 ] unit-test
223 [ 1 2 { 1 2 3 } 7 8 9 ffi_test_12 ] must-fail
225 FUNCTION: float ffi_test_23 ( float[3] x, float[3] y ) ;
228 { 1.0 2.0 3.0 } >float-array
229 { 4.0 5.0 6.0 } >float-array
233 ! Test odd-size structs
234 STRUCT: test-struct-1 { x char[1] } ;
236 FUNCTION: test-struct-1 ffi_test_24 ;
238 [ S{ test-struct-1 { x char-array{ 1 } } } ] [ ffi_test_24 ] unit-test
240 STRUCT: test-struct-2 { x char[2] } ;
242 FUNCTION: test-struct-2 ffi_test_25 ;
244 [ S{ test-struct-2 { x char-array{ 1 2 } } } ] [ ffi_test_25 ] unit-test
246 STRUCT: test-struct-3 { x char[3] } ;
248 FUNCTION: test-struct-3 ffi_test_26 ;
250 [ S{ test-struct-3 { x char-array{ 1 2 3 } } } ] [ ffi_test_26 ] unit-test
252 STRUCT: test-struct-4 { x char[4] } ;
254 FUNCTION: test-struct-4 ffi_test_27 ;
256 [ S{ test-struct-4 { x char-array{ 1 2 3 4 } } } ] [ ffi_test_27 ] unit-test
258 STRUCT: test-struct-5 { x char[5] } ;
260 FUNCTION: test-struct-5 ffi_test_28 ;
262 [ S{ test-struct-5 { x char-array{ 1 2 3 4 5 } } } ] [ ffi_test_28 ] unit-test
264 STRUCT: test-struct-6 { x char[6] } ;
266 FUNCTION: test-struct-6 ffi_test_29 ;
268 [ S{ test-struct-6 { x char-array{ 1 2 3 4 5 6 } } } ] [ ffi_test_29 ] unit-test
270 STRUCT: test-struct-7 { x char[7] } ;
272 FUNCTION: test-struct-7 ffi_test_30 ;
274 [ S{ test-struct-7 { x char-array{ 1 2 3 4 5 6 7 } } } ] [ ffi_test_30 ] unit-test
276 STRUCT: test-struct-8 { x double } { y double } ;
278 FUNCTION: double ffi_test_32 test-struct-8 x int y ;
281 test-struct-8 <struct>
287 STRUCT: test-struct-9 { x float } { y float } ;
289 FUNCTION: double ffi_test_33 test-struct-9 x int y ;
292 test-struct-9 <struct>
298 STRUCT: test-struct-10 { x float } { y int } ;
300 FUNCTION: double ffi_test_34 test-struct-10 x int y ;
303 test-struct-10 <struct>
309 STRUCT: test-struct-11 { x int } { y int } ;
311 FUNCTION: double ffi_test_35 test-struct-11 x int y ;
314 test-struct-11 <struct>
320 STRUCT: test-struct-12 { a int } { x double } ;
322 : make-struct-12 ( x -- alien )
323 test-struct-12 <struct>
326 FUNCTION: double ffi_test_36 ( test-struct-12 x ) ;
328 [ 1.23456 ] [ 1.23456 make-struct-12 ffi_test_36 ] unit-test
330 FUNCTION: ulonglong ffi_test_38 ( ulonglong x, ulonglong y ) ;
332 [ t ] [ 31 2^ 32 2^ ffi_test_38 63 2^ = ] unit-test
336 : callback-1 ( -- callback ) void { } cdecl [ ] alien-callback ;
338 [ 0 1 ] [ [ callback-1 ] infer [ in>> length ] [ out>> length ] bi ] unit-test
340 [ t ] [ callback-1 alien? ] unit-test
342 : callback_test_1 ( ptr -- ) void { } cdecl alien-indirect ;
344 [ ] [ callback-1 callback_test_1 ] unit-test
346 : callback-2 ( -- callback ) void { } cdecl [ [ 5 throw ] ignore-errors ] alien-callback ;
348 [ ] [ callback-2 callback_test_1 ] unit-test
350 : callback-3 ( -- callback ) void { } cdecl [ 5 "x" set ] alien-callback ;
355 3 "x" set callback-3 callback_test_1
357 "x" get "x" get-global
361 : callback-5 ( -- callback )
362 void { } cdecl [ gc ] alien-callback ;
365 "testing" callback-5 callback_test_1
368 : callback-5b ( -- callback )
369 void { } cdecl [ compact-gc ] alien-callback ;
372 "testing" callback-5b callback_test_1
375 : callback-6 ( -- callback )
376 void { } cdecl [ [ continue ] callcc0 ] alien-callback ;
378 [ 1 2 3 ] [ callback-6 callback_test_1 1 2 3 ] unit-test
380 : callback-7 ( -- callback )
381 void { } cdecl [ 1000000 sleep ] alien-callback ;
383 [ 1 2 3 ] [ callback-7 callback_test_1 1 2 3 ] unit-test
385 [ f ] [ namespace global eq? ] unit-test
387 : callback-8 ( -- callback )
388 void { } cdecl [ [ ] in-thread yield ] alien-callback ;
390 [ ] [ callback-8 callback_test_1 ] unit-test
392 : callback-9 ( -- callback )
393 int { int int int } cdecl [
397 FUNCTION: void ffi_test_36_point_5 ( ) ;
399 [ ] [ ffi_test_36_point_5 ] unit-test
401 FUNCTION: int ffi_test_37 ( void* func ) ;
403 [ 1 ] [ callback-9 ffi_test_37 ] unit-test
405 [ 7 ] [ callback-9 ffi_test_37 ] unit-test
407 STRUCT: test_struct_13
415 : make-test-struct-13 ( -- alien )
416 test_struct_13 <struct>
424 FUNCTION: int ffi_test_39 ( long a, long b, test_struct_13 s ) ;
426 [ 21 ] [ 12347 12347 make-test-struct-13 ffi_test_39 ] unit-test
428 ! Joe Groff found this problem
435 : <double-rect> ( a b c d -- foo )
442 : >double-rect< ( foo -- a b c d )
450 : double-rect-callback ( -- alien )
451 void { void* void* double-rect } cdecl
452 [ "example" set-global 2drop ] alien-callback ;
454 : double-rect-test ( arg callback -- arg' )
456 void { void* void* double-rect } cdecl alien-indirect
457 "example" get-global ;
459 [ byte-array 1.0 2.0 3.0 4.0 ]
461 1.0 2.0 3.0 4.0 <double-rect>
462 double-rect-callback double-rect-test
463 [ >c-ptr class ] [ >double-rect< ] bi
466 STRUCT: test_struct_14
470 FUNCTION: test_struct_14 ffi_test_40 ( double x1, double x2 ) ;
473 1.0 2.0 ffi_test_40 [ x1>> ] [ x2>> ] bi
476 : callback-10 ( -- callback )
477 test_struct_14 { double double } cdecl
479 test_struct_14 <struct>
484 : callback-10-test ( x1 x2 callback -- result )
485 test_struct_14 { double double } cdecl alien-indirect ;
488 1.0 2.0 callback-10 callback-10-test
492 FUNCTION: test-struct-12 ffi_test_41 ( int a, double x ) ;
499 : callback-11 ( -- callback )
500 test-struct-12 { int double } cdecl
502 test-struct-12 <struct>
507 : callback-11-test ( x1 x2 callback -- result )
508 test-struct-12 { int double } cdecl alien-indirect ;
511 1 2.0 callback-11 callback-11-test
515 STRUCT: test_struct_15
519 FUNCTION: test_struct_15 ffi_test_42 ( float x, float y ) ;
521 [ 1.0 2.0 ] [ 1.0 2.0 ffi_test_42 [ x>> ] [ y>> ] bi ] unit-test
523 : callback-12 ( -- callback )
524 test_struct_15 { float float } cdecl
526 test_struct_15 <struct>
531 : callback-12-test ( x1 x2 callback -- result )
532 test_struct_15 { float float } cdecl alien-indirect ;
535 1.0 2.0 callback-12 callback-12-test [ x>> ] [ y>> ] bi
538 STRUCT: test_struct_16
542 FUNCTION: test_struct_16 ffi_test_43 ( float x, int a ) ;
544 [ 1.0 2 ] [ 1.0 2 ffi_test_43 [ x>> ] [ a>> ] bi ] unit-test
546 : callback-13 ( -- callback )
547 test_struct_16 { float int } cdecl
549 test_struct_16 <struct>
554 : callback-13-test ( x1 x2 callback -- result )
555 test_struct_16 { float int } cdecl alien-indirect ;
558 1.0 2 callback-13 callback-13-test
562 FUNCTION: test_struct_14 ffi_test_44 ( ) ; inline
564 [ 1.0 2.0 ] [ ffi_test_44 [ x1>> ] [ x2>> ] bi ] unit-test
566 : stack-frame-bustage ( -- a b ) ffi_test_44 gc 3 ;
568 [ ] [ stack-frame-bustage 2drop ] unit-test
573 FUNCTION: complex-float ffi_test_45 ( int x ) ;
575 [ C{ 3.0 0.0 } ] [ 3 ffi_test_45 ] unit-test
577 FUNCTION: complex-double ffi_test_46 ( int x ) ;
579 [ C{ 3.0 0.0 } ] [ 3 ffi_test_46 ] unit-test
581 FUNCTION: complex-float ffi_test_47 ( complex-float x, complex-double y ) ;
585 C{ 1.5 1.0 } ffi_test_47
589 STRUCT: bool-field-test
594 FUNCTION: short ffi_test_48 ( bool-field-test x ) ;
597 bool-field-test <struct>
604 ! Test interaction between threads and callbacks
605 : thread-callback-1 ( -- callback )
606 int { } cdecl [ yield 100 ] alien-callback ;
608 : thread-callback-2 ( -- callback )
609 int { } cdecl [ yield 200 ] alien-callback ;
611 : thread-callback-invoker ( callback -- n )
612 int { } cdecl alien-indirect ;
615 [ thread-callback-1 thread-callback-invoker "p" get fulfill ] in-thread
616 [ 200 ] [ thread-callback-2 thread-callback-invoker ] unit-test
617 [ 100 ] [ "p" get ?promise ] unit-test
619 ! More alien-assembly tests are in cpu.* vocabs
620 : assembly-test-1 ( -- ) void { } cdecl [ ] alien-assembly ;
622 [ ] [ assembly-test-1 ] unit-test
624 [ f ] [ "f-fastcall" load-library f = ] unit-test
625 [ fastcall ] [ "f-fastcall" library abi>> ] unit-test
627 : ffi_test_49 ( x -- int )
628 int "f-fastcall" "ffi_test_49" { int }
630 : ffi_test_50 ( x y -- int )
631 int "f-fastcall" "ffi_test_50" { int int }
633 : ffi_test_51 ( x y z -- int )
634 int "f-fastcall" "ffi_test_51" { int int int }
636 : multi_ffi_test_51 ( x y z x' y' z' -- int int )
637 [ int "f-fastcall" "ffi_test_51" { int int int } alien-invoke ]
639 int "f-fastcall" "ffi_test_51" { int int int } alien-invoke gc ;
641 [ 4 ] [ 3 ffi_test_49 ] unit-test
642 [ 8 ] [ 3 4 ffi_test_50 ] unit-test
643 [ 13 ] [ 3 4 5 ffi_test_51 ] unit-test
644 [ 13 22 ] [ 3 4 5 6 7 8 multi_ffi_test_51 ] unit-test
646 : ffi_test_52 ( x y z -- int )
647 int "f-fastcall" "ffi_test_52" { int float int }
649 : ffi_test_53 ( x y z w -- int )
650 int "f-fastcall" "ffi_test_53" { int float int int }
652 : ffi_test_57 ( x y -- test-struct-11 )
653 test-struct-11 "f-fastcall" "ffi_test_57" { int int }
655 : ffi_test_58 ( x y z -- test-struct-11 )
656 test-struct-11 "f-fastcall" "ffi_test_58" { int int int }
661 [ 13 ] [ 3 4.0 5 ffi_test_52 ] unit-test
663 [ 19 ] [ 3 4.0 5 6 ffi_test_53 ] unit-test
666 [ S{ test-struct-11 f 7 -1 } ] [ 3 4 ffi_test_57 ] unit-test
668 [ S{ test-struct-11 f 7 -3 } ] [ 3 4 7 ffi_test_58 ] unit-test
670 : fastcall-ii-indirect ( x y ptr -- result )
671 int { int int } fastcall alien-indirect ;
673 : fastcall-iii-indirect ( x y z ptr -- result )
674 int { int int int } fastcall alien-indirect ;
676 : fastcall-ifi-indirect ( x y z ptr -- result )
677 int { int float int } fastcall alien-indirect ;
679 : fastcall-ifii-indirect ( x y z w ptr -- result )
680 int { int float int int } fastcall alien-indirect ;
682 : fastcall-struct-return-ii-indirect ( x y ptr -- result )
683 test-struct-11 { int int } fastcall alien-indirect ;
685 : fastcall-struct-return-iii-indirect ( x y z ptr -- result )
686 test-struct-11 { int int int } fastcall alien-indirect ;
688 : win32? ( -- ? ) os windows? cpu x86.32? and ;
692 win32? [ &: @ffi_test_50@8 ] [ &: ffi_test_50 ] if
698 win32? [ &: @ffi_test_51@12 ] [ &: ffi_test_51 ] if
699 fastcall-iii-indirect
705 win32? [ &: @ffi_test_52@12 ] [ &: ffi_test_52 ] if
706 fastcall-ifi-indirect
711 win32? [ &: @ffi_test_53@16 ] [ &: ffi_test_53 ] if
712 fastcall-ifii-indirect
716 [ S{ test-struct-11 f 7 -1 } ]
719 win32? [ &: @ffi_test_57@8 ] [ &: ffi_test_57 ] if
720 fastcall-struct-return-ii-indirect
723 [ S{ test-struct-11 f 7 -3 } ]
726 win32? [ &: @ffi_test_58@12 ] [ &: ffi_test_58 ] if
727 fastcall-struct-return-iii-indirect
730 : fastcall-ii-callback ( -- ptr )
731 int { int int } fastcall [ + 1 + ] alien-callback ;
733 : fastcall-iii-callback ( -- ptr )
734 int { int int int } fastcall [ + + 1 + ] alien-callback ;
736 : fastcall-ifi-callback ( -- ptr )
737 int { int float int } fastcall
738 [ [ >integer ] dip + + 1 + ] alien-callback ;
740 : fastcall-ifii-callback ( -- ptr )
741 int { int float int int } fastcall
742 [ [ >integer ] 2dip + + + 1 + ] alien-callback ;
744 : fastcall-struct-return-ii-callback ( -- ptr )
745 test-struct-11 { int int } fastcall
746 [ [ + ] [ - ] 2bi test-struct-11 <struct-boa> ] alien-callback ;
748 : fastcall-struct-return-iii-callback ( -- ptr )
749 test-struct-11 { int int int } fastcall
750 [ [ drop + ] [ - nip ] 3bi test-struct-11 <struct-boa> ] alien-callback ;
752 [ 8 ] [ 3 4 fastcall-ii-callback fastcall-ii-indirect ] unit-test
754 [ 13 ] [ 3 4 5 fastcall-iii-callback fastcall-iii-indirect ] unit-test
756 [ 13 ] [ 3 4.0 5 fastcall-ifi-callback fastcall-ifi-indirect ] unit-test
758 [ 19 ] [ 3 4.0 5 6 fastcall-ifii-callback fastcall-ifii-indirect ] unit-test
760 [ S{ test-struct-11 f 7 -1 } ]
761 [ 3 4 fastcall-struct-return-ii-callback fastcall-struct-return-ii-indirect ] unit-test
763 [ S{ test-struct-11 f 7 -3 } ]
764 [ 3 4 7 fastcall-struct-return-iii-callback fastcall-struct-return-iii-indirect ] unit-test
766 : x64-regression-1 ( -- c )
767 int { int int int int int } cdecl [ + + + + ] alien-callback ;
769 : x64-regression-2 ( x x x x x c -- y )
770 int { int int int int int } cdecl alien-indirect ; inline
772 [ 661 ] [ 100 500 50 10 1 x64-regression-1 x64-regression-2 ] unit-test
775 : blah ( -- x ) { RECT } [ 1.5 >>x 2.0 >>y [ x>> ] [ y>> ] bi * >fixnum ] with-scoped-allocation ;
777 [ 3 ] [ blah ] unit-test
779 : out-param-test-1 ( -- b )
780 { int } [ [ 12 ] dip 0 int set-alien-value ] [ ] with-out-parameters ;
782 [ 12 ] [ out-param-test-1 ] unit-test
784 : out-param-test-2 ( -- b )
785 { { int initial: 12 } } [ drop ] [ ] with-out-parameters ;
787 [ 12 ] [ out-param-test-2 ] unit-test
789 : out-param-test-3 ( -- x y )
790 { { RECT initial: S{ RECT { x 3 } { y 4 } } } } [ drop ]
791 [ clone ] with-out-parameters
794 [ 3.0 4.0 ] [ out-param-test-3 ] unit-test
796 : out-param-callback ( -- a )
797 void { int pointer: int } cdecl
798 [ [ 2 * ] dip 0 int set-alien-value ] alien-callback ;
800 : out-param-indirect ( a a -- b )
802 swap void { int pointer: int } cdecl
804 ] [ ] with-out-parameters ;
806 [ 12 ] [ 6 out-param-callback out-param-indirect ] unit-test