File: 4-perl_tag_scheme.t

package info (click to toggle)
libyaml-syck-perl 1.20-1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 932 kB
  • sloc: ansic: 3,987; perl: 3,387; makefile: 4
file content (97 lines) | stat: -rw-r--r-- 2,239 bytes parent folder | download | duplicates (4)
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
use t::TestYAML tests => 18;

ok(YAML::Syck->VERSION);

#use YAML;
#use Test::More 'no_plan';

# This file is based on pyyaml wiki entry for PerlTagScheme, and Ingy's
# guidance.

# http://pyyaml.org/wiki/PerlTagScheme says:
#
# !!perl/hash     # hash reference
# !!perl/array    # array reference
# !!perl/scalar   # scalar reference
# !!perl/code     # code reference
# !!perl/io       # io reference
# !!perl/glob     # a glob (not a ref)
# !!perl/regexp   # a regexp (not a ref)
# !!perl/ref      # a container ref to any of the above
#
# All of the above types can be blessed:
#
# !!perl/hash:Foo::Bar   # hash ref blessed with 'Foo::Bar'
# !!perl/glob:Foo::Bar   # glob blessed with 'Foo::Bar'
#

sub yaml_is {
    my ( $yaml, $expected, @args ) = @_;
    $yaml =~ s/\s+\n/\n/gs;
    @_ = ( $yaml, $expected, @args );
    goto &is;
}

{
	my $hash = { foo => "bar" };
	yaml_is(Dump($hash), "---\nfoo: bar\n");
	bless $hash, "Foo::Bar";
	yaml_is(Dump($hash), "--- !!perl/hash:Foo::Bar\nfoo: bar\n");
}

{
	my $scalar = "foo";
    yaml_is(Dump($scalar), "--- foo\n");
    my $ref = \$scalar;
    yaml_is(Dump($ref), "--- !!perl/ref\n=: foo\n");
	bless $ref, "Foo::Bar";
    yaml_is(Dump($ref), "--- !!perl/scalar:Foo::Bar foo\n");
}

{
	my $hash = { foo => "bar" };
	my $deep_scalar = \$hash;
    yaml_is(Dump($deep_scalar), "--- !!perl/ref\n=:\n  foo: bar\n");
	bless $deep_scalar, "Foo::Bar";
    yaml_is(Dump($deep_scalar), "--- !!perl/ref:Foo::Bar\n=:\n  foo: bar\n");
}

{
	my $array = [ 23, 42 ];
	yaml_is(Dump($array), "---\n- 23\n- 42\n");
	bless $array, "Foo::Bar";
	yaml_is(Dump($array), "--- !!perl/array:Foo::Bar\n- 23\n- 42\n");
}

{
    # FIXME regexes
	my $regex = qr/a(b|c)d/;
    #print Dump($regex);
	bless $regex, "Foo::bar";
    #print Dump($regex);
}

{
	my $hash = Load("--- !!perl/hash\nfoo: bar\n");
	is( ref($hash), "HASH" );
	is( $hash->{foo}, "bar" );
}

{
	my $hash = Load("--- !!perl/hash:Foo::Bar\nfoo: bar\n");
	is( ref($hash), "Foo::Bar" );
	is( $hash->{foo}, "bar" );
}

{
	my $array = Load("--- !!perl/array\n- 42\n- 3\n");
	is( ref($array), "ARRAY" );
	is( $array->[0], 42 );
}

{
	my $array = Load("--- !!perl/array:Foo::Bar\n- 42\n- 3\n");
	is( ref($array), "Foo::Bar" );
	is( $array->[0], 42 );
}