~ubuntu-branches/ubuntu/vivid/nqp/vivid-proposed

« back to all changes in this revision

Viewing changes to .pc/07_disable-serialization-tests.patch/t/serialization/01-basic.t

  • Committer: Package Import Robot
  • Author(s): Alessandro Ghedini
  • Date: 2013-11-01 12:09:18 UTC
  • mfrom: (1.1.4)
  • Revision ID: package-import@ubuntu.com-20131101120918-kx51sl0sxl3exsxi
Tags: 2013.10-1
* New upstream release
* Bump versioned (Build-)Depends on parrot
* Update patches
* Install new README.pod
* Fix vcs-field-not-canonical
* Do not install rubyish examples
* Do not Depends on parrot-devel anymore
* Add 07_disable-serialization-tests.patch

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
#! nqp
 
2
 
 
3
plan(66);
 
4
 
 
5
sub add_to_sc($sc, $idx, $obj) {
 
6
    nqp::scsetobj($sc, $idx, $obj);
 
7
    nqp::setobjsc($obj, $sc);
 
8
}
 
9
 
 
10
# Serializing an empty SC.
 
11
{
 
12
    my $sc := nqp::createsc('TEST_SC_1_IN');
 
13
    my $sh := nqp::list_s();
 
14
    
 
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');
 
18
 
 
19
    my $dsc := nqp::createsc('TEST_SC_1_OUT');
 
20
    nqp::deserialize($serialized, $dsc, $sh, nqp::list(), nqp::null());
 
21
    
 
22
    ok(nqp::scobjcount($dsc) == 0, 'deserialized SC is also empty');
 
23
}
 
24
 
 
25
# Serializing an SC with a single object with P6int REPR.
 
26
{
 
27
    my $sc := nqp::createsc('TEST_SC_2_IN');
 
28
    my $sh := nqp::list_s();
 
29
    
 
30
    class T1 is repr('P6int') { }
 
31
    my $v1 := nqp::box_i(42, T1);
 
32
    add_to_sc($sc, 0, $v1);
 
33
 
 
34
    my $serialized := nqp::serialize($sc, $sh);
 
35
    ok(nqp::chars($serialized) > 36, 'serialized SC with P6int output longer than a header');
 
36
    
 
37
    my $dsc := nqp::createsc('TEST_SC_2_OUT');
 
38
    nqp::deserialize($serialized, $dsc, $sh, nqp::list(), nqp::null());
 
39
    
 
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');
 
43
}
 
44
    
 
45
# Serializing an SC with a single object with P6num REPR.
 
46
{
 
47
    my $sc := nqp::createsc('TEST_SC_3_IN');
 
48
    my $sh := nqp::list_s();
 
49
    
 
50
    class T2 is repr('P6num') { }
 
51
    my $v := nqp::box_n(6.9, T2);
 
52
    add_to_sc($sc, 0, $v);
 
53
 
 
54
    my $serialized := nqp::serialize($sc, $sh);
 
55
    ok(nqp::chars($serialized) > 36, 'serialized SC with P6num output longer than a header');
 
56
    
 
57
    my $dsc := nqp::createsc('TEST_SC_3_OUT');
 
58
    nqp::deserialize($serialized, $dsc, $sh, nqp::list(), nqp::null());
 
59
    
 
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');
 
63
}
 
64
 
 
65
# Serializing an SC with a single object with P6str REPR.
 
66
{
 
67
    my $sc := nqp::createsc('TEST_SC_4_IN');
 
68
    my $sh := nqp::list_s();
 
69
    
 
70
    class T3 is repr('P6str') { }
 
71
    my $v := nqp::box_s('dugong', T3);
 
72
    add_to_sc($sc, 0, $v);
 
73
 
 
74
    my $serialized := nqp::serialize($sc, $sh);
 
75
    ok(nqp::chars($serialized) > 36, 'serialized SC with P6str output longer than a header');
 
76
    
 
77
    my $dsc := nqp::createsc('TEST_SC_4_OUT');
 
78
    nqp::deserialize($serialized, $dsc, $sh, nqp::list(), nqp::null());
 
79
    
 
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');
 
83
}
 
84
 
 
85
# Serializing an SC with a P6opaque containing a P6int, P6num and P6str.
 
