Moose-2.1405HEADMoose-2.1405master

1 files changed, 153 insertions, 0 deletions

diff --git a/t/recipes/meta_globref_instancemetaclass.t b/t/recipes/meta_globref_instancemetaclass.t
new file mode 100644
index 0000000..b02c0eb
--- /dev/null
+++ b/t/recipes/meta_globref_instancemetaclass.t
@@ -0,0 +1,153 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More 'no_plan';
+use Test::Fatal;
+$| = 1;
+
+
+
+# =begin testing SETUP
+{
+
+  package My::Meta::Instance;
+
+  use Scalar::Util qw( weaken );
+  use Symbol qw( gensym );
+
+  use Moose::Role;
+
+  sub create_instance {
+      my $self = shift;
+      my $sym = gensym();
+      bless $sym, $self->_class_name;
+  }
+
+  sub clone_instance {
+      my ( $self, $instance ) = @_;
+
+      my $new_sym = gensym();
+      %{*$new_sym} = %{*$instance};
+
+      bless $new_sym, $self->_class_name;
+  }
+
+  sub get_slot_value {
+      my ( $self, $instance, $slot_name ) = @_;
+      return *$instance->{$slot_name};
+  }
+
+  sub set_slot_value {
+      my ( $self, $instance, $slot_name, $value ) = @_;
+      *$instance->{$slot_name} = $value;
+  }
+
+  sub deinitialize_slot {
+      my ( $self, $instance, $slot_name ) = @_;
+      delete *$instance->{$slot_name};
+  }
+
+  sub is_slot_initialized {
+      my ( $self, $instance, $slot_name ) = @_;
+      exists *$instance->{$slot_name};
+  }
+
+  sub weaken_slot_value {
+      my ( $self, $instance, $slot_name ) = @_;
+      weaken *$instance->{$slot_name};
+  }
+
+  sub inline_create_instance {
+      my ( $self, $class_variable ) = @_;
+      return 'do { my $sym = Symbol::gensym(); bless $sym, ' . $class_variable . ' }';
+  }
+
+  sub inline_slot_access {
+      my ( $self, $instance, $slot_name ) = @_;
+      return '*{' . $instance . '}->{' . $slot_name . '}';
+  }
+
+  package MyApp::User;
+
+  use Moose;
+  Moose::Util::MetaRole::apply_metaroles(
+      for => __PACKAGE__,
+      class_metaroles => {
+          instance => ['My::Meta::Instance'],
+      },
+  );
+
+  has 'name' => (
+      is  => 'rw',
+      isa => 'Str',
+  );
+
+  has 'email' => (
+      is  => 'rw',
+      isa => 'Str',
+  );
+}
+
+
+
+# =begin testing
+{
+{
+    package MyApp::Employee;
+
+    use Moose;
+    extends 'MyApp::User';
+
+    has 'employee_number' => ( is => 'rw' );
+}
+
+for my $x ( 0 .. 1 ) {
+    MyApp::User->meta->make_immutable if $x;
+
+    my $user = MyApp::User->new(
+        name  => 'Faye',
+        email => 'faye@example.com',
+    );
+
+    ok( eval { *{$user} }, 'user object is an glob ref with some values' );
+
+    is( $user->name,  'Faye',             'check name' );
+    is( $user->email, 'faye@example.com', 'check email' );
+
+    $user->name('Ralph');
+    is( $user->name, 'Ralph', 'check name after changing it' );
+
+    $user->email('ralph@example.com');
+    is( $user->email, 'ralph@example.com', 'check email after changing it' );
+}
+
+for my $x ( 0 .. 1 ) {
+    MyApp::Employee->meta->make_immutable if $x;
+
+    my $emp = MyApp::Employee->new(
+        name            => 'Faye',
+        email           => 'faye@example.com',
+        employee_number => $x,
+    );
+
+    ok( eval { *{$emp} }, 'employee object is an glob ref with some values' );
+
+    is( $emp->name,            'Faye',             'check name' );
+    is( $emp->email,           'faye@example.com', 'check email' );
+    is( $emp->employee_number, $x,                 'check employee_number' );
+
+    $emp->name('Ralph');
+    is( $emp->name, 'Ralph', 'check name after changing it' );
+
+    $emp->email('ralph@example.com');
+    is( $emp->email, 'ralph@example.com', 'check email after changing it' );
+
+    $emp->employee_number(42);
+    is( $emp->employee_number, 42, 'check employee_number after changing it' );
+}
+}
+
+
+
+
+1;