[Moose-commits] r7434 - in MooseX-GlobRef-Object/trunk: .
lib/MooseX/GlobRef lib/MooseX/GlobRef/Meta t
t/tlib/MooseX/GlobRef t/tlib/MooseX/GlobRef/Meta
dexter at code2.0beta.co.uk
dexter at code2.0beta.co.uk
Fri Jan 30 20:59:12 GMT 2009
Author: dexter
Date: 2009-01-30 12:59:11 -0800 (Fri, 30 Jan 2009)
New Revision: 7434
Added:
MooseX-GlobRef-Object/trunk/Incompatibilities
MooseX-GlobRef-Object/trunk/t/test.pl
MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectImmutableWithScalarSlotTest.pm
MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectWithScalarSlotTest.pm
Modified:
MooseX-GlobRef-Object/trunk/Build.PL
MooseX-GlobRef-Object/trunk/Changes
MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Meta/Class.pm
MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Meta/Instance.pm
MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Object.pm
MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassImmutableTest.pm
MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassTest.pm
MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassTestSuite.pm
MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/InstanceImmutableTest.pm
MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/InstanceTest.pm
MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/InstanceTestSuite.pm
MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectImmutableTest.pm
MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectTest.pm
MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectTestSuite.pm
Log:
* Prepared to changes.
Modified: MooseX-GlobRef-Object/trunk/Build.PL
===================================================================
--- MooseX-GlobRef-Object/trunk/Build.PL 2009-01-30 19:33:46 UTC (rev 7433)
+++ MooseX-GlobRef-Object/trunk/Build.PL 2009-01-30 20:59:11 UTC (rev 7434)
@@ -50,7 +50,7 @@
meta_merge => {
resources => {
bugtracker => "http://rt.cpan.org/NoAuth/Bugs.html?Dist=$dist",
- repository => "http://dexter-cpan.googlecode.com/svn/$dist",
+ repository => "http://code2.0beta.co.uk/moose/svn/$dist",
},
},
);
Modified: MooseX-GlobRef-Object/trunk/Changes
===================================================================
--- MooseX-GlobRef-Object/trunk/Changes 2009-01-30 19:33:46 UTC (rev 7433)
+++ MooseX-GlobRef-Object/trunk/Changes 2009-01-30 20:59:11 UTC (rev 7434)
@@ -1,4 +1,10 @@
------------------------------------------------------------------------
+0.05 | Piotr Roszatycki <dexter at debian.org> | 2009-01-30
+
+* Attributes are stored in hash slot of glob reference. Previously they were
+ stored in hash reference pointed by scalar slot.
+
+------------------------------------------------------------------------
0.04 | Piotr Roszatycki <dexter at debian.org> | 2008-12-30
* Cannot be implemented as class trait.
Added: MooseX-GlobRef-Object/trunk/Incompatibilities
===================================================================
--- MooseX-GlobRef-Object/trunk/Incompatibilities (rev 0)
+++ MooseX-GlobRef-Object/trunk/Incompatibilities 2009-01-30 20:59:11 UTC (rev 7434)
@@ -0,0 +1,24 @@
+------------------------------------------------------------------------
+0.04 -> 0.05
+
+* Attributes are stored in hash slot of glob reference. Previously they were
+ stored in hash reference pointed by scalar slot.
+
+ Was:
+
+ my $obj = MooseX::GlobRef::Object->new;
+ ${*$obj}->{attr} = 42;
+
+ or:
+
+ my $obj = MooseX::GlobRef::Object->new;
+ my $hashref = ${*$obj};
+ ${*$obj}->{attr} = 42;
+
+ Should be:
+
+ my $obj = MooseX::GlobRef::Object->new;
+ my $hashref = \%{*$obj};
+ $hashref->{attr} = 42;
+
+------------------------------------------------------------------------
Modified: MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Meta/Class.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Meta/Class.pm 2009-01-30 19:33:46 UTC (rev 7433)
+++ MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Meta/Class.pm 2009-01-30 20:59:11 UTC (rev 7434)
@@ -17,7 +17,7 @@
use strict;
use warnings;
-our $VERSION = 0.04;
+our $VERSION = '0.05';
use parent 'Moose::Meta::Class';
Modified: MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Meta/Instance.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Meta/Instance.pm 2009-01-30 19:33:46 UTC (rev 7433)
+++ MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Meta/Instance.pm 2009-01-30 20:59:11 UTC (rev 7434)
@@ -19,7 +19,7 @@
sub open {
my $fh = shift;
- my $hashref = ${*$fh};
+ my $hashref = \%{*$fh};
open $fh, $hashref->{file} or confess "cannot open";
return $fh;
};
@@ -50,7 +50,7 @@
use strict;
use warnings;
-our $VERSION = 0.04;
+our $VERSION = '0.05';
use parent 'Moose::Meta::Instance';
Modified: MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Object.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Object.pm 2009-01-30 19:33:46 UTC (rev 7433)
+++ MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Object.pm 2009-01-30 20:59:11 UTC (rev 7434)
@@ -18,7 +18,7 @@
sub open {
my $fh = shift;
- my $hashref = ${*$fh};
+ my $hashref = \%{*$fh};
open $fh, $hashref->{file} or confess "cannot open";
return $fh;
}
@@ -38,11 +38,14 @@
=head1 DESCRIPTION
This meta-policy allows to store Moose object in glob reference or file
-handle. The class attributes will be stored in anonymous hash associated
-with glob reference. It allows to create a Moose version of L<IO::Handle>.
+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 elements of hash can be accessed with C<${*$self}-E<gt>{key}> expression.
+The elements of hash can be accessed with following expression:
+ my $hashref = \%{*$self};
+ $hashref->{key} = $value;
+
You can use L<MooseX::GlobRef::Meta::Instance> metaclass directly if you need
more customised configuration.
@@ -52,7 +55,7 @@
use strict;
use warnings;
-our $VERSION = 0.04;
+our $VERSION = '0.05';
use metaclass 'MooseX::GlobRef::Meta::Class' => (
@@ -92,7 +95,7 @@
=head1 LICENSE
-Copyright (C) 2007, 2008 by Piotr Roszatycki E<lt>dexter at debian.orgE<gt>.
+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.
Added: MooseX-GlobRef-Object/trunk/t/test.pl
===================================================================
--- MooseX-GlobRef-Object/trunk/t/test.pl (rev 0)
+++ MooseX-GlobRef-Object/trunk/t/test.pl 2009-01-30 20:59:11 UTC (rev 7434)
@@ -0,0 +1,19 @@
+#!/usr/bin/perl
+
+use 5.008;
+use strict;
+no warnings;
+
+use File::Basename;
+use File::Spec;
+use Cwd;
+
+BEGIN {
+ chdir dirname(__FILE__) or die "$!";
+ chdir '..' or die "$!";
+};
+
+do "./Build.PL";
+
+local @ARGV = (@ARGV, 'test');
+do "./Build";
Property changes on: MooseX-GlobRef-Object/trunk/t/test.pl
___________________________________________________________________
Name: svn:executable
+ *
Name: svn:mime-type
+ text/plain
Modified: MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassImmutableTest.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassImmutableTest.pm 2009-01-30 19:33:46 UTC (rev 7433)
+++ MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassImmutableTest.pm 2009-01-30 20:59:11 UTC (rev 7434)
@@ -1,6 +1,8 @@
package MooseX::GlobRef::Meta::ClassImmutableTest;
+use Test::Unit::Lite;
use parent 'Test::Unit::TestCase';
+
use Test::Assert ':all';
use Scalar::Util 'reftype';
Modified: MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassTest.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassTest.pm 2009-01-30 19:33:46 UTC (rev 7433)
+++ MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassTest.pm 2009-01-30 20:59:11 UTC (rev 7434)
@@ -1,6 +1,8 @@
package MooseX::GlobRef::Meta::ClassTest;
+use Test::Unit::Lite;
use parent 'Test::Unit::TestCase';
+
use Test::Assert ':all';
use Scalar::Util 'reftype';
Modified: MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassTestSuite.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassTestSuite.pm 2009-01-30 19:33:46 UTC (rev 7433)
+++ MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassTestSuite.pm 2009-01-30 20:59:11 UTC (rev 7434)
@@ -1,8 +1,7 @@
package MooseX::GlobRef::Meta::ClassTestSuite;
-use parent 'Test::Unit::TestSuite';
-
use Test::Unit::Lite;
+use parent 'Test::Unit::TestSuite';
sub suite {
my $class = shift;
Modified: MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/InstanceImmutableTest.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/InstanceImmutableTest.pm 2009-01-30 19:33:46 UTC (rev 7433)
+++ MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/InstanceImmutableTest.pm 2009-01-30 20:59:11 UTC (rev 7434)
@@ -1,6 +1,8 @@
package MooseX::GlobRef::Meta::InstanceImmutableTest;
+use Test::Unit::Lite;
use parent 'Test::Unit::TestCase';
+
use Test::Assert ':all';
use Scalar::Util 'reftype';
Modified: MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/InstanceTest.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/InstanceTest.pm 2009-01-30 19:33:46 UTC (rev 7433)
+++ MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/InstanceTest.pm 2009-01-30 20:59:11 UTC (rev 7434)
@@ -1,6 +1,8 @@
package MooseX::GlobRef::Meta::InstanceTest;
+use Test::Unit::Lite;
use parent 'Test::Unit::TestCase';
+
use Test::Assert ':all';
use Scalar::Util 'reftype';
Modified: MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/InstanceTestSuite.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/InstanceTestSuite.pm 2009-01-30 19:33:46 UTC (rev 7433)
+++ MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/InstanceTestSuite.pm 2009-01-30 20:59:11 UTC (rev 7434)
@@ -1,8 +1,7 @@
package MooseX::GlobRef::Meta::InstanceTestSuite;
-use parent 'Test::Unit::TestSuite';
-
use Test::Unit::Lite;
+use parent 'Test::Unit::TestSuite';
sub suite {
my $class = shift;
Modified: MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectImmutableTest.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectImmutableTest.pm 2009-01-30 19:33:46 UTC (rev 7433)
+++ MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectImmutableTest.pm 2009-01-30 20:59:11 UTC (rev 7434)
@@ -1,6 +1,8 @@
package MooseX::GlobRef::ObjectImmutableTest;
+use Test::Unit::Lite;
use parent 'Test::Unit::TestCase';
+
use Test::Assert ':all';
use Scalar::Util 'reftype';
Added: MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectImmutableWithScalarSlotTest.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectImmutableWithScalarSlotTest.pm (rev 0)
+++ MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectImmutableWithScalarSlotTest.pm 2009-01-30 20:59:11 UTC (rev 7434)
@@ -0,0 +1,127 @@
+package MooseX::GlobRef::ObjectImmutableWithScalarTest;
+
+use Test::Unit::Lite;
+use parent 'Test::Unit::TestCase';
+
+use Test::Assert ':all';
+
+use Scalar::Util 'reftype';
+
+
+{
+ package MooseX::GlobRef::ObjectImmutableWithScalarTest::Test1;
+
+ use Moose;
+
+ extends 'MooseX::GlobRef::Object';
+
+ has field => (
+ is => 'rw',
+ clearer => 'clear_field',
+ default => 'default',
+ lazy => 1,
+ );
+
+ has weak_field => (
+ is => 'rw',
+ );
+
+ sub new {
+ my $class = shift;
+ my $self = $class->SUPER::new(@_);
+ my $scalarref = ${*$self};
+ ${$scalarref} = 'SCALAR';
+ return $self;
+ };
+
+ __PACKAGE__->meta->make_immutable;
+};
+
+
+sub test___isa {
+ my $self = shift;
+ my $obj = MooseX::GlobRef::ObjectImmutableWithScalarTest::Test1->new;
+ assert_not_null($obj);
+ assert_true($obj->isa('MooseX::GlobRef::ObjectImmutableWithScalarTest::Test1'));
+ assert_equals('GLOB', reftype($obj));
+ assert_equals('HASH', reftype(${*$obj}));
+};
+
+sub test_accessor {
+ my $self = shift;
+ my $obj = MooseX::GlobRef::ObjectImmutableWithScalarTest::Test1->new;
+ assert_not_null($obj);
+ assert_true($obj->isa('MooseX::GlobRef::ObjectImmutableWithScalarTest::Test1'));
+ 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 $mi = MooseX::GlobRef::ObjectImmutableWithScalarTest::Test1->meta->get_meta_instance;
+ assert_not_null($mi);
+
+ my $obj = $mi->create_instance;
+ assert_not_null($obj);
+ assert_true($obj->isa('MooseX::GlobRef::ObjectImmutableWithScalarTest::Test1'));
+ 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 $mi = MooseX::GlobRef::ObjectImmutableWithScalarTest::Test1->meta->get_meta_instance;
+ assert_not_null($mi);
+
+ my $code_create_instance = $mi->inline_create_instance('$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 "my \$class = 'MooseX::GlobRef::ObjectImmutableWithScalarTest::Test1'; $code_create_instance;";
+ assert_not_null($obj);
+ assert_true($obj->isa('MooseX::GlobRef::ObjectImmutableWithScalarTest::Test1'));
+ assert_null(eval $code_get_slot_value);
+ assert_true(! eval $code_is_slot_initialized);
+ assert_equals(1, eval "my \$value = 1; $code_set_slot_value;");
+ assert_equals(1, 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 $mi = MooseX::GlobRef::ObjectImmutableWithScalarTest::Test1->meta->get_meta_instance;
+ assert_not_null($mi);
+ my $obj = MooseX::GlobRef::ObjectImmutableWithScalarTest::Test1->new;
+ assert_not_null($obj);
+ assert_true($obj->isa('MooseX::GlobRef::ObjectImmutableWithScalarTest::Test1'));
+ 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-Object/trunk/t/tlib/MooseX/GlobRef/ObjectImmutableWithScalarSlotTest.pm
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Modified: MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectTest.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectTest.pm 2009-01-30 19:33:46 UTC (rev 7433)
+++ MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectTest.pm 2009-01-30 20:59:11 UTC (rev 7434)
@@ -1,6 +1,8 @@
package MooseX::GlobRef::ObjectTest;
+use Test::Unit::Lite;
use parent 'Test::Unit::TestCase';
+
use Test::Assert ':all';
use Scalar::Util 'reftype';
@@ -32,7 +34,6 @@
assert_not_null($obj);
assert_true($obj->isa('MooseX::GlobRef::ObjectTest::Test1'));
assert_equals('GLOB', reftype($obj));
- assert_equals('HASH', reftype(${*$obj}));
};
sub test_accessor {
Modified: MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectTestSuite.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectTestSuite.pm 2009-01-30 19:33:46 UTC (rev 7433)
+++ MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectTestSuite.pm 2009-01-30 20:59:11 UTC (rev 7434)
@@ -1,14 +1,15 @@
package MooseX::GlobRef::ObjectTestSuite;
+use Test::Unit::Lite;
use parent 'Test::Unit::TestSuite';
-use Test::Unit::Lite;
-
sub suite {
my $class = shift;
my $suite = Test::Unit::TestSuite->empty_new('ExtendsObject');
$suite->add_test('MooseX::GlobRef::ObjectTest');
$suite->add_test('MooseX::GlobRef::ObjectImmutableTest');
+ $suite->add_test('MooseX::GlobRef::ObjectWithScalarSlotTest');
+ $suite->add_test('MooseX::GlobRef::ObjectImmutableWithScalarSlotTest');
return $suite;
};
Added: MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectWithScalarSlotTest.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectWithScalarSlotTest.pm (rev 0)
+++ MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectWithScalarSlotTest.pm 2009-01-30 20:59:11 UTC (rev 7434)
@@ -0,0 +1,125 @@
+package MooseX::GlobRef::ObjectWithScalarSlotTest;
+
+use Test::Unit::Lite;
+use parent 'Test::Unit::TestCase';
+
+use Test::Assert ':all';
+
+use Scalar::Util 'reftype';
+
+
+{
+ package MooseX::GlobRef::ObjectWithScalarSlotTest::Test1;
+
+ use Moose;
+
+ extends 'MooseX::GlobRef::Object';
+
+ has field => (
+ is => 'rw',
+ clearer => 'clear_field',
+ default => 'default',
+ lazy => 1,
+ );
+
+ has weak_field => (
+ is => 'rw',
+ );
+
+ sub new {
+ my $class = shift;
+ my $self = $class->SUPER::new(@_);
+ my $scalarref = ${*$self};
+ ${$scalarref} = 'SCALAR';
+ return $self;
+ };
+};
+
+
+sub test___isa {
+ my $self = shift;
+ my $obj = MooseX::GlobRef::ObjectWithScalarSlotTest::Test1->new;
+ assert_not_null($obj);
+ assert_true($obj->isa('MooseX::GlobRef::ObjectWithScalarSlotTest::Test1'));
+ assert_equals('GLOB', reftype($obj));
+ assert_equals('HASH', reftype(${*$obj}));
+};
+
+sub test_accessor {
+ my $self = shift;
+ my $obj = MooseX::GlobRef::ObjectWithScalarSlotTest::Test1->new;
+ assert_not_null($obj);
+ assert_true($obj->isa('MooseX::GlobRef::ObjectWithScalarSlotTest::Test1'));
+ 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 $mi = MooseX::GlobRef::ObjectWithScalarSlotTest::Test1->meta->get_meta_instance;
+ assert_not_null($mi);
+
+ my $obj = $mi->create_instance;
+ assert_not_null($obj);
+ assert_true($obj->isa('MooseX::GlobRef::ObjectWithScalarSlotTest::Test1'));
+ 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 $mi = MooseX::GlobRef::ObjectWithScalarSlotTest::Test1->meta->get_meta_instance;
+ assert_not_null($mi);
+
+ my $code_create_instance = $mi->inline_create_instance('$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 "my \$class = 'MooseX::GlobRef::ObjectWithScalarSlotTest::Test1'; $code_create_instance;";
+ assert_not_null($obj);
+ assert_true($obj->isa('MooseX::GlobRef::ObjectWithScalarSlotTest::Test1'));
+ assert_null(eval $code_get_slot_value);
+ assert_true(! eval $code_is_slot_initialized);
+ assert_equals(1, eval "my \$value = 1; $code_set_slot_value;");
+ assert_equals(1, 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 $mi = MooseX::GlobRef::ObjectWithScalarSlotTest::Test1->meta->get_meta_instance;
+ assert_not_null($mi);
+ my $obj = MooseX::GlobRef::ObjectWithScalarSlotTest::Test1->new;
+ assert_not_null($obj);
+ assert_true($obj->isa('MooseX::GlobRef::ObjectWithScalarSlotTest::Test1'));
+ 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-Object/trunk/t/tlib/MooseX/GlobRef/ObjectWithScalarSlotTest.pm
___________________________________________________________________
Name: svn:mime-type
+ text/plain
More information about the Moose-commits
mailing list