86
{
 
87
    my $sc := nqp::createsc('TEST_SC_5_IN');
 
88
    my $sh := nqp::list_s();
 
89
    
 
90
    class T4 {
 
91
        has int $!a;
 
92
        has num $!b;
 
93
        has str $!c;
 
94
        method new() {
 
95
            my $obj := nqp::create(self);
 
96
            $obj.BUILD();
 
97
            $obj;
 
98
        }
 
99
        method BUILD() {
 
100
            $!a := 42;
 
101
            $!b := 6.9;
 
102
            $!c := 'llama';
 
103
        }
 
104
        method a() { $!a }
 
105
        method b() { $!b }
 
106
        method c() { $!c }
 
107
    }
 
108
    my $v := T4.new();
 
109
    add_to_sc($sc, 0, $v);
 
110
 
 
111
    my $serialized := nqp::serialize($sc, $sh);
 
112
    ok(nqp::chars($serialized) > 36, 'serialized SC with P6opaque output longer than a header');
 
113
    
 
114
    my $dsc := nqp::createsc('TEST_SC_5_OUT');
 
115
    nqp::deserialize($serialized, $dsc, $sh, nqp::list(), nqp::null());
 
116
 
 
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');
 
122
}
 
123
 
 
124
# Serializing an SC with P6opaues and circular references
 
125
{
 
126
    my $sc := nqp::createsc('TEST_SC_6_IN');
 
127
    my $sh := nqp::list_s();
 
128
    
 
129
    class T5 {
 
130
        has $!x;
 
131
        method set_x($x) {
 
132
            $!x := $x;
 
133
        }
 
134
        method x() { $!x }
 
135
    }
 
136
    my $v1 := T5.new();
 
137
    my $v2 := T5.new();
 
138
    $v1.set_x($v2);
 
139
    $v2.set_x($v1);
 
140
    add_to_sc($sc, 0, $v1);
 
141
    add_to_sc($sc, 1, $v2);
 
142
 
 
143
    my $serialized := nqp::serialize($sc, $sh);
 
144
    ok(nqp::chars($serialized) > 36, 'serialized SC with P6opaque output longer than a header');
 
145
    
 
146
    my $dsc := nqp::createsc('TEST_SC_6_OUT');
 
147
    nqp::deserialize($serialized, $dsc, $sh, nqp::list(), nqp::null());
 
148
    
 
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');
 
154
}
 
155
 
 
156
# Tracing an object graph.
 
157
{
 
158
    my $sc := nqp::createsc('TEST_SC_7_IN');
 
159
    my $sh := nqp::list_s();
 
160
    
 
161
    class T6 {
 
162
        has $!x;
 
163
        has int $!v;
 
164
        method set_xv($x, $v) {
 
165
            $!x := $x;
 
166
            $!v := $v;
 
167
        }
 
168
        method set_v($v) {
 
169
            $!v := $v;
 
170
        }
 
171
        method x() { $!x }
 
172
        method v() { $!v }
 
173
    }
 
174
    my $v1 := T6.new();
 
175
    my $v2 := T6.new();
 
176
    my $v3 := T6.new();
 
177
    $v1.set_xv($v2, 5);
 
178
    $v2.set_xv($v3, 8);
 
179
    $v3.set_v(40);
 
180
    
 
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);
 
184
    
 
185
    my $dsc := nqp::createsc('TEST_SC_7_OUT');
 
186
    nqp::deserialize($serialized, $dsc, $sh, nqp::list(), nqp::null());
 
187
    
 
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');
 
197
}
 
198
 
 
199
# Serializing an SC with a P6opaque containing VM Integer/Float/String
 
200
{
 
201
    my $sc := nqp::createsc('TEST_SC_8_IN');
 
202
    my $sh := nqp::list_s();
 
203
    
 
204
    class T7 {
 
205
        has $!a;
 
206
        has $!b;
 
207
        has $!c;
 
208
        method new() {
 
209
            my $obj := nqp::create(self);
 
210
            $obj.BUILD();
 
211
            $obj;
 
212
        }
 
213
        method BUILD() {
 
214
            $!a := 42;
 
215
            $!b := 6.9;
 
216
            $!c := 'llama';
 
217
        }
 
218
        method a() { $!a }
 
219
        method b() { $!b }
 
220
        method c() { $!c }
 
221
    }
 
222
    my $v := T7.new();
 
223
    add_to_sc($sc, 0, $v);
 
224
 
 
225
    my $serialized := nqp::serialize($sc, $sh);
 
226
    
 
227
    my $dsc := nqp::createsc('TEST_SC_8_OUT');
 
228
    nqp::deserialize($serialized, $dsc, $sh, nqp::list(), nqp::null());
 
229
 
 
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');
 
235
}
 
