Front page | perl.perl5.changes |
Postings from April 2012
[perl.git] branch blead, updated. v5.15.9-159-g781fa0f
From:
Father Chrysostomos
Date:
April 19, 2012 20:09
Subject:
[perl.git] branch blead, updated. v5.15.9-159-g781fa0f
Message ID:
E1SL4EE-0006tQ-U3@camel.ams6.corp.booking.com
In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/781fa0f4588fedaa5faa25afbf2adfa74a85d24b?hp=ed5958d4d0be98bffc846ce92d77c382457feea0>
- Log -----------------------------------------------------------------
commit 781fa0f4588fedaa5faa25afbf2adfa74a85d24b
Author: Father Chrysostomos <sprout@cpan.org>
Date: Thu Apr 12 06:38:59 2012 -0700
[perl #107636] Make Carp::longmess work inside die override
When PL_last_in_gv (and hence $.) is set, Carp::longmess uses
eval { die } to find out what handle and line number perl will append
to the error message.
It was not qualifying the die with CORE::, so a CORE::GLOBAL::die
override that itself calls Carp::longmess would result in infinite
recursion if that override were installed before Carp loaded.
This broke Class::Scaffold’s tests, which began to hang.
M dist/Carp/lib/Carp.pm
M dist/Carp/t/Carp.t
commit cc336327ca70797fda607b15c125e7d157b03e68
Author: Father Chrysostomos <sprout@cpan.org>
Date: Thu Apr 12 14:50:47 2012 -0700
Increase $Carp::Heavy::VERSION to 1.26
M dist/Carp/lib/Carp/Heavy.pm
commit efbca4494726c8dcd5bd82b86144a2e02e739497
Author: Father Chrysostomos <sprout@cpan.org>
Date: Thu Apr 12 06:39:50 2012 -0700
Increase $Carp::VERSION to 1.26
M dist/Carp/lib/Carp.pm
commit 707475cd74fef60149c3f020c29472b1814b3e9b
Author: Father Chrysostomos <sprout@cpan.org>
Date: Sun Apr 8 23:04:38 2012 -0700
Make strict vars respect ‘package ĵ; *ĵ::bar = [];’
In this particular case, the name of the current package in UTF-8 (it
cannot be expressed in Latin-1) is the same byte sequence as the name
of the package being assigned to in Latin-1.
Some of the logic in stashpv_hvname_match was faulty. It worked for
a Latin-1 current package assigning to a glob in a UTF-8 package, but
not the other way around.
M t/lib/strict/vars
M util.c
commit 6379d4a9afb32e86e55704579c9ac81237309672
Author: Father Chrysostomos <sprout@cpan.org>
Date: Sun Apr 8 20:25:52 2012 -0700
[perl #112316] Make strict vars respect assignment from null pkg
Under threads, strict vars was not respecting glob assignment from a
package with a null in its name if the name of the package assigned to
was equal to the prefix of the current package up to the null.
M cop.h
M embed.fnc
M gv.c
M op.c
M proto.h
M scope.h
M t/lib/strict/vars
M util.c
commit 862504fb08ed24a37a327d325e83ceac76cf05cf
Author: Father Chrysostomos <sprout@cpan.org>
Date: Sun Apr 8 14:51:57 2012 -0700
[perl #112316] Make strict vars respect assignment to null pkg
Under threads, strict vars was not respecting assignment to a package
with a null in its name if the name of the package assigned from was
equal to the prefix of the destination package up to the null.
M t/lib/strict/vars
M util.c
-----------------------------------------------------------------------
Summary of changes:
cop.h | 35 +++++++++++++++++++++--------------
dist/Carp/lib/Carp.pm | 4 ++--
dist/Carp/lib/Carp/Heavy.pm | 2 +-
dist/Carp/t/Carp.t | 16 +++++++++++++++-
embed.fnc | 5 ++++-
gv.c | 6 ++++--
op.c | 1 +
proto.h | 5 +----
scope.h | 3 ++-
t/lib/strict/vars | 27 +++++++++++++++++++++++++++
util.c | 15 +++++++++------
11 files changed, 87 insertions(+), 32 deletions(-)
diff --git a/cop.h b/cop.h
index 8690494..0cfeb44 100644
--- a/cop.h
+++ b/cop.h
@@ -389,7 +389,7 @@ struct cop {
#ifdef USE_ITHREADS
char * cop_stashpv; /* package line was compiled in */
char * cop_file; /* file name the following line # is from */
- U32 cop_stashflags; /* currently only SVf_UTF8 */
+ I32 cop_stashlen; /* negative for UTF8 */
#else
HV * cop_stash; /* package line was compiled in */
GV * cop_filegv; /* file the following line # is from */
@@ -429,25 +429,32 @@ struct cop {
# define CopSTASHPV(c) ((c)->cop_stashpv)
# ifdef NETWARE
-# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : NULL))
+# define CopSTASHPV_set(c,pv,n) ((c)->cop_stashpv = \
+ ((pv) ? savepvn(pv,n) : NULL))
# else
-# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = savesharedpv(pv))
+# define CopSTASHPV_set(c,pv,n) ((c)->cop_stashpv = (pv) \
+ ? savesharedpvn(pv,n) : NULL)
# endif
-# define CopSTASH_flags(c) ((c)->cop_stashflags)
-# define CopSTASH_flags_set(c,flags) ((c)->cop_stashflags = flags)
+# define CopSTASH_len_set(c,n) ((c)->cop_stashlen = (n))
+# define CopSTASH_len(c) ((c)->cop_stashlen)
# define CopSTASH(c) (CopSTASHPV(c) \
- ? gv_stashpv(CopSTASHPV(c), \
- GV_ADD|(CopSTASH_flags(c) \
- ? CopSTASH_flags(c): 0 )) \
+ ? gv_stashpvn(CopSTASHPV(c), \
+ CopSTASH_len(c) < 0 \
+ ? -CopSTASH_len(c) \
+ : CopSTASH_len(c), \
+ GV_ADD|SVf_UTF8*(CopSTASH_len(c) < 0) \
+ ) \
: NULL)
-# define CopSTASH_set(c,hv) (CopSTASHPV_set(c, (hv) ? HvNAME_get(hv) : NULL), \
- CopSTASH_flags_set(c, \
- ((hv) && HvNAME_HEK(hv) && \
- HvNAMEUTF8(hv)) \
- ? SVf_UTF8 \
- : 0))
+# define CopSTASH_set(c,hv) (CopSTASHPV_set(c, \
+ (hv) ? HvNAME_get(hv) : NULL, \
+ (hv) ? HvNAMELEN(hv) : 0), \
+ CopSTASH_len_set(c, \
+ (hv) ? HvNAMEUTF8(hv) \
+ ? -HvNAMELEN(hv) \
+ : HvNAMELEN(hv) \
+ : 0))
# define CopSTASH_eq(c,hv) ((hv) && stashpv_hvname_match(c,hv))
# ifdef NETWARE
# define CopSTASH_free(c) SAVECOPSTASH_FREE(c)
diff --git a/dist/Carp/lib/Carp.pm b/dist/Carp/lib/Carp.pm
index fc2eab3..51df862 100644
--- a/dist/Carp/lib/Carp.pm
+++ b/dist/Carp/lib/Carp.pm
@@ -24,7 +24,7 @@ BEGIN {
}
}
-our $VERSION = '1.25';
+our $VERSION = '1.26';
our $MaxEvalLen = 0;
our $Verbose = 0;
@@ -291,7 +291,7 @@ sub ret_backtrace {
local $@ = '';
local $SIG{__DIE__};
eval {
- die;
+ CORE::die;
};
if($@ =~ /^Died at .*(, <.*?> line \d+).$/ ) {
$mess .= $1;
diff --git a/dist/Carp/lib/Carp/Heavy.pm b/dist/Carp/lib/Carp/Heavy.pm
index 8094e85..3147d9b 100644
--- a/dist/Carp/lib/Carp/Heavy.pm
+++ b/dist/Carp/lib/Carp/Heavy.pm
@@ -2,7 +2,7 @@ package Carp::Heavy;
use Carp ();
-our $VERSION = '1.25';
+our $VERSION = '1.26';
1;
diff --git a/dist/Carp/t/Carp.t b/dist/Carp/t/Carp.t
index 803ec0a..815139d 100644
--- a/dist/Carp/t/Carp.t
+++ b/dist/Carp/t/Carp.t
@@ -3,7 +3,7 @@ no warnings "once";
use Config;
use IPC::Open3 1.0103 qw(open3);
-use Test::More tests => 59;
+use Test::More tests => 60;
sub runperl {
my(%args) = @_;
@@ -430,6 +430,20 @@ $@ =~ s/\n.*//; # just check first line
is $@, "heek at ".__FILE__." line ".(__LINE__-2).", <DATA> line 2.\n",
'last handle line num is mentioned';
+like(
+ runperl(
+ prog => q<
+ open FH, q-Makefile.PL-;
+ <FH>; # set PL_last_in_gv
+ BEGIN { *CORE::GLOBAL::die = sub { die Carp::longmess(@_) } };
+ use Carp;
+ die fumpts;
+ >,
+ ),
+ qr 'fumpts',
+ 'Carp::longmess works inside CORE::GLOBAL::die',
+);
+
# New tests go here
diff --git a/embed.fnc b/embed.fnc
index 17d5bcf..ab2b2f8 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1111,7 +1111,10 @@ p |I32 |same_dirent |NN const char* a|NN const char* b
Apda |char* |savepv |NULLOK const char* pv
Apda |char* |savepvn |NULLOK const char* pv|I32 len
Apda |char* |savesharedpv |NULLOK const char* pv
-Apda |char* |savesharedpvn |NN const char *const pv|const STRLEN len
+
+: NULLOK only to suppress a compiler warning
+Apda |char* |savesharedpvn |NULLOK const char *const pv \
+ |const STRLEN len
Apda |char* |savesharedsvpv |NN SV *sv
Apda |char* |savesvpv |NN SV* sv
Ap |void |savestack_grow
diff --git a/gv.c b/gv.c
index a61c34f..f51fe05 100644
--- a/gv.c
+++ b/gv.c
@@ -911,8 +911,10 @@ S_gv_get_super_pkg(pTHX_ const char* name, I32 namelen, U32 flags)
sv_magic(MUTABLE_SV(superisa), MUTABLE_SV(gv), PERL_MAGIC_isa, NULL, 0);
#ifdef USE_ITHREADS
av_push(superisa, newSVpvn_flags(CopSTASHPV(PL_curcop),
- strlen(CopSTASHPV(PL_curcop)),
- CopSTASH_flags(PL_curcop)
+ CopSTASH_len(PL_curcop) < 0
+ ? -CopSTASH_len(PL_curcop)
+ : CopSTASH_len(PL_curcop),
+ SVf_UTF8*(CopSTASH_len(PL_curcop) < 0)
));
#else
av_push(superisa, newSVhek(CopSTASH(PL_curcop)
diff --git a/op.c b/op.c
index 4c3d6d0..3deb025 100644
--- a/op.c
+++ b/op.c
@@ -10007,6 +10007,7 @@ Perl_rpeep(pTHX_ register OP *o)
firstcop->cop_line = secondcop->cop_line;
#ifdef USE_ITHREADS
firstcop->cop_stashpv = secondcop->cop_stashpv;
+ firstcop->cop_stashlen = secondcop->cop_stashlen;
firstcop->cop_file = secondcop->cop_file;
#else
firstcop->cop_stash = secondcop->cop_stash;
diff --git a/proto.h b/proto.h
index a9bd7c5..11a7d1b 100644
--- a/proto.h
+++ b/proto.h
@@ -3556,10 +3556,7 @@ PERL_CALLCONV char* Perl_savesharedpv(pTHX_ const char* pv)
PERL_CALLCONV char* Perl_savesharedpvn(pTHX_ const char *const pv, const STRLEN len)
__attribute__malloc__
- __attribute__warn_unused_result__
- __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_SAVESHAREDPVN \
- assert(pv)
+ __attribute__warn_unused_result__;
PERL_CALLCONV char* Perl_savesharedsvpv(pTHX_ SV *sv)
__attribute__malloc__
diff --git a/scope.h b/scope.h
index 22407e1..aa04a79 100644
--- a/scope.h
+++ b/scope.h
@@ -235,7 +235,8 @@ scope has the given name. Name must be a literal string.
#define SAVEPARSER(p) save_pushptr((p), SAVEt_PARSER)
#ifdef USE_ITHREADS
-# define SAVECOPSTASH(c) SAVEPPTR(CopSTASHPV(c))
+# define SAVECOPSTASH(c) (SAVEPPTR(CopSTASHPV(c)), \
+ SAVEI32(CopSTASH_len(c)))
# define SAVECOPSTASH_FREE(c) SAVESHAREDPV(CopSTASHPV(c))
# define SAVECOPFILE(c) SAVEPPTR(CopFILE(c))
# define SAVECOPFILE_FREE(c) SAVESHAREDPV(CopFILE(c))
diff --git a/t/lib/strict/vars b/t/lib/strict/vars
index fdd7af3..b8c6d1f 100644
--- a/t/lib/strict/vars
+++ b/t/lib/strict/vars
@@ -536,3 +536,30 @@ use strict 'vars';
no warnings;
eval q/$dweck/;
EXPECT
+########
+# [perl #112316] strict vars getting confused by nulls
+# Assigning to a package whose name contains a null
+BEGIN { *Foo:: = *{"foo\0bar::"} }
+package foo;
+*Foo::bar = [];
+use strict;
+eval 'package Foo; @bar = 1' or die;
+EXPECT
+########
+# [perl #112316] strict vars getting confused by nulls
+# Assigning from within a package whose name contains a null
+BEGIN { *Foo:: = *{"foo\0bar::"} }
+package Foo;
+*foo::bar = [];
+use strict;
+eval 'package foo; @bar = 1' or die;
+EXPECT
+########
+# UTF8 and Latin1 package names equivalent at the byte level
+use utf8;
+# ĵ in UTF-8 is the same as ĵ in Latin-1
+package ĵ;
+*ĵ::bar = [];
+use strict;
+eval 'package ĵ; @bar = 1' or die;
+EXPECT
diff --git a/util.c b/util.c
index d147e9e..716944d 100644
--- a/util.c
+++ b/util.c
@@ -1182,7 +1182,7 @@ Perl_savesharedpvn(pTHX_ const char *const pv, const STRLEN len)
{
char *const newaddr = (char*)PerlMemShared_malloc(len + 1);
- PERL_ARGS_ASSERT_SAVESHAREDPVN;
+ /* PERL_ARGS_ASSERT_SAVESHAREDPVN; */
if (!newaddr) {
return write_no_mem();
@@ -5854,25 +5854,28 @@ Perl_stashpv_hvname_match(pTHX_ const COP *c, const HV *hv)
{
const char * stashpv = CopSTASHPV(c);
const char * name = HvNAME_get(hv);
+ const bool utf8 = CopSTASH_len(c) < 0;
+ const I32 len = utf8 ? -CopSTASH_len(c) : CopSTASH_len(c);
PERL_UNUSED_CONTEXT;
PERL_ARGS_ASSERT_STASHPV_HVNAME_MATCH;
if (!stashpv || !name)
return stashpv == name;
- if ( HvNAMEUTF8(hv) && !(CopSTASH_flags(c) & SVf_UTF8 ? 1 : 0) ) {
- if (CopSTASH_flags(c) & SVf_UTF8) {
+ if ( !HvNAMEUTF8(hv) != !utf8 ) {
+ if (utf8) {
return (bytes_cmp_utf8(
- (const U8*)stashpv, strlen(stashpv),
+ (const U8*)stashpv, len,
(const U8*)name, HEK_LEN(HvNAME_HEK(hv))) == 0);
} else {
return (bytes_cmp_utf8(
(const U8*)name, HEK_LEN(HvNAME_HEK(hv)),
- (const U8*)stashpv, strlen(stashpv)) == 0);
+ (const U8*)stashpv, len) == 0);
}
}
else
return (stashpv == name
- || strEQ(stashpv, name));
+ || (HEK_LEN(HvNAME_HEK(hv)) == len
+ && strEQ(stashpv, name)));
/*NOTREACHED*/
return FALSE;
}
--
Perl5 Master Repository
-
[perl.git] branch blead, updated. v5.15.9-159-g781fa0f
by Father Chrysostomos