We only need local $? if we inline calls to DEMOLISH

[gitmo/Moose.git] / t / type_constraints / util_std_type_constraints.t

diff --git a/t/type_constraints/util_std_type_constraints.t b/t/type_constraints/util_std_type_constraints.t
index 0ff5b20..31e22b4 100644 (file)
--- a/t/type_constraints/util_std_type_constraints.t
+++ b/t/type_constraints/util_std_type_constraints.t
@@ -717,14 +717,27 @@ my %tests = (
 
 for my $name ( sort keys %tests ) {
     test_constraint( $name, $tests{$name} );
+
+    test_constraint(
+        Moose::Util::TypeConstraints::find_or_create_type_constraint(
+            "$name|$name"),
+        $tests{$name}
+    );
 }
 
-# We need to test that the Str constraint accepts the return val of substr() -
-# which means passing that return val directly to the checking code
+my %substr_test_str = (
+    ClassName   => 'x' . $CLASS_NAME,
+    RoleName    => 'x' . $ROLE_NAME,
+);
+
+# We need to test that the Str constraint (and types that derive from it)
+# accept the return val of substr() - which means passing that return val
+# directly to the checking code
+foreach my $type_name (qw(Str Num Int ClassName RoleName))
 {
-    my $str = 'some string';
+    my $str = $substr_test_str{$type_name} || '123456789';
 
-    my $type = Moose::Util::TypeConstraints::find_type_constraint('Str');
+    my $type = Moose::Util::TypeConstraints::find_type_constraint($type_name);
 
     my $unoptimized
         = $type->has_parent
@@ -739,29 +752,32 @@ for my $name ( sort keys %tests ) {
     }
 
     ok(
-        $type->check( substr( $str, 1, 3 ) ),
-        'Str accepts return val from substr using ->check'
+        $type->check( substr( $str, 1, 5 ) ),
+        $type_name . ' accepts return val from substr using ->check'
     );
     ok(
-        $unoptimized->( substr( $str, 1, 3 ) ),
-        'Str accepts return val from substr using unoptimized constraint'
+        $unoptimized->( substr( $str, 1, 5 ) ),
+        $type_name . ' accepts return val from substr using unoptimized constraint'
     );
     ok(
-        $inlined->( substr( $str, 1, 3 ) ),
-        'Str accepts return val from substr using inlined constraint'
+        $inlined->( substr( $str, 1, 5 ) ),
+        $type_name . ' accepts return val from substr using inlined constraint'
     );
 
+    # only Str accepts empty strings.
+    next unless $type_name eq 'Str';
+
     ok(
         $type->check( substr( $str, 0, 0 ) ),
-        'Str accepts empty return val from substr using ->check'
+        $type_name . ' accepts empty return val from substr using ->check'
     );
     ok(
         $unoptimized->( substr( $str, 0, 0 ) ),
-        'Str accepts empty return val from substr using unoptimized constraint'
+        $type_name . ' accepts empty return val from substr using unoptimized constraint'
     );
     ok(
         $inlined->( substr( $str, 0, 0 ) ),
-        'Str accepts empty return val from substr using inlined constraint'
+        $type_name . ' accepts empty return val from substr using inlined constraint'
     );
 }
 
@@ -947,6 +963,128 @@ for my $name ( sort keys %tests ) {
         }
     );
 }
+{
+    note 'Anonymous Union Test';
+
+    my $union = union(['Int','Object']);
+
+    test_constraint(
+        $union, {
+            accept => [
+                $ZERO,
+                $ONE,
+                $INT,
+                $NEG_INT,
+                $FH_OBJECT,
+                $REGEX,
+                $REGEX_OBJ,
+                $FAKE_REGEX,
+                $OBJECT,
+            ],
+            reject => [
+                $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,
+                $UNDEF,
+            ],
+        }
+    );
+}
+{
+    note 'Named Union Test';
+    union 'NamedUnion' => ['Int','Object'];
+
+    test_constraint(
+        'NamedUnion', {
+            accept => [
+                $ZERO,
+                $ONE,
+                $INT,
+                $NEG_INT,
+                $FH_OBJECT,
+                $REGEX,
+                $REGEX_OBJ,
+                $FAKE_REGEX,
+                $OBJECT,
+            ],
+            reject => [
+                $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,
+                $UNDEF,
+            ],
+        }
+    );
+}
+
+{
+    note 'Combined Union Test';
+    my $union = union( [ 'Int', enum( [qw[ red green blue ]] ) ] );
+
+    test_constraint(
+        $union, {
+            accept => [
+                $ZERO,
+                $ONE,
+                $INT,
+                $NEG_INT,
+                'red',
+                'green',
+                'blue',
+            ],
+            reject => [
+                'yellow',
+                'pink',
+                $FH_OBJECT,
+                $REGEX,
+                $REGEX_OBJ,
+                $FAKE_REGEX,
+                $OBJECT,
+                $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,
+                $UNDEF,
+            ],
+        }
+    );
+}
+
 
 {
     enum 'Enum1' => 'a', 'b';