This is an automated email from the git hooks/post-receive script.
gregoa pushed a commit to branch master
in repository libdata-alias-perl.
commit 6faa4f258cf805b20cb34e300ae3fa027d703cbb
Author: gregor herrmann <gre...@debian.org>
Date: Wed Oct 21 17:03:00 2015 +0200
Imported Upstream version 1.19
---
.gitignore | 1 +
Alias.xs | 128 ++++++++++++++++++++++++++++++++++++++++++++++--------
Changes | 22 ++++++++++
META.yml | 2 +-
README | 2 +-
lib/Data/Alias.pm | 4 +-
6 files changed, 136 insertions(+), 23 deletions(-)
diff --git a/.gitignore b/.gitignore
index 45b2336..7f7b25a 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,6 +1,7 @@
/Makefile
/pm_to_blib
/blib
+/MYMETA.json
/MYMETA.yml
/Data-Alias-*
/Alias.c
diff --git a/Alias.xs b/Alias.xs
index 17a6d3d..32e7550 100644
--- a/Alias.xs
+++ b/Alias.xs
@@ -1,6 +1,6 @@
/* Copyright (C) 2003, 2004, 2006, 2007 Matthijs van Duin <xm...@cpan.org>
*
- * Copyright (C) 2010, 2011, 2013 Andrew Main (Zefram) <zef...@fysh.org>
+ * Copyright (C) 2010, 2011, 2013, 2015 Andrew Main (Zefram) <zef...@fysh.org>
*
* Parts from perl, which is Copyright (C) 1991-2013 Larry Wall and others
*
@@ -146,6 +146,22 @@
#define SVt_RV SVt_IV
#endif
+#ifndef IS_PADGV
+#ifdef USE_ITHREADS
+#define IS_PADGV(v) ((v) && SvTYPE(v) == SVt_PVGV)
+#else
+#define IS_PADGV(v) 0
+#endif
+#endif
+
+#ifndef PadnamelistARRAY
+#define PadnamelistARRAY(pnl) AvARRAY(pnl)
+#endif
+
+#ifndef PadnameOUTER
+#define PadnameOUTER(pn) (!!SvFAKE(pn))
+#endif
+
#if (PERL_COMBI_VERSION >= 5006000) && (PERL_COMBI_VERSION < 5011000)
#define case_OP_SETSTATE_ case OP_SETSTATE:
#else
@@ -164,7 +180,9 @@ static char const msg_no_symref[] =
#error "Data::Alias doesn't support Misc Attribute Decoration yet"
#endif
#define PL_lex_defer (PL_parser->lex_defer)
+#if (PERL_COMBI_VERSION < 5021004)
#define PL_lex_expect (PL_parser->lex_expect)
+#endif
#define PL_linestr (PL_parser->linestr)
#define PL_expect (PL_parser->expect)
#define PL_bufptr (PL_parser->bufptr)
@@ -183,11 +201,11 @@ static char const msg_no_symref[] =
#endif
-#define OPpALIASAV 2
-#define OPpALIASHV 4
+#define OPpALIASAV 1
+#define OPpALIASHV 2
#define OPpALIAS (OPpALIASAV | OPpALIASHV)
-#define OPpUSEFUL 128
+#define OPpUSEFUL OPpLVAL_INTRO
#define MOD(op) op_lvalue((op), OP_GREPSTART)
@@ -221,6 +239,10 @@ static char const msg_no_symref[] =
STATIC OP *(*da_old_ck_rv2cv)(pTHX_ OP *op);
STATIC OP *(*da_old_ck_entersub)(pTHX_ OP *op);
+#if (PERL_COMBI_VERSION >= 5021007)
+STATIC OP *(*da_old_ck_aelem)(pTHX_ OP *op);
+STATIC OP *(*da_old_ck_helem)(pTHX_ OP *op);
+#endif
#ifdef USE_ITHREADS
@@ -1485,7 +1507,8 @@ STATIC OP *DataAlias_pp_copy(pTHX) {
STATIC void da_lvalue(pTHX_ OP *op, int list) {
switch (op->op_type) {
case OP_PADSV: op->op_ppaddr = DataAlias_pp_padsv;
- if (SvFAKE(AvARRAY(PL_comppad_name)[op->op_targ])
+ if (PadnameOUTER(
+ PadnamelistARRAY(PL_comppad_name)[op->op_targ])
&& ckWARN(WARN_CLOSURE))
Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
DA_OUTER_ERR);
@@ -1497,7 +1520,8 @@ STATIC void da_lvalue(pTHX_ OP *op, int list) {
int i;
if (!list) goto bad;
for(i = start; i != start+count; i++) {
- if (SvFAKE(AvARRAY(PL_comppad_name)[i])
+ if (PadnameOUTER(
+ PadnamelistARRAY(PL_comppad_name)[i])
&& ckWARN(WARN_CLOSURE))
Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
DA_OUTER_ERR);
@@ -1704,6 +1728,7 @@ STATIC int da_transform(pTHX_ OP *op, int sib) {
break;
case OP_AASSIGN:
op->op_ppaddr = DataAlias_pp_aassign;
+ op->op_private = 0;
da_aassign(op, kid);
MOD(kid);
ksib = FALSE;
@@ -1780,7 +1805,7 @@ STATIC int da_transform(pTHX_ OP *op, int sib) {
}
STATIC void da_peep2(pTHX_ OP *o) {
- OP *sib, *k;
+ OP *sib, *k, *fk;
int useful;
while (o->op_ppaddr != da_tag_list) {
while ((sib = o->op_sibling)) {
@@ -1800,21 +1825,22 @@ STATIC void da_peep2(pTHX_ OP *o) {
useful = o->op_private & OPpUSEFUL;
op_null(o);
o->op_ppaddr = PL_ppaddr[OP_NULL];
- k = o = cLISTOPo->op_first;
+ k = fk = cLISTOPo->op_first;
while ((sib = k->op_sibling))
k = sib;
- if (!(sib = cUNOPo->op_first) || sib->op_ppaddr != da_tag_rv2cv) {
+ if (!(sib = cUNOPx(fk)->op_first) || sib->op_ppaddr != da_tag_rv2cv) {
Perl_warn(aTHX_ "da peep weirdness 1");
} else {
k->op_sibling = sib;
+ cLISTOPo->op_last = sib;
if (!(k = sib->op_next) || k->op_ppaddr != da_tag_entersub) {
Perl_warn(aTHX_ "da peep weirdness 2");
} else {
k->op_type = OP_ENTERSUB;
if (sib->op_flags & OPf_SPECIAL) {
k->op_ppaddr = DataAlias_pp_copy;
- da_peep2(aTHX_ o);
- } else if (!da_transform(aTHX_ o, TRUE)
+ da_peep2(aTHX_ fk);
+ } else if (!da_transform(aTHX_ fk, TRUE)
&& !useful && ckWARN(WARN_VOID)) {
Perl_warner(aTHX_ packWARN(WARN_VOID),
"Useless use of alias");
@@ -1846,7 +1872,7 @@ STATIC void da_peep(pTHX_ OP *o) {
STATIC OP *da_ck_rv2cv(pTHX_ OP *o) {
dDA;
- SV **sp;
+ SV **sp, *gvsv;
OP *kid;
char *s, *start_s;
CV *cv;
@@ -1859,7 +1885,14 @@ STATIC OP *da_ck_rv2cv(pTHX_ OP *o) {
return o; /* not lexing? */
kid = cUNOPo->op_first;
if (kid->op_type != OP_GV || !DA_ACTIVE || (
- (cv = GvCV(kGVOP_gv)) != da_cv && cv != da_cvc ))
+ (gvsv = (SV*)kGVOP_gv,
+ cv =
+#if (PERL_COMBI_VERSION >= 5021004)
+ SvROK(gvsv) ? (CV*)SvRV(gvsv) :
+#endif
+ GvCV((GV*)gvsv),
+ 1) &&
+ cv != da_cv && cv != da_cvc ))
return o;
if (o->op_private & OPpENTERSUB_AMPER)
return o;
@@ -1900,16 +1933,25 @@ STATIC OP *da_ck_rv2cv(pTHX_ OP *o) {
if ((PL_nexttype[PL_nexttoke++] = yylex()) == '{') {
PL_nexttype[PL_nexttoke++] = DO;
sv_setpv((SV *) cv, "$");
- if (PERL_COMBI_VERSION >= 5011002 &&
- *PL_bufptr == '(') {
+ if ((PERL_COMBI_VERSION >= 5021004) ||
+ (PERL_COMBI_VERSION >= 5011002 &&
+ *PL_bufptr == '(')) {
/*
- * A paren here triggers special lexer
+ * On 5.21.4+, PL_expect can't be
+ * directly set as we'd like, and ends
+ * up wrong for parsing the interior of
+ * the block. Rectify it by injecting
+ * a semicolon, lexing of which sets
+ * PL_expect appropriately. On 5.11.2+,
+ * a paren here triggers special lexer
* behaviour for a parenthesised argument
* list, which screws up the normal
* parsing that we want to continue.
- * Suppress it by injecting a semicolon,
- * which is otherwise a no-op coming just
- * after the opening brace of a block.
+ * Suppress it by injecting a semicolon.
+ * Either way, apart from this tweaking of
+ * the lexer the semicolon is a no-op,
+ * coming as it does just after the
+ * opening brace of a block.
*/
Move(PL_bufptr, PL_bufptr+1,
PL_bufend+1-PL_bufptr, char);
@@ -1920,7 +1962,9 @@ STATIC OP *da_ck_rv2cv(pTHX_ OP *o) {
}
if(PL_lex_state != LEX_KNOWNEXT) {
PL_lex_defer = PL_lex_state;
+#if (PERL_COMBI_VERSION < 5021004)
PL_lex_expect = PL_expect;
+#endif
PL_lex_state = LEX_KNOWNEXT;
}
PL_yylval = yylval;
@@ -1994,6 +2038,9 @@ STATIC OP *da_ck_entersub(pTHX_ OP *o) {
if (inside)
op_null(tmp);
RenewOpc(0, tmp, 1, UNOP, OP);
+#if (PERL_COMBI_VERSION >= 5021006)
+ tmp->op_type = OP_CUSTOM;
+#endif
tmp->op_next = tmp;
kLISTOP->op_first = tmp;
kid = tmp;
@@ -2008,6 +2055,10 @@ STATIC OP *da_ck_entersub(pTHX_ OP *o) {
return o;
}
+#if (PERL_COMBI_VERSION >= 5021007)
+STATIC OP *da_ck_aelem(pTHX_ OP *o) { return da_old_ck_aelem(aTHX_ o); }
+STATIC OP *da_ck_helem(pTHX_ OP *o) { return da_old_ck_helem(aTHX_ o); }
+#endif
MODULE = Data::Alias PACKAGE = Data::Alias
@@ -2025,6 +2076,45 @@ BOOT:
PL_check[OP_RV2CV] = da_ck_rv2cv;
da_old_ck_entersub = PL_check[OP_ENTERSUB];
PL_check[OP_ENTERSUB] = da_ck_entersub;
+#if (PERL_COMBI_VERSION >= 5021007)
+ /*
+ * The multideref peep-time optimisation, introduced in
+ * Perl 5.21.7, is liable to incorporate into a multideref
+ * op aelem/helem ops that we need to modify. Because our
+ * modification of those ops gets applied late at peep
+ * time, after the main peeper, the specialness of the
+ * ops doesn't get a chance to inhibit incorporation
+ * into a multideref. As an ugly hack, we disable the
+ * multideref optimisation entirely for these op types
+ * by hooking their checking (and not actually doing
+ * anything in the checker).
+ *
+ * The multideref peep-time code has no logical
+ * reason to look at whether the op checking is in a
+ * non-default state. It deals with already-checked ops,
+ * so a check hook cannot make any difference to the
+ * future behaviour of those ops. Rather, it should,
+ * but currently (5.23.4) doesn't, check that op_ppaddr
+ * of the op to be incorporated has the standard value.
+ * If the superfluous PL_check[] check goes away, this
+ * hack will break.
+ *
+ * The proper fix for this problem would be to move our op
+ * munging from peep time to op check time. When ops are
+ * placed into an alias() wrapper they should be walked,
+ * and the contained assignments and lvalues modified.
+ * The modified lvalue aelem/helem ops would thereby be
+ * made visibly non-standard in plenty of time for the
+ * multideref peep-time code to avoid replacing them.
+ * If the multideref code is changed to look at op_ppaddr
+ * then that change alone will be sufficient; failing
+ * that the op_type can be changed to OP_CUSTOM.
+ */
+ da_old_ck_aelem = PL_check[OP_AELEM];
+ PL_check[OP_AELEM] = da_ck_aelem;
+ da_old_ck_helem = PL_check[OP_HELEM];
+ PL_check[OP_HELEM] = da_ck_helem;
+#endif
}
CvLVALUE_on(get_cv("Data::Alias::deref", TRUE));
da_old_peepp = PL_peepp;
diff --git a/Changes b/Changes
index 448a5eb..46bfb5f 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,25 @@
+version 1.19; 2015-10-21
+
+ * update for new stricture on op_last in Perl 5.21.2
+
+ * update for the parser's PL_expect changes in Perl 5.21.4
+
+ * update for op_private stricture in Perl 5.21.4
+
+ * update for sub references directly in stash in Perl 5.21.4
+
+ * update for IS_PADGV()'s limited visibility in Perl 5.21.4
+
+ * update for increased specialness of OP_PUSHMARK in Perl 5.21.6
+
+ * update for distinct PADNAMELIST type in Perl 5.21.7
+
+ * update for multideref optimisation in Perl 5.21.7, by a disgusting
+ hack that depends on a flaw in the optimisation (which may disappear
+ in the future) and which disables the optimisation entirely
+
+ * add MYMETA.json to .gitignore
+
version 1.18; 2013-09-21
* bugfix: store peep chain link reliably under threads
diff --git a/META.yml b/META.yml
index 3de735c..19fa62f 100644
--- a/META.yml
+++ b/META.yml
@@ -16,4 +16,4 @@ no_index:
- t
requires:
perl: 5.8.1
-version: 1.18
+version: 1.19
diff --git a/README b/README
index b5ade74..f9a3f00 100644
--- a/README
+++ b/README
@@ -29,7 +29,7 @@ updated it to work with Perl versions 5.11.0 and later.
COPYRIGHT
Copyright (C) 2003-2007 Matthijs van Duin.
-Copyright (C) 2010, 2011, 2013 Andrew Main (Zefram) <zef...@fysh.org>.
+Copyright (C) 2010, 2011, 2013, 2015 Andrew Main (Zefram) <zef...@fysh.org>.
LICENSE
diff --git a/lib/Data/Alias.pm b/lib/Data/Alias.pm
index d315f0e..e7c0d69 100644
--- a/lib/Data/Alias.pm
+++ b/lib/Data/Alias.pm
@@ -5,7 +5,7 @@ use 5.008001;
use strict;
use warnings;
-our $VERSION = '1.18';
+our $VERSION = '1.19';
use base 'Exporter';
use base 'DynaLoader';
@@ -412,7 +412,7 @@ updated it to work with Perl versions 5.11.0 and later.
=head1 LICENSE
Copyright (C) 2003-2007 Matthijs van Duin.
-Copyright (C) 2010, 2011, 2013 Andrew Main (Zefram) <zef...@fysh.org>.
+Copyright (C) 2010, 2011, 2013, 2015 Andrew Main (Zefram) <zef...@fysh.org>.
All rights reserved.
This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
--
Alioth's /usr/local/bin/git-commit-notice on
/srv/git.debian.org/git/pkg-perl/packages/libdata-alias-perl.git
_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
