Fix Str() and ScalarRef()

diff --git a/lib/Mouse/PurePerl.pm b/lib/Mouse/PurePerl.pm
index 0a626f8..df00604 100644 (file)
--- a/lib/Mouse/PurePerl.pm
+++ b/lib/Mouse/PurePerl.pm
@@ -138,10 +138,16 @@ sub Defined    {  defined($_[0])  }
 sub Value      {  defined($_[0]) && !ref($_[0]) }
 sub Num        { !ref($_[0]) && looks_like_number($_[0]) }
 sub Int        {  defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ }
-sub Str        {  defined($_[0]) && !ref($_[0]) }
+sub Str        {
+    my($value) = @_;
+    return defined($value) && ref(\$value) eq 'SCALAR';
+}
 
 sub Ref        { ref($_[0]) }
-sub ScalarRef  { ref($_[0]) eq 'SCALAR' }
+sub ScalarRef  {
+    my($value) = @_;
+    return ref($value) eq 'SCALAR'
+}
 sub ArrayRef   { ref($_[0]) eq 'ARRAY'  }
 sub HashRef    { ref($_[0]) eq 'HASH'   }
 sub CodeRef    { ref($_[0]) eq 'CODE'   }
@@ -149,7 +155,7 @@ sub RegexpRef  { ref($_[0]) eq 'Regexp' }
 sub GlobRef    { ref($_[0]) eq 'GLOB'   }
 
 sub FileHandle {
-    openhandle($_[0])  || (blessed($_[0]) && $_[0]->isa("IO::Handle"))
+    return openhandle($_[0])  || (blessed($_[0]) && $_[0]->isa("IO::Handle"))
 }
 
 sub Object     { blessed($_[0]) && blessed($_[0]) ne 'Regexp' }

diff --git a/t/040_type_constraints/003_util_std_type_constraints.t b/t/040_type_constraints/003_util_std_type_constraints.t
index a9d6a6d..0ce13fb 100644 (file)
--- a/t/040_type_constraints/003_util_std_type_constraints.t
+++ b/t/040_type_constraints/003_util_std_type_constraints.t
@@ -1,24 +1,25 @@
 #!/usr/bin/perl
 
-use lib 't/lib';
 use strict;
 use warnings;
 
-use Test::More tests => 277;
+use Test::More;
 use Test::Exception;
 
-use MooseCompat;
-
+use t::lib::MooseCompat;
 use Scalar::Util ();
 
 BEGIN {
     use_ok('Mouse::Util::TypeConstraints');
 }
 
+my $STRING     = "foo";
+
 my $SCALAR_REF = \(my $var);
 
 no warnings 'once'; # << I *hates* that warning ...
-my $GLOB_REF   = \*GLOB_REF;
+my $GLOB       = *GLOB_REF;
+my $GLOB_REF   = \$GLOB;
 
 my $fh;
 open($fh, '<', $0) || die "Could not open $0 for the test";
@@ -35,6 +36,7 @@ ok(defined Any([]),              '... Any accepts anything');
 ok(defined Any({}),              '... Any accepts anything');
 ok(defined Any(sub {}),          '... Any accepts anything');
 ok(defined Any($SCALAR_REF),     '... Any accepts anything');
+ok(defined Any($GLOB),           '... Any accepts anything');
 ok(defined Any($GLOB_REF),       '... Any accepts anything');
 ok(defined Any($fh),             '... Any accepts anything');
 ok(defined Any(qr/../),          '... Any accepts anything');
