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