Mini Shell

#============================================================= -*-perl-*-
#
# t/leak.t
#
# Attempts to detect memory leaks... but fails.  That's a Good Thing
# if it means there are no memory leaks (in this particular aspect)
# or a Bad Thing if it there are, but we're not smart enough to detect
# them. :-)
#
# Written by Andy Wardley <abw@wardley.org>
#
# Copyright (C) 1996-2001 Andy Wardley.  All Rights Reserved.
# Copyright (C) 1998-2001 Canon Research Centre Europe Ltd.
#
# This is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# $Id$
#
#========================================================================

use strict;
use lib qw( ./lib ../lib ../blib/arch );
use Template::Test;
$^W = 1;

$Template::Test::PRESERVE = 1;
#$Template::Parser::DEBUG = 1;
#$Template::Directive::PRETTY = 1;

#------------------------------------------------------------------------
package Holler;
our ( $TRACE, $PREFIX );
$TRACE = '';
$PREFIX = 'Holler:';

sub new {
    my $class = shift;
    my $id = shift || '<anon>';
    my $self  = bless \$id, $class;
    $self->trace("created");
    return $self;
}

sub trace {
    my $self = shift;
    $TRACE  .= "$$self @_\n";
}

sub clear {
    $TRACE = '';
    return '';
}

sub DESTROY {
    my $self = shift;
    $self->trace("destroyed");
}

#------------------------------------------------------------------------
package Plugin::Holler;
use base qw( Template::Plugin );

sub new {
    my ($class, $context, @args) = @_;
    bless {
	context => $context,
	holler  => Holler->new(@args),
    }, $class;
}

sub trace {
    my $self = shift;
    $self->{ context }->process('trace');
}

#------------------------------------------------------------------------
package main;

my $ttcfg = {
    INCLUDE_PATH   => -d 't' ? 't/test/src' : 'test/src',
    PLUGIN_FACTORY => { holler => 'Plugin::Holler' },
    EVAL_PERL      => 1,
    BLOCKS         => {
        trace => "TRACE ==[% trace %]==",
    },
};

my $ttvars = {
    holler => sub { Holler->new(@_) },
    trace  => sub { $Holler::TRACE },
    clear  => \&Holler::clear,
    v56 => ( $^V && eval '$^V ge v5.6.0' && eval '$^V le v5.7.0' ),
};

test_expect(\*DATA, $ttcfg, $ttvars);

__DATA__

-- test --
[% a = holler('first'); trace %]
-- expect --
first created

-- test --
[% trace %]
-- expect --
first created
first destroyed

-- test --
[% clear; b = [ ]; b.0 = holler('list'); trace %]
-- expect --
list created

-- test --
[% trace %]
-- expect --
list created
list destroyed

-- stop --


-- test --
[% BLOCK shout; a = holler('second'); END -%]
[% clear; PROCESS shout; trace %]
-- expect --
second created

-- test --
[% BLOCK shout; a = holler('third'); END -%]
[% clear; INCLUDE shout; trace %]
-- expect --
third created
third destroyed

-- test --
[% MACRO shout BLOCK; a = holler('fourth'); END -%]
[% clear; shout; trace %]
-- expect --
fourth created
fourth destroyed

-- test --
[% clear; USE holler('holler plugin'); trace %]
-- expect --
holler plugin created

-- test --
[% BLOCK shout; USE holler('process plugin'); END -%]
[% clear; PROCESS shout; holler.trace %]
-- expect --
TRACE ==process plugin created
==

-- test --
[% BLOCK shout; USE holler('include plugin'); END -%]
[% clear; INCLUDE shout; trace %]
-- expect --
include plugin created
include plugin destroyed

-- test --
[% MACRO shout BLOCK; USE holler('macro plugin'); END -%]
[% clear; shout; trace %]
-- expect --
macro plugin created
macro plugin destroyed

-- test --
[%  MACRO shout BLOCK; 
	USE holler('macro plugin'); 
	holler.trace;
    END 
-%]
[% clear; shout; trace %]
-- expect --
TRACE ==macro plugin created
==macro plugin created
macro plugin destroyed

-- test --
[% clear; PROCESS leak1; trace %]
-- expect --
<leak1>
</leak1>
Hello created

-- test --
[% clear; INCLUDE leak1; trace %]
-- expect --
<leak1>
</leak1>
Hello created
Hello destroyed

-- test --
[% clear; PROCESS leak2; trace %]
-- expect --
<leak2>
</leak2>
Goodbye created

-- test --
[% clear; INCLUDE leak2; trace %]
-- expect --
<leak2>
</leak2>
Goodbye created
Goodbye destroyed

-- test --
[%  MACRO leak BLOCK; 
	PROCESS leak1 + leak2;
        USE holler('macro plugin'); 
    END 
-%]
[% IF v56;
	clear; leak; trace;
    ELSE;
       "Perl version < 5.6.0 or > 5.7.0, skipping this test";
    END
-%]
-- expect --
-- process --
[% IF v56 -%]
<leak1>
</leak1>
<leak2>
</leak2>
Hello created
Goodbye created
macro plugin created
Hello destroyed
Goodbye destroyed
macro plugin destroyed
[% ELSE -%]
Perl version < 5.6.0 or > 5.7.0, skipping this test
[% END -%]

-- test --
[% PERL %]
    Holler->clear();
    my $h = Holler->new('perl');
    $stash->set( h => $h );
[% END -%]
[% trace %]
-- expect --
perl created

-- test --
[% BLOCK x; PERL %]
    Holler->clear();
    my $h = Holler->new('perl');
    $stash->set( h => $h );
[% END; END -%]
[% x; trace %]
-- expect --
perl created
perl destroyed

-- test --
[% MACRO y PERL %]
    Holler->clear();
    my $h = Holler->new('perl macro');
    $stash->set( h => $h );
[% END -%]
[% y; trace %]
-- expect --
perl macro created
perl macro destroyed