Hello community,
here is the log from the commit of package perl-Method-Signatures for
openSUSE:Factory checked in at 2017-02-15 10:06:43
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-Method-Signatures (Old)
and /work/SRC/openSUSE:Factory/.perl-Method-Signatures.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Method-Signatures"
Changes:
--------
---
/work/SRC/openSUSE:Factory/perl-Method-Signatures/perl-Method-Signatures.changes
2016-04-22 16:23:11.000000000 +0200
+++
/work/SRC/openSUSE:Factory/.perl-Method-Signatures.new/perl-Method-Signatures.changes
2017-02-15 10:06:44.965291329 +0100
@@ -1,0 +2,21 @@
+Sun Feb 12 06:08:53 UTC 2017 - [email protected]
+
+- updated to 20170211
+ see /usr/share/doc/packages/perl-Method-Signatures/Changes
+
+ 20170211 Feb 11 13:38:39 PST 2017
+ Promoted to full release
+
+ 20160608.0051_002 Wed Jun 8 00:51:42 PDT 2016
+ New Features
+ * Can now put prototypes in front of signatures
+ (provides compatibility with sigs in 5.20)
+ [RT/93336, github #99/#127] (thanks brummett)
+
+ 20160516.2032_001 Mon May 16 20:32:59 PDT 2016
+ New Features
+ * Can now use bare sigils as placeholders
+ (provides compatibility with sigs in 5.20)
+ [RT/93334, github #100/#126] (thanks brummett)
+
+-------------------------------------------------------------------
Old:
----
Method-Signatures-20160315.tar.gz
New:
----
Method-Signatures-20170211.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-Method-Signatures.spec ++++++
--- /var/tmp/diff_new_pack.kyuzJU/_old 2017-02-15 10:06:45.321241191 +0100
+++ /var/tmp/diff_new_pack.kyuzJU/_new 2017-02-15 10:06:45.325240628 +0100
@@ -1,7 +1,7 @@
#
# spec file for package perl-Method-Signatures
#
-# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -17,7 +17,7 @@
Name: perl-Method-Signatures
-Version: 20160315
+Version: 20170211
Release: 0
%define cpan_name Method-Signatures
Summary: Method and Function Declarations with Signatures and No Source
Filter
++++++ Method-Signatures-20160315.tar.gz -> Method-Signatures-20170211.tar.gz
++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Method-Signatures-20160315/Changes
new/Method-Signatures-20170211/Changes
--- old/Method-Signatures-20160315/Changes 2016-03-16 00:25:26.000000000
+0100
+++ new/Method-Signatures-20170211/Changes 2017-02-11 22:40:54.000000000
+0100
@@ -1,3 +1,18 @@
+20170211 Feb 11 13:38:39 PST 2017
+ Promoted to full release
+
+20160608.0051_002 Wed Jun 8 00:51:42 PDT 2016
+ New Features
+ * Can now put prototypes in front of signatures
+ (provides compatibility with sigs in 5.20)
+ [RT/93336, github #99/#127] (thanks brummett)
+
+20160516.2032_001 Mon May 16 20:32:59 PDT 2016
+ New Features
+ * Can now use bare sigils as placeholders
+ (provides compatibility with sigs in 5.20)
+ [RT/93334, github #100/#126] (thanks brummett)
+
20160315 Tue Mar 15 16:21:33 PDT 2016
Promoted to full release
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Method-Signatures-20160315/LICENSE
new/Method-Signatures-20170211/LICENSE
--- old/Method-Signatures-20160315/LICENSE 2016-03-16 00:25:26.000000000
+0100
+++ new/Method-Signatures-20170211/LICENSE 2017-02-11 22:40:54.000000000
+0100
@@ -1,4 +1,4 @@
-This software is copyright (c) 2016 by Michael G Schwern <[email protected]>.
+This software is copyright (c) 2017 by Michael G Schwern <[email protected]>.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
@@ -12,7 +12,7 @@
--- The GNU General Public License, Version 1, February 1989 ---
-This software is Copyright (c) 2016 by Michael G Schwern <[email protected]>.
+This software is Copyright (c) 2017 by Michael G Schwern <[email protected]>.
This is free software, licensed under:
@@ -272,7 +272,7 @@
--- The Artistic License 1.0 ---
-This software is Copyright (c) 2016 by Michael G Schwern <[email protected]>.
+This software is Copyright (c) 2017 by Michael G Schwern <[email protected]>.
This is free software, licensed under:
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Method-Signatures-20160315/MANIFEST
new/Method-Signatures-20170211/MANIFEST
--- old/Method-Signatures-20160315/MANIFEST 2016-03-16 00:25:26.000000000
+0100
+++ new/Method-Signatures-20170211/MANIFEST 2017-02-11 22:40:54.000000000
+0100
@@ -21,6 +21,8 @@
t/array_param.t
t/at_underscore.t
t/attributes.t
+t/attributes_before_signature.t
+t/bare_sigils.t
t/before_510.t
t/begin.t
t/block_defaults.t
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Method-Signatures-20160315/META.json
new/Method-Signatures-20170211/META.json
--- old/Method-Signatures-20160315/META.json 2016-03-16 00:25:26.000000000
+0100
+++ new/Method-Signatures-20170211/META.json 2017-02-11 22:40:54.000000000
+0100
@@ -49,11 +49,11 @@
"provides" : {
"Method::Signatures" : {
"file" : "lib/Method/Signatures.pm",
- "version" : "20160315"
+ "version" : "20170211"
},
"Method::Signatures::Modifiers" : {
"file" : "lib/Method/Signatures/Modifiers.pm",
- "version" : "20160315"
+ "version" : "20170211"
},
"Method::Signatures::Parameter" : {
"file" : "lib/Method/Signatures/Parameter.pm"
@@ -80,5 +80,5 @@
"url" : "https://github.com/evalEmpire/method-signatures";
}
},
- "version" : "20160315"
+ "version" : "20170211"
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Method-Signatures-20160315/META.yml
new/Method-Signatures-20170211/META.yml
--- old/Method-Signatures-20160315/META.yml 2016-03-16 00:25:26.000000000
+0100
+++ new/Method-Signatures-20170211/META.yml 2017-02-11 22:40:54.000000000
+0100
@@ -20,10 +20,10 @@
provides:
Method::Signatures:
file: lib/Method/Signatures.pm
- version: '20160315'
+ version: '20170211'
Method::Signatures::Modifiers:
file: lib/Method/Signatures/Modifiers.pm
- version: '20160315'
+ version: '20170211'
Method::Signatures::Parameter:
file: lib/Method/Signatures/Parameter.pm
Method::Signatures::Signature:
@@ -49,4 +49,4 @@
bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Method-Signatures
license: http://dev.perl.org/licenses/
repository: https://github.com/evalEmpire/method-signatures
-version: '20160315'
+version: '20170211'
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Method-Signatures-20160315/README
new/Method-Signatures-20170211/README
--- old/Method-Signatures-20160315/README 2016-03-16 00:25:26.000000000
+0100
+++ new/Method-Signatures-20170211/README 2017-02-11 22:40:54.000000000
+0100
@@ -5,7 +5,7 @@
VERSION
- 20160315
+ 20170211
SYNOPSIS
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Method-Signatures-20160315/README.pod
new/Method-Signatures-20170211/README.pod
--- old/Method-Signatures-20160315/README.pod 2016-03-16 00:25:26.000000000
+0100
+++ new/Method-Signatures-20170211/README.pod 2017-02-11 22:40:54.000000000
+0100
@@ -4,7 +4,7 @@
=head1 VERSION
-20160315
+20170211
=head1 SYNOPSIS
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/Method-Signatures-20160315/lib/Method/Signatures/Modifiers.pm
new/Method-Signatures-20170211/lib/Method/Signatures/Modifiers.pm
--- old/Method-Signatures-20160315/lib/Method/Signatures/Modifiers.pm
2016-03-16 00:25:26.000000000 +0100
+++ new/Method-Signatures-20170211/lib/Method/Signatures/Modifiers.pm
2017-02-11 22:40:54.000000000 +0100
@@ -7,7 +7,7 @@
use base 'Method::Signatures';
-our $VERSION = '20160315';
+our $VERSION = '20170211';
=head1 NAME
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/Method-Signatures-20160315/lib/Method/Signatures/Parameter.pm
new/Method-Signatures-20170211/lib/Method/Signatures/Parameter.pm
--- old/Method-Signatures-20160315/lib/Method/Signatures/Parameter.pm
2016-03-16 00:25:26.000000000 +0100
+++ new/Method-Signatures-20170211/lib/Method/Signatures/Parameter.pm
2017-02-11 22:40:54.000000000 +0100
@@ -5,7 +5,7 @@
use Method::Signatures::Utils;
my $IDENTIFIER = qr{ [^\W\d] \w* }x;
-my $VARIABLE = qr{ [\$\@%] $IDENTIFIER }x;
+my $VARIABLE = qr{ [\$\@%] $IDENTIFIER? }x;
my $TYPENAME = qr{ $IDENTIFIER (?: \:\: $IDENTIFIER )* }x;
our $PARAMETERIZED;
$PARAMETERIZED = do{ use re 'eval';
@@ -32,7 +32,16 @@
default => sub {
my $self = shift;
- return $self->original_code =~ m{^ \s* \Q...\E \s* $}x;
+ return $self->original_code =~ m{^ \s* (?:\Q...\E)|(?:@) \s* $}x;
+ };
+
+has is_hash_yadayada =>
+ is => 'ro',
+ isa => 'Bool',
+ lazy => 1,
+ default => sub {
+ my $self = shift;
+ return $self->original_code =~ m{^ \s* % \s* $}x;
};
has type =>
@@ -62,6 +71,11 @@
isa => 'Str',
default => '';
+has is_placeholder =>
+ is => 'rw',
+ isa => 'Bool',
+ default => 0;
+
has first_line_number =>
is => 'rw',
isa => 'Int';
@@ -340,7 +354,14 @@
$self->is_named ($premod =~ m{ : }x);
$self->required_flag($postmod) if $postmod;
- $self->variable($var) if $var;
+ if ($var) {
+ if ($var eq '$') {
+ $self->is_placeholder(1);
+ $self->variable('$tmp');
+ } else {
+ $self->variable($var);
+ }
+ }
$self->ppi_clean_code($original_code);
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/Method-Signatures-20160315/lib/Method/Signatures/Signature.pm
new/Method-Signatures-20170211/lib/Method/Signatures/Signature.pm
--- old/Method-Signatures-20160315/lib/Method/Signatures/Signature.pm
2016-03-16 00:25:26.000000000 +0100
+++ new/Method-Signatures-20170211/lib/Method/Signatures/Signature.pm
2017-02-11 22:40:54.000000000 +0100
@@ -5,6 +5,7 @@
use Method::Signatures::Types;
use Method::Signatures::Parameter;
use Method::Signatures::Utils qw(new_ppi_doc sig_parsing_error DEBUG);
+use List::Util qw(all);
my $INF = ( 0 + "inf" ) == 0 ? 9e9999 : "inf";
@@ -242,6 +243,19 @@
# Split the signature into parameters as tokens.
my @tokens_by_param = ([]);
do {
+ if( $token->class eq "PPI::Token::Magic"
+ and $token->content eq '$,'
+ and _all_tokens_in_listref_are_whitespace($tokens_by_param[-1]))
+ {
+ # a placeholder scalar with no constraints gets parsed by PPI as
if it's the special var "$,"
+ # it needs to be split up into 2 tokens, "$" and ","
+ my $bare_dollar_token = PPI::Token::Cast->new('$');
+ $token->insert_after($bare_dollar_token);
+ $bare_dollar_token->insert_after(PPI::Token::Operator->new(','));
+ $token->remove;
+ $token = $bare_dollar_token;
+ }
+
if( $token->class eq "PPI::Token::Operator" and $token->content eq ','
)
{
push @tokens_by_param, [];
@@ -283,6 +297,12 @@
}
+sub _all_tokens_in_listref_are_whitespace {
+ my $listref = shift;
+ return all { $_->class eq 'PPI::Token::Whitespace' } @$listref;
+}
+
+
sub _first_significant_token {
my $tokens = shift;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Method-Signatures-20160315/lib/Method/Signatures.pm
new/Method-Signatures-20170211/lib/Method/Signatures.pm
--- old/Method-Signatures-20160315/lib/Method/Signatures.pm 2016-03-16
00:25:26.000000000 +0100
+++ new/Method-Signatures-20170211/lib/Method/Signatures.pm 2017-02-11
22:40:54.000000000 +0100
@@ -9,7 +9,7 @@
use Method::Signatures::Parameter;
use Method::Signatures::Signature;
-our $VERSION = '20160315';
+our $VERSION = '20170211';
our $DEBUG = $ENV{METHOD_SIGNATURES_DEBUG} || 0;
@@ -462,6 +462,22 @@
specified within the signature.
+=head3 Placeholder parameters
+
+A positional argument can be ignored by using a bare C<$> sigil as its name.
+
+ method foo( $a, $, $c ) {
+ ...
+ }
+
+The argument's value doesn't get stored in a variable, but the caller must
+still supply it. Value and type constraints can be applied to placeholders.
+
+ method bar( Int $ where { $_ < 10 } ) {
+ ...
+ }
+
+
=head3 Parameter traits
Each parameter can be assigned a trait with the C<$arg is TRAIT> syntax.
@@ -591,6 +607,10 @@
This is also marginally more efficient, as it does not have to allocate,
initialize, or deallocate the unused slurpy parameter C<@etc>.
+The bare C<@> sigil is a synonym for C<...>. A bare C<%> sigil is also a
+synonym for C<...>, but requires that there must be an even number of extra
+arguments, such as would be assigned to a hash.
+
=head3 Required and optional parameters
@@ -839,6 +859,49 @@
}
+# Largely copied from Devel::Declare::MethodInstaller::Simple::parser()
+# The original expects things in this order:
+# <keyword> name ($$@) :attr1 :attr2 {
+# * name
+# * prototype
+# * attributes
+# * an open brace
+# We want to support the prototype coming after the attributes as well as
before,
+# but D::D::strip_attrs() looks for the open brace, and gets into an endless
+# loop if it doesn't find one. Meanwhile, D::D::strip_proto() doesn't find
anything
+# if the attributes are before the prototype.
+sub parser {
+ my $self = shift;
+ $self->init(@_);
+
+ $self->skip_declarator;
+ my $name = $self->strip_name;
+
+ my $linestr = Devel::Declare::get_linestr;
+
+ my($proto, $attrs);
+ my($char) = $linestr =~ m/(\(|:)/;
+ if (defined($char) and $char eq '(') {
+ $proto = $self->strip_proto;
+ $attrs = $self->strip_attrs;
+ } else {
+ $attrs = $self->strip_attrs;
+ $proto = $self->strip_proto;
+ }
+
+ my @decl = $self->parse_proto($proto);
+ my $inject = $self->inject_parsed_proto(@decl);
+ if (defined $name) {
+ $inject = $self->scope_injector_call() . $inject;
+ }
+ $self->inject_if_block($inject, $attrs ? "sub ${attrs} " : '');
+
+ $self->install( $name );
+
+ return;
+}
+
+
# Capture the function name
sub strip_name {
my $self = shift;
@@ -851,10 +914,54 @@
# Capture the attributes
+# A copy of the method of the same name from
Devel::Declare::Context::Simple::strip_attrs()
+# The only change is that the while() loop now terminates if it finds an open
brace _or_
+# open paren. This is necessary to allow the function signature to come after
the attributes.
sub strip_attrs {
my $self = shift;
- my $attrs = $self->SUPER::strip_attrs(@_);
+ $self->skipspace;
+
+ my $linestr = Devel::Declare::get_linestr;
+ my $attrs = '';
+
+ if (substr($linestr, $self->offset, 1) eq ':') {
+ while (substr($linestr, $self->offset, 1) ne '{'
+ and substr($linestr, $self->offset, 1) ne '('
+ ) {
+ if (substr($linestr, $self->offset, 1) eq ':') {
+ substr($linestr, $self->offset, 1) = '';
+ Devel::Declare::set_linestr($linestr);
+
+ $attrs .= ':';
+ }
+
+ $self->skipspace;
+ $linestr = Devel::Declare::get_linestr();
+
+ if (my $len = Devel::Declare::toke_scan_word($self->offset, 0)) {
+ my $name = substr($linestr, $self->offset, $len);
+ substr($linestr, $self->offset, $len) = '';
+ Devel::Declare::set_linestr($linestr);
+
+ $attrs .= " ${name}";
+
+ if (substr($linestr, $self->offset, 1) eq '(') {
+ my $length = Devel::Declare::toke_scan_str($self->offset);
+ my $arg = Devel::Declare::get_lex_stuff();
+ Devel::Declare::clear_lex_stuff();
+ $linestr = Devel::Declare::get_linestr();
+ substr($linestr, $self->offset, $length) = '';
+ Devel::Declare::set_linestr($linestr);
+
+ $attrs .= "(${arg})";
+ }
+ }
+ }
+
+ $linestr = Devel::Declare::get_linestr();
+ }
+
$self->{attributes} = $attrs;
return $attrs;
@@ -938,6 +1045,13 @@
}
+sub odd_number_args_error {
+ my($class) = @_;
+
+ $class->signature_error('was given an odd number of arguments for a
placeholder hash');
+}
+
+
sub named_param_error {
my ($class, $args) = @_;
my @keys = keys %$args;
@@ -971,6 +1085,12 @@
# Add any necessary leading newlines so line numbers are preserved.
push @code, $self->inject_newlines($sig->first_line_number -
$self->{line_number});
+ if( $sig->is_hash_yadayada ) {
+ my $is_odd = $sig->position % 2;
+ push @code, qq[$class->odd_number_args_error() if scalar(\@_) % 2 !=
$is_odd;];
+ return @code;
+ }
+
my $sigil = $sig->sigil;
my $name = $sig->variable_name;
my $idx = $sig->position;
@@ -1016,7 +1136,11 @@
}
if( $sig->is_required ) {
- push @code, qq[${class}->required_arg('$var') unless $check_exists; ];
+ if( $sig->is_placeholder ) {
+ push @code, qq[${class}->required_placeholder_arg('$idx') unless
$check_exists; ];
+ } else {
+ push @code, qq[${class}->required_arg('$var') unless
$check_exists; ];
+ }
}
# Handle \@foo
@@ -1046,10 +1170,20 @@
$constraint =~ m{^ \s* \{ (?: .* ; .* | (?:(?! => ). )* ) \} \s* $}xs
? "sub $constraint"
: $constraint;
- my $error = sprintf q{ %s->where_error(%s, '%s', '%s') }, $class,
$var, $var, $constraint;
+
+ my( $error_reporter, $var_name ) =
+ $sig->is_placeholder
+ ? ( 'placeholder_where_error', $sig->position )
+ : ( 'where_error', $var );
+ my $error = sprintf q{ %s->%s(%s, '%s', '%s') }, $class,
$error_reporter, $var, $var_name, $constraint;
push @code, "$error unless do { no if \$] >= 5.017011, warnings
=> 'experimental::smartmatch'; grep { \$_ ~~ $constraint_impl } $var }; ";
}
+ if( $sig->is_placeholder ) {
+ unshift @code, 'do {';
+ push @code, '};';
+ }
+
# Record the current line number for the next injection.
$self->{line_number} = $sig->first_line_number;
@@ -1088,8 +1222,13 @@
if( $class->can("type_check") eq __PACKAGE__->can("type_check") ) {
my $check = sprintf q[($%s::mutc{cache}{'%s'} ||=
%s->_make_constraint('%s'))->check(%s)],
__PACKAGE__, $sig->type, $class, $sig->type, $sig->variable;
- my $error = sprintf q[%s->type_error('%s', %s, '%s') ],
- $class, $sig->type, $sig->variable, $sig->variable_name;
+
+ my( $error_reporter, $variable_name ) =
+ $sig->is_placeholder
+ ? ( 'placeholder_type_error', $sig->position )
+ : ( 'type_error', $sig->variable_name );
+ my $error = sprintf q[%s->%s('%s', %s, '%s') ],
+ $class, $error_reporter, $sig->type, $sig->variable, $variable_name;
my $code = "$error if ";
$code .= "$check_exists && " if $check_exists;
$code .= "!$check";
@@ -1129,6 +1268,13 @@
}
+sub required_placeholder_arg {
+ my ($class, $idx) = @_;
+
+ $class->signature_error("missing required placeholder argument at position
$idx");
+}
+
+
# STUFF FOR TYPE CHECKING
# This variable will hold all the bits we need. MUTC could stand for
Moose::Util::TypeConstraint,
@@ -1218,6 +1364,13 @@
$class->signature_error(qq{the '$name' parameter ($value) is not of type
$type});
}
+sub placeholder_type_error
+{
+ my ($class, $type, $value, $idx) = @_;
+ $value = defined $value ? qq{"$value"} : 'undef';
+ $class->signature_error(qq{the placeholder parameter at position $idx
($value) is not of type $type});
+}
+
# Errors from `where' constraints are handled here.
sub where_error
{
@@ -1226,6 +1379,12 @@
$class->signature_error(qq{$name value ($value) does not satisfy
constraint: $constraint});
}
+sub placeholder_where_error
+{
+ my ($class, $value, $idx, $constraint) = @_;
+ $value = defined $value ? qq{"$value"} : 'undef';
+ $class->signature_error(qq{the placeholder parameter at position $idx
value ($value) does not satisfy constraint: $constraint});
+}
=head1 PERFORMANCE
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/Method-Signatures-20160315/t/attributes_before_signature.t
new/Method-Signatures-20170211/t/attributes_before_signature.t
--- old/Method-Signatures-20160315/t/attributes_before_signature.t
1970-01-01 01:00:00.000000000 +0100
+++ new/Method-Signatures-20170211/t/attributes_before_signature.t
2017-02-11 22:40:54.000000000 +0100
@@ -0,0 +1,64 @@
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+
+use attributes;
+
+{
+ package Stuff;
+
+ use Test::More;
+ use Method::Signatures;
+
+ method echo : method ($arg) {
+ return $arg;
+ }
+
+ is( Stuff->echo(42), 42 );
+ is_deeply( [attributes::get \&echo], ['method'] );
+}
+
+
+{
+ package Foo;
+
+ use Test::More;
+ use Method::Signatures;
+
+ my $code = func : method () {};
+ is_deeply( [attributes::get $code], ['method'] );
+}
+
+
+{
+ package Things;
+
+ use attributes;
+ use Method::Signatures;
+
+ my $attrs;
+ my $cb_called;
+
+ sub MODIFY_CODE_ATTRIBUTES {
+ my ($pkg, $code, @attrs) = @_;
+ $cb_called = 1;
+ $attrs = \@attrs;
+ return ();
+ }
+
+ method moo : Bar Baz(fubar) ($foo, $bar) {
+ }
+
+ # Torture test for the attribute handling.
+ method foo
+ :
+ Bar
+ :Moo(:Ko{oh)
+ : Baz(fu{bar:): ($foo, $bar) { return {} }
+
+ ::ok($cb_called, 'attribute handler got called');
+ ::is_deeply($attrs, [qw/Bar Moo(:Ko{oh) Baz(fu{bar:)/], '... with the
right attributes');
+}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Method-Signatures-20160315/t/bare_sigils.t
new/Method-Signatures-20170211/t/bare_sigils.t
--- old/Method-Signatures-20160315/t/bare_sigils.t 1970-01-01
01:00:00.000000000 +0100
+++ new/Method-Signatures-20170211/t/bare_sigils.t 2017-02-11
22:40:54.000000000 +0100
@@ -0,0 +1,73 @@
+#!/usr/bin/perl -w
+
+# Test the bare sigil syntax: $, @ and %
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use Method::Signatures;
+
+{
+ package Placeholder;
+
+ use lib 't/lib';
+ use GenErrorRegex qw< required_error required_placeholder_error >;
+
+ use Test::More;
+ use Test::Exception;
+ use Method::Signatures;
+
+ method only_placeholder($) {
+ return $self;
+ }
+
+ is( Placeholder->only_placeholder(23), 'Placeholder' );
+
+#line 28
+ throws_ok { Placeholder->only_placeholder() }
required_placeholder_error('Placeholder', 0, 'only_placeholder', LINE => 28),
+ 'simple required placeholder error okay';
+
+ method add_first_and_last($first!, $, $last = 22) {
+ return $first + $last
+ }
+
+ is( Placeholder->add_first_and_last(18, 19, 20), 18 + 20 );
+ is( Placeholder->add_first_and_last(18, 19), 18 + 22 );
+
+#line 39
+ throws_ok { Placeholder->add_first_and_last() }
required_error('Placeholder', '$first', 'add_first_and_last', LINE => 39),
+ 'missing required/named param error okay';
+
+#line 43
+ throws_ok { Placeholder->add_first_and_last(18) }
required_placeholder_error('Placeholder', 1, 'add_first_and_last', LINE => 43),
+ 'missing required placeholder after required param error okay';
+
+ method slurpy($foo, @) {
+ $foo
+ }
+
+ is( Placeholder->slurpy(123), 123, 'slurpy, no extras');
+ is( Placeholder->slurpy(123, 456, 789), 123, 'slurpy with extras');
+
+ method slurpy_hash($foo, %) {
+ $foo
+ }
+
+ is( Placeholder->slurpy_hash(123), 123, 'slurpy_hash, no extras');
+ is( Placeholder->slurpy_hash(123, a => 1, b => 2), 123, 'slurpy_hash with
extras');
+ throws_ok { Placeholder->slurpy_hash(123, 456, a => 1) }
+ qr{was given an odd number of arguments for a placeholder hash},
+ 'slurpy_hash with odd number of extras throws exception';
+
+ method optional_placeholder($foo, $?, $bar?) {
+ return [ $foo, $bar ];
+ }
+
+ is_deeply( Placeholder->optional_placeholder(1), [ 1, undef ],
'optional_placeholder with 1 arg');
+ is_deeply( Placeholder->optional_placeholder(1, 2), [ 1, undef ],
'optional_placeholder with 2 args');
+ is_deeply( Placeholder->optional_placeholder(1, 2, 3), [ 1, 3 ],
'optional_placeholder with 3 args');
+}
+
+done_testing();
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Method-Signatures-20160315/t/lib/GenErrorRegex.pm
new/Method-Signatures-20170211/t/lib/GenErrorRegex.pm
--- old/Method-Signatures-20160315/t/lib/GenErrorRegex.pm 2016-03-16
00:25:26.000000000 +0100
+++ new/Method-Signatures-20170211/t/lib/GenErrorRegex.pm 2017-02-11
22:40:54.000000000 +0100
@@ -8,7 +8,7 @@
(
qw< bad_param_error unexpected_after_error named_after_optpos_error
pos_after_named_error required_after_optional_error >, # compile-time
qw< mispositioned_slurpy_error multiple_slurpy_error named_slurpy_error >,
# compile-time
- qw< required_error named_param_error badval_error badtype_error >,
# run-time
+ qw< required_error required_placeholder_error named_param_error
badval_error placeholder_badval_error badtype_error
placeholder_failed_constraint_error >, # run-time
);
@@ -132,6 +132,14 @@
}
+sub required_placeholder_error
+{
+ my($obj, $n, $method, %extra) = @_;
+
+ return _regexify($obj, $method, "missing required placeholder argument at
position $n", %extra);
+}
+
+
sub named_param_error
{
my ($obj, $varname, $method, %extra) = @_;
@@ -148,6 +156,14 @@
return _regexify($obj, $method, "the '$varname' parameter ($val) is not of
type $type", %extra);
}
+sub placeholder_badval_error
+{
+ my ($obj, $idx, $type, $val, $method, %extra) = @_;
+
+ $val = defined $val ? qq{"$val"} : 'undef';
+ return _regexify($obj, $method, "the placeholder parameter at position
$idx ($val) is not of type $type", %extra);
+}
+
sub badtype_error
{
my ($obj, $type, $submsg, $method, %extra) = @_;
@@ -155,5 +171,13 @@
return _regexify($obj, $method, "the type $type is unrecognized
($submsg)", %extra);
}
+sub placeholder_failed_constraint_error
+{
+ my ($obj, $idx, $val, $constraint, $method, %extra) = @_;
+
+ $val = defined $val ? qq{"$val"} : 'undef';
+ return _regexify($obj, $method, "the placeholder parameter at position
$idx value ($val) does not satisfy constraint: $constraint", %extra);
+}
+
1;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Method-Signatures-20160315/t/parameters.t
new/Method-Signatures-20170211/t/parameters.t
--- old/Method-Signatures-20160315/t/parameters.t 2016-03-16
00:25:26.000000000 +0100
+++ new/Method-Signatures-20170211/t/parameters.t 2017-02-11
22:40:54.000000000 +0100
@@ -19,6 +19,11 @@
'$foo = [1,2,3]', '$bar = { this => 23, that => 42 }'
],
'$code = sub { my $bar = 2+2; }, :$this' => ['$code = sub { my $bar =
2+2; }', ':$this'],
+ '$foo, $, $bar, $ = $,, $' => [
+ '$foo', '$', '$bar', '$ = $,', '$'
+ ],
+ '$foo, @' => ['$foo', '@'],
+ '$foo, %' => ['$foo', '%'],
q[
$num = 42,
@@ -37,6 +42,19 @@
);
while(my($args, $expect) = each %tests) {
+ test_tokenize_sig( $args, $expect );
+}
+
+SKIP: {
+ skip q(Perl 5.10 or later needed to test 'where' constraints), 1 if $] <
5.010;
+ test_tokenize_sig(
+ 'Int $ where { $_ < 10 } = 4',
+ [ 'Int $ where { $_ < 10 } = 4' ]
+ );
+};
+
+sub test_tokenize_sig {
+ my($args, $expect) = @_;
my $sig = Method::Signatures::Signature->new(
signature_string => $args,
# we just want to test the tokenizing
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Method-Signatures-20160315/t/where.t
new/Method-Signatures-20170211/t/where.t
--- old/Method-Signatures-20160315/t/where.t 2016-03-16 00:25:26.000000000
+0100
+++ new/Method-Signatures-20170211/t/where.t 2017-02-11 22:40:54.000000000
+0100
@@ -6,6 +6,8 @@
use Test::More;
use Test::Warn;
use Test::Exception;
+use lib 't/lib';
+use GenErrorRegex qw< required_placeholder_error placeholder_badval_error
placeholder_failed_constraint_error >;
# Skip the test before Method::Signatures can try to compile it and blow up.
BEGIN {
@@ -142,5 +144,24 @@
like $@, qr{\$x value \(undef\) does not satisfy constraint:},
"neg_and_odd_and_prime(undef) as expected";
};
+subtest 'where with placeholders' => sub {
+ func constrained_placeholder(Int $ where { $_ < 10 }) {
+ pass 'placeholder passes constraints';
+ }
+
+ ok eval { constrained_placeholder(2) }, 'constrained_placeholder() called
as expected'
+ or note $@;
+
+ # line 155
+ throws_ok { constrained_placeholder() }
+ required_placeholder_error('main', 0, 'constrained_placeholder', LINE
=> 156),
+ 'missing requierd constrained placeholder';
+ throws_ok { constrained_placeholder('foo') }
+ placeholder_badval_error('main', 0, 'Int' => 'foo',
'constrained_placeholder', LINE => 159),
+ 'placeholder value wrong type';
+ throws_ok { constrained_placeholder(99) }
+ placeholder_failed_constraint_error('main', 0, 99 => '{$_<10}',
'constrained_placeholder', LINE => 162),
+ 'placeholder value wrong type';
+};
done_testing;
