In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/738f9dbfd2c2579147ef1010c651a0baeca1e5d4?hp=e04fc1aa1cb8f08ee6e04f5c80e645cad2b3c75a>
- Log -----------------------------------------------------------------
commit 738f9dbfd2c2579147ef1010c651a0baeca1e5d4
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sun Sep 17 11:18:15 2017 -0700
Let Deparse.t be run from the top-level
It used to work before 851f7bb3. It is helpful when debugging tests
to be able to run â./perl -Ilib lib/B/Deparse.tâ without chdir-
ring around.
M lib/B/Deparse.t
commit 14062320f488e14541f86806767c360405a42e23
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sun Sep 17 11:10:11 2017 -0700
Unbreak gv_fetchmeth_sv
Commit v5.21.6-383-gc290e18 stopped gv_fetchmeth_sv from working cor-
rectly when fetching a constant with a utf8 name, because it no longer
passed the utf8 flag to the underlying functions.
That utf8 flag gets passed to gv_init when upgrading a glob proxy
(such as a constant) into a real glob.
M ext/XS-APItest/t/gv_fetchmeth.t
M gv.c
commit 951698f8f098fd4b23f351122836cdb4e03d9f10
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sun Sep 10 22:13:48 2017 -0700
Increase $B::VERSION to 1.70
M ext/B/B.pm
commit 6a4fc5265ba102bfd84de80bdb946121153387af
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sun Sep 10 22:12:50 2017 -0700
B.pm: Remove unused var
This variable stopped being used in perl-5.005_02-1108-g8bac7e0 but
continued to exist until now.
M ext/B/B.pm
commit 42bcad312582e88fc4e5bd1e9c2ad91a7bdac1c1
Author: Father Chrysostomos <spr...@cpan.org>
Date: Mon Aug 28 12:52:10 2017 -0700
Donât assign PL_curstash twice in init_main_stash
This commit:
commit 8990e3071044a96302560bbdb5706f3e74cf1bef
Author: Larry Wall <la...@netlabs.com>
Date: Fri Mar 18 00:00:00 1994 +0000
perl 5.0 alpha 6
added âcurstash = defstashâ to perl.c:init_main_stash, which already
had such an assignment a few lines above. So it is redundant, and
always has been.
M perl.c
commit 04680144c43db3714671c554db48c5c4a8096517
Author: Father Chrysostomos <spr...@cpan.org>
Date: Mon Aug 28 12:40:58 2017 -0700
Set PL_curstname in pp_ctl.c:doeval
Otherwise we get the wrong name in sub error and warning messages:
$ ./miniperl -we 'package bar { sub bar { eval q"sub foo ([)" } } bar::bar'
Missing ']' in prototype for main::foo : [ at (eval 1) line 1.
(PL_curstname is probably used for other things too. I didnât check.)
I can arbitrarily set the package name in the warning to what-
ever I want:
$ ./miniperl -we 'package bar { sub bar { eval q"sub foo ([)" } } package
fwipm; BEGIN { bar::bar }'
Missing ']' in prototype for fwipm::foo : [ at (eval 1) line 1.
M pp_ctl.c
M t/lib/warnings/toke
-----------------------------------------------------------------------
Summary of changes:
ext/B/B.pm | 3 +--
ext/XS-APItest/t/gv_fetchmeth.t | 7 ++++++-
gv.c | 3 ++-
lib/B/Deparse.t | 4 ++--
perl.c | 1 -
pp_ctl.c | 6 +++++-
t/lib/warnings/toke | 6 ++++++
7 files changed, 22 insertions(+), 8 deletions(-)
diff --git a/ext/B/B.pm b/ext/B/B.pm
index daa576435e..d48fa3ad73 100644
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -15,7 +15,7 @@ require Exporter;
# walkoptree comes from B.xs
BEGIN {
- $B::VERSION = '1.69';
+ $B::VERSION = '1.70';
@B::EXPORT_OK = ();
# Our BOOT code needs $VERSION set, and will append to @EXPORT_OK.
@@ -262,7 +262,6 @@ sub walksymtable {
no strict 'refs';
$prefix = '' unless defined $prefix;
foreach my $sym ( sort keys %$symref ) {
- $ref= $symref->{$sym};
$fullname = "*main::".$prefix.$sym;
if ($sym =~ /::$/) {
$sym = $prefix . $sym;
diff --git a/ext/XS-APItest/t/gv_fetchmeth.t b/ext/XS-APItest/t/gv_fetchmeth.t
index 9f6e884a11..22e8b142b3 100644
--- a/ext/XS-APItest/t/gv_fetchmeth.t
+++ b/ext/XS-APItest/t/gv_fetchmeth.t
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 40;
+use Test::More tests => 43;
use_ok('XS::APItest');
@@ -45,6 +45,10 @@ ok !XS::APItest::gv_fetchmeth_type(\%::, "method\0not
quite!", 3, $level, 0), "g
sub ï½ï½
ï½ï½ï½ï½ { 1 }
+ use constant { ÏοÏ
1 => 1,
+ ÏοÏ
2 => 2,
+ ÏοÏ
3 => 3, };
+
my $meth_as_octets =
"\357\275\215\357\275\205\357\275\224\357\275\210\357\275\217\357\275\204";
@@ -53,6 +57,7 @@ ok !XS::APItest::gv_fetchmeth_type(\%::, "method\0not
quite!", 3, $level, 0), "g
::is XS::APItest::gv_fetchmeth_type(\%ï½ï½ï½ï½::, "ï½ï½
ï½ï½ï½ï½", $type, $level, 0), "*ï½ï½ï½ï½::ï½ï½
ï½ï½ï½ï½",
"$types[$type] is UTF-8 clean";
::ok !XS::APItest::gv_fetchmeth_type(\%ï½ï½ï½ï½::,
$meth_as_octets, $type, $level, 0);
::ok !XS::APItest::gv_fetchmeth_type(\%ï½ï½ï½ï½::, "method",
$type, $level, 0);
+ ::is XS::APItest::gv_fetchmeth_type(\%ï½ï½ï½ï½::, "ÏοÏ
$type",
$type, $level, 0), "*ï½ï½ï½ï½::ÏοÏ
$type", "$types[$type] can fetch UTF-8
constant";
{
no strict 'refs';
diff --git a/gv.c b/gv.c
index 6df78cc013..eebf542e47 100644
--- a/gv.c
+++ b/gv.c
@@ -639,7 +639,8 @@ Perl_gv_fetchmeth_sv(pTHX_ HV *stash, SV *namesv, I32
level, U32 flags)
STRLEN namelen;
PERL_ARGS_ASSERT_GV_FETCHMETH_SV;
if (LIKELY(SvPOK_nog(namesv))) /* common case */
- return gv_fetchmeth_internal(stash, namesv, NULL, 0, level, flags);
+ return gv_fetchmeth_internal(stash, namesv, NULL, 0, level,
+ flags | SvUTF8(namesv));
namepv = SvPV(namesv, namelen);
if (SvUTF8(namesv)) flags |= SVf_UTF8;
return gv_fetchmeth_pvn(stash, namepv, namelen, level, flags);
diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t
index 0ee9e9ef38..62570edfa8 100644
--- a/lib/B/Deparse.t
+++ b/lib/B/Deparse.t
@@ -1,13 +1,13 @@
#!./perl
BEGIN {
- unshift @INC, 't';
+ splice @INC, 0, 0, 't', '.';
require Config;
if (($Config::Config{'extensions'} !~ /\bB\b/) ){
print "1..0 # Skip -- Perl configured without B module\n";
exit 0;
}
- require './test.pl';
+ require 'test.pl';
}
use warnings;
diff --git a/perl.c b/perl.c
index dc77e49f8b..281f42412c 100644
--- a/perl.c
+++ b/perl.c
@@ -3823,7 +3823,6 @@ S_init_main_stash(pTHX)
#endif
sv_grow(ERRSV, 240); /* Preallocate - for immediate signals. */
CLEAR_ERRSV();
- SET_CURSTASH(PL_defstash);
CopSTASH_set(&PL_compiling, PL_defstash);
PL_debstash = GvHV(gv_fetchpvs("DB::", GV_ADDMULTI, SVt_PVHV));
PL_globalstash = GvHV(gv_fetchpvs("CORE::GLOBAL::", GV_ADDMULTI,
diff --git a/pp_ctl.c b/pp_ctl.c
index 1ef7fb463d..611dee49a7 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3372,7 +3372,11 @@ S_doeval_compile(pTHX_ U8 gimme, CV* outside, U32 seq,
HV *hh)
SAVEGENERICSV(PL_curstash);
PL_curstash = (HV *)CopSTASH(PL_curcop);
if (SvTYPE(PL_curstash) != SVt_PVHV) PL_curstash = NULL;
- else SvREFCNT_inc_simple_void(PL_curstash);
+ else {
+ SvREFCNT_inc_simple_void(PL_curstash);
+ save_item(PL_curstname);
+ sv_sethek(PL_curstname, HvNAME_HEK(PL_curstash));
+ }
}
/* XXX:ajgo do we really need to alloc an AV for begin/checkunit */
SAVESPTR(PL_beginav);
diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke
index cf1d632cc6..0179bc49a7 100644
--- a/t/lib/warnings/toke
+++ b/t/lib/warnings/toke
@@ -189,6 +189,12 @@ EXPECT
Missing ']' in prototype for main::f : [ at - line 2.
Missing ']' in prototype for main::f : [ at - line 3.
########
+use warnings;
+package bar { sub bar { eval q"sub foo ([)" } }
+bar::bar
+EXPECT
+Missing ']' in prototype for bar::foo : [ at (eval 1) line 1.
+########
# toke.c
$a =~ m/$foo/eq;
$a =~ s/$foo/fool/seq;
--
Perl5 Master Repository
