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