The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

# Main testing for Class::Adapter::Builder

use strict;
BEGIN {
	$|  = 1;
	$^W = 1;
}

use Test::More tests => 4;
use Scalar::Util 'refaddr';
use Class::Adapter::Builder ();

sub string_is {
	my @left  = split /\n/, shift;
	my @right = split /\n/, shift;
	is_deeply( \@left, \@right, @_ );
}

# Manually implement the Class::Adapter::Clear class
my $clear1 = Class::Adapter::Builder->new( 'My::Clear' );
isa_ok( $clear1, 'Class::Adapter::Builder' );
ok( $clear1->set_ISA( '_OBJECT_' ), '->set_ISA(_OBJECT_) returns true' );
ok( $clear1->set_AUTOLOAD(1), '->set_AUTOLOAD() returns true' );

# Check the resulting code
string_is( $clear1->make_class, <<'END_CLEAR', '->make_class matches expected code' );
package My::Clear;

# Generated by Class::Abstract::Builder

use strict;
use Carp ();
use Class::Adapter ();

BEGIN {
	@My::Clear::ISA = 'Class::Adapter';
}

sub isa {
	ref($_[0])
	? shift->_OBJECT_->isa(@_)
	: shift->isa(@_);
}

sub can {
	ref($_[0])
	? shift->_OBJECT_->can(@_)
	: shift->can(@_);
}

sub AUTOLOAD {
	my $self     = shift;
	my ($method) = $My::Clear::AUTOLOAD =~ m/^.*::(.*)\z/s;
	unless ( ref($self) ) {
		Carp::croak(
			  qq{Can't locate object method "$method" via package "$self" }
			. qq{(perhaps you forgot to load "$self")}
		);
	}
	$self->_OBJECT_->$method(@_);
}

sub DESTROY {
	if ( defined $_[0]->{OBJECT} and $_[0]->{OBJECT}->can('DESTROY') ) {
		undef $_[0]->{OBJECT};
	}
}

1;
END_CLEAR