Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 277 lines (235 sloc) 5.132 kb
6ddeb78 @abw added leak.t
authored
1 #============================================================= -*-perl-*-
2 #
3 # t/leak.t
4 #
5 # Attempts to detect memory leaks... but fails. That's a Good Thing
6 # if it means there are no memory leaks (in this particular aspect)
7 # or a Bad Thing if it there are, but we're not smart enough to detect
8 # them. :-)
9 #
10 # Written by Andy Wardley <abw@kfs.org>
11 #
12 # Copyright (C) 1996-2001 Andy Wardley. All Rights Reserved.
13 # Copyright (C) 1998-2001 Canon Research Centre Europe Ltd.
14 #
15 # This is free software; you can redistribute it and/or modify it
16 # under the same terms as Perl itself.
17 #
18 # $Id$
19 #
20 #========================================================================
21
22 use strict;
2bea327 @abw * added some tests to make sure lists didn't leak memory
authored
23 use lib qw( ./lib ../lib ../blib/arch );
6ddeb78 @abw added leak.t
authored
24 use Template::Test;
25 $^W = 1;
26
27 $Template::Test::PRESERVE = 1;
28 #$Template::Parser::DEBUG = 1;
29 #$Template::Directive::PRETTY = 1;
30
31 #------------------------------------------------------------------------
32 package Holler;
33 use vars qw( $TRACE $PREFIX );
34 $TRACE = '';
35 $PREFIX = 'Holler:';
36
37 sub new {
38 my $class = shift;
39 my $id = shift || '<anon>';
40 my $self = bless \$id, $class;
41 $self->trace("created");
42 return $self;
43 }
44
45 sub trace {
46 my $self = shift;
47 $TRACE .= "$$self @_\n";
48 }
49
50 sub clear {
51 $TRACE = '';
52 return '';
53 }
54
55 sub DESTROY {
56 my $self = shift;
57 $self->trace("destroyed");
58 }
59
60 #------------------------------------------------------------------------
61 package Plugin::Holler;
62 use base qw( Template::Plugin );
63
64 sub new {
65 my ($class, $context, @args) = @_;
66 bless {
67 context => $context,
68 holler => Holler->new(@args),
69 }, $class;
70 }
71
72 sub trace {
73 my $self = shift;
74 $self->{ context }->process('trace');
75 }
76
77 #------------------------------------------------------------------------
78 package main;
79
80 my $ttcfg = {
81 INCLUDE_PATH => -d 't' ? 't/test/src' : 'test/src',
82 PLUGIN_FACTORY => { holler => 'Plugin::Holler' },
83 EVAL_PERL => 1,
84 BLOCKS => {
2bea327 @abw * added some tests to make sure lists didn't leak memory
authored
85 trace => "TRACE ==[% trace %]==",
6ddeb78 @abw added leak.t
authored
86 },
87 };
88
89 my $ttvars = {
90 holler => sub { Holler->new(@_) },
91 trace => sub { $Holler::TRACE },
92 clear => \&Holler::clear,
9acc796 @abw post 2.03a
authored
93 v56 => ( $^V && eval '$^V ge v5.6.0' && eval '$^V le v5.7.0' ),
6ddeb78 @abw added leak.t
authored
94 };
95
96 test_expect(\*DATA, $ttcfg, $ttvars);
97
98 __DATA__
99
100 -- test --
101 [% a = holler('first'); trace %]
102 -- expect --
103 first created
104
105 -- test --
106 [% trace %]
107 -- expect --
108 first created
109 first destroyed
110
111 -- test --
2bea327 @abw * added some tests to make sure lists didn't leak memory
authored
112 [% clear; b = [ ]; b.0 = holler('list'); trace %]
113 -- expect --
114 list created
115
116 -- test --
117 [% trace %]
118 -- expect --
119 list created
120 list destroyed
121
122 -- stop --
123
124
125 -- test --
6ddeb78 @abw added leak.t
authored
126 [% BLOCK shout; a = holler('second'); END -%]
127 [% clear; PROCESS shout; trace %]
128 -- expect --
129 second created
130
131 -- test --
132 [% BLOCK shout; a = holler('third'); END -%]
133 [% clear; INCLUDE shout; trace %]
134 -- expect --
135 third created
136 third destroyed
137
138 -- test --
139 [% MACRO shout BLOCK; a = holler('fourth'); END -%]
140 [% clear; shout; trace %]
141 -- expect --
142 fourth created
143 fourth destroyed
144
145 -- test --
146 [% clear; USE holler('holler plugin'); trace %]
147 -- expect --
148 holler plugin created
149
150 -- test --
151 [% BLOCK shout; USE holler('process plugin'); END -%]
152 [% clear; PROCESS shout; holler.trace %]
153 -- expect --
154 TRACE ==process plugin created
155 ==
156
157 -- test --
158 [% BLOCK shout; USE holler('include plugin'); END -%]
159 [% clear; INCLUDE shout; trace %]
160 -- expect --
161 include plugin created
162 include plugin destroyed
163
164 -- test --
165 [% MACRO shout BLOCK; USE holler('macro plugin'); END -%]
166 [% clear; shout; trace %]
167 -- expect --
168 macro plugin created
169 macro plugin destroyed
170
171 -- test --
172 [% MACRO shout BLOCK;
173 USE holler('macro plugin');
174 holler.trace;
175 END
176 -%]
177 [% clear; shout; trace %]
178 -- expect --
179 TRACE ==macro plugin created
180 ==macro plugin created
181 macro plugin destroyed
182
183 -- test --
184 [% clear; PROCESS leak1; trace %]
185 -- expect --
186 <leak1>
187 </leak1>
188 Hello created
189
190 -- test --
191 [% clear; INCLUDE leak1; trace %]
192 -- expect --
193 <leak1>
194 </leak1>
195 Hello created
196 Hello destroyed
197
198 -- test --
199 [% clear; PROCESS leak2; trace %]
200 -- expect --
201 <leak2>
202 </leak2>
203 Goodbye created
204
205 -- test --
206 [% clear; INCLUDE leak2; trace %]
207 -- expect --
208 <leak2>
209 </leak2>
210 Goodbye created
211 Goodbye destroyed
212
213 -- test --
214 [% MACRO leak BLOCK;
215 PROCESS leak1 + leak2;
216 USE holler('macro plugin');
217 END
218 -%]
9acc796 @abw post 2.03a
authored
219 [% IF v56;
911a5e3 @abw *** empty log message ***
authored
220 clear; leak; trace;
221 ELSE;
9acc796 @abw post 2.03a
authored
222 "Perl version < 5.6.0 or > 5.7.0, skipping this test";
911a5e3 @abw *** empty log message ***
authored
223 END
224 -%]
6ddeb78 @abw added leak.t
authored
225 -- expect --
911a5e3 @abw *** empty log message ***
authored
226 -- process --
9acc796 @abw post 2.03a
authored
227 [% IF v56 -%]
6ddeb78 @abw added leak.t
authored
228 <leak1>
229 </leak1>
230 <leak2>
231 </leak2>
232 Hello created
233 Goodbye created
234 macro plugin created
235 Hello destroyed
236 Goodbye destroyed
237 macro plugin destroyed
911a5e3 @abw *** empty log message ***
authored
238 [% ELSE -%]
9acc796 @abw post 2.03a
authored
239 Perl version < 5.6.0 or > 5.7.0, skipping this test
911a5e3 @abw *** empty log message ***
authored
240 [% END -%]
6ddeb78 @abw added leak.t
authored
241
f8656e4 @abw *** empty log message ***
authored
242 -- test --
243 [% PERL %]
244 Holler->clear();
245 my $h = Holler->new('perl');
246 $stash->set( h => $h );
247 [% END -%]
248 [% trace %]
249 -- expect --
250 perl created
251
252 -- test --
253 [% BLOCK x; PERL %]
254 Holler->clear();
255 my $h = Holler->new('perl');
256 $stash->set( h => $h );
257 [% END; END -%]
258 [% x; trace %]
259 -- expect --
260 perl created
261 perl destroyed
262
263 -- test --
264 [% MACRO y PERL %]
265 Holler->clear();
266 my $h = Holler->new('perl macro');
267 $stash->set( h => $h );
268 [% END -%]
269 [% y; trace %]
270 -- expect --
271 perl macro created
272 perl macro destroyed
273
274
275
276
Something went wrong with that request. Please try again.