| Subject: | cannot mock a class because "it is not pristine" |
Greetings,
I'm not sure if this is a bug or a feature, but the exception does not
tells much what is happening and/or how I could fix the problem.
I'm trying to mock a class that instantiates a Windows COM object that
interacts with a application server. For this, the mock class should
hide any interaction with the server and with the Windows COM object.
When I run the test, this is what I got:
C:\COM+\lib\Siebel-COM>prove -v t\mockApp.t
t\mockApp.t ..
1..1
Can't fix metaclass incompatibility for
Siebel::COM::App::DataServer::Mock because it is not pristine. at
C:/Perl/site/lib/Class/MOP/Class.pm line 389.
Class::MOP::Class::_fix_single_metaclass_incompatibility('Test::Mock::Class=HASH(0x258f344)',
'attribute_metaclass',
'Class::MOP::Class::Immutable::Moose::Meta::Class=HASH(
0x258b8b4)') called at C:/Perl/site/lib/Moose/Meta/Class.pm line 655
Moose::Meta::Class::_fix_single_metaclass_incompatibility('Test::Mock::Class=HASH(0x258f344)',
'attribute_metaclass',
'Class::MOP::Class::Immutable::Moose::Meta::Class=HASH
(0x258b8b4)') called at C:/Perl/site/lib/Class/MOP/Class.pm line 318
Class::MOP::Class::_fix_metaclass_incompatibility('Test::Mock::Class=HASH(0x258f344)',
'Siebel::COM::App::DataServer', 'Moose::Object', 'Siebel::COM::App')
called at C:/Per
l/site/lib/Class/MOP/Class.pm line 206
Class::MOP::Class::_check_metaclass_compatibility('Test::Mock::Class=HASH(0x258f344)')
called at C:/Perl/site/lib/Class/MOP/Class.pm line 958
Class::MOP::Class::superclasses('Test::Mock::Class=HASH(0x258f344)',
'Siebel::COM::App::DataServer', 'Moose::Object', 'Siebel::COM::App')
called at C:/Perl/site/lib/Moose/M
eta/Class.pm line 559
Moose::Meta::Class::superclasses(undef,
'Siebel::COM::App::DataServer', 'Moose::Object', 'Siebel::COM::App')
called at C:/Perl/site/lib/Test/Mock/Class/Role/Meta/Class.pm l
ine 212
Test::Mock::Class::Role::Meta::Class::_construct_mock_class('Test::Mock::Class=HASH(0x258f344)',
'class', 'Siebel::COM::App::DataServer') called at C:/Perl/site/lib/Test/Mo
ck/Class/Role/Meta/Class.pm line 121
Test::Mock::Class::Role::Meta::Class::create_mock_class('Test::Mock::Class',
'Siebel::COM::App::DataServer::Mock', 'class',
'Siebel::COM::App::DataServer') called at C:/Per
l/site/lib/Test/Mock/Class.pm line 140
Test::Mock::Class::__ANON__('Siebel::COM::App::DataServer',
'Siebel::COM::App::DataServer::Mock') called at t\mockApp.t line 6
# Looks like your test exited with 255 before it could output anything.
Dubious, test returned 255 (wstat 65280, 0xff00)
Failed 1/1 subtests
Test Summary Report
-------------------
t\mockApp.t (Wstat: 65280 Tests: 0 Failed: 0)
Non-zero exit status: 255
Parse errors: Bad plan. You planned 1 tests but ran 0.
Files=1, Tests=0, 1 wallclock secs ( 0.09 usr + 0.03 sys = 0.13 CPU)
Result: FAIL
I attached the mock test and the classes used during the tests.
I'm using Active Perl v5.16.1 MSWin32-x86-multi-thread in a Windows 7
Enterprise Service Pack 1.
Please let me know if you need more information.
Regards,
Alceu
| Subject: | App.pm |
package Siebel::COM::App;
use 5.010;
use Win32::OLE;
use Moose;
use MooseX::FollowPBP;
use Siebel::COM::Business::Object;
use Siebel::COM::Business::Object::DataServer;
use namespace::autoclean;
with 'Siebel::COM';
has 'user' => ( is => 'ro', isa => 'Str', required => 1 );
has 'password' => ( is => 'ro', isa => 'Str', required => 1 );
has 'ole_class' => ( is => 'ro', isa => 'Str', required => 1 );
sub BUILD {
my $self = shift;
my $app = Win32::OLE->new( $self->get_ole_class() )
or confess( 'failed to load ' . $self->get_ole_class() . ': ' . $! );
Win32::OLE->Option( Warn => 3 );
$self->_set_ole($app);
}
sub login {
my $self = shift;
$self->get_ole()->Login( $self->get_user(), $self->get_password() );
}
sub get_bus_object {
my $self = shift;
my $bo_name = shift;
my $bo = Siebel::COM::Business::Object->new(
{ '_ole' => $self->get_ole()->GetBusObject($bo_name) } );
return $bo;
}
sub get_last_error {
my $self = shift;
return $self->_error();
}
1;
__END__
# Below is stub documentation for your module. You'd better edit it!
=head1 NAME
Siebel::COM - Perl extension for blah blah blah
=head1 SYNOPSIS
use Siebel::COM;
blah blah blah
=head1 DESCRIPTION
Stub documentation for Siebel::COM, created by h2xs. It looks like the
author of the extension was negligent enough to leave the stub
unedited.
Blah blah blah.
=head2 EXPORT
None by default.
=head1 SEE ALSO
Mention other useful documentation such as the documentation of
related modules or operating system documentation (such as man pages
in UNIX), or any relevant external documentation such as RFCs or
standards.
If you have a mailing list set up for your module, mention it here.
If you have a web site set up for your module, mention it here.
=head1 AUTHOR
A. U. Thor, E<lt>a.u.thor@a.galaxy.far.far.awayE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2013 by A. U. Thor
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.16.1 or,
at your option, any later version of Perl 5 you may have available.
=cut
| Subject: | mockApp.t |
use Test::Most tests => 1;
use Test::Moose;
use Test::Mock::Class ':all';
require Siebel::COM::App::DataServer;
mock_class 'Siebel::COM::App::DataServer' => 'Siebel::COM::App::DataServer::Mock';
my $mock = Siebel::COM::App::DataServer::Mock->new();
ok( $mock->login( 'foo', 'bar' ), 'login works' );
| Subject: | COM.pm |
package Siebel::COM;
use 5.010;
use Moose::Role;
our $VERSION = 0.1;
has '_ole' => (
is => 'ro',
isa => 'Win32::OLE',
reader => 'get_ole',
writer => '_set_ole',
required => 1
);
1;
__END__
# Below is stub documentation for your module. You'd better edit it!
=head1 NAME
Siebel::COM - Perl extension for blah blah blah
=head1 SYNOPSIS
use Siebel::COM;
blah blah blah
=head1 DESCRIPTION
Stub documentation for Siebel::COM, created by h2xs. It looks like the
author of the extension was negligent enough to leave the stub
unedited.
Blah blah blah.
=head2 EXPORT
None by default.
=head1 SEE ALSO
Mention other useful documentation such as the documentation of
related modules or operating system documentation (such as man pages
in UNIX), or any relevant external documentation such as RFCs or
standards.
If you have a mailing list set up for your module, mention it here.
If you have a web site set up for your module, mention it here.
=head1 AUTHOR
A. U. Thor, E<lt>a.u.thor@a.galaxy.far.far.awayE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2013 by A. U. Thor
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.16.1 or,
at your option, any later version of Perl 5 you may have available.
=cut
| Subject: | DataServer.pm |
package Siebel::COM::App::DataServer;
use 5.010;
use strict;
use warnings;
use Moose;
use namespace::autoclean;
extends 'Siebel::COM::App';
with 'Siebel::COM::Exception::DataServer';
has cfg => ( is => 'rw', isa => 'Str', required => 1 );
has data_source => ( is => 'rw', isa => 'Str', required => 1 );
has ole_class =>
( is => 'ro', isa => 'Str', default => 'SiebelDataServer.ApplicationObject' );
sub _error {
my $self = shift;
return ('('
. $self->get_return_code() . '): '
. $self->get_ole()->GetLastErrText() );
}
sub BUILD {
my $self = shift;
$self->load_objects();
}
sub get_app_def {
my $self = shift;
my $cfg = $self->get_cfg();
open( my $read, '<', $cfg )
or die "could not read cfg file $cfg: $!";
close($read);
return $cfg . ',' . $self->get_data_source();
}
sub load_objects {
my $self = shift;
my $object =
$self->get_ole()
->LoadObjects( $self->get_app_def(), $self->get_return_code() );
$self->check_error();
return $object;
}
override 'login' => sub {
my $self = shift;
$self->get_ole()
->Login( $self->get_user(), $self->get_password(),
$self->get_return_code() );
$self->check_error();
};
sub get_bus_object {
my $self = shift;
my $bo_name = shift;
my $bo = Siebel::COM::Business::Object::DataServer->new(
{
'_ole' => $self->get_ole()
->GetBusObject( $bo_name, $self->get_return_code() )
}
);
$self->check_error();
return $bo;
}
__PACKAGE__->meta->make_immutable;
1;
__END__
# Below is stub documentation for your module. You'd better edit it!
=head1 NAME
Siebel::COM - Perl extension for blah blah blah
=head1 SYNOPSIS
use Siebel::COM;
blah blah blah
=head1 DESCRIPTION
Stub documentation for Siebel::COM, created by h2xs. It looks like the
author of the extension was negligent enough to leave the stub
unedited.
Blah blah blah.
=head2 EXPORT
None by default.
=head1 SEE ALSO
Mention other useful documentation such as the documentation of
related modules or operating system documentation (such as man pages
in UNIX), or any relevant external documentation such as RFCs or
standards.
If you have a mailing list set up for your module, mention it here.
If you have a web site set up for your module, mention it here.
=head1 AUTHOR
A. U. Thor, E<lt>a.u.thor@a.galaxy.far.far.awayE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2013 by A. U. Thor
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.16.1 or,
at your option, any later version of Perl 5 you may have available.
=cut