Implement strict constructors, which will warn unkown constructor arguments
[gitmo/Mouse.git] / benchmarks / class_type.pl
CommitLineData
53e42eac 1#!perl
2use strict;
3use warnings;
4use Benchmark qw/cmpthese/;
5
6{
7 package Foo;
8 sub new{ bless {}, shift }
9}
10
11eval q{
12 package C::XSAOne;
13 use Class::XSAccessor
14 constructor => 'new',
15 accessors => { n => 'n' },
16 ;
17 1;
18};
19
20for my $klass (qw/Moose Mouse/) {
21 eval qq{
22 package ${klass}One;
23 use $klass;
24
25 has n => (
26 is => 'rw',
27 isa => 'Foo',
28 );
29 no $klass;
30 __PACKAGE__->meta->make_immutable;
31 };
32 die $@ if $@;
33}
34
35print "Class::MOP: $Class::MOP::VERSION\n";
36print "Moose: $Moose::VERSION\n";
37print "Mouse: $Mouse::VERSION\n";
38print "---- new\n";
39
40my $foo = Foo->new();
41
42my @classes = qw(Moose Mouse);
43if(C::XSAOne->can('new')){
44 push @classes, 'C::XSA';
45}
46
47cmpthese(
48 -1 => {
49 map { my $x = $_; $_ => sub { $x->new(n => $foo) } }
50 map { "${_}One" } @classes
51 }
52);
53
54print "---- new,set\n";
55cmpthese(
56 -1 => {
57 map { my $y = $_; $_ => sub { $y->new(n => $foo)->n($foo) } }
58 map { "${_}One" } @classes
59 }
60);
61
62print "---- set\n";
63my %c = map { $_ => "${_}One"->new(n => $foo) } @classes;
64cmpthese(
65 -1 => {
66 map { my $y = $_; $_ => sub { $c{$y}->n($foo) } } @classes
67 }
68);