#!/usr/bin/perl use strict; use warnings; use Test::More 'no_plan'; use ok 'Devel::Events::Generator::Objects'; use Devel::Events::Handler::Callback; my $file = quotemeta(__FILE__); eval { bless "foo", "bar" }; like( $@, qr/^Can't bless non-reference value at $file line \d+/, "bless doesn't poop errors"); my @events; my $h = Devel::Events::Handler::Callback->new(sub { push @events, [ map { ref($_) ? "$_" : $_ } @_ ]; # don't leak }); my $gen = Devel::Events::Generator::Objects->new( handler => $h, ); isa_ok( $gen, "Devel::Events::Generator::Objects" ); is( $gen->handler, $h, "right handler" ); is( @events, 0, "no events" ); bless( {}, "Some::Class" ); { package Some::Class; ::isa_ok( bless({}), "Some::Class") } is( @events, 0, "no events" ); $gen->enable(); eval { bless "foo", "bar" }; like( $@, qr/^Can't bless non-reference value at $file line \d+/, "bless doesn't poop errors after registring handler either" ); is( @events, 0, "no events" ); my $line; my $obj = bless( {}, "Some::Class" ); $line = __LINE__; my $obj_str = "$obj"; is( @events, 1, "one event" ); is_deeply( \@events, [ [ object_bless => ( generator => "$gen", object => $obj_str, tracked => 1, class => "Some::Class", old_class => undef, package => "main", file => __FILE__, line => $line, ) ], ], "event log", ); @events = (); { package Some::Other::Class; bless($obj); $line = __LINE__ } $obj_str = "$obj"; is( @events, 1, "one event" ); is_deeply( \@events, [ [ object_bless => ( generator => "$gen", object => $obj_str, tracked => 1, class => "Some::Other::Class", old_class => "Some::Class", package => "Some::Other::Class", file => __FILE__, line => $line, ) ], ], "event log", ); my ( $hash_str ) = ( $obj_str =~ /^Some::Other::Class=(HASH\(0x[\w]+\))$/ ); # objects are first unblessed, then they get freed @events = (); $obj = undef; no warnings 'uninitialized'; # wtf?! is_deeply( \@events, [ [ object_destroy => ( generator => "$gen", object => $hash_str ) ], ], "event log", );