236
 
 
237
# Array in an object attribute
 
238
{
 
239
    my $sc := nqp::createsc('TEST_SC_9_IN');
 
240
    my $sh := nqp::list_s();
 
241
    
 
242
    class T8 {
 
243
        has $!a;
 
244
        has $!b;
 
245
        method new() {
 
246
            my $obj := nqp::create(self);
 
247
            $obj.BUILD();
 
248
            $obj;
 
249
        }
 
250
        method BUILD() {
 
251
            $!a := [1,'lol',3];
 
252
            $!b := [1,[2,3],4];
 
253
        }
 
254
        method a() { $!a }
 
255
        method b() { $!b }
 
256
    }
 
257
    my $v := T8.new();
 
258
    add_to_sc($sc, 0, $v);
 
259
 
 
260
    my $serialized := nqp::serialize($sc, $sh);
 
261
    
 
262
    my $dsc := nqp::createsc('TEST_SC_9_OUT');
 
263
    nqp::deserialize($serialized, $dsc, $sh, nqp::list(), nqp::null());
 
264
 
 
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');
 
276
}
 
277
 
 
278
# Hash in an object attribute.
 
279
{
 
280
    my $sc := nqp::createsc('TEST_SC_10_IN');
 
281
    my $sh := nqp::list_s();
 
282
    
 
283
    class T9 {
 
284
        has $!a;
 
285
        method new() {
 
286
            my $obj := nqp::create(self);
 
287
            $obj.BUILD();
 
288
            $obj;
 
289
        }
 
290
        method BUILD() {
 
291
            my %h;
 
292
            %h<a> := 42;
 
293
            %h<b> := 'polar bear';
 
294
            $!a := %h;
 
295
        }
 
296
        method a() { $!a }
 
297
    }
 
298
    my $v := T9.new();
 
299
    add_to_sc($sc, 0, $v);
 
300
 
 
301
    my $serialized := nqp::serialize($sc, $sh);
 
302
    
 
303
    my $dsc := nqp::createsc('TEST_SC_10_OUT');
 
304
    nqp::deserialize($serialized, $dsc, $sh, nqp::list(), nqp::null());
 
305
 
 
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');
 
310
}
 
311
 
 
312
# Integer array (probably needed for NFA serialization).
 
313
{
 
314
    my $sc := nqp::createsc('TEST_SC_11_IN');
 
315
    my $sh := nqp::list_s();
 
316
    
 
317
    class T10 {
 
318
        has $!a;
 
319
        method new() {
 
320
            my $obj := nqp::create(self);
 
321
            $obj.BUILD();
 
322
            $obj;
 
323
        }
 
324
        method BUILD() {
 
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);
 
329
            $!a := @a;
 
330
        }
 
331
        method a() { $!a }
 
332
    }
 
333
    my $v := T10.new();
 
334
    add_to_sc($sc, 0, $v);
 
335
 
 
336
    my $serialized := nqp::serialize($sc, $sh);
 
337
    
 
338
    my $dsc := nqp::createsc('TEST_SC_11_OUT');
 
339
    nqp::deserialize($serialized, $dsc, $sh, nqp::list(), nqp::null());
 
340
 
 
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');
 
346
}
 
347
 
 
348
# String array (used by Rakudo in signatures)
 
349
{
 
350
    my $sc := nqp::createsc('TEST_SC_12_IN');
 
351
    my $sh := nqp::list_s();
 
352
    
 
353
    class T11 {
 
354
        has $!a;
 
355
        method new() {
 
356
            my $obj := nqp::create(self);
 
357
            $obj.BUILD();
 
358
            $obj;
 
359
        }
 
360
        method BUILD() {
 
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');
 
365
            $!a := @a;
 
366
        }
 
367
        method a() { $!a }
 
368
    }
 
369
    my $v := T11.new();
 
370
    add_to_sc($sc, 0, $v);
 
371
 
 
372
    my $serialized := nqp::serialize($sc, $sh);
 
373
    
 
374
    my $dsc := nqp::createsc('TEST_SC_12_OUT');
 
375
    nqp::deserialize($serialized, $dsc, $sh, nqp::list(), nqp::null());
 
376
 
 
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');
 
382
}