Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 252 lines (214 sloc) 4.684 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;
f8656e4 @abw *** empty log message ***
authored
23 use lib qw( ./lib ../lib );
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 => {
85 trace => "TRACE ==[% trace %]==",
86 },
87 };
88
89 my $ttvars = {
90 holler => sub { Holler->new(@_) },
91 trace => sub { $Holler::TRACE },
92 clear => \&Holler::clear,
93 };
94
95 test_expect(\*DATA, $ttcfg, $ttvars);
96
97 __DATA__
98
99 -- test --
100 [% a = holler('first'); trace %]
101 -- expect --
102 first created
103
104 -- test --
105 [% trace %]
106 -- expect --
107 first created
108 first destroyed
109
110 -- test --
111 [% BLOCK shout; a = holler('second'); END -%]
112 [% clear; PROCESS shout; trace %]
113 -- expect --
114 second created
115
116 -- test --
117 [% BLOCK shout; a = holler('third'); END -%]
118 [% clear; INCLUDE shout; trace %]
119 -- expect --
120 third created
121 third destroyed
122
123 -- test --
124 [% MACRO shout BLOCK; a = holler('fourth'); END -%]
125 [% clear; shout; trace %]
126 -- expect --
127 fourth created
128 fourth destroyed
129
130 -- test --
131 [% clear; USE holler('holler plugin'); trace %]
132 -- expect --
133 holler plugin created
134
135 -- test --
136 [% BLOCK shout; USE holler('process plugin'); END -%]
137 [% clear; PROCESS shout; holler.trace %]
138 -- expect --
139 TRACE ==process plugin created
140 ==
141
142 -- test --
143 [% BLOCK shout; USE holler('include plugin'); END -%]
144 [% clear; INCLUDE shout; trace %]
145 -- expect --
146 include plugin created
147 include plugin destroyed
148
149 -- test --
150 [% MACRO shout BLOCK; USE holler('macro plugin'); END -%]
151 [% clear; shout; trace %]
152 -- expect --
153 macro plugin created
154 macro plugin destroyed
155
156 -- test --
157 [% MACRO shout BLOCK;
158 USE holler('macro plugin');
159 holler.trace;
160 END
161 -%]
162 [% clear; shout; trace %]
163 -- expect --
164 TRACE ==macro plugin created
165 ==macro plugin created
166 macro plugin destroyed
167
168 -- test --
169 [% clear; PROCESS leak1; trace %]
170 -- expect --
171 <leak1>
172 </leak1>
173 Hello created
174
175 -- test --
176 [% clear; INCLUDE leak1; trace %]
177 -- expect --
178 <leak1>
179 </leak1>
180 Hello created
181 Hello destroyed
182
183 -- test --
184 [% clear; PROCESS leak2; trace %]
185 -- expect --
186 <leak2>
187 </leak2>
188 Goodbye created
189
190 -- test --
191 [% clear; INCLUDE leak2; trace %]
192 -- expect --
193 <leak2>
194 </leak2>
195 Goodbye created
196 Goodbye destroyed
197
198 -- test --
199 [% MACRO leak BLOCK;
200 PROCESS leak1 + leak2;
201 USE holler('macro plugin');
202 END
203 -%]
204 [% clear; leak; trace %]
205 -- expect --
206 <leak1>
207 </leak1>
208 <leak2>
209 </leak2>
210 Hello created
211 Goodbye created
212 macro plugin created
213 Hello destroyed
214 Goodbye destroyed
215 macro plugin destroyed
216
f8656e4 @abw *** empty log message ***
authored
217 -- test --
218 [% PERL %]
219 Holler->clear();
220 my $h = Holler->new('perl');
221 $stash->set( h => $h );
222 [% END -%]
223 [% trace %]
224 -- expect --
225 perl created
226
227 -- test --
228 [% BLOCK x; PERL %]
229 Holler->clear();
230 my $h = Holler->new('perl');
231 $stash->set( h => $h );
232 [% END; END -%]
233 [% x; trace %]
234 -- expect --
235 perl created
236 perl destroyed
237
238 -- test --
239 [% MACRO y PERL %]
240 Holler->clear();
241 my $h = Holler->new('perl macro');
242 $stash->set( h => $h );
243 [% END -%]
244 [% y; trace %]
245 -- expect --
246 perl macro created
247 perl macro destroyed
248
249
250
251
Something went wrong with that request. Please try again.