@@ -1,3 +1,9 @@
+3.12
+ - fix super class namespace bug
+3.12
+ - fix some role bug
+3.11
+ - add with option and role support(EXPERIMENTAL)
3.10
- suppress warnings "Ambiguous use of *{-} resolved to -". after Perl 5.16
3.09
@@ -1,13 +1,14 @@
Changes
lib/Object/Simple.pm
lib/Object/Simple/Accessor.pm
-lib/Object/Simple/Guide.pod
Makefile.PL
MANIFEST This list of files
README
t/object-simple.t
+t/object-simple/Role1.pm
+t/object-simple/Some/Role2.pm
+t/object-simple/Some/T2.pm
t/object-simple/T1.pm
-t/object-simple/T2.pm
t/object-simple/T3.pm
t/object-simple/T3_2.pm
xt/boilerplate.t
@@ -4,7 +4,7 @@
"Yuki Kimoto <kimoto.yuki@gmail.com>"
],
"dynamic_config" : 1,
- "generated_by" : "ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.131560",
+ "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142690",
"license" : [
"perl_5"
],
@@ -37,5 +37,5 @@
}
},
"release_status" : "stable",
- "version" : "3.10"
+ "version" : "3.13"
}
@@ -3,20 +3,20 @@ abstract: 'Simple class builder(Mojo::Base porting)'
author:
- 'Yuki Kimoto <kimoto.yuki@gmail.com>'
build_requires:
- ExtUtils::MakeMaker: 0
+ ExtUtils::MakeMaker: '0'
configure_requires:
- ExtUtils::MakeMaker: 0
+ ExtUtils::MakeMaker: '0'
dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.131560'
+generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142690'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ version: '1.4'
name: Object-Simple
no_index:
directory:
- t
- inc
requires:
- Test::More: 0
-version: 3.10
+ Test::More: '0'
+version: '3.13'
@@ -1,289 +0,0 @@
-=head1 NAME
-
-Object::Simple::Guide - Object::Simple Guide
-
-=head1 GUIDE
-
-=head2 1. Create accessor
-
-At first, you create a class inheriting L<Object::Simple> by C<-base> flag.
-
- package SomeClass;
- use Object::Simple -base;
-
-L<Object::Simple> have C<new> method. This is a constructor.
-It can receive hash and hash reference as arguments.
-
- my $obj = SomeClass->new;
- my $obj = SomeClass->new(foo => 1, bar => 2);
- my $obj = SomeClass->new({foo => 1, bar => 2});
-
-You can create accessor by C<has> function.
-
- has 'foo';
-
-You can set and get the value by accessor.
-
- # Set the value
- $obj->foo(1);
-
- # Get the value
- my $foo = $obj->foo;
-
-You can specify a default value for the accessor.
-
- has foo => 1;
-
-If the value of C<foo> is not exists and C<foo> is called,
-You can get the default value.
-
- my $default_value = $obj->foo;
-
-If you want to specify a reference or object as default value,
-it must be sub reference, whose return value is the default value.
-This is requirment not to share the default value with other objects.
-
- has foo => sub { [] };
- has foo => sub { {} };
- has foo => sub { SomeClass->new };
-
-You can create accessors at once.
-
- has [qw/foo bar baz/];
- has [qw/foo bar baz/] => 0;
-
-You can create all accessors at once.
-
- has [qw/foo bar baz/],
- some => 1,
- other => sub { 5 };
-
-If arguments count is odd number, first argument is
-for accessor not having default value.
-
-=head2 Create Class
-
-I show a example to understand L<Object::Simple> well.
-
-Point class, which have two accessor, C<x> and C<y>,
-and C<clear> method to set C<x> and C<y> to 0.
-
- package Point;
- use Object::Simple -base;
-
- has x => 0;
- has y => 0;
-
- sub clear {
- my $self = shift;
-
- $self->x(0);
- $self->y(0);
- }
-
-You can use Point class in the folowing way.
-
- use Point;
- my $point = Point->new(x => 3, y => 5);
- print $point->x;
- $point->y(9);
- $point->clear;
-
-Point3D class, which inherit L<Point> class.
-This class has C<z> accessor in addition to C<x> and C<y>.
-C<clear> method is overridden to clear C<x>, C<y> and C<z>.
-
- package Point3D;
- use Point -base;
-
- has z => 0;
-
- sub clear {
- my $self = shift;
-
- $self->SUPER::clear;
-
- $self->z(0);
- }
-
-You can use Point3D class in the folowing way.
-
- use Point3D;
- my $point = Point->new(x => 3, y => 5, z => 8);
- print $point->z;
- $point->z(9);
- $point->clear;
-
-=head2 2. Concepts of Object-Oriented programing
-
-=head3 Inheritance
-
-I explain the essence of Object-Oriented programing
-to use L<Object::Simple> well.
-
-First concept of Object-Oriented programing is Inheritance.
-Inheritance means that
-If Class Q inherit Class P, Class Q can call all method of class P.
-
- +---+
- | P | Base class
- +---+ having method1 and method2
- |
- +---+
- | Q | Sub class
- +---+ having method3
-
-Class Q inherits Class P,
-so Q can call all methods of P in addition to methods of Q.
-In other words, Q can call
-C<method1>, C<method2>, and C<method3>
-
-To inherit a class, use L<base> module.
-
- package P;
- use Object::Simple -base;
-
- sub method1 { ... }
- sub method2 { ... }
-
- package Q;
- use P -base;
-
- sub method3 { ... }
-
-Perl has useful functions and methods to help Object-Oriented programing.
-
-To know the object is belong to what class, use C<ref> function.
-
- my $class = ref $obj;
-
-To know whether the object inherits the specified class, use C<isa> method.
-
- $obj->isa('SomeClass');
-
-To know whether the object(or class)
-can call the specified method,
-use C<can> method
-
- SomeClass->can('method1');
- $obj->can('method1');
-
-=head3 Capsulation
-
-Second concept of Object-Oriented programing is capsulation.
-Capsulation means that
-you don't touch internal data directory.
-You must use public methods in documentation.
-If you keep this rule, All the things become simple.
-
-To keep this rule,
-Use accessor to get and set to the value.
-
- my $value = $obj->foo;
- $obj->foo(1);
-
-To access the value directory is bad manner.
-
- # Bad manner!
- my $value = $obj->{foo};
- $obj->{foo} = 1;
-
-=head3 Polymorphism
-
-Third concept Object-Oriented programing is polymorphism.
-Polymorphism is devieded into two concepts,
-overloading and overriding.
-
-Perl programer don't have to care overloading.
-Perl is dynamic language,
-so subroutine can receive any value.
-Overloading is worth for languages having static type variable,
-like C++ or Java.
-
-Overriding means that in sub class you can change the process of the base class's method.
-
- package P;
- use Object::Simple -base;
-
- sub method1 { return 1 }
-
- package Q;
- use P -base;
-
- sub method1 { return 2 }
-
-C<method1> of class P return 1. C<method1> of class Q return 2.
-That is to say, C<method1> is overridden in class Q.
-
- my $obj_a = P->new;
- $obj_p->method1; # Return value is 1
-
- my $obj_b = Q->new;
- $obj_q->method1; # Return value is 2
-
-If you want to call the method of base class from sub class,
-use SUPER pseudo-class.
-
- package Q;
-
- sub method1 {
- my $self = shift;
-
- # return 1
- my $value = $self->SUPER::method1;
-
- return 2 + $value;
- }
-
-If you understand only these three concepts,
-you can do enough powerful Object-Oriented programming.
-and source code is readable for other language users.
-
-=head2 3. Offten used techniques
-
-=head3 Override new method
-
-C<new> method is overridden if needed.
-
-B<Example:>
-
-Initialize the object
-
- sub new {
- my $self = shift->SUPER::new(@_);
-
- # Initialization
-
- return $self;
- }
-
-B<Example:>
-
-Change arguments of C<new>.
-
- sub new {
- my $self = shift;
-
- $self->SUPER::new(x => $_[0], y => $_[1]);
-
- return $self;
- }
-
-You can pass array to C<new> method by overridden C<new> method.
-
- my $point = Point->new(4, 5);
-
-=head3 Import methods
-
-You can import methods of L<Object::Simple>.
-This is useful in case you don't want to use multiple inheritance.
-
- package SomeClass;
- use Object::Simple qw/new attr/;
-
- has 'foo';
-
-Note that you can't override C<new> method
-because C<new> method is imported in the class,
-not inherited from base class.
-
@@ -1,35 +1,113 @@
package Object::Simple;
-our $VERSION = '3.10';
+our $VERSION = '3.13';
use strict;
use warnings;
+use Scalar::Util ();
+
no warnings 'redefine';
use Carp ();
+my $role_id = 1;
+
sub import {
- my ($class, @methods) = @_;
+ my $class = shift;
+
+ return unless @_;
# Caller
my $caller = caller;
- # Base
- if ((my $flag = $methods[0] || '') eq '-base') {
-
- # Can haz?
+ # No export syntax
+ my $no_export_syntax;
+ unless (grep { $_[0] eq $_ } qw/new attr class_attr dual_attr/) {
+ $no_export_syntax = 1;
+ }
+
+ # Inheritance and including role
+ if ($no_export_syntax) {
+
+ # Option
+ my %opt;
+ my $base_opt_name;
+ if (@_ % 2 != 0) {
+ my $base_opt_name = shift;
+ if ($base_opt_name ne '-base') {
+ Carp::croak "'$base_opt_name' is invalid option(Object::Simple::import())";
+ }
+ $opt{-base} = undef;
+ }
+ %opt = (%opt, @_);
+
+ # Base class
+ my $base_class = delete $opt{-base};
+
+ # Roles
+ my $roles = delete $opt{with};
+ if (defined $roles) {
+ $roles = [$roles] if ref $roles ne 'ARRAY';
+ }
+ else {
+ $roles = [];
+ }
+
+ # Check option
+ for my $opt_name (keys %opt) {
+ Carp::croak "'$opt_name' is invalid option(Object::Simple::import())";
+ }
+
+ # Export has function
no strict 'refs';
no warnings 'redefine';
*{"${caller}::has"} = sub { attr($caller, @_) };
# Inheritance
- if (my $module = $methods[1]) {
- $module =~ s/::|'/\//g;
- require "$module.pm" unless $module->can('new');
- push @{"${caller}::ISA"}, $module;
+ if ($base_class) {
+ my $base_class_path = $base_class;
+ $base_class_path =~ s/::|'/\//g;
+ require "$base_class_path.pm";
+ @{"${caller}::ISA"} = ($base_class);
}
- else { push @{"${caller}::ISA"}, $class }
-
+ else { @{"${caller}::ISA"} = ($class) }
+
+ # Roles
+ for my $role (@$roles) {
+
+ my $role_file = $role;
+ $role_file =~ s/::/\//g;
+ $role_file .= ".pm";
+ require $role_file;
+
+ my $role_path = $INC{$role_file};
+ open my $fh, '<', $role_path
+ or Carp::croak "Can't open file $role_path: $!";
+
+ my $role_content = do { local $/; <$fh> };
+ my $role_for_file = "Object::Simple::role_id_${role_id}::$role";
+ $role_id++;
+ $INC{$role_for_file} = undef;
+
+ my $role_for = $role_for_file;
+ $role_for =~ s/\//::/g;
+ $role_for =~ s/\.pm$//;
+
+ my $role_for_content = $role_content;
+ $role_for_content =~ s/package\s+([a-zA-Z0-9:]+)/package $role_for/;
+ eval $role_for_content;
+ Carp::croak $@ if $@;
+
+ {
+ no strict 'refs';
+ my $parent = ${"${caller}::ISA"}[0];
+ @{"${caller}::ISA"} = ($role_for);
+ if ($parent) {
+ @{"${role_for}::ISA"} = ($parent);
+ }
+ }
+ }
+
# strict!
strict->import;
warnings->import;
@@ -37,8 +115,10 @@ sub import {
# Modern!
feature->import(':5.10') if $] >= 5.010;
}
- # Method export
+
+ # Export methods
else {
+ my @methods = @_;
# Exports
my %exports = map { $_ => 1 } qw/new attr class_attr dual_attr/;
@@ -138,10 +218,10 @@ Object::Simple - Simple class builder(Mojo::Base porting)
package SomeClass;
use Object::Simple -base;
- # Create a accessor
+ # Create accessor
has 'foo';
- # Create a accessor having default value
+ # Create accessor with default value
has foo => 1;
has foo => sub { [] };
has foo => sub { {} };
@@ -151,12 +231,7 @@ Object::Simple - Simple class builder(Mojo::Base porting)
has [qw/foo bar baz/];
has [qw/foo bar baz/] => 0;
- # Create all accessors at once
- has [qw/foo bar baz/],
- some => 1,
- other => sub { 5 };
-
-Use the class.
+Create object.
# Create a new object
my $obj = SomeClass->new;
@@ -166,19 +241,47 @@ Use the class.
# Set and get value
my $foo = $obj->foo;
$obj->foo(1);
+
+ # set-accessor can be changed
+ $obj->foo(1)->bar(2);
Inheritance
-
+
+ # Foo.pm
package Foo;
use Object::Simple -base;
+ # Bar.pm
package Bar;
use Foo -base;
- # Another way
+ # Bar.pm (another way to inherit)
package Bar;
use Object::Simple -base => 'Foo';
+Role(EXPERIMENTAL)
+
+ # SomeRole1.pm
+ package SomeRole;
+ sub bar {
+ ...
+ }
+
+ # SomeRole2.pm
+ package SomeRole;
+ sub baz {
+ ...
+ }
+
+ # Foo.pm
+ package Foo;
+ use Object::Simple -base, with => ['SomeRole1', 'SomeRole2'];
+
+ # main.pl
+ my $foo = Foo->new;
+ $foo->bar;
+ $foo->baz;
+
=head1 DESCRIPTION
L<Object::Simple> is L<Mojo::Base> porting.
@@ -214,14 +317,272 @@ If you like L<Mojo::Base>, L<Object::Simple> is good choice.
=head1 GUIDE
-See L<Object::Simple::Guide> to know L<Object::Simple> details.
+=head2 1. Create accessor
+
+At first, you create class.
+
+ package SomeClass;
+ use Object::Simple -base;
+
+By using C<-base> option, SomeClass inherit Object::Simple and import C<has> method.
+
+L<Object::Simple> have C<new> method. C<new> method is constructor.
+C<new> method can receive hash or hash reference.
+
+ my $obj = SomeClass->new;
+ my $obj = SomeClass->new(foo => 1, bar => 2);
+ my $obj = SomeClass->new({foo => 1, bar => 2});
+
+Create accessor by using C<has> function.
+
+ has 'foo';
+
+If you create accessor, you can set or get attribute value.s
+
+ # Set value
+ $obj->foo(1);
+
+ # Get value
+ my $foo = $obj->foo;
+
+set-accessor can be changed.
+
+ $obj->foo(1)->bar(2);
+
+You can define default value.
+
+ has foo => 1;
+
+If C<foo> attribute value is not exists, default value is used.
+
+ my $foo_default = $obj->foo;
+
+If you want to use reference or object as default value,
+default value must be surrounded by code reference.
+the return value become default value.
+
+ has foo => sub { [] };
+ has foo => sub { {} };
+ has foo => sub { SomeClass->new };
+
+You can create multiple accessors at once.
+
+ has [qw/foo bar baz/];
+ has [qw/foo bar baz/] => 0;
+
+=head2 Class example
+
+I introduce L<Object::Simple> example.
+
+Point class: two accessor C<x> and C<y>,
+and C<clear> method to set C<x> and C<y> to 0.
+
+ package Point;
+ use Object::Simple -base;
+
+ has x => 0;
+ has y => 0;
+
+ sub clear {
+ my $self = shift;
+
+ $self->x(0);
+ $self->y(0);
+ }
+
+Use Point class.
+
+ use Point;
+ my $point = Point->new(x => 3, y => 5);
+ print $point->x;
+ $point->y(9);
+ $point->clear;
+
+Point3D class: Point3D inherit Point class.
+Point3D class has C<z> accessor in addition to C<x> and C<y>.
+C<clear> method is overriden to clear C<x>, C<y> and C<z>.
+
+ package Point3D;
+ use Point -base;
+
+ has z => 0;
+
+ sub clear {
+ my $self = shift;
+
+ $self->SUPER::clear;
+
+ $self->z(0);
+ }
+
+Use Point3D class.
+
+ use Point3D;
+ my $point = Point->new(x => 3, y => 5, z => 8);
+ print $point->z;
+ $point->z(9);
+ $point->clear;
+
+=head2 2. Concepts of Object-Oriented programing
+
+I introduce concepts of Object-Oriented programing
+
+=head3 Inheritance
+
+I explain the essence of Object-Oriented programing.
+
+First concept is inheritance.
+Inheritance means that
+if Class Q inherit Class P, Class Q use all methods of class P.
+
+ +---+
+ | P | Base class
+ +---+ have method1 and method2
+ |
+ +---+
+ | Q | Sub class
+ +---+ have method3
+
+Class Q inherits Class P,
+Q can use all methods of P in addition to methods of Q.
+
+In other words, Q can use
+C<method1>, C<method2>, and C<method3>
+
+You can use C<-base> option to inherit class.
+
+ # P.pm
+ package P;
+ use Object::Simple -base;
+
+ sub method1 { ... }
+ sub method2 { ... }
+
+ # Q.pm
+ package Q;
+ use P -base;
+
+ sub method3 { ... }
+
+Perl have useful functions and methods to help Object-Oriented programing.
+
+If you know what class the object is belonged to, use C<ref> function.
+
+ my $class = ref $obj;
+
+If you know what class the object inherits, use C<isa> method.
+
+ $obj->isa('SomeClass');
+
+If you know what method the object(or class) can use, use C<can> method
+
+ SomeClass->can('method1');
+ $obj->can('method1');
+
+=head3 Encapsulation
+
+Second concept is encapsulation.
+Encapsulation means that
+you don't touch internal data directory.
+You must use public method when you access internal data.
+
+Create accessor and use it to keep thie rule.
+
+ my $value = $obj->foo;
+ $obj->foo(1);
+
+=head3 Polymorphism
+
+Third concept is polymorphism.
+Polymorphism is divided into two concepts,
+overload and override
+
+Perl programer don't need to care overload.
+Perl is dynamic type language.
+Subroutine can receive any value.
+
+Override means that you can change method behavior in sub class.
+
+ # P.pm
+ package P;
+ use Object::Simple -base;
+
+ sub method1 { return 1 }
+
+ # Q.pm
+ package Q;
+ use P -base;
+
+ sub method1 { return 2 }
+
+P C<method1> return 1. Q C<method1> return 2.
+Q C<method1> override P C<method1>.
+
+ # P method1 return 1
+ my $obj_a = P->new;
+ $obj_p->method1;
+
+ # Q method1 return 2
+ my $obj_b = Q->new;
+ $obj_q->method1;
+
+If you want to use super class method from sub class,
+use SUPER pseudo-class.
+
+ package Q;
+
+ sub method1 {
+ my $self = shift;
+
+ # Call supper class P method1
+ my $value = $self->SUPER::method1;
+
+ return 2 + $value;
+ }
+
+If you understand three concepts,
+you have learned Object-Oriented programming primary parts.
+
+=head2 3. Often used techniques
+
+=head3 Override new method
+
+C<new> method can be overridden.
+
+B<Example:>
+
+Initialize the object
+
+ sub new {
+ my $self = shift->SUPER::new(@_);
+
+ # Initialization
+
+ return $self;
+ }
+
+B<Example:>
+
+Change arguments of C<new>.
+
+ sub new {
+ my $self = shift;
+
+ $self->SUPER::new(x => $_[0], y => $_[1]);
+
+ return $self;
+ }
+
+You can pass array to C<new> method.
+
+ my $point = Point->new(4, 5);
=head1 IMPORT OPTIONS
=head2 -base
-you can inherit Object::Simple
-and C<has> function is imported by C<-base> option.
+By using C<-base> option, the class inherit Object::Simple
+and import C<has> function.
package Foo;
use Object::Simple -base;
@@ -245,6 +606,41 @@ You can also use the following syntax.
package Bar;
use Object::Simple -base => 'Foo';
+=head2 with(EXPERIMENTAL)
+
+ with => 'SomeRole'
+ with => ['SomeRole1', 'SomeRole2']
+
+You can include roles by using C<with> option.
+
+ # SomeRole1.pm
+ package SomeRole1;
+ sub foo { ... }
+
+ # SomeRole2.pm
+ package SomeRole2;
+ sub bar { ... }
+
+ # SomeClass.pm
+ package SomeClass;
+ use Object::Simple -base, with => ['SomeRole1', 'SomeRole2'];
+
+Role is class. Role itself should not inherit other class.
+
+By using C<with> option, You can include roles into your class.
+
+Role classes is cloned, and it is inserted into inheritance structure.
+
+ Object::Simple
+ |
+ SomeRole1(cloned)
+ |
+ SomeRole2(cloned)
+ |
+ SomeClass
+
+SomeClass use all methods of Object::Simple, SomeRole1, SomeRole2.
+
=head1 FUNCTIONS
=head2 has
@@ -339,7 +735,7 @@ Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
=head1 COPYRIGHT & LICENSE
-Copyright 2008-2013 Yuki Kimoto, all rights reserved.
+Copyright 2008-2014 Yuki Kimoto, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
@@ -0,0 +1,14 @@
+package Role1;
+
+use strict;
+use warnings;
+
+sub role1_method1 {
+ return 'role1_method1';
+}
+
+sub same_method1 {
+ return 'role1_same_method1';
+}
+
+1;
@@ -0,0 +1,14 @@
+package Some::Role2;
+
+use strict;
+use warnings;
+
+sub role2_method1 {
+ return 'role2_method1';
+}
+
+sub same_method1 {
+ return 'role2_same_method1';
+}
+
+1;
@@ -0,0 +1,8 @@
+package Some::T2;
+
+use Object::Simple -base;
+
+has x => 1;
+has y => 2;
+
+1;
@@ -1,8 +0,0 @@
-package T2;
-
-use Object::Simple -base;
-
-has x => 1;
-has y => 2;
-
-1;
@@ -1,6 +1,6 @@
package T3;
-use T2 -base;
+use Some::T2 -base;
has z => 3;
@@ -1,6 +1,6 @@
package T3_2;
-use T2 -base;
+use Some::T2 -base;
has z => 3;
@@ -2,12 +2,145 @@ use Test::More 'no_plan';
use strict;
use warnings;
+use lib 't/object-simple';
+
+# role
+{
+ # role - use both -base and with 2
+ {
+ {
+ package T10;
+ use Object::Simple -base => 'Some::T2', with => ['Role1', 'Some::Role2'];
+ }
+
+ {
+ my $o = T10->new;
+ is($o->x, 1);
+ is($o->role1_method1, 'role1_method1');
+ }
+ }
+
+ # role - use both -base and with 1
+ {
+ {
+ package T9;
+ use Some::T2 -base, with => ['Role1', 'Some::Role2'];
+ }
+
+ {
+ my $o = T9->new;
+ is($o->x, 1);
+ is($o->role1_method1, 'role1_method1');
+ }
+ }
+
+ # role - call super class method
+ {
+ {
+ package T8;
+ use Object::Simple -base, with => ['Role1', 'Some::Role2'];
+
+ sub role1_method1 {
+ my $self = shift;
+
+ return 'a ' . $self->SUPER::role1_method1();
+ }
+ }
+
+ {
+ my $o = T8->new;
+ is($o->role1_method1, 'a role1_method1');
+ }
+ }
+
+ # role - after role is high privilage
+ {
+ {
+ package T7;
+ use Object::Simple -base, with => ['Role1', 'Some::Role2'];
+ }
+
+ {
+ my $o = T7->new;
+ is($o->same_method1, 'role2_same_method1');
+ }
+ }
+
+ # role - include two role
+ {
+ {
+ package T6;
+ use Object::Simple -base, with => ['Role1', 'Some::Role2'];
+ }
+
+ {
+ my $o = T6->new;
+ is($o->role1_method1, 'role1_method1');
+ is($o->role2_method1, 'role2_method1');
+ }
+ }
+
+ # role - include one role
+ {
+ {
+ package T5;
+ use Object::Simple -base, with => 'Role1';
+ }
+
+ {
+ my $o = T5->new;
+ is($o->role1_method1, 'role1_method1');
+ }
+ }
+}
+
+# -base flag
+{
+ {
+ use Some::T2;
+ my $o = Some::T2->new;
+ is($o->x, 1);
+ is($o->y, 2);
+ }
+
+ {
+ use T3;
+ my $o = T3->new;
+ is($o->x, 1);
+ is($o->y, 2);
+ is($o->z, 3);
+ }
+
+ {
+ package T4;
+ use Object::Simple -base => 'T3';
+ }
+
+ {
+ my $o = T4->new;
+ is($o->x, 1);
+ is($o->y, 2);
+ is($o->z, 3);
+ }
+
+ {
+ package T4_2;
+ use Object::Simple -base => 'T3_2';
+ }
+
+ {
+ my $o = T4_2->new;
+ is($o->x, 1);
+ is($o->y, 2);
+ is($o->z, 3);
+ }
+}
+
+
# Test name
my $test;
sub test {$test = shift}
-use lib 't/object-simple';
-
my $o;
test 'new()';
@@ -154,15 +287,15 @@ is_deeply($o->m26, 3, "$test :subclass 2 : object");
test 'Error';
{
- package T2;
+ package Some::T2;
use base 'Object::Simple';
eval{__PACKAGE__->attr(m1 => {})};
- Test::More::like($@, qr/Default has to be a code reference or constant value.*T2::m1/,
+ Test::More::like($@, qr/Default has to be a code reference or constant value.*Some::T2::m1/,
'default is not scalar or code ref');
eval{__PACKAGE__->class_attr('m2', inherit => 'no')};
- Test::More::like($@, qr/\Q'inherit' opiton must be 'scalar_copy', 'array_copy', 'hash_copy', or code reference (T2::m2)/,
+ Test::More::like($@, qr/\Q'inherit' opiton must be 'scalar_copy', 'array_copy', 'hash_copy', or code reference (Some::T2::m2)/,
'invalid inherit options');
eval{__PACKAGE__->class_attr('m4', no => 1)};
@@ -195,7 +328,7 @@ test 'Method export error';
package T4;
eval "use Object::Simple 'none';";
}
-like($@, qr/Cannot export 'none'/, "$test");
+like($@, qr/'none' is invalid option/, "$test");
test 'Inherit class_attr';
is_deeply(T1->m27, {a1 => 1}, "$test : no effect : hash");
@@ -296,32 +429,3 @@ $o->attr('from_object');
ok($o->can('from_object'), $test);
-test '-base flag';
-use T2;
-$o = T2->new;
-is($o->x, 1);
-is($o->y, 2);
-
-use T3;
-$o = T3->new;
-is($o->x, 1);
-is($o->y, 2);
-is($o->z, 3);
-{
- package T4;
- use Object::Simple -base => 'T3';
-}
-$o = T4->new;
-is($o->x, 1);
-is($o->y, 2);
-is($o->z, 3);
-
-{
- package T4_2;
- use Object::Simple -base => 'T3_2';
-}
-$o = T4_2->new;
-is($o->x, 1);
-is($o->y, 2);
-is($o->z, 3);
-