The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;

use File::Spec;
use File::Temp  qw( tempdir );
use Test::More;

use HTML::Mason::Interp;

BEGIN
{
    unless ( eval { require Test::Memory::Cycle;
                    Test::Memory::Cycle->import(); 1 } )
    {
        plan skip_all => 'These tests require Test::Memory::Cycle to run.';
    }
}

plan tests => 8;

SIMPLE_OBJECTS:
{
    my $interp = HTML::Mason::Interp->new( out_method => sub {} );
    memory_cycle_ok( $interp, 'Interp before making a request' );

    my $comp = $interp->make_component( comp_source => 'Comp' );
    $interp->exec( $comp, foo => 1 );
    memory_cycle_ok( $interp, 'Interp after making a request with in-memory comp' );
}

our $Destroyed = 0;

COMP_ON_DISK:
{
    my $dir = tempdir( CLEANUP => 1 );

    make_comp( $dir, 'comp1', <<'EOF' );
This is component 1.

<&| comp2, object => $object &>
content
</&>

<%args>
$object
</%args>
EOF

    make_comp( $dir, 'comp2', <<'EOF' );
This is component 2.
EOF

    my $interp = HTML::Mason::Interp->new( out_method => sub {},
                                           comp_root  => $dir,
                                         );

    $interp->exec( '/comp1', object => Object->new() );
    memory_cycle_ok( $interp, 'Interp after making a request with on-disk comp' );
    is( $Destroyed, 1, 'object passed into request was destroyed' );

    my $req = $interp->make_request( comp => '/comp1', args => [ object => Object->new() ] );
    memory_cycle_ok( $req, 'Request object' );

    undef $req;
    is( $Destroyed, 2, 'object passed into make_request was destroyed' );
}

# See http://marc.theaimsgroup.com/?l=mason&m=115883578111647&w=2 for
# details.
OBJECTS_CREATED_IN_COMP:
{
    my $dir = tempdir( CLEANUP => 1 );

    make_comp( $dir, 'comp1', <<'EOF' );
<& /comp2, object => Object->new() &>

Destroyed: <% Object->DestroyCount() %>
EOF

    make_comp( $dir, 'comp2', 'Comp 2' );

    my $output = '';
    my $interp = HTML::Mason::Interp->new( out_method => \$output,
                                           comp_root  => $dir,
                                         );

    $Destroyed = 0;
    $interp->exec('/comp1');

    like( $output, qr/Destroyed: 1/,
          'one object was destroyed in comp1' );
}

# See http://marc.theaimsgroup.com/?l=mason&m=111769803701028&w=2 for
# details. It actually has nothing to do with %ARGS, it's seems that
# anything referred to inside nested comp-with-content calls never
# gets destroyed.
TWO_COMP_WITH_CONTENT_CALLS:
{
    my $dir = tempdir( CLEANUP => 1 );

    make_comp( $dir, 'comp1', <<'EOF' );
<%init>
my $object = Object->new();
</%init>

<&| .sub &>
%# <% $object %> - with this here the object doesn't leak!
<&| .sub &>
<% $object %>
</&>
</&>

else

<%def .sub>
<% $m->content() %>
</%def>
EOF

    my $output = '';
    my $interp = HTML::Mason::Interp->new( out_method => sub {},
                                           comp_root  => $dir,
                                         );

    $Destroyed = 0;
    $interp->exec('/comp1');

    # See
    # http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2006-10/msg00189.html
    # for further details.
    local $TODO = 'This seems to be a bug in Perl (< 5.10.0), not Mason.'
        if $] < 5.010000;
    is( $Destroyed, 1, 'object was destroyed - 2 layers of comp-with-content' );
}

sub make_comp
{
    my $dir     = shift;
    my $file    = shift;
    my $content = shift;

    open my $fh, '>', File::Spec->catfile( $dir, $file )
        or die $!;
    print $fh $content
        or die $!;
    close $fh;
}


package Object;

sub new { return bless {}, $_[0] }

sub DESTROY { $Destroyed++ }

sub DestroyCount { $Destroyed }