Sponsoring The Perl Toolchain Summit 2025: Help make this important event another success Learn more

TODDR / YAML-Syck-1.34 / t / leak.t 

            

              
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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142

              
#!/sw/bin/perl -w
use strict;
use YAML::Syck;
use Test::More tests => 11;
SKIP: {
    eval { require Devel::Leak; require 5.8.9; 1; }
      or skip( "Devel::Leak not installed or perl too old", 11 );
    # check if arrays leak
    my $yaml = q{---
blah
};
    require Symbol;
    my $handle = Symbol::gensym();
    my $diff;
    # For some reason we have to do a full test run of this loop and the
    # Devel::Leak test before it's stable.  The first time diff ends up
    # being -2.  This is probably Devel::Leak wonkiness.
    my $before = Devel::Leak::NoteSV($handle);
    foreach ( 1 .. 100 ) {
        Load($yaml);
    }
    $diff = Devel::Leak::NoteSV($handle) - $before;
    $before = Devel::Leak::NoteSV($handle);
    foreach ( 1 .. 100 ) {
        Load($yaml);
    }
    $diff = Devel::Leak::NoteSV($handle) - $before;
    is( $diff, 0, "No leaks - array" );
    # Check if hashess leak
    $yaml = q{---
result: test
};
    $before = Devel::Leak::NoteSV($handle);
    foreach ( 1 .. 100 ) {
        Load($yaml);
    }
    $diff = Devel::Leak::NoteSV($handle) - $before;
    is( $diff, 0, "No leaks - hash" );
    # Check if subs leak
    $YAML::Syck::UseCode = 1;
    $yaml                = q#---
result: !perl/code: '{ 42 + $_[0] }'
#;
    # Initial load to offset one-time load cost of B::Deparse
    Load($yaml);
    $before = Devel::Leak::NoteSV($handle);
    foreach ( 1 .. 100 ) {
        Load($yaml);
    }
    # Load in list context again
    foreach ( 1 .. 100 ) {
        () = Load($yaml);
    }
    $diff = Devel::Leak::NoteSV($handle) - $before;
    is( $diff, 0, "No leaks - code" );
    $yaml = q{---
a: b
c:
 - d
 - e
!
};
    ok( !eval { Load($yaml) }, "Load failed (expected)" );
    $before = Devel::Leak::NoteSV($handle);
    eval { Load($yaml) } for ( 1 .. 10 );
    $diff = Devel::Leak::NoteSV($handle) - $before;
    is( $diff, 0, "No leaks - Load failure" );
    $yaml = q#---
result: !perl/code: '{ 42 + + 54ih a; $" }'
#;
    {
        local $SIG{__WARN__} = sub { };
        ok(
            !eval { Load($yaml) },
            "Load failed on code syntax error (expected)"
        );
        $before = Devel::Leak::NoteSV($handle);
        eval { Load($yaml) } for ( 1 .. 10 );
        $diff = Devel::Leak::NoteSV($handle) - $before;
        local $TODO = "It looks like evals leak, but we're better than Storable"
          if $diff;
        is( $diff, 0, "No leaks - Load failure (code)" );
    }
    my $todump = {
        a => [ { c => { nums => [ '1', '2', '3', '4', '5' ] }, b => 'foo' } ],
        d => 'e'
    };
    ok( eval { Dump($todump) }, "Dump succeeded" );
    $before = Devel::Leak::NoteSV($handle);
    foreach ( 1 .. 100 ) {
        Dump($todump);
    }
    $diff = Devel::Leak::NoteSV($handle) - $before;
    is( $diff, 0, "No leaks - Dump" );
    $todump = sub { 42 };
    ok( eval { Dump($todump) }, "Dump succeeded" );
    # For some reason we have to do a full test run of this loop and the
    # Devel::Leak test before it's stable.  The first time diff ends up
    # being -1.  This is probably Devel::Leak wonkiness.
    foreach ( 1 .. 100 ) {
        Dump($todump);
    }
    $before = Devel::Leak::NoteSV($handle);
    foreach ( 1 .. 100 ) {
        Dump($todump);
    }
    $diff = Devel::Leak::NoteSV($handle) - $before;
    local $TODO = "It looks like evals leak, but we're better than Storable"
      if $diff;
    is( $diff, 0, "No leaks - Dump code" );
}