The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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",
);