Commits

Toby Inkster committed ffc45aa

change behaviour of single-argument versions of does and overloads

  • Participants
  • Parent commits 8be48e0

Comments (0)

Files changed (6)

File lib/Scalar/Does.pm

 our %_CONSTANTS;
 BEGIN {
 	$Scalar::Does::AUTHORITY = 'cpan:TOBYINK';
-	$Scalar::Does::VERSION   = '0.007';
+	$Scalar::Does::VERSION   = '0.008';
 	
 	%_CONSTANTS = (
 		BOOLEAN    => q[bool],
 BEGIN {
 	package Scalar::Does::RoleChecker;
 	$Scalar::Does::RoleChecker::AUTHORITY = 'cpan:TOBYINK';
-	$Scalar::Does::RoleChecker::VERSION   = '0.007';
+	$Scalar::Does::RoleChecker::VERSION   = '0.008';
 	use overload
 		q[""]    => 'name',
 		q[&{}]   => 'code',
 
 use constant \%_CONSTANTS;
 use Carp             0     qw( confess );
-use IO::Detect       0.001 qw( is_filehandle );
 use namespace::clean 0.19  qw();
 use Scalar::Util     1.20  qw( blessed reftype looks_like_number );
 
 		make           => [qw( make_role where )],
 	},
 	installer => sub {
-		namespace::clean->import(
+		namespace::clean::->import(
 			-cleanee => $_[0]{into},
 			grep { !ref } @{ $_[1] },
 		);
 	GLOB     => sub { reftype($_) eq 'GLOB'    or overloads($_, q[*{}]) },
 	LVALUE   => sub { ref($_) eq 'LVALUE' },
 	FORMAT   => sub { reftype($_) eq 'FORMAT' },
-	IO       => \&is_filehandle,
+	IO       => sub { require IO::Detect; IO::Detect::is_filehandle($_) },
 	VSTRING  => sub { reftype($_) eq 'VSTRING' or ref($_) eq 'VSTRING' },
 	Regexp   => sub { reftype($_) eq 'Regexp'  or ref($_) eq 'Regexp'  or overloads($_, q[qr]) },
 	q[bool]  => sub { !blessed($_) or !overload::Overloaded($_) or overloads($_, q[bool]) },
 	q[""]    => sub { !ref($_)     or !overload::Overloaded($_) or overloads($_, q[""]) },
 	q[0+]    => sub { !ref($_)     or !overload::Overloaded($_) or overloads($_, q[0+]) },
-	q[<>]    => sub { overloads($_, q[<>])     or is_filehandle($_) },
-	q[~~]    => sub { overloads($_, q[~~])     or not blessed($_) },
+	q[<>]    => sub { require IO::Detect; overloads($_, q[<>]) or IO::Detect::is_filehandle($_) },
+	q[~~]    => sub { overloads($_, q[~~]) or not blessed($_) },
 	q[${}]   => 'SCALAR',
 	q[@{}]   => 'ARRAY',
 	q[%{}]   => 'HASH',
 while (my ($k, $v) = each %ROLES)
 	{ $ROLES{$k} = $ROLES{$v} unless ref $v }
 
+sub _process
+{
+	if (@_==1)
+	{
+		require PadWalker;
+		my $h = PadWalker::peek_my(2);
+		unshift @_,
+			exists $h->{'$_'} ? ${$h->{'$_'}} : $_;
+	}
+	return @_;
+}
+
 sub overloads ($;$)
 {
-	my ($thing, $role) = @_;
-	
-	# curry (kinda)
-	return sub { overloads(shift, $thing) } if @_==1;
-	
+	my ($thing, $role) = _process @_;
+		
 	return unless defined $thing;
 	goto \&overload::Method;
 }
 
 sub does ($;$)
 {
-	my ($thing, $role) = @_;
-	
-	# curry (kinda)
-	return sub { does(shift, $thing) } if @_==1;
+	my ($thing, $role) = _process @_;
 	
 	if (my $test = $ROLES{$role})
 	{
 
 sub make_role
 {
-	return 'Scalar::Does::RoleChecker'->new(@_);
+	return Scalar::Does::RoleChecker::->new(@_);
 }
 
 sub where (&)
 
 =item C<< does($role) >>
 
-The single-argument form of C<does> returns a curried coderef.
+Called with a single argument, tests C<< $_ >>. Yes, this works with lexical
+C<< $_ >>.
+
+  given ($object) {
+     when(does ARRAY)  { ... }
+     when(does HASH)   { ... }
+  }
+
+Note: in Scalar::Does 0.007 and below the single-argument form of C<does>
+returned a curried coderef. This was changed in Scalar::Does 0.008.
 
 =item C<< overloads($scalar, $role) >>
 
 
 =item C<< overloads($role) >>
 
-The single-argument form of C<overloads> returns a curried coderef.
+Called with a single argument, tests C<< $_ >>. Yes, this works with lexical
+C<< $_ >>.
+
+Note: in Scalar::Does 0.007 and below the single-argument form of C<overloads>
+returned a curried coderef. This was changed in Scalar::Does 0.008.
 
 =item C<< blessed($scalar) >>, C<< reftype($scalar) >>, C<< looks_like_number($scalar) >>
 

File lib/Scalar/Does/MooseTypes.pm

 package Scalar::Does::MooseTypes;
 
 our $AUTHORITY = 'cpan:TOBYINK';
-our $VERSION   = '0.007';
+our $VERSION   = '0.008';
 
 use Scalar::Does qw( blessed does looks_like_number -make );
 
 		make_role('CodeRef',   sub { ref $_[0] eq 'CODE' }),
 		make_role('RegexpRef', sub { ref $_[0] eq 'Regexp' }),
 		make_role('GlobRef',   sub { ref $_[0] eq 'GLOB' }),
-		make_role('FileHandle',\&IO::Detect::is_filehandle),
+		make_role('FileHandle',sub { require IO::Detect; IO::Detect::is_filehandle($_[0]) }),
 		make_role('Object',    sub { blessed($_[0]) }),
 		make_role('ClassName', sub { !ref($_[0]) && UNIVERSAL::can($_[0], 'can') }),
 		make_role('RoleName',  sub { !ref($_[0]) && UNIVERSAL::can($_[0], 'can') }),

File meta/changes.pret

 			dcs:fixes RT#80121;
 		];
 	].
+
+`Scalar-Does 0.008 cpan:TOBYINK`
+	issued  2012-10-27;
+	changeset [
+		item [
+			a dcs:Change;
+			label "INCOMPATIBLE CHANGE: single-argument does($role) and overloads($role) now check $_.";
+			comment "I've gone through the reverse dependencies on metacpan, and don't think anything should break.";
+			seealso RT#80434;
+			dcs:thanks cpan:DAMI;
+		];
+	].

File t/10underscore.t

+use Test::More;
+use Scalar::Does -constants;
+
+$_ = [];
+ok does ARRAY;
+ok not does HASH;
+
+{
+	my $_ = {};
+	ok does HASH;
+	ok not does ARRAY;
+}
+
+done_testing;
+

File t/11givenwhen.t

+use Test::More;
+BEGIN { $] >= 5.010001 or plan skip_all => "Perl 5.10.1+" };
+
+use feature qw(switch);
+use Scalar::Does -constants;
+
+plan tests => 2;
+
+my $array = [];
+
+ok does $array, ARRAY;
+
+given ($array) {
+	when ( does(HASH)  ) { fail() }
+	when ( does(ARRAY) ) { pass() }
+}
+

File t/99smartmatch.t

-# This is an experimental feature.
-#
-
-use Test::More;
-BEGIN { $] >= 5.010001 or plan skip_all => "Perl 5.10.1+" };
-
-plan tests => 4;
-
-use Scalar::Does qw( does overloads -constants );
-
-BEGIN {
-	package Local::OL;
-	use overload q[@{}] => sub { [] };
-	sub new { bless +{} }
-}
-
-ok(  ("a" ~~ does STRING)  );
-ok( !("a" ~~ does SCALAR) );
-
-my $obj = Local::OL->new;
-ok(  ($obj ~~ overloads '@{}') );
-ok( !($obj ~~ overloads '${}') );
-