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
89
90
91
92
93
94
95
96
97
98
99
100
|
use t::TestYAML tests => 48, (
($] < 5.008) ? (todo => [19..20, 26..29])
: ()
);
ok(YAML::Syck->VERSION);
is(Dump(bless({}, 'foo')), "--- !!perl/hash:foo {}\n\n");
sub ref_ok {
my $x = Load("--- $_[0] {a: b}\n");
is(ref($x), $_[1], "ref - $_[0]");
is($x->{a}, 'b', "data - $_[0]");
}
sub run_ref_ok {
ref_ok(splice(@_, 0, 2)) while @_;
}
run_ref_ok(qw(
!!perl/hash:foo foo
!perl/foo foo
!hs/Foo hs::Foo
!haskell.org/Foo haskell.org::Foo
!haskell.org/^Foo haskell.org::Foo
!!perl HASH
!!moose moose
!ruby/object:Test::Bear ruby::object:Test::Bear
));
# perl 5.13.5 and later has fb85c04, which changed the regex
# stringification syntax. This is also valid.
use constant REGEX_CARET => qr// =~ /\Q(?^\E/;
my $rx = qr/123/;
if (REGEX_CARET) {
ok(1, "Testing regexes with the >=5.13.5 caret syntax");
is(Dump($rx), "--- !!perl/regexp (?^:123)\n");
is(Dump(Load(Dump($rx))), "--- !!perl/regexp (?^:(?^:123))\n");
} else {
ok(1, "Testing regexes with the old <5.13.5 syntax");
is(Dump($rx), "--- !!perl/regexp (?-xism:123)\n");
is(Dump(Load(Dump($rx))), "--- !!perl/regexp (?-xism:123)\n");
}
SKIP: {
Test::More::skip "5.6 doesn't support printing regexes", 2 if($] < 5.007);
my $rx_obj = bless qr/123/i => 'Foo';
if (REGEX_CARET) {
is(Dump($rx_obj), "--- !!perl/regexp:Foo (?^i:123)\n");
is(Dump(Load(Dump($rx_obj))), "--- !!perl/regexp:Foo (?^:(?^i:123))\n");
} else {
is(Dump($rx_obj), "--- !!perl/regexp:Foo (?i-xsm:123)\n");
is(Dump(Load(Dump($rx_obj))), "--- !!perl/regexp:Foo (?i-xsm:123)\n");
}
}
my $obj = bless(\(my $undef) => 'Foo');
is(Dump($obj), "--- !!perl/scalar:Foo ~\n");
is(Dump(Load(Dump($obj))), "--- !!perl/scalar:Foo ~\n");
is(Dump(bless({1..10}, 'foo')), "--- !!perl/hash:foo \n1: 2\n3: 4\n5: 6\n7: 8\n9: 10\n");
$YAML::Syck::UseCode = 1;
{
my $hash = Load(Dump(bless({1 .. 4}, "code")));
is(ref($hash), "code", "blessed to code");
is(eval { $hash->{1} }, 2, "it's a hash");
}
TODO: {
my $sub = eval { Load(Dump(bless(sub { 42 }, "foobar"))) };
is(ref($sub), "foobar", "blessed to foobar");
local $TODO = "5.6 can't do code references in Syck right now" if($] < 5.007);
is(eval { $sub->() }, 42, "it's a CODE");
}
TODO: {
my $sub = eval { Load(Dump(bless(sub { 42 }, "code"))) };
is(ref($sub), "code", "blessed to code");
local $TODO = "5.6 can't do code references in Syck right now" if($] < 5.007);
is(eval { $sub->() }, 42, "it's a CODE");
}
$YAML::Syck::LoadBlessed = 0;
run_ref_ok(qw(
!!perl/hash:foo foo
!perl/foo foo
!hs/Foo HASH
!haskell.org/Foo HASH
!haskell.org/^Foo HASH
!!perl HASH
!!moose HASH
!ruby/object:Test::Bear HASH
));
exit;
|