@@ -49,6 +51,7 @@ ok(defined Item([]),              '... Item is the base type, so accepts anythin
 ok(defined Item({}),              '... Item is the base type, so accepts anything');
 ok(defined Item(sub {}),          '... Item is the base type, so accepts anything');
 ok(defined Item($SCALAR_REF),     '... Item is the base type, so accepts anything');
+ok(defined Item($GLOB),           '... Item is the base type, so accepts anything');
 ok(defined Item($GLOB_REF),       '... Item is the base type, so accepts anything');
 ok(defined Item($fh),             '... Item is the base type, so accepts anything');
 ok(defined Item(qr/../),          '... Item is the base type, so accepts anything');
@@ -63,6 +66,7 @@ ok(defined Defined([]),              '... Defined accepts anything which is defi
 ok(defined Defined({}),              '... Defined accepts anything which is defined');
 ok(defined Defined(sub {}),          '... Defined accepts anything which is defined');
 ok(defined Defined($SCALAR_REF),     '... Defined accepts anything which is defined');
+ok(defined Defined($GLOB),           '... Defined accepts anything which is defined');
 ok(defined Defined($GLOB_REF),       '... Defined accepts anything which is defined');
 ok(defined Defined($fh),             '... Defined accepts anything which is defined');
 ok(defined Defined(qr/../),          '... Defined accepts anything which is defined');
@@ -77,6 +81,7 @@ ok(!defined Undef([]),              '... Undef accepts anything which is not def
 ok(!defined Undef({}),              '... Undef accepts anything which is not defined');
 ok(!defined Undef(sub {}),          '... Undef accepts anything which is not defined');
 ok(!defined Undef($SCALAR_REF),     '... Undef accepts anything which is not defined');
+ok(!defined Undef($GLOB),           '... Undef accepts anything which is not defined');
 ok(!defined Undef($GLOB_REF),       '... Undef accepts anything which is not defined');
 ok(!defined Undef($fh),             '... Undef accepts anything which is not defined');
 ok(!defined Undef(qr/../),          '... Undef accepts anything which is not defined');
@@ -92,6 +97,7 @@ ok(!defined Bool([]),               '... Bool rejects anything which is not a 1
 ok(!defined Bool({}),               '... Bool rejects anything which is not a 1 or 0 or "" or undef');
 ok(!defined Bool(sub {}),           '... Bool rejects anything which is not a 1 or 0 or "" or undef');
 ok(!defined Bool($SCALAR_REF),      '... Bool rejects anything which is not a 1 or 0 or "" or undef');
+ok(!defined Bool($GLOB),            '... Bool rejects anything which is not a 1 or 0 or "" or undef');
 ok(!defined Bool($GLOB_REF),        '... Bool rejects anything which is not a 1 or 0 or "" or undef');
 ok(!defined Bool($fh),              '... Bool rejects anything which is not a 1 or 0 or "" or undef');
 ok(!defined Bool(qr/../),           '... Bool rejects anything which is not a 1 or 0 or "" or undef');
@@ -106,6 +112,7 @@ ok(!defined Value([]),               '... Value rejects anything which is not a
 ok(!defined Value({}),               '... Value rejects anything which is not a Value');
 ok(!defined Value(sub {}),           '... Value rejects anything which is not a Value');
 ok(!defined Value($SCALAR_REF),      '... Value rejects anything which is not a Value');
+ok(defined Value($GLOB),             '... Value accepts anything which is not a Ref');
 ok(!defined Value($GLOB_REF),        '... Value rejects anything which is not a Value');
 ok(!defined Value($fh),              '... Value rejects anything which is not a Value');
 ok(!defined Value(qr/../),           '... Value rejects anything which is not a Value');
@@ -120,6 +127,7 @@ ok(defined Ref([]),               '... Ref rejects anything which is not a Ref')
 ok(defined Ref({}),               '... Ref rejects anything which is not a Ref');
 ok(defined Ref(sub {}),           '... Ref rejects anything which is not a Ref');
 ok(defined Ref($SCALAR_REF),      '... Ref rejects anything which is not a Ref');
+ok(!defined Ref($GLOB),           '... Ref accepts anything which is not a Value');
 ok(defined Ref($GLOB_REF),        '... Ref rejects anything which is not a Ref');
 ok(defined Ref($fh),              '... Ref rejects anything which is not a Ref');
 ok(defined Ref(qr/../),           '... Ref rejects anything which is not a Ref');
@@ -128,19 +136,20 @@ ok(!defined Ref(undef),           '... Ref rejects anything which is not a Ref')
 
 ok(defined Int(0),                 '... Int accepts anything which is an Int');
 ok(defined Int(100),               '... Int accepts anything which is an Int');
-ok(!defined Int(0.5),              '... Int accepts anything which is not a Int');
-ok(!defined Int(100.01),           '... Int accepts anything which is not a Int');
-ok(!defined Int(''),               '... Int rejects anything which is not a Int');
-ok(!defined Int('Foo'),            '... Int rejects anything which is not a Int');
-ok(!defined Int([]),               '... Int rejects anything which is not a Int');
-ok(!defined Int({}),               '... Int rejects anything which is not a Int');
-ok(!defined Int(sub {}),           '... Int rejects anything which is not a Int');
-ok(!defined Int($SCALAR_REF),      '... Int rejects anything which is not a Int');
-ok(!defined Int($GLOB_REF),        '... Int rejects anything which is not a Int');
-ok(!defined Int($fh),              '... Int rejects anything which is not a Int');
-ok(!defined Int(qr/../),           '... Int rejects anything which is not a Int');
-ok(!defined Int(bless {}, 'Foo'),  '... Int rejects anything which is not a Int');
-ok(!defined Int(undef),            '... Int rejects anything which is not a Int');
+ok(!defined Int(0.5),              '... Int accepts anything which is not an Int');
+ok(!defined Int(100.01),           '... Int accepts anything which is not an Int');
+ok(!defined Int(''),               '... Int rejects anything which is not an Int');
+ok(!defined Int('Foo'),            '... Int rejects anything which is not an Int');
+ok(!defined Int([]),               '... Int rejects anything which is not an Int');
+ok(!defined Int({}),               '... Int rejects anything which is not an Int');
+ok(!defined Int(sub {}),           '... Int rejects anything which is not an Int');
+ok(!defined Int($SCALAR_REF),      '... Int rejects anything which is not an Int');
+ok(!defined Int($GLOB),            '... Int rejects anything which is not an Int');
+ok(!defined Int($GLOB_REF),        '... Int rejects anything which is not an Int');
+ok(!defined Int($fh),              '... Int rejects anything which is not an Int');
+ok(!defined Int(qr/../),           '... Int rejects anything which is not an Int');
+ok(!defined Int(bless {}, 'Foo'),  '... Int rejects anything which is not an Int');
+ok(!defined Int(undef),            '... Int rejects anything which is not an Int');
 
 ok(defined Num(0),                 '... Num accepts anything which is an Num');
 ok(defined Num(100),               '... Num accepts anything which is an Num');
@@ -152,6 +161,7 @@ ok(!defined Num([]),               '... Num rejects anything which is not a Num'
 ok(!defined Num({}),               '... Num rejects anything which is not a Num');
 ok(!defined Num(sub {}),           '... Num rejects anything which is not a Num');
 ok(!defined Num($SCALAR_REF),      '... Num rejects anything which is not a Num');
+ok(!defined Num($GLOB),            '... Num rejects anything which is not a Num');
 ok(!defined Num($GLOB_REF),        '... Num rejects anything which is not a Num');
 ok(!defined Num($fh),              '... Num rejects anything which is not a Num');
 ok(!defined Num(qr/../),           '... Num rejects anything which is not a Num');
@@ -162,11 +172,13 @@ ok(defined Str(0),                 '... Str accepts anything which is a Str');
 ok(defined Str(100),               '... Str accepts anything which is a Str');
 ok(defined Str(''),                '... Str accepts anything which is a Str');
 ok(defined Str('Foo'),             '... Str accepts anything which is a Str');
+ok(defined Str(substr($STRING,0,1)),'... Str accepts anything which is a Str');
 ok(!defined Str([]),               '... Str rejects anything which is not a Str');
 ok(!defined Str({}),               '... Str rejects anything which is not a Str');
 ok(!defined Str(sub {}),           '... Str rejects anything which is not a Str');
 ok(!defined Str($SCALAR_REF),      '... Str rejects anything which is not a Str');
 ok(!defined Str($fh),              '... Str rejects anything which is not a Str');
+ok(!defined Str($GLOB),            '... Str rejects anything which is not a Str');
 ok(!defined Str($GLOB_REF),        '... Str rejects anything which is not a Str');
 ok(!defined Str(qr/../),           '... Str rejects anything which is not a Str');
 ok(!defined Str(bless {}, 'Foo'),  '... Str rejects anything which is not a Str');
@@ -180,6 +192,7 @@ ok(!defined ScalarRef([]),               '... ScalarRef rejects anything which i
 ok(!defined ScalarRef({}),               '... ScalarRef rejects anything which is not a ScalarRef');
 ok(!defined ScalarRef(sub {}),           '... ScalarRef rejects anything which is not a ScalarRef');
 ok(defined ScalarRef($SCALAR_REF),       '... ScalarRef accepts anything which is a ScalarRef');
+ok(!defined ScalarRef($GLOB),            '... ScalarRef rejects anything which is not a ScalarRef');
 ok(!defined ScalarRef($GLOB_REF),        '... ScalarRef rejects anything which is not a ScalarRef');
 ok(!defined ScalarRef($fh),              '... ScalarRef rejects anything which is not a ScalarRef');
 ok(!defined ScalarRef(qr/../),           '... ScalarRef rejects anything which is not a ScalarRef');
@@ -194,6 +207,7 @@ ok(defined ArrayRef([]),                '... ArrayRef accepts anything which is
 ok(!defined ArrayRef({}),               '... ArrayRef rejects anything which is not a ArrayRef');
 ok(!defined ArrayRef(sub {}),           '... ArrayRef rejects anything which is not a ArrayRef');
 ok(!defined ArrayRef($SCALAR_REF),      '... ArrayRef rejects anything which is not a ArrayRef');
+ok(!defined ArrayRef($GLOB),            '... ArrayRef rejects anything which is not a ArrayRef');
 ok(!defined ArrayRef($GLOB_REF),        '... ArrayRef rejects anything which is not a ArrayRef');
 ok(!defined ArrayRef($fh),              '... ArrayRef rejects anything which is not a ArrayRef');
 ok(!defined ArrayRef(qr/../),           '... ArrayRef rejects anything which is not a ArrayRef');
@@ -208,6 +222,7 @@ ok(!defined HashRef([]),               '... HashRef rejects anything which is no
 ok(defined HashRef({}),                '... HashRef accepts anything which is a HashRef');
 ok(!defined HashRef(sub {}),           '... HashRef rejects anything which is not a HashRef');
 ok(!defined HashRef($SCALAR_REF),      '... HashRef rejects anything which is not a HashRef');
+ok(!defined HashRef($GLOB),            '... HashRef rejects anything which is not a HashRef');
 ok(!defined HashRef($GLOB_REF),        '... HashRef rejects anything which is not a HashRef');
 ok(!defined HashRef($fh),              '... HashRef rejects anything which is not a HashRef');
 ok(!defined HashRef(qr/../),           '... HashRef rejects anything which is not a HashRef');
@@ -222,6 +237,7 @@ ok(!defined CodeRef([]),               '... CodeRef rejects anything which is no
 ok(!defined CodeRef({}),               '... CodeRef rejects anything which is not a CodeRef');
 ok(defined CodeRef(sub {}),            '... CodeRef accepts anything which is a CodeRef');
 ok(!defined CodeRef($SCALAR_REF),      '... CodeRef rejects anything which is not a CodeRef');
+ok(!defined CodeRef($GLOB),            '... CodeRef rejects anything which is not a CodeRef');
 ok(!defined CodeRef($GLOB_REF),        '... CodeRef rejects anything which is not a CodeRef');
 ok(!defined CodeRef($fh),              '... CodeRef rejects anything which is not a CodeRef');
 ok(!defined CodeRef(qr/../),           '... CodeRef rejects anything which is not a CodeRef');
@@ -236,6 +252,7 @@ ok(!defined RegexpRef([]),               '... RegexpRef rejects anything which i
 ok(!defined RegexpRef({}),               '... RegexpRef rejects anything which is not a RegexpRef');
 ok(!defined RegexpRef(sub {}),           '... RegexpRef rejects anything which is not a RegexpRef');
 ok(!defined RegexpRef($SCALAR_REF),      '... RegexpRef rejects anything which is not a RegexpRef');
+ok(!defined RegexpRef($GLOB),            '... RegexpRef rejects anything which is not a RegexpRef');
 ok(!defined RegexpRef($GLOB_REF),        '... RegexpRef rejects anything which is not a RegexpRef');
 ok(!defined RegexpRef($fh),              '... RegexpRef rejects anything which is not a RegexpRef');
 ok(defined RegexpRef(qr/../),            '... RegexpRef accepts anything which is a RegexpRef');
@@ -250,6 +267,7 @@ ok(!defined GlobRef([]),               '... GlobRef rejects anything which is no
 ok(!defined GlobRef({}),               '... GlobRef rejects anything which is not a GlobRef');
 ok(!defined GlobRef(sub {}),           '... GlobRef rejects anything which is not a GlobRef');
 ok(!defined GlobRef($SCALAR_REF),      '... GlobRef rejects anything which is not a GlobRef');
+ok(!defined GlobRef($GLOB),            '... GlobRef rejects anything which is not a GlobRef');
 ok(defined GlobRef($GLOB_REF),         '... GlobRef accepts anything which is a GlobRef');
 ok(defined GlobRef($fh),               '... GlobRef accepts anything which is a GlobRef');
 ok(!defined GlobRef($fh_obj),          '... GlobRef rejects anything which is not a GlobRef');
@@ -265,6 +283,7 @@ ok(!defined FileHandle([]),               '... FileHandle rejects anything which
 ok(!defined FileHandle({}),               '... FileHandle rejects anything which is not a FileHandle');
 ok(!defined FileHandle(sub {}),           '... FileHandle rejects anything which is not a FileHandle');
 ok(!defined FileHandle($SCALAR_REF),      '... FileHandle rejects anything which is not a FileHandle');
+ok(!defined FileHandle($GLOB),            '... FileHandle rejects anything which is not a FileHandle');
 ok(!defined FileHandle($GLOB_REF),        '... FileHandle rejects anything which is not a FileHandle');
 ok(defined FileHandle($fh),               '... FileHandle accepts anything which is a FileHandle');
 ok(defined FileHandle($fh_obj),           '... FileHandle accepts anything which is a FileHandle');
@@ -280,6 +299,7 @@ ok(!defined Object([]),               '... Object rejects anything which is not
 ok(!defined Object({}),               '... Object rejects anything which is not blessed');
 ok(!defined Object(sub {}),           '... Object rejects anything which is not blessed');
 ok(!defined Object($SCALAR_REF),      '... Object rejects anything which is not blessed');
+ok(!defined Object($GLOB),            '... Object rejects anything which is not blessed');
 ok(!defined Object($GLOB_REF),        '... Object rejects anything which is not blessed');
 ok(!defined Object($fh),              '... Object rejects anything which is not blessed');
 ok(!defined Object(qr/../),           '... Object rejects anything which is not blessed');
@@ -303,6 +323,7 @@ ok(!defined ClassName({}),              '... ClassName rejects anything which is
 ok(!defined ClassName(sub {}),          '... ClassName rejects anything which is not a ClassName');
 ok(!defined ClassName($SCALAR_REF),     '... ClassName rejects anything which is not a ClassName');
 ok(!defined ClassName($fh),             '... ClassName rejects anything which is not a ClassName');
+ok(!defined ClassName($GLOB),           '... ClassName rejects anything which is not a ClassName');
 ok(!defined ClassName($GLOB_REF),       '... ClassName rejects anything which is not a ClassName');
 ok(!defined ClassName(qr/../),          '... ClassName rejects anything which is not a ClassName');
 ok(!defined ClassName(bless {}, 'Foo'), '... ClassName rejects anything which is not a ClassName');
@@ -328,6 +349,7 @@ ok(!defined RoleName({}),              '... Rolename rejects anything which is n
 ok(!defined RoleName(sub {}),          '... Rolename rejects anything which is not a RoleName');
 ok(!defined RoleName($SCALAR_REF),     '... Rolename rejects anything which is not a RoleName');
 ok(!defined RoleName($fh),             '... Rolename rejects anything which is not a RoleName');
+ok(!defined RoleName($GLOB),           '... Rolename rejects anything which is not a RoleName');
 ok(!defined RoleName($GLOB_REF),       '... Rolename rejects anything which is not a RoleName');
 ok(!defined RoleName(qr/../),          '... Rolename rejects anything which is not a RoleName');
 ok(!defined RoleName(bless {}, 'Foo'), '... Rolename rejects anything which is not a RoleName');
@@ -338,3 +360,5 @@ ok(!defined RoleName('Mouse::Meta::TypeConstraint'),  '... RoleName accepts anyt
 ok(defined RoleName('Quux::Wibble::Role'),      '... RoleName accepts anything which is a RoleName');
 
 close($fh) || die "Could not close the filehandle $0 for test";
+
+done_testing;