Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 56 lines (43 sloc) 1.442 kb
2a2c373 @moritz include path fixes
moritz authored
1 use lib '.';
3b4926f @arnsholt Add tests for write-barriering of CArray and CStruct types.
arnsholt authored
2 use t::CompileTestLib;
3 use NativeCall;
4 use Test;
5
3bf6712 @arnsholt Expose refresh op through function, tests for refresh().
arnsholt authored
6 plan 8;
3b4926f @arnsholt Add tests for write-barriering of CArray and CStruct types.
arnsholt authored
7
8 compile_test_lib('07-writebarrier');
9
10 class IntPtr is repr('CPointer') {
2a2c373 @moritz include path fixes
moritz authored
11 sub _deref(IntPtr $x) returns int is native('./07-writebarrier') { * }
3b4926f @arnsholt Add tests for write-barriering of CArray and CStruct types.
arnsholt authored
12 method deref() { return _deref(self); }
13 }
14
15 class Structy is repr('CStruct') {
16 has IntPtr $.ptr;
17
18 method set($ptr) {
19 $!ptr := $ptr;
20 }
21 }
22
2a2c373 @moritz include path fixes
moritz authored
23 sub make_ptr() returns IntPtr is native('./07-writebarrier') { * }
24 sub array_twiddle(CArray[IntPtr] $a) is native('./07-writebarrier') { * }
25 sub struct_twiddle(Structy $s) is native('./07-writebarrier') { * }
26 sub dummy(CArray[OpaquePointer] $a) is native('./07-writebarrier') { * }
3bf6712 @arnsholt Expose refresh op through function, tests for refresh().
arnsholt authored
27 sub save_ref(Structy $s) is native('./07-writebarrier') { * }
28 sub atadistance() is native('./07-writebarrier') { * }
3b4926f @arnsholt Add tests for write-barriering of CArray and CStruct types.
arnsholt authored
29
30 my Structy $s .= new;
31 $s.set(make_ptr);
32
33 is $s.ptr.deref, 32, 'pointer in struct before twiddle';
34 struct_twiddle($s);
35 is $s.ptr.deref, 9, 'pointer in struct after twiddle';
36
37 my @arr := CArray[IntPtr].new;
38 @arr[0] = make_ptr;
39 @arr[1] = make_ptr;
40 @arr[2] = make_ptr;
41 array_twiddle(@arr);
42 is @arr[0].deref, 1, 'array element 1 after twiddle';
43 is @arr[1].deref, 2, 'array element 2 after twiddle';
44 is @arr[2].deref, 3, 'array element 3 after twiddle';
45
46 dummy(CArray);
3bf6712 @arnsholt Expose refresh op through function, tests for refresh().
arnsholt authored
47 pass 'ignore NULL arguments';
48
49 save_ref($s);
50 atadistance();
51 isnt($s.ptr.deref, 42, 'struct value before refresh');
52 refresh($s);
53 is($s.ptr.deref, 42, 'struct value before refresh');
3b4926f @arnsholt Add tests for write-barriering of CArray and CStruct types.
arnsholt authored
54
55 # vim:ft=perl6
Something went wrong with that request. Please try again.