1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
#! nqp
use nqpmo;
plan(9);
sub add_to_sc($sc, $idx, $obj) {
nqp::scsetobj($sc, $idx, $obj);
nqp::setobjsc($obj, $sc);
}
# Serializing a type where some methods are clones; no dependency on outers
# just yet.
{
my $sc := nqp::createsc('TEST_SC_1_IN');
my $sh := nqp::list_s();
my $m1 := nqp::getstaticcode(method () { "success!" });
nqp::scsetcode($sc, 0, $m1);
nqp::markcodestatic($m1);
# Here we make a clone of it, which is what we're testing.
my $m2 := nqp::clone($m1);
my $type := nqp::knowhow().new_type(:name('SimpleCloneTest'), :repr('P6opaque'));
$type.HOW.add_method($type, 'original', $m1);
$type.HOW.add_method($type, 'cloned', $m2);
$type.HOW.compose($type);
add_to_sc($sc, 0, $type);
my $serialized := nqp::serialize($sc, $sh);
my $dsc := nqp::createsc('TEST_SC_1_OUT');
my $cr := nqp::list($m1);
nqp::deserialize($serialized, $dsc, $sh, $cr, nqp::null());
ok(nqp::scobjcount($dsc) >= 1, 'deserialized SC has at least the type');
ok(!nqp::isconcrete(nqp::scgetobj($dsc, 0)), 'type object deserialized and is not concrete');
ok(nqp::scgetobj($dsc, 0).original eq 'success!', 'method call on static code object ok');
ok(nqp::scgetobj($dsc, 0).cloned eq 'success!', 'method call on cloned code object ok');
}
# Serializing a type where some methods are clones and depend on lexical
# environment. This is kinda faking up how roles work.
{
my $sc := nqp::createsc('TEST_SC_2_IN');
my $sh := nqp::list_s();
my $raw_sub := nqp::getstaticcode(sub make_meth_with($x) {
my $m := method () { $x };
$m;
});
my $m1 := $raw_sub('dolphin');
my $m2 := $raw_sub('whale');
# one more invocation just to avoid getting lucky...
$raw_sub('XXX');
nqp::scsetcode($sc, 0, $raw_sub);
nqp::markcodestatic($raw_sub);
my $raw_meth := nqp::getstaticcode($m1);
nqp::scsetcode($sc, 1, $raw_meth);
nqp::markcodestatic($raw_meth);
my $type1 := nqp::knowhow().new_type(:name('RoleLikeTest1'), :repr('P6opaque'));
$type1.HOW.add_method($type1, 'm', $m1);
$type1.HOW.compose($type1);
add_to_sc($sc, 0, $type1);
my $type2 := nqp::knowhow().new_type(:name('RoleLikeTest2'), :repr('P6opaque'));
$type2.HOW.add_method($type2, 'm', $m2);
$type2.HOW.compose($type2);
add_to_sc($sc, 1, $type2);
my $serialized := nqp::serialize($sc, $sh);
my $dsc := nqp::createsc('TEST_SC_2_OUT');
my $cr := nqp::list($raw_sub, $raw_meth);
nqp::deserialize($serialized, $dsc, $sh, $cr, nqp::null());
ok(nqp::scobjcount($dsc) >= 2, 'deserialized SC has at least the two type');
ok(!nqp::isconcrete(nqp::scgetobj($dsc, 0)), 'first type object deserialized and is not concrete');
ok(!nqp::isconcrete(nqp::scgetobj($dsc, 1)), 'second type object deserialized and is not concrete');
ok(nqp::scgetobj($dsc, 0).m eq 'dolphin', 'first method call got correct deserialized outer');
ok(nqp::scgetobj($dsc, 1).m eq 'whale', 'second method call got correct deserialized outer');
}
|
