#!/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