[Moose-commits] r7651 - in MooseX-GlobRef/trunk: . lib/MooseX
lib/MooseX/GlobRef lib/MooseX/GlobRef/Role
lib/MooseX/GlobRef/Role/Meta t t/tlib/MooseX t/tlib/MooseX/GlobRef
dexter at code2.0beta.co.uk
dexter at code2.0beta.co.uk
Fri Feb 13 15:55:16 GMT 2009
Author: dexter
Date: 2009-02-13 07:55:16 -0800 (Fri, 13 Feb 2009)
New Revision: 7651
Added:
MooseX-GlobRef/trunk/lib/MooseX/GlobRef.pm
MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Role/
MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Role/Meta/
MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Role/Meta/Instance.pm
MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Role/Object.pm
MooseX-GlobRef/trunk/t/010_MooseX_GlobRef.t
MooseX-GlobRef/trunk/t/020_MooseX_GlobRef_Object.t
MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefBaseTest.pm
MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefImmutableTest.pm
MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefTest.pm
MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefTestSuite.pm
Removed:
MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Meta/
MooseX-GlobRef/trunk/t/010_MooseX_GlobRef_Object.t
MooseX-GlobRef/trunk/t/020_MooseX_GlobRef_Meta_Class.t
MooseX-GlobRef/trunk/t/030_MooseX_GlobRef_Meta_Instance.t
MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectBaseTest.pm
Modified:
MooseX-GlobRef/trunk/Build.PL
MooseX-GlobRef/trunk/Changes
MooseX-GlobRef/trunk/Incompatibilities
MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Object.pm
MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectImmutableTest.pm
MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectTest.pm
Log:
* Package is renamed to MooseX::GlobRef and reimplemented as a role.
* MooseX::GlobRef::Role::Meta::Instance:
* New method "clone_instance".
* Method "inline_create_instance" returns a do {} block.
Modified: MooseX-GlobRef/trunk/Build.PL
===================================================================
--- MooseX-GlobRef/trunk/Build.PL 2009-02-13 14:56:42 UTC (rev 7650)
+++ MooseX-GlobRef/trunk/Build.PL 2009-02-13 15:55:16 UTC (rev 7651)
@@ -7,7 +7,7 @@
use Module::Build;
-my $module = 'MooseX::GlobRef::Object';
+my $module = 'MooseX::GlobRef';
(my $dist = $module) =~ s/::/-/g;
Modified: MooseX-GlobRef/trunk/Changes
===================================================================
--- MooseX-GlobRef/trunk/Changes 2009-02-13 14:56:42 UTC (rev 7650)
+++ MooseX-GlobRef/trunk/Changes 2009-02-13 15:55:16 UTC (rev 7651)
@@ -1,4 +1,15 @@
------------------------------------------------------------------------
+0.07 | Piotr Roszatycki <dexter at debian.org> | 2009-02-13
+
+Changes:
+
+* Package is renamed to MooseX::GlobRef and reimplemented as a role.
+
+* MooseX::GlobRef::Role::Meta::Instance:
+ * New method "clone_instance".
+ * Method "inline_create_instance" returns a do {} block.
+
+------------------------------------------------------------------------
0.06 | Piotr Roszatycki <dexter at debian.org> | 2009-02-12
Changes:
Modified: MooseX-GlobRef/trunk/Incompatibilities
===================================================================
--- MooseX-GlobRef/trunk/Incompatibilities 2009-02-13 14:56:42 UTC (rev 7650)
+++ MooseX-GlobRef/trunk/Incompatibilities 2009-02-13 15:55:16 UTC (rev 7651)
@@ -18,7 +18,7 @@
Should be:
my $obj = MooseX::GlobRef::Object->new;
- do { \%{*$obj} }->{attr} = 42;
+ *$obj->{attr} = 42;
or:
Modified: MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Object.pm
===================================================================
--- MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Object.pm 2009-02-13 14:56:42 UTC (rev 7650)
+++ MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Object.pm 2009-02-13 15:55:16 UTC (rev 7651)
@@ -36,36 +36,20 @@
=head1 DESCRIPTION
-This meta-policy allows to store Moose object in glob reference of file
-handle. The class attributes will be stored in hash slot associated with glob
-reference. It allows to create a Moose version of L<IO::Handle>.
+This class extends L<Moose::Object> and is provided only for backward
+compatibility. You should use L<MooseX::GlobRef> instead.
-The attributes can be accessed directly with following expression:
-
- my $hashref = \%{*$self};
- print $hashref->{key};
-
-or shorter:
-
- print *$self->{key};
-
-but the standard accessors should be used instead:
-
- print $self->key;
-
-You can use L<MooseX::GlobRef::Meta::Instance> metaclass directly if you need
-more customised configuration.
-
=cut
use 5.006;
use strict;
use warnings;
-our $VERSION = '0.06';
+our $VERSION = '0.07';
+use Moose;
-use metaclass 'MooseX::GlobRef::Meta::Class';
+use MooseX::GlobRef;
=head1 INHERITANCE
@@ -76,11 +60,19 @@
extends L<Moose::Object>
+=cut
+
+extends 'Moose::Object';
+
+=item *
+
+with L<MooseX::GlobRef::Role::Object>
+
=back
=cut
-use parent 'Moose::Object';
+with 'MooseX::GlobRef::Role::Object';
1;
@@ -90,8 +82,7 @@
=head1 SEE ALSO
-L<MooseX::GlobRef::Meta::Instance>, L<MooseX::GlobRef::Meta::Class>,
-L<Moose>, L<metaclass>.
+L<MooseX::GlobRef>, L<Moose::Object>.
=for readme continue
Copied: MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Role/Meta/Instance.pm (from rev 7649, MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Meta/Instance.pm)
===================================================================
--- MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Role/Meta/Instance.pm (rev 0)
+++ MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Role/Meta/Instance.pm 2009-02-13 15:55:16 UTC (rev 7651)
@@ -0,0 +1,193 @@
+#!/usr/bin/perl -c
+
+package MooseX::GlobRef::Role::Meta::Instance;
+
+=head1 NAME
+
+MooseX::GlobRef::Role::Meta::Instance - Instance metaclass for MooseX::GlobRef
+
+=head1 SYNOPSIS
+
+ package My::IO;
+
+ use metaclass 'Moose::Meta::Class' => (
+ instance_metaclass => 'MooseX::GlobRef::Meta::Instance'
+ );
+
+ use Moose;
+
+ has 'file' => ( is => 'ro', isa => 'Str', required => 1 );
+
+ sub open {
+ my $fh = shift;
+ open $fh, $fh->file or confess "cannot open";
+ return $fh;
+ };
+
+ sub getlines {
+ my $fh = shift;
+ return readline $fh;
+ };
+
+ my $io = My::IO->new( file => '/etc/passwd' );
+ print "::::::::::::::\n";
+ print $io->file, "\n";
+ print "::::::::::::::\n";
+ $io->open;
+ print $io->getlines;
+
+=head1 DESCRIPTION
+
+This instance metaclass allows to store Moose object in glob reference of
+file handle. It can be used directly with L<metaclass> pragma or with
+L<MooseX::GlobRef::Object> base class.
+
+Notice, that C<use metaclass> have to be before C<use Moose>.
+
+=cut
+
+use 5.006;
+use strict;
+use warnings;
+
+our $VERSION = '0.07';
+
+use Moose::Role;
+
+
+# Use weaken
+use Scalar::Util ();
+
+
+=head1 METHODS
+
+=over
+
+=item create_instance
+
+=cut
+
+override 'create_instance' => sub {
+ my ($self) = @_;
+
+ # create anonymous file handle
+ select select my $fh;
+
+ # initialize hash slot of file handle
+ %{*$fh} = ();
+
+ return bless $fh => $self->_class_name;
+};
+
+
+=item clone_instance
+
+=cut
+
+override 'clone_instance' => sub {
+ my ($self, $instance) = @_;
+
+ # create anonymous file handle
+ select select my $fh;
+
+ # initialize hash slot of file handle
+ %{*$fh} = ( %{*$fh} );
+
+ return bless $fh => $self->_class_name;
+};
+
+=item get_slot_value
+
+=cut
+
+override 'get_slot_value' => sub {
+ my ($self, $instance, $slot_name) = @_;
+ return *$instance->{$slot_name};
+};
+
+
+=item set_slot_value
+
+=cut
+
+override 'set_slot_value' => sub {
+ my ($self, $instance, $slot_name, $value) = @_;
+ return *$instance->{$slot_name} = $value;
+};
+
+
+=item deinitialize_slot
+
+=cut
+
+override 'deinitialize_slot' => sub {
+ my ($self, $instance, $slot_name) = @_;
+ return delete *$instance->{$slot_name};
+};
+
+
+=item is_slot_initialized
+
+=cut
+
+override 'is_slot_initialized' => sub {
+ my ($self, $instance, $slot_name) = @_;
+ return exists *$instance->{$slot_name};
+};
+
+
+=item weaken_slot_value
+
+=cut
+
+override 'weaken_slot_value' => sub {
+ my ($self, $instance, $slot_name) = @_;
+ return Scalar::Util::weaken *$instance->{$slot_name};
+};
+
+
+=item inline_create_instance
+
+=cut
+
+override 'inline_create_instance' => sub {
+ my ($self, $class_variable) = @_;
+ return 'do { select select my $fh; %{*$fh} = (); bless $fh => ' . $class_variable . ' }';
+};
+
+
+=item inline_slot_access
+
+The methods overridden by this class.
+
+=back
+
+=cut
+
+override 'inline_slot_access' => sub {
+ my ($self, $instance, $slot_name) = @_;
+ return '*{' . $instance . '}->{' . $slot_name . '}';
+};
+
+
+no Moose::Role;
+
+1;
+
+
+=head1 SEE ALSO
+
+L<MooseX::GlobRef>, L<Moose::Meta::Instance>, L<Moose>.
+
+=head1 AUTHOR
+
+Piotr Roszatycki <dexter at cpan.org>
+
+=head1 LICENSE
+
+Copyright (C) 2007, 2008, 2009 by Piotr Roszatycki E<lt>dexter at debian.orgE<gt>.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
Property changes on: MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Role/Meta/Instance.pm
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Role/Object.pm (from rev 7649, MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Object.pm)
===================================================================
--- MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Role/Object.pm (rev 0)
+++ MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Role/Object.pm 2009-02-13 15:55:16 UTC (rev 7651)
@@ -0,0 +1,77 @@
+#!/usr/bin/perl -c
+
+package MooseX::GlobRef::Role::Object;
+
+=head1 NAME
+
+MooseX::GlobRef::Role::Object - A role for MooseX::GlobRef
+
+=head1 SYNOPSIS
+
+ Moose::Util::MetaRole::apply_base_class_roles
+ ( for_class => $caller,
+ roles =>
+ [ 'MooseX::StrictConstructor::Role::Object' ],
+ );
+
+=head1 DESCRIPTION
+
+This is a role for L<Moose::Object> which is applied by L<MooseX::GlobRef>.
+It allows to store Moose object in glob reference of file handle.
+
+=cut
+
+use 5.006;
+use strict;
+use warnings;
+
+our $VERSION = '0.07';
+
+use Moose::Role;
+
+
+=head1 METHODS
+
+=over
+
+=item dump
+
+See L<Moose::Object>.
+
+=back
+
+=cut
+
+override 'dump' => sub {
+ my ($self) = @_;
+ require Data::Dumper;
+ local $Data::Dumper::Maxdepth = shift || 1;
+ return super, Data::Dumper::Dumper( \%{*$self} );
+};
+
+
+no Moose::Role;
+
+1;
+
+
+=for readme stop
+
+=head1 SEE ALSO
+
+L<MooseX::GlobRef>, L<Moose::Object>, L<Moose::Role>.
+
+=for readme continue
+
+=head1 AUTHOR
+
+Piotr Roszatycki <dexter at cpan.org>
+
+=head1 LICENSE
+
+Copyright (C) 2007, 2008, 2009 by Piotr Roszatycki E<lt>dexter at debian.orgE<gt>.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
Property changes on: MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Role/Object.pm
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: MooseX-GlobRef/trunk/lib/MooseX/GlobRef.pm (from rev 7649, MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Object.pm)
===================================================================
--- MooseX-GlobRef/trunk/lib/MooseX/GlobRef.pm (rev 0)
+++ MooseX-GlobRef/trunk/lib/MooseX/GlobRef.pm 2009-02-13 15:55:16 UTC (rev 7651)
@@ -0,0 +1,130 @@
+#!/usr/bin/perl -c
+
+package MooseX::GlobRef;
+
+=head1 NAME
+
+MooseX::GlobRef - Store a Moose object in glob reference
+
+=head1 SYNOPSIS
+
+ package My::IO;
+
+ use Moose;
+ use MooseX::GlobRef;
+
+ has 'file' => ( is => 'ro', isa => 'Str', required => 1 );
+
+ sub open {
+ my $fh = shift;
+ open $fh, $fh->file or confess "cannot open";
+ return $fh;
+ }
+
+ sub getlines {
+ my $fh = shift;
+ return readline $fh;
+ }
+
+ my $io = My::IO->new( file => '/etc/passwd' );
+ print "::::::::::::::\n";
+ print $io->file, "\n";
+ print "::::::::::::::\n";
+ $io->open;
+ print $io->getlines;
+
+=head1 DESCRIPTION
+
+This module allows to store Moose object in glob reference of file handle.
+The class attributes will be stored in hash slot associated with glob
+reference. It allows to create a Moose version of L<IO::Handle>.
+
+The attributes can be accessed directly with following expression:
+
+ my $hashref = \%{*$self};
+ print $hashref->{key};
+
+or shorter:
+
+ print *$self->{key};
+
+but the standard accessors should be used instead:
+
+ print $self->key;
+
+=cut
+
+use 5.006;
+use strict;
+use warnings;
+
+our $VERSION = '0.07';
+
+
+use Moose 0.56 ();
+use Moose::Exporter;
+use Moose::Util::MetaRole;
+use MooseX::GlobRef::Role::Object;
+use MooseX::GlobRef::Role::Meta::Instance;
+
+
+Moose::Exporter->setup_import_methods();
+
+
+=head1 METHODS
+
+=over
+
+=item init_meta
+
+See L<Moose::Exporter>.
+
+=back
+
+=cut
+
+sub init_meta {
+ my (undef, %args) = @_;
+
+ Moose->init_meta(%args);
+
+ my $caller = $args{for_class};
+
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => $caller,
+ instance_metaclass_roles =>
+ [ 'MooseX::GlobRef::Role::Meta::Instance' ],
+ );
+
+ Moose::Util::MetaRole::apply_base_class_roles(
+ for_class => $caller,
+ roles => [ 'MooseX::GlobRef::Role::Object' ],
+ );
+
+ return $caller->meta();
+};
+
+
+1;
+
+
+=for readme stop
+
+=head1 SEE ALSO
+
+L<Moose>.
+
+=for readme continue
+
+=head1 AUTHOR
+
+Piotr Roszatycki <dexter at cpan.org>
+
+=head1 LICENSE
+
+Copyright (C) 2007, 2008, 2009 by Piotr Roszatycki E<lt>dexter at debian.orgE<gt>.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
Property changes on: MooseX-GlobRef/trunk/lib/MooseX/GlobRef.pm
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: MooseX-GlobRef/trunk/t/010_MooseX_GlobRef.t (from rev 7649, MooseX-GlobRef/trunk/t/010_MooseX_GlobRef_Object.t)
===================================================================
--- MooseX-GlobRef/trunk/t/010_MooseX_GlobRef.t (rev 0)
+++ MooseX-GlobRef/trunk/t/010_MooseX_GlobRef.t 2009-02-13 15:55:16 UTC (rev 7651)
@@ -0,0 +1,25 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use File::Spec;
+use Cwd;
+
+BEGIN {
+ unshift @INC, map { /(.*)/; $1 } split(/:/, $ENV{PERL5LIB}) if defined $ENV{PERL5LIB} and ${^TAINT};
+
+ my $cwd = ${^TAINT} ? do { local $_=getcwd; /(.*)/; $1 } : '.';
+ unshift @INC, File::Spec->catdir($cwd, 't/tlib');
+};
+
+use Test::Unit::Lite;
+
+local $SIG{__WARN__} = sub { require Carp; Carp::confess("Warning: ", @_) };
+
+my $suite = __FILE__;
+$suite =~ s/.*\d{3}_(.*)\.t/$1/ or die;
+$suite =~ s/_/::/g;
+$suite .= "TestSuite";
+
+Test::Unit::HarnessUnit->new->start($suite);
Deleted: MooseX-GlobRef/trunk/t/010_MooseX_GlobRef_Object.t
===================================================================
--- MooseX-GlobRef/trunk/t/010_MooseX_GlobRef_Object.t 2009-02-13 14:56:42 UTC (rev 7650)
+++ MooseX-GlobRef/trunk/t/010_MooseX_GlobRef_Object.t 2009-02-13 15:55:16 UTC (rev 7651)
@@ -1,25 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use File::Spec;
-use Cwd;
-
-BEGIN {
- unshift @INC, map { /(.*)/; $1 } split(/:/, $ENV{PERL5LIB}) if defined $ENV{PERL5LIB} and ${^TAINT};
-
- my $cwd = ${^TAINT} ? do { local $_=getcwd; /(.*)/; $1 } : '.';
- unshift @INC, File::Spec->catdir($cwd, 't/tlib');
-};
-
-use Test::Unit::Lite;
-
-local $SIG{__WARN__} = sub { require Carp; Carp::confess("Warning: ", @_) };
-
-my $suite = __FILE__;
-$suite =~ s/.*\d{3}_(.*)\.t/$1/ or die;
-$suite =~ s/_/::/g;
-$suite .= "TestSuite";
-
-Test::Unit::HarnessUnit->new->start($suite);
Deleted: MooseX-GlobRef/trunk/t/020_MooseX_GlobRef_Meta_Class.t
===================================================================
--- MooseX-GlobRef/trunk/t/020_MooseX_GlobRef_Meta_Class.t 2009-02-13 14:56:42 UTC (rev 7650)
+++ MooseX-GlobRef/trunk/t/020_MooseX_GlobRef_Meta_Class.t 2009-02-13 15:55:16 UTC (rev 7651)
@@ -1,25 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use File::Spec;
-use Cwd;
-
-BEGIN {
- unshift @INC, map { /(.*)/; $1 } split(/:/, $ENV{PERL5LIB}) if defined $ENV{PERL5LIB} and ${^TAINT};
-
- my $cwd = ${^TAINT} ? do { local $_=getcwd; /(.*)/; $1 } : '.';
- unshift @INC, File::Spec->catdir($cwd, 't/tlib');
-};
-
-use Test::Unit::Lite;
-
-local $SIG{__WARN__} = sub { require Carp; Carp::confess("Warning: ", @_) };
-
-my $suite = __FILE__;
-$suite =~ s/.*\d{3}_(.*)\.t/$1/ or die;
-$suite =~ s/_/::/g;
-$suite .= "TestSuite";
-
-Test::Unit::HarnessUnit->new->start($suite);
Copied: MooseX-GlobRef/trunk/t/020_MooseX_GlobRef_Object.t (from rev 7649, MooseX-GlobRef/trunk/t/020_MooseX_GlobRef_Meta_Class.t)
===================================================================
--- MooseX-GlobRef/trunk/t/020_MooseX_GlobRef_Object.t (rev 0)
+++ MooseX-GlobRef/trunk/t/020_MooseX_GlobRef_Object.t 2009-02-13 15:55:16 UTC (rev 7651)
@@ -0,0 +1,25 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use File::Spec;
+use Cwd;
+
+BEGIN {
+ unshift @INC, map { /(.*)/; $1 } split(/:/, $ENV{PERL5LIB}) if defined $ENV{PERL5LIB} and ${^TAINT};
+
+ my $cwd = ${^TAINT} ? do { local $_=getcwd; /(.*)/; $1 } : '.';
+ unshift @INC, File::Spec->catdir($cwd, 't/tlib');
+};
+
+use Test::Unit::Lite;
+
+local $SIG{__WARN__} = sub { require Carp; Carp::confess("Warning: ", @_) };
+
+my $suite = __FILE__;
+$suite =~ s/.*\d{3}_(.*)\.t/$1/ or die;
+$suite =~ s/_/::/g;
+$suite .= "TestSuite";
+
+Test::Unit::HarnessUnit->new->start($suite);
Deleted: MooseX-GlobRef/trunk/t/030_MooseX_GlobRef_Meta_Instance.t
===================================================================
--- MooseX-GlobRef/trunk/t/030_MooseX_GlobRef_Meta_Instance.t 2009-02-13 14:56:42 UTC (rev 7650)
+++ MooseX-GlobRef/trunk/t/030_MooseX_GlobRef_Meta_Instance.t 2009-02-13 15:55:16 UTC (rev 7651)
@@ -1,25 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use File::Spec;
-use Cwd;
-
-BEGIN {
- unshift @INC, map { /(.*)/; $1 } split(/:/, $ENV{PERL5LIB}) if defined $ENV{PERL5LIB} and ${^TAINT};
-
- my $cwd = ${^TAINT} ? do { local $_=getcwd; /(.*)/; $1 } : '.';
- unshift @INC, File::Spec->catdir($cwd, 't/tlib');
-};
-
-use Test::Unit::Lite;
-
-local $SIG{__WARN__} = sub { require Carp; Carp::confess("Warning: ", @_) };
-
-my $suite = __FILE__;
-$suite =~ s/.*\d{3}_(.*)\.t/$1/ or die;
-$suite =~ s/_/::/g;
-$suite .= "TestSuite";
-
-Test::Unit::HarnessUnit->new->start($suite);
Deleted: MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectBaseTest.pm
===================================================================
--- MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectBaseTest.pm 2009-02-13 14:56:42 UTC (rev 7650)
+++ MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectBaseTest.pm 2009-02-13 15:55:16 UTC (rev 7651)
@@ -1,110 +0,0 @@
-package MooseX::GlobRef::ObjectBaseTest;
-
-use Test::Unit::Lite;
-use parent 'Test::Unit::TestCase';
-
-use Test::Assert ':all';
-
-use Scalar::Util 'reftype';
-
-sub test_class {
- fail('test_class is not overriden');
-};
-
-sub test___isa {
- my $self = shift;
- my $test_class = $self->test_class;
-
- my $obj = $test_class->new;
- assert_not_null($obj);
- assert_isa($test_class, $obj);
- assert_equals('GLOB', reftype($obj));
-};
-
-sub test_accessor {
- my $self = shift;
- my $test_class = $self->test_class;
-
- my $obj = $test_class->new;
- assert_not_null($obj);
- assert_isa($test_class, $obj);
- assert_equals('default', $obj->field);
- assert_equals(1, $obj->field(1));
- assert_equals(1, $obj->field);
- assert_true($obj->clear_field);
- assert_equals('default', $obj->field);
-};
-
-sub test_slot_moc {
- my $self = shift;
- my $test_class = $self->test_class;
-
- my $mi = $test_class->meta->get_meta_instance;
- assert_not_null($mi);
-
- my $obj = $mi->create_instance;
- assert_not_null($obj);
- assert_isa($test_class, $obj);
- assert_null($mi->get_slot_value($obj, 'field'));
- assert_true(! $mi->is_slot_initialized($obj, 'field'));
- assert_equals(1, $mi->set_slot_value($obj, 'field', 1));
- assert_equals(1, $mi->get_slot_value($obj, 'field'));
- assert_true($mi->is_slot_initialized($obj, 'field'));
- assert_true($mi->deinitialize_slot($obj, 'field'));
- assert_null($mi->get_slot_value($obj, 'field'));
- assert_true(! $mi->is_slot_initialized($obj, 'field'));
-};
-
-sub test_slot_moc_inline {
- my $self = shift;
- my $test_class = $self->test_class;
-
- my $mi = $test_class->meta->get_meta_instance;
- assert_not_null($mi);
-
- my $code_create_instance = $mi->inline_create_instance('$test_class');
- assert_not_equals('', $code_create_instance);
- my $code_get_slot_value = $mi->inline_get_slot_value('$obj', 'field');
- assert_not_equals('', $code_get_slot_value);
- my $code_is_slot_initialized = $mi->inline_is_slot_initialized('$obj', 'field');
- assert_not_equals('', $code_is_slot_initialized);
- my $code_set_slot_value = $mi->inline_set_slot_value('$obj', 'field', '$value');
- assert_not_equals('', $code_set_slot_value);
- my $code_deinitialize_slot = $mi->inline_deinitialize_slot('$obj', 'field');
- assert_not_equals('', $code_deinitialize_slot);
-
- my $obj = eval $code_create_instance;
- assert_not_null($obj);
- assert_isa($test_class, $obj);
- assert_null(eval $code_get_slot_value);
- assert_true(! eval $code_is_slot_initialized);
- my $value = 42;
- assert_equals($value, eval $code_set_slot_value);
- assert_equals($value, eval $code_get_slot_value);
- assert_true(eval $code_is_slot_initialized);
- assert_true(eval $code_deinitialize_slot);
- assert_null(eval $code_get_slot_value);
- assert_true(! eval $code_is_slot_initialized);
-};
-
-sub test_weak_field {
- my $self = shift;
- my $test_class = $self->test_class;
-
- my $mi = $test_class->meta->get_meta_instance;
- assert_not_null($mi);
- my $obj = $test_class->new;
- assert_not_null($obj);
- assert_isa($test_class, $obj);
- assert_null($obj->weak_field);
- {
- my $scalar = 'SCALAR';
- assert_not_null($obj->weak_field(\$scalar));
- assert_not_null($obj->weak_field);
- assert_equals('SCALAR', ${$obj->weak_field});
- $mi->weaken_slot_value($obj, 'weak_field');
- };
- assert_null($obj->weak_field);
-};
-
-1;
Modified: MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectImmutableTest.pm
===================================================================
--- MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectImmutableTest.pm 2009-02-13 14:56:42 UTC (rev 7650)
+++ MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectImmutableTest.pm 2009-02-13 15:55:16 UTC (rev 7651)
@@ -1,6 +1,6 @@
package MooseX::GlobRef::ObjectImmutableTest;
-use parent 'MooseX::GlobRef::ObjectBaseTest';
+use parent 'MooseX::GlobRefBaseTest';
use constant test_class => (__PACKAGE__ . '::TestClass');
Modified: MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectTest.pm
===================================================================
--- MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectTest.pm 2009-02-13 14:56:42 UTC (rev 7650)
+++ MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectTest.pm 2009-02-13 15:55:16 UTC (rev 7651)
@@ -1,6 +1,6 @@
package MooseX::GlobRef::ObjectTest;
-use parent 'MooseX::GlobRef::ObjectBaseTest';
+use parent 'MooseX::GlobRefBaseTest';
use constant test_class => (__PACKAGE__ . '::TestClass');
Copied: MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefBaseTest.pm (from rev 7649, MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectBaseTest.pm)
===================================================================
--- MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefBaseTest.pm (rev 0)
+++ MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefBaseTest.pm 2009-02-13 15:55:16 UTC (rev 7651)
@@ -0,0 +1,110 @@
+package MooseX::GlobRef::GlobRefBaseTest;
+
+use Test::Unit::Lite;
+use parent 'Test::Unit::TestCase';
+
+use Test::Assert ':all';
+
+use Scalar::Util 'reftype';
+
+sub test_class {
+ fail('test_class is not overriden');
+};
+
+sub test___isa {
+ my $self = shift;
+ my $test_class = $self->test_class;
+
+ my $obj = $test_class->new;
+ assert_not_null($obj);
+ assert_isa($test_class, $obj);
+ assert_equals('GLOB', reftype($obj));
+};
+
+sub test_accessor {
+ my $self = shift;
+ my $test_class = $self->test_class;
+
+ my $obj = $test_class->new;
+ assert_not_null($obj);
+ assert_isa($test_class, $obj);
+ assert_equals('default', $obj->field);
+ assert_equals(1, $obj->field(1));
+ assert_equals(1, $obj->field);
+ assert_true($obj->clear_field);
+ assert_equals('default', $obj->field);
+};
+
+sub test_slot_moc {
+ my $self = shift;
+ my $test_class = $self->test_class;
+
+ my $mi = $test_class->meta->get_meta_instance;
+ assert_not_null($mi);
+
+ my $obj = $mi->create_instance;
+ assert_not_null($obj);
+ assert_isa($test_class, $obj);
+ assert_null($mi->get_slot_value($obj, 'field'));
+ assert_true(! $mi->is_slot_initialized($obj, 'field'));
+ assert_equals(1, $mi->set_slot_value($obj, 'field', 1));
+ assert_equals(1, $mi->get_slot_value($obj, 'field'));
+ assert_true($mi->is_slot_initialized($obj, 'field'));
+ assert_true($mi->deinitialize_slot($obj, 'field'));
+ assert_null($mi->get_slot_value($obj, 'field'));
+ assert_true(! $mi->is_slot_initialized($obj, 'field'));
+};
+
+sub test_slot_moc_inline {
+ my $self = shift;
+ my $test_class = $self->test_class;
+
+ my $mi = $test_class->meta->get_meta_instance;
+ assert_not_null($mi);
+
+ my $code_create_instance = $mi->inline_create_instance('$test_class');
+ assert_not_equals('', $code_create_instance);
+ my $code_get_slot_value = $mi->inline_get_slot_value('$obj', 'field');
+ assert_not_equals('', $code_get_slot_value);
+ my $code_is_slot_initialized = $mi->inline_is_slot_initialized('$obj', 'field');
+ assert_not_equals('', $code_is_slot_initialized);
+ my $code_set_slot_value = $mi->inline_set_slot_value('$obj', 'field', '$value');
+ assert_not_equals('', $code_set_slot_value);
+ my $code_deinitialize_slot = $mi->inline_deinitialize_slot('$obj', 'field');
+ assert_not_equals('', $code_deinitialize_slot);
+
+ my $obj = eval $code_create_instance;
+ assert_not_null($obj);
+ assert_isa($test_class, $obj);
+ assert_null(eval $code_get_slot_value);
+ assert_true(! eval $code_is_slot_initialized);
+ my $value = 42;
+ assert_equals($value, eval $code_set_slot_value);
+ assert_equals($value, eval $code_get_slot_value);
+ assert_true(eval $code_is_slot_initialized);
+ assert_true(eval $code_deinitialize_slot);
+ assert_null(eval $code_get_slot_value);
+ assert_true(! eval $code_is_slot_initialized);
+};
+
+sub test_weak_field {
+ my $self = shift;
+ my $test_class = $self->test_class;
+
+ my $mi = $test_class->meta->get_meta_instance;
+ assert_not_null($mi);
+ my $obj = $test_class->new;
+ assert_not_null($obj);
+ assert_isa($test_class, $obj);
+ assert_null($obj->weak_field);
+ {
+ my $scalar = 'SCALAR';
+ assert_not_null($obj->weak_field(\$scalar));
+ assert_not_null($obj->weak_field);
+ assert_equals('SCALAR', ${$obj->weak_field});
+ $mi->weaken_slot_value($obj, 'weak_field');
+ };
+ assert_null($obj->weak_field);
+};
+
+1;
Property changes on: MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefBaseTest.pm
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefImmutableTest.pm (from rev 7649, MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectImmutableTest.pm)
===================================================================
--- MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefImmutableTest.pm (rev 0)
+++ MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefImmutableTest.pm 2009-02-13 15:55:16 UTC (rev 7651)
@@ -0,0 +1,40 @@
+package MooseX::GlobRefImmutableTest;
+
+use parent 'MooseX::GlobRefBaseTest';
+
+use constant test_class => (__PACKAGE__ . '::TestClass');
+
+{
+ package MooseX::GlobRefImmutableTest::TestClass;
+
+ use Moose;
+
+ use 'MooseX::GlobRef';
+
+ has field => (
+ is => 'rw',
+ clearer => 'clear_field',
+ default => 'default',
+ lazy => 1,
+ );
+
+ has weak_field => (
+ is => 'rw',
+ );
+
+ sub BUILD {
+ my $self = shift;
+
+ # fill some other slots in globref
+ my $scalarref = ${*$self};
+ $$scalarref = 'SCALAR';
+ my $arrayref = \@{*$self};
+ @$arrayref = ('ARRAY');
+
+ return $self;
+ };
+
+ __PACKAGE__->meta->make_immutable;
+};
+
+1;
Property changes on: MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefImmutableTest.pm
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefTest.pm (from rev 7649, MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectTest.pm)
===================================================================
--- MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefTest.pm (rev 0)
+++ MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefTest.pm 2009-02-13 15:55:16 UTC (rev 7651)
@@ -0,0 +1,41 @@
+package MooseX::GlobRefTest;
+
+use parent 'MooseX::GlobRefBaseTest';
+
+use constant test_class => (__PACKAGE__ . '::TestClass');
+
+{
+ package MooseX::GlobRefTest::TestClass;
+
+ use Moose;
+
+ use 'MooseX::GlobRef';
+
+ has field => (
+ is => 'rw',
+ clearer => 'clear_field',
+ default => 'default',
+ lazy => 1,
+ );
+
+ has weak_field => (
+ is => 'rw',
+ );
+
+ sub BUILD {
+ my $self = shift;
+
+ # if not a globref then will fail later on assertion
+ if (Scalar::Util::reftype($self) eq 'GLOB') {
+ # fill some other slots in globref
+ my $scalarref = ${*$self};
+ $$scalarref = 'SCALAR';
+ my $arrayref = \@{*$self};
+ @$arrayref = ('ARRAY');
+ };
+
+ return $self;
+ };
+};
+
+1;
Property changes on: MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefTest.pm
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefTestSuite.pm (from rev 7649, MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectTestSuite.pm)
===================================================================
--- MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefTestSuite.pm (rev 0)
+++ MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefTestSuite.pm 2009-02-13 15:55:16 UTC (rev 7651)
@@ -0,0 +1,24 @@
+package MooseX::GlobRefTestSuite;
+
+use Test::Unit::Lite;
+use parent 'Test::Unit::TestSuite';
+
+sub suite {
+ my $class = shift;
+
+ my $suite_name = __PACKAGE__;
+ $suite_name =~ s/.*://;
+
+ my $simple_test_name = __PACKAGE__;
+ $simple_test_name =~ s/Suite$//;
+
+ my $immutable_test_name = __PACKAGE__;
+ $immutable_test_name =~ s/TestSuite$/ImmutableTest/;
+
+ my $suite = Test::Unit::TestSuite->empty_new($suite_name);
+ $suite->add_test($simple_test_name);
+ $suite->add_test($immutable_test_name);
+ return $suite;
+};
+
+1;
Property changes on: MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefTestSuite.pm
___________________________________________________________________
Name: svn:mergeinfo
+
More information about the Moose-commits
mailing list