In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/b54d603d2b0409d931d988215873268c9de799d1?hp=4c9b78f4fff91b5c7e4f74e09e1bc2838c0f740f>
- Log -----------------------------------------------------------------
commit b54d603d2b0409d931d988215873268c9de799d1
Author: Peter Martini <petercmart...@gmail.com>
Date: Tue Jul 9 00:29:48 2013 -0400
'Prototype after' and 'Illegal character' warnings should both pretty print
the prototype text.
For example, prior to this patch,
eval "sub foo (@\0) {}"
would give two warnings:
Prototype after '@' for main::foo : @ at (eval 1) line 1.
Illegal character in prototype for main::foo : @\0 at (eval 1) line 1.
In both cases, the representation which makes a NULL visible
is useful, and of course since we're printing the same warning twice,
it doesn't hurt to display it consistently.
M t/lib/warnings/op
M toke.c
commit fc4b816451cc28ba7a582a778b109e5339551a65
Author: Petr PÃsaÅ <ppi...@redhat.com>
Date: Mon Jul 8 16:10:38 2013 +0200
Suppress system Term::ReadLine::Gnu
perl5db.t will die in Term::ReadLine if Term::ReadLine::Gnu is installed
in the system. Let's favour core implementation.
Best solution would be to prune @INC to prevent from loading already
installed modules like this:
BEGIN {
use Config;
@INC = grep { ! /^\Q$Config{installprefix}\E(\/|\z)/ } @INC;
}
However that is not possible (now) due to various execs (even without
proper -I) in the harness chain. perl should implement -nostdinc
option.
Signed-off-by: Petr PÃsaÅ <ppi...@redhat.com>
M lib/perl5db.t
commit a76c80a7e25ec6178a519942045a9a18e598c539
Author: Father Chrysostomos <spr...@cpan.org>
Date: Tue Jul 9 20:39:00 2013 -0700
Add Nathan Trapuzzano to AUTHORS
M AUTHORS
commit 3b543d8408a3f651b51462a03bd54f8198fd203d
Author: Nathan Trapuzzano <nbt...@nbtrap.com>
Date: Tue Jul 9 20:59:34 2013 -0400
Fix typo in perlreapi(1perl).
M pod/perlreapi.pod
commit d80cf4708315ac91f3033203b385761c18e3ba25
Author: Peter Martini <petercmart...@gmail.com>
Date: Tue Jul 9 23:07:10 2013 -0400
Quiet warning in a DEBUG print
The variable type is STRLEN, and the format
code is expecting a UV, so just cast it to UV
to quiet a warning.
M util.c
-----------------------------------------------------------------------
Summary of changes:
AUTHORS | 1 +
lib/perl5db.t | 1 +
pod/perlreapi.pod | 2 +-
t/lib/warnings/op | 32 +++++++++++++++++++-------------
toke.c | 20 ++++++++------------
util.c | 2 +-
6 files changed, 31 insertions(+), 27 deletions(-)
diff --git a/AUTHORS b/AUTHORS
index d80759b..1037f96 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -825,6 +825,7 @@ Mr. Nobody <mrnobo1...@yahoo.com>
Murray Nesbitt <mur...@nesbitt.ca>
Nathan Kurz <n...@valleytel.net>
Nathan Torkington <g...@frii.com>
+Nathan Trapuzzano <nbt...@nbtrap.com>
Neale Ferguson <ne...@vma.tabnsw.com.au>
Neil Bowers <n...@bowers.com>
Neil Watkiss <neil.watk...@sophos.com>
diff --git a/lib/perl5db.t b/lib/perl5db.t
index 9a57960..6ab4694 100644
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -26,6 +26,7 @@ BEGIN {
print "1..0 # Skip: \$ENV{PERL5DB} is already set to
'$ENV{PERL5DB}'\n";
exit 0;
}
+ $ENV{PERL_RL} = 'Perl'; # Suppress system Term::ReadLine::Gnu
}
plan(116);
diff --git a/pod/perlreapi.pod b/pod/perlreapi.pod
index c4e30cb..2221764 100644
--- a/pod/perlreapi.pod
+++ b/pod/perlreapi.pod
@@ -336,7 +336,7 @@ Perl will handle releasing anything else contained in the
C<regexp> structure.
=head2 Numbered capture callbacks
Called to get/set the value of C<$`>, C<$'>, C<$&> and their named
-equivalents, ${^PREMATCH}, ${^POSTMATCH} and $^{MATCH}, as well as the
+equivalents, ${^PREMATCH}, ${^POSTMATCH} and ${^MATCH}, as well as the
numbered capture groups (C<$1>, C<$2>, ...).
The C<paren> parameter will be C<1> for C<$1>, C<2> for C<$2> and so
diff --git a/t/lib/warnings/op b/t/lib/warnings/op
index 5696ed4..c38bcde 100644
--- a/t/lib/warnings/op
+++ b/t/lib/warnings/op
@@ -933,48 +933,54 @@ Prototype mismatch: sub main::frèd () vs ($) at - line 5.
use utf8;
use open qw( :utf8 :std );
use warnings;
-eval "sub fòò (\$\0) {}";
+eval "sub fòò (@\$\0) {}";
EXPECT
-Illegal character in prototype for main::fòò : $\0 at (eval 1) line 1.
+Prototype after '@' for main::fòò : @$\0 at (eval 1) line 1.
+Illegal character in prototype for main::fòò : @$\0 at (eval 1) line 1.
########
# op.c
use utf8;
use open qw( :utf8 :std );
use warnings;
-eval "sub foo (\0) {}";
+eval "sub foo (@\0) {}";
EXPECT
-Illegal character in prototype for main::foo : \0 at (eval 1) line 1.
+Prototype after '@' for main::foo : @\0 at (eval 1) line 1.
+Illegal character in prototype for main::foo : @\0 at (eval 1) line 1.
########
# op.c
use utf8;
use open qw( :utf8 :std );
use warnings;
-BEGIN { $::{"foo"} = "\$\0L\351on" }
-BEGIN { eval "sub foo (\$\0L\x{c3}\x{a9}on) {}"; }
+BEGIN { $::{"foo"} = "\@\$\0L\351on" }
+BEGIN { eval "sub foo (@\$\0L\x{c3}\x{a9}on) {}"; }
EXPECT
-Illegal character in prototype for main::foo : $\x{0}L... at (eval 1) line 1.
+Prototype after '@' for main::foo : @$\x{0}L... at (eval 1) line 1.
+Illegal character in prototype for main::foo : @$\x{0}L... at (eval 1) line 1.
########
# op.c
use utf8;
use open qw( :utf8 :std );
use warnings;
-BEGIN { eval "sub foo (\0) {}"; }
+BEGIN { eval "sub foo (@\0) {}"; }
EXPECT
-Illegal character in prototype for main::foo : \0 at (eval 1) line 1.
+Prototype after '@' for main::foo : @\0 at (eval 1) line 1.
+Illegal character in prototype for main::foo : @\0 at (eval 1) line 1.
########
# op.c
use warnings;
-eval "sub foo (\xAB) {}";
+eval "sub foo (@\xAB) {}";
EXPECT
-Illegal character in prototype for main::foo : \x{ab} at (eval 1) line 1.
+Prototype after '@' for main::foo : @\x{ab} at (eval 1) line 1.
+Illegal character in prototype for main::foo : @\x{ab} at (eval 1) line 1.
########
# op.c
use utf8;
use open qw( :utf8 :std );
use warnings;
-BEGIN { eval "sub foo (\x{30cb}) {}"; }
+BEGIN { eval "sub foo (@\x{30cb}) {}"; }
EXPECT
-Illegal character in prototype for main::foo : \x{30cb} at (eval 1) line 1.
+Prototype after '@' for main::foo : @\x{30cb} at (eval 1) line 1.
+Illegal character in prototype for main::foo : @\x{30cb} at (eval 1) line 1.
########
# op.c
use utf8;
diff --git a/toke.c b/toke.c
index 878b084..11b235f 100644
--- a/toke.c
+++ b/toke.c
@@ -1651,25 +1651,21 @@ Perl_validate_proto(pTHX_ SV *name, SV *proto, bool
warn)
}
if (warn) {
+ SV *tmpsv = newSVpvs_flags("", SVs_TEMP);
p -= origlen;
+ p = SvUTF8(proto)
+ ? sv_uni_display(tmpsv, newSVpvn_flags(p, origlen, SVs_TEMP |
SVf_UTF8),
+ origlen, UNI_DISPLAY_ISPRINT)
+ : pv_pretty(tmpsv, p, origlen, 60, NULL, NULL,
PERL_PV_ESCAPE_NONASCII);
+
if (proto_after_greedy_proto)
Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO),
"Prototype after '%c' for %"SVf" : %s",
greedy_proto, SVfARG(name), p);
- if (bad_proto) {
- SV *dsv = newSVpvs_flags("", SVs_TEMP);
+ if (bad_proto)
Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO),
"Illegal character %sin prototype for %"SVf" : %s",
- seen_underscore ? "after '_' " : "",
- SVfARG(PL_subname),
- SvUTF8(PL_lex_stuff)
- ? sv_uni_display(dsv,
- newSVpvn_flags(p, origlen, SVs_TEMP | SVf_UTF8),
- origlen,
- UNI_DISPLAY_ISPRINT)
- : pv_pretty(dsv, p, origlen, 60, NULL, NULL,
- PERL_PV_ESCAPE_NONASCII));
- }
+ seen_underscore ? "after '_' " : "", SVfARG(name), p);
}
return (! (proto_after_greedy_proto || bad_proto) );
diff --git a/util.c b/util.c
index 2904500..ffd41b9 100644
--- a/util.c
+++ b/util.c
@@ -599,7 +599,7 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
if (flags & FBMcf_TAIL)
SvTAIL_on(sv);
DEBUG_r(PerlIO_printf(Perl_debug_log, "rarest char %c at %"UVuf"\n",
- s[rarest], rarest));
+ s[rarest], (UV)rarest));
}
/* If SvTAIL(littlestr), it has a fake '\n' at end. */
--
Perl5 Master Repository
