5
sub add_to_sc($sc, $idx, $obj) {
6
nqp::scsetobj($sc, $idx, $obj);
7
nqp::setobjsc($obj, $sc);
10
# Serializing an empty SC.
12
my $sc := nqp::createsc('TEST_SC_1_IN');
13
my $sh := nqp::list_s();
15
my $serialized := nqp::serialize($sc, $sh);
16
ok(nqp::chars($serialized) > 0, 'serialized empty SC to non-empty string');
17
ok(nqp::chars($serialized) >= 36, 'output is at least as long as the header');
19
my $dsc := nqp::createsc('TEST_SC_1_OUT');
20
nqp::deserialize($serialized, $dsc, $sh, nqp::list(), nqp::null());
22
ok(nqp::scobjcount($dsc) == 0, 'deserialized SC is also empty');
25
# Serializing an SC with a single object with P6int REPR.
27
my $sc := nqp::createsc('TEST_SC_2_IN');
28
my $sh := nqp::list_s();
30
class T1 is repr('P6int') { }
31
my $v1 := nqp::box_i(42, T1);
32
add_to_sc($sc, 0, $v1);
34
my $serialized := nqp::serialize($sc, $sh);
35
ok(nqp::chars($serialized) > 36, 'serialized SC with P6int output longer than a header');
37
my $dsc := nqp::createsc('TEST_SC_2_OUT');
38
nqp::deserialize($serialized, $dsc, $sh, nqp::list(), nqp::null());
40
ok(nqp::scobjcount($dsc) == 1, 'deserialized SC has a single object');
41
ok(nqp::istype(nqp::scgetobj($dsc, 0), T1), 'deserialized object has correct type');
42
ok(nqp::unbox_i(nqp::scgetobj($dsc, 0)) == 42, 'deserialized object has correct value');
45
# Serializing an SC with a single object with P6num REPR.
47
my $sc := nqp::createsc('TEST_SC_3_IN');
48
my $sh := nqp::list_s();
50
class T2 is repr('P6num') { }
51
my $v := nqp::box_n(6.9, T2);
52
add_to_sc($sc, 0, $v);
54
my $serialized := nqp::serialize($sc, $sh);
55
ok(nqp::chars($serialized) > 36, 'serialized SC with P6num output longer than a header');
57
my $dsc := nqp::createsc('TEST_SC_3_OUT');
58
nqp::deserialize($serialized, $dsc, $sh, nqp::list(), nqp::null());
60
ok(nqp::scobjcount($dsc) == 1, 'deserialized SC has a single object');
61
ok(nqp::istype(nqp::scgetobj($dsc, 0), T2), 'deserialized object has correct type');
62
ok(nqp::unbox_n(nqp::scgetobj($dsc, 0)) == 6.9, 'deserialized object has correct value');
65
# Serializing an SC with a single object with P6str REPR.
67
my $sc := nqp::createsc('TEST_SC_4_IN');
68
my $sh := nqp::list_s();
70
class T3 is repr('P6str') { }
71
my $v := nqp::box_s('dugong', T3);
72
add_to_sc($sc, 0, $v);
74
my $serialized := nqp::serialize($sc, $sh);
75
ok(nqp::chars($serialized) > 36, 'serialized SC with P6str output longer than a header');
77
my $dsc := nqp::createsc('TEST_SC_4_OUT');
78
nqp::deserialize($serialized, $dsc, $sh, nqp::list(), nqp::null());
80
ok(nqp::scobjcount($dsc) == 1, 'deserialized SC has a single object');
81
ok(nqp::istype(nqp::scgetobj($dsc, 0), T3), 'deserialized object has correct type');
82
ok(nqp::unbox_s(nqp::scgetobj($dsc, 0)) eq 'dugong', 'deserialized object has correct value');
85
# Serializing an SC with a P6opaque containing a P6int, P6num and P6str.
87
my $sc := nqp::createsc('TEST_SC_5_IN');
88
my $sh := nqp::list_s();
95
my $obj := nqp::create(self);
109
add_to_sc($sc, 0, $v);
111
my $serialized := nqp::serialize($sc, $sh);
112
ok(nqp::chars($serialized) > 36, 'serialized SC with P6opaque output longer than a header');
114
my $dsc := nqp::createsc('TEST_SC_5_OUT');
115
nqp::deserialize($serialized, $dsc, $sh, nqp::list(), nqp::null());
117
ok(nqp::scobjcount($dsc) == 1, 'deserialized SC has a single object');
118
ok(nqp::istype(nqp::scgetobj($dsc, 0), T4), 'deserialized object has correct type');
119
ok(nqp::scgetobj($dsc, 0).a == 42, 'P6int attribute has correct value');
120
ok(nqp::scgetobj($dsc, 0).b == 6.9, 'P6num attribute has correct value');
121
ok(nqp::scgetobj($dsc, 0).c eq 'llama', 'P6str attribute has correct value');
124
# Serializing an SC with P6opaues and circular references
126
my $sc := nqp::createsc('TEST_SC_6_IN');
127
my $sh := nqp::list_s();
140
add_to_sc($sc, 0, $v1);
141
add_to_sc($sc, 1, $v2);
143
my $serialized := nqp::serialize($sc, $sh);
144
ok(nqp::chars($serialized) > 36, 'serialized SC with P6opaque output longer than a header');
146
my $dsc := nqp::createsc('TEST_SC_6_OUT');
147
nqp::deserialize($serialized, $dsc, $sh, nqp::list(), nqp::null());
149
ok(nqp::scobjcount($dsc) == 2, 'deserialized SC has 2 objects');
150
ok(nqp::istype(nqp::scgetobj($dsc, 0), T5), 'first deserialized object has correct type');
151
ok(nqp::istype(nqp::scgetobj($dsc, 1), T5), 'second deserialized object has correct type');
152
ok(nqp::scgetobj($dsc, 0).x =:= nqp::scgetobj($dsc, 1), 'reference from first object to second ok');
153
ok(nqp::scgetobj($dsc, 1).x =:= nqp::scgetobj($dsc, 0), 'reference from second object to first ok');
156
# Tracing an object graph.
158
my $sc := nqp::createsc('TEST_SC_7_IN');
159
my $sh := nqp::list_s();
164
method set_xv($x, $v) {
181
# Here, we only add *one* of the three explicitly to the SC.
182
add_to_sc($sc, 0, $v1);
183
my $serialized := nqp::serialize($sc, $sh);
185
my $dsc := nqp::createsc('TEST_SC_7_OUT');
186
nqp::deserialize($serialized, $dsc, $sh, nqp::list(), nqp::null());
188
ok(nqp::scobjcount($dsc) == 3, 'deserialized SC has 3 objects - the one we added and two discovered');
189
ok(nqp::istype(nqp::scgetobj($dsc, 0), T6), 'first deserialized object has correct type');
190
ok(nqp::istype(nqp::scgetobj($dsc, 1), T6), 'second deserialized object has correct type');
191
ok(nqp::istype(nqp::scgetobj($dsc, 2), T6), 'third deserialized object has correct type');
192
ok(nqp::scgetobj($dsc, 0).x =:= nqp::scgetobj($dsc, 1), 'reference from first object to second ok');
193
ok(nqp::scgetobj($dsc, 0).v == 5, 'first object value attribute is ok');
194
ok(nqp::scgetobj($dsc, 1).x =:= nqp::scgetobj($dsc, 2), 'reference from second object to third ok');
195
ok(nqp::scgetobj($dsc, 1).v == 8, 'second object value attribute is ok');
196
ok(nqp::scgetobj($dsc, 2).v == 40, 'third object value attribute is ok');
199
# Serializing an SC with a P6opaque containing VM Integer/Float/String
201
my $sc := nqp::createsc('TEST_SC_8_IN');
202
my $sh := nqp::list_s();
209
my $obj := nqp::create(self);
223
add_to_sc($sc, 0, $v);
225
my $serialized := nqp::serialize($sc, $sh);
227
my $dsc := nqp::createsc('TEST_SC_8_OUT');
228
nqp::deserialize($serialized, $dsc, $sh, nqp::list(), nqp::null());
230
ok(nqp::scobjcount($dsc) == 1, 'deserialized SC has a single object');
231
ok(nqp::istype(nqp::scgetobj($dsc, 0), T7), 'deserialized object has correct type');
232
ok(nqp::scgetobj($dsc, 0).a == 42, 'Integer survived serialization');
233
ok(nqp::scgetobj($dsc, 0).b == 6.9, 'Float survived serialization');
234
ok(nqp::scgetobj($dsc, 0).c eq 'llama', 'String survived serialization');
237
# Array in an object attribute
239
my $sc := nqp::createsc('TEST_SC_9_IN');
240
my $sh := nqp::list_s();
246
my $obj := nqp::create(self);
258
add_to_sc($sc, 0, $v);
260
my $serialized := nqp::serialize($sc, $sh);
262
my $dsc := nqp::createsc('TEST_SC_9_OUT');
263
nqp::deserialize($serialized, $dsc, $sh, nqp::list(), nqp::null());
265
ok(nqp::istype(nqp::scgetobj($dsc, 0), T8), 'deserialized object has correct type');
266
ok(nqp::elems(nqp::scgetobj($dsc, 0).a) == 3, 'array a came back with correct element count');
267
ok(nqp::scgetobj($dsc, 0).a[0] == 1, 'array a first element is correct');
268
ok(nqp::scgetobj($dsc, 0).a[1] eq 'lol', 'array a second element is correct');
269
ok(nqp::scgetobj($dsc, 0).a[2] == 3, 'array a third element is fine');
270
ok(nqp::elems(nqp::scgetobj($dsc, 0).b) == 3, 'array b came back with correct element count');
271
ok(nqp::scgetobj($dsc, 0).b[0] == 1, 'array b first element is correct');
272
ok(nqp::elems(nqp::scgetobj($dsc, 0).b[1]) == 2, 'array b nested array has correct element count');
273
ok(+nqp::scgetobj($dsc, 0).b[1][0] == 2, 'array b nested array first element ok');
274
ok(+nqp::scgetobj($dsc, 0).b[1][1] == 3, 'array b nested array second element ok');
275
ok(+nqp::scgetobj($dsc, 0).b[2] == 4, 'array b third element is correct');
278
# Hash in an object attribute.
280
my $sc := nqp::createsc('TEST_SC_10_IN');
281
my $sh := nqp::list_s();
286
my $obj := nqp::create(self);
293
%h<b> := 'polar bear';
299
add_to_sc($sc, 0, $v);
301
my $serialized := nqp::serialize($sc, $sh);
303
my $dsc := nqp::createsc('TEST_SC_10_OUT');
304
nqp::deserialize($serialized, $dsc, $sh, nqp::list(), nqp::null());
306
ok(nqp::istype(nqp::scgetobj($dsc, 0), T9), 'deserialized object has correct type');
307
ok(nqp::elems(nqp::scgetobj($dsc, 0).a) == 2, 'hash came back with correct element count');
308
ok(nqp::scgetobj($dsc, 0).a<a> == 42, 'hash first element is correct');
309
ok(nqp::scgetobj($dsc, 0).a<b> eq 'polar bear', 'hash second element is correct');
312
# Integer array (probably needed for NFA serialization).
314
my $sc := nqp::createsc('TEST_SC_11_IN');
315
my $sh := nqp::list_s();
320
my $obj := nqp::create(self);
325
my @a := nqp::list_i();
326
nqp::bindpos_i(@a, 0, 101);
327
nqp::bindpos_i(@a, 1, 102);
328
nqp::bindpos_i(@a, 2, 103);
334
add_to_sc($sc, 0, $v);
336
my $serialized := nqp::serialize($sc, $sh);
338
my $dsc := nqp::createsc('TEST_SC_11_OUT');
339
nqp::deserialize($serialized, $dsc, $sh, nqp::list(), nqp::null());
341
ok(nqp::istype(nqp::scgetobj($dsc, 0), T10), 'deserialized object has correct type');
342
ok(nqp::elems(nqp::scgetobj($dsc, 0).a) == 3, 'integer array came back with correct element count');
343
ok(nqp::atpos_i(nqp::scgetobj($dsc, 0).a, 0) == 101, 'integer array first element is correct');
344
ok(nqp::atpos_i(nqp::scgetobj($dsc, 0).a, 1) == 102, 'integer array second element is correct');
345
ok(nqp::atpos_i(nqp::scgetobj($dsc, 0).a, 2) == 103, 'integer array third element is correct');
348
# String array (used by Rakudo in signatures)
350
my $sc := nqp::createsc('TEST_SC_12_IN');
351
my $sh := nqp::list_s();
356
my $obj := nqp::create(self);
361
my @a := nqp::list_s();
362
nqp::bindpos_s(@a, 0, 'cow');
363
nqp::bindpos_s(@a, 1, 'sheep');
364
nqp::bindpos_s(@a, 2, 'pig');
370
add_to_sc($sc, 0, $v);
372
my $serialized := nqp::serialize($sc, $sh);
374
my $dsc := nqp::createsc('TEST_SC_12_OUT');
375
nqp::deserialize($serialized, $dsc, $sh, nqp::list(), nqp::null());
377
ok(nqp::istype(nqp::scgetobj($dsc, 0), T11), 'deserialized object has correct type');
378
ok(nqp::elems(nqp::scgetobj($dsc, 0).a) == 3, 'string array came back with correct element count');
379
ok(nqp::atpos_s(nqp::scgetobj($dsc, 0).a, 0) eq 'cow', 'string array first element is correct');
380
ok(nqp::atpos_s(nqp::scgetobj($dsc, 0).a, 1) eq 'sheep', 'string array second element is correct');
381
ok(nqp::atpos_s(nqp::scgetobj($dsc, 0).a, 2) eq 'pig', 'string array third element is correct');