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
22use strict;
23use lib qw( ./lib ../lib ../blib/arch );
24use Template::Test;
25$^W = 1;
26
27$Template::Test::PRESERVE = 1;
28#$Template::Parser::DEBUG = 1;
29#$Template::Directive::PRETTY = 1;
30
31#------------------------------------------------------------------------
32package Holler;
33use vars qw( $TRACE $PREFIX );
34$TRACE = '';
35$PREFIX = 'Holler:';
36
37sub 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
45sub trace {
46    my $self = shift;
47    $TRACE  .= "$$self @_\n";
48}
49
50sub clear {
51    $TRACE = '';
52    return '';
53}
54
55sub DESTROY {
56    my $self = shift;
57    $self->trace("destroyed");
58}
59
60#------------------------------------------------------------------------
61package Plugin::Holler;
62use base qw( Template::Plugin );
63
64sub new {
65    my ($class, $context, @args) = @_;
66    bless {
67	context => $context,
68	holler  => Holler->new(@args),
69    }, $class;
70}
71
72sub trace {
73    my $self = shift;
74    $self->{ context }->process('trace');
75}
76
77#------------------------------------------------------------------------
78package main;
79
80my $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
89my $ttvars = {
90    holler => sub { Holler->new(@_) },
91    trace  => sub { $Holler::TRACE },
92    clear  => \&Holler::clear,
93    v56 => ( $^V && eval '$^V ge v5.6.0' && eval '$^V le v5.7.0' ),
94};
95
96test_expect(\*DATA, $ttcfg, $ttvars);
97
98__DATA__
99
100-- test --
101[% a = holler('first'); trace %]
102-- expect --
103first created
104
105-- test --
106[% trace %]
107-- expect --
108first created
109first destroyed
110
111-- test --
112[% clear; b = [ ]; b.0 = holler('list'); trace %]
113-- expect --
114list created
115
116-- test --
117[% trace %]
118-- expect --
119list created
120list destroyed
121
122-- stop --
123
124
125-- test --
126[% BLOCK shout; a = holler('second'); END -%]
127[% clear; PROCESS shout; trace %]
128-- expect --
129second created
130
131-- test --
132[% BLOCK shout; a = holler('third'); END -%]
133[% clear; INCLUDE shout; trace %]
134-- expect --
135third created
136third destroyed
137
138-- test --
139[% MACRO shout BLOCK; a = holler('fourth'); END -%]
140[% clear; shout; trace %]
141-- expect --
142fourth created
143fourth destroyed
144
145-- test --
146[% clear; USE holler('holler plugin'); trace %]
147-- expect --
148holler plugin created
149
150-- test --
151[% BLOCK shout; USE holler('process plugin'); END -%]
152[% clear; PROCESS shout; holler.trace %]
153-- expect --
154TRACE ==process plugin created
155==
156
157-- test --
158[% BLOCK shout; USE holler('include plugin'); END -%]
159[% clear; INCLUDE shout; trace %]
160-- expect --
161include plugin created
162include plugin destroyed
163
164-- test --
165[% MACRO shout BLOCK; USE holler('macro plugin'); END -%]
166[% clear; shout; trace %]
167-- expect --
168macro plugin created
169macro 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 --
179TRACE ==macro plugin created
180==macro plugin created
181macro plugin destroyed
182
183-- test --
184[% clear; PROCESS leak1; trace %]
185-- expect --
186<leak1>
187</leak1>
188Hello created
189
190-- test --
191[% clear; INCLUDE leak1; trace %]
192-- expect --
193<leak1>
194</leak1>
195Hello created
196Hello destroyed
197
198-- test --
199[% clear; PROCESS leak2; trace %]
200-- expect --
201<leak2>
202</leak2>
203Goodbye created
204
205-- test --
206[% clear; INCLUDE leak2; trace %]
207-- expect --
208<leak2>
209</leak2>
210Goodbye created
211Goodbye destroyed
212
213-- test --
214[%  MACRO leak BLOCK; 
215	PROCESS leak1 + leak2;
216        USE holler('macro plugin'); 
217    END 
218-%]
219[% IF v56;
220	clear; leak; trace;
221    ELSE;
222       "Perl version < 5.6.0 or > 5.7.0, skipping this test";
223    END
224-%]
225-- expect --
226-- process --
227[% IF v56 -%]
228<leak1>
229</leak1>
230<leak2>
231</leak2>
232Hello created
233Goodbye created
234macro plugin created
235Hello destroyed
236Goodbye destroyed
237macro plugin destroyed
238[% ELSE -%]
239Perl version < 5.6.0 or > 5.7.0, skipping this test
240[% END -%]
241
242-- test --
243[% PERL %]
244    Holler->clear();
245    my $h = Holler->new('perl');
246    $stash->set( h => $h );
247[% END -%]
248[% trace %]
249-- expect --
250perl 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 --
260perl created
261perl 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 --
271perl macro created
272perl macro destroyed
273
274
275
276
277