1#!/usr/bin/perl
2
3##
4## Test for wrapping abilities of Object::Destroyer
5##
6
7use strict;
8BEGIN {
9    $|  = 1;
10    $^W = 1;
11}
12
13use Test::More tests => 8;
14use Object::Destroyer 2.01;
15
16
17SCOPE: {
18    my $foo = Foo->new;
19}
20is($Foo::destroy_counter, 0, 'Foo must not be destroyed');
21
22SCOPE: {
23    my $foo = Foo->new;
24    my $sentry = Object::Destroyer->new($foo, 'release');
25    is($Foo::destroy_counter, 0, 'Pre-check');
26    ok( $sentry->self_test, 'Wrapper is ok');
27}
28is($Foo::destroy_counter, 1, 'Foo must be destroyed');
29
30$Foo::destroy_counter = 0;
31SCOPE: {
32    my $foo = Foo->new;
33    my $sentry = Object::Destroyer->new($foo, 'release');
34    is($Foo::destroy_counter, 0, 'Pre-check');
35    ok( $sentry->self_test, 'Wrapper is ok' );
36    $sentry->dismiss;
37    ok( $sentry->self_test, 'Wrapper is still ok');
38}
39is($Foo::destroy_counter, 0, 'Foo must not ve destroyed');
40
41
42
43
44
45#####################################################################
46# Test Classes
47
48package Foo;
49
50use vars qw{$destroy_counter @ISA};
51BEGIN { $destroy_counter = 0; };
52
53sub new {
54    my $class = ref $_[0] ? ref shift : shift;
55    my $self = bless {}, $class;
56    $self->{self} = $self; ## This is a circular reference
57    return $self;
58}
59
60sub self_test{
61    my $self = shift;
62    return $self==$self->{self};
63}
64
65sub DESTROY {
66    $destroy_counter++;
67}
68
69sub release{
70    my $self = shift;
71    undef $self->{self};
72}
73