From: Dave Rolsky <autarch@urth.org>
Date: Thu, 21 Apr 2011 20:51:36 +0000 (-0500)
Subject: Make sure that inlining union preserves the inline env
X-Git-Tag: 2.0100~46
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ca7899039443df28ae0d58a29632c5ae5a51601a;p=gitmo%2FMoose.git

Make sure that inlining union preserves the inline env

Make sure that an enum's inline env works when unioned with another enum (each env has a unique var)
---

diff --git a/lib/Moose/Meta/TypeConstraint.pm b/lib/Moose/Meta/TypeConstraint.pm
index 95e89de..d500356 100644
--- a/lib/Moose/Meta/TypeConstraint.pm
+++ b/lib/Moose/Meta/TypeConstraint.pm
@@ -52,7 +52,7 @@ __PACKAGE__->meta->add_attribute('inlined' => (
 
 __PACKAGE__->meta->add_attribute('inline_environment' => (
     init_arg => 'inline_environment',
-    accessor => 'inline_environment',
+    accessor => '_inline_environment',
     default  => sub { {} },
 ));
 
@@ -160,6 +160,16 @@ sub _inline_check {
     return $self->inlined->( $self, @_ );
 }
 
+sub inline_environment {
+    my $self = shift;
+
+    if ( $self->has_parent && $self->constraint == $null_constraint ) {
+        return $self->parent->inline_environment;
+    }
+
+    return $self->_inline_environment;
+}
+
 sub assert_valid {
     my ($self, $value) = @_;
 
diff --git a/lib/Moose/Meta/TypeConstraint/Enum.pm b/lib/Moose/Meta/TypeConstraint/Enum.pm
index 2a7a5ad..4dfc8ce 100644
--- a/lib/Moose/Meta/TypeConstraint/Enum.pm
+++ b/lib/Moose/Meta/TypeConstraint/Enum.pm
@@ -13,15 +13,22 @@ __PACKAGE__->meta->add_attribute('values' => (
     accessor => 'values',
 ));
 
+__PACKAGE__->meta->add_attribute('_inline_var_name' => (
+    accessor => '_inline_var_name',
+));
+
 my $inliner = sub {
     my $self = shift;
     my $val  = shift;
 
     return 'defined(' . $val . ') '
              . '&& !ref(' . $val . ') '
-             . '&& $enums{' . $val . '}';
+             . '&& $' . $self->_inline_var_name . '{' . $val . '}';
 };
 
+# a quadrillion enums ought to be enough for any app
+my $var_suffix = '000000000000000000';
+
 sub new {
     my ( $class, %args ) = @_;
 
@@ -46,7 +53,10 @@ sub new {
 
     my %values = map { $_ => 1 } @{ $args{values} };
     $args{constraint} = sub { $values{ $_[0] } };
-    $args{inline_environment} = { '%enums' => \%values };
+
+    my $var_name = 'enums' . $var_suffix++;;
+    $args{_inline_var_name} = $var_name;
+    $args{inline_environment} = { '%' . $var_name => \%values };
 
     my $self = $class->_new(\%args);
 
diff --git a/lib/Moose/Meta/TypeConstraint/Union.pm b/lib/Moose/Meta/TypeConstraint/Union.pm
index feb4697..ae0ea12 100644
--- a/lib/Moose/Meta/TypeConstraint/Union.pm
+++ b/lib/Moose/Meta/TypeConstraint/Union.pm
@@ -86,6 +86,13 @@ sub _inline_check {
         @{ $self->type_constraints };
 };
 
+sub inline_environment {
+    my $self = shift;
+
+    return { map { %{ $_->inline_environment } }
+            @{ $self->type_constraints } };
+}
+
 sub equals {
     my ( $self, $type_or_name ) = @_;
 
diff --git a/t/type_constraints/util_std_type_constraints.t b/t/type_constraints/util_std_type_constraints.t
index 181d647..0ff5b20 100644
--- a/t/type_constraints/util_std_type_constraints.t
+++ b/t/type_constraints/util_std_type_constraints.t
@@ -949,6 +949,46 @@ for my $name ( sort keys %tests ) {
 }
 
 {
+    enum 'Enum1' => 'a', 'b';
+    enum 'Enum2' => 'x', 'y';
+
+    subtype 'EnumUnion', as 'Enum1 | Enum2';
+
+    test_constraint(
+        'EnumUnion', {
+            accept => [qw( a b x y )],
+            reject => [
+                $ZERO,
+                $ONE,
+                $INT,
+                $NEG_INT,
+                $NUM,
+                $NEG_NUM,
+                $EMPTY_STRING,
+                $STRING,
+                $NUM_IN_STRING,
+                $INT_WITH_NL1,
+                $INT_WITH_NL2,
+                $SCALAR_REF,
+                $SCALAR_REF_REF,
+                $ARRAY_REF,
+                $HASH_REF,
+                $CODE_REF,
+                $GLOB,
+                $GLOB_REF,
+                $FH,
+                $FH_OBJECT,
+                $REGEX,
+                $REGEX_OBJ,
+                $FAKE_REGEX,
+                $OBJECT,
+                $UNDEF,
+            ],
+        }
+    );
+}
+
+{
     package DoesRole;
 
     use Moose;