Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package perl-Syntax-Keyword-Try for
openSUSE:Factory checked in at 2021-10-23 00:51:17
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-Syntax-Keyword-Try (Old)
and /work/SRC/openSUSE:Factory/.perl-Syntax-Keyword-Try.new.1890 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Syntax-Keyword-Try"
Sat Oct 23 00:51:17 2021 rev:13 rq:926886 version:0.26
Changes:
--------
---
/work/SRC/openSUSE:Factory/perl-Syntax-Keyword-Try/perl-Syntax-Keyword-Try.changes
2021-08-31 19:56:35.254029696 +0200
+++
/work/SRC/openSUSE:Factory/.perl-Syntax-Keyword-Try.new.1890/perl-Syntax-Keyword-Try.changes
2021-10-23 00:52:01.157148965 +0200
@@ -1,0 +2,14 @@
+Wed Oct 13 03:06:22 UTC 2021 - Tina M??ller <[email protected]>
+
+- updated to 0.26
+ see /usr/share/doc/packages/perl-Syntax-Keyword-Try/Changes
+
+ 0.26 2021-10-12
+ [CHANGES]
+ * Many internal updates to hax/ support files
+
+ [BUGFIXES]
+ * Fix try { return } to work correctly in all contexts without
+ upsetting -DDEBUGGING perls
+
+-------------------------------------------------------------------
Old:
----
Syntax-Keyword-Try-0.25.tar.gz
New:
----
Syntax-Keyword-Try-0.26.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-Syntax-Keyword-Try.spec ++++++
--- /var/tmp/diff_new_pack.rVBcca/_old 2021-10-23 00:52:01.633149175 +0200
+++ /var/tmp/diff_new_pack.rVBcca/_new 2021-10-23 00:52:01.633149175 +0200
@@ -18,7 +18,7 @@
%define cpan_name Syntax-Keyword-Try
Name: perl-Syntax-Keyword-Try
-Version: 0.25
+Version: 0.26
Release: 0
Summary: C<try/catch/finally> syntax for perl
License: Artistic-1.0 OR GPL-1.0-or-later
++++++ Syntax-Keyword-Try-0.25.tar.gz -> Syntax-Keyword-Try-0.26.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.25/Changes
new/Syntax-Keyword-Try-0.26/Changes
--- old/Syntax-Keyword-Try-0.25/Changes 2021-06-01 22:49:17.000000000 +0200
+++ new/Syntax-Keyword-Try-0.26/Changes 2021-10-12 19:12:24.000000000 +0200
@@ -1,5 +1,13 @@
Revision history for Syntax-Keyword-Try
+0.26 2021-10-12
+ [CHANGES]
+ * Many internal updates to hax/ support files
+
+ [BUGFIXES]
+ * Fix try { return } to work correctly in all contexts without
+ upsetting -DDEBUGGING perls
+
0.25 2021-06-01
[CHANGES]
* Rewrite parsing logic to use XS::Parse::Keyword 0.06
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.25/MANIFEST
new/Syntax-Keyword-Try-0.26/MANIFEST
--- old/Syntax-Keyword-Try-0.25/MANIFEST 2021-06-01 22:49:17.000000000
+0200
+++ new/Syntax-Keyword-Try-0.26/MANIFEST 2021-10-12 19:12:24.000000000
+0200
@@ -1,5 +1,8 @@
Build.PL
Changes
+hax/newOP_CUSTOM.c.inc
+hax/op_sibling_splice.c.inc
+hax/optree-additions.c.inc
hax/perl-additions.c.inc
hax/perl-backcompat.c.inc
lib/Syntax/Keyword/Try.pm
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.25/META.json
new/Syntax-Keyword-Try-0.26/META.json
--- old/Syntax-Keyword-Try-0.25/META.json 2021-06-01 22:49:17.000000000
+0200
+++ new/Syntax-Keyword-Try-0.26/META.json 2021-10-12 19:12:24.000000000
+0200
@@ -40,11 +40,11 @@
"provides" : {
"Syntax::Keyword::Try" : {
"file" : "lib/Syntax/Keyword/Try.pm",
- "version" : "0.25"
+ "version" : "0.26"
},
"Syntax::Keyword::Try::Deparse" : {
"file" : "lib/Syntax/Keyword/Try/Deparse.pm",
- "version" : "0.25"
+ "version" : "0.26"
}
},
"release_status" : "stable",
@@ -54,6 +54,6 @@
],
"x_IRC" : "irc://irc.perl.org/#io-async"
},
- "version" : "0.25",
+ "version" : "0.26",
"x_serialization_backend" : "JSON::PP version 4.05"
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.25/META.yml
new/Syntax-Keyword-Try-0.26/META.yml
--- old/Syntax-Keyword-Try-0.25/META.yml 2021-06-01 22:49:17.000000000
+0200
+++ new/Syntax-Keyword-Try-0.26/META.yml 2021-10-12 19:12:24.000000000
+0200
@@ -18,15 +18,15 @@
provides:
Syntax::Keyword::Try:
file: lib/Syntax/Keyword/Try.pm
- version: '0.25'
+ version: '0.26'
Syntax::Keyword::Try::Deparse:
file: lib/Syntax/Keyword/Try/Deparse.pm
- version: '0.25'
+ version: '0.26'
requires:
XS::Parse::Keyword: '0.06'
perl: '5.014'
resources:
IRC: irc://irc.perl.org/#io-async
license: http://dev.perl.org/licenses/
-version: '0.25'
+version: '0.26'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.25/hax/newOP_CUSTOM.c.inc
new/Syntax-Keyword-Try-0.26/hax/newOP_CUSTOM.c.inc
--- old/Syntax-Keyword-Try-0.25/hax/newOP_CUSTOM.c.inc 1970-01-01
01:00:00.000000000 +0100
+++ new/Syntax-Keyword-Try-0.26/hax/newOP_CUSTOM.c.inc 2021-10-12
19:12:24.000000000 +0200
@@ -0,0 +1,109 @@
+/* vi: set ft=c : */
+
+/* Before perl 5.22 under -DDEBUGGING, various new*OP() functions throw assert
+ * failures on OP_CUSTOM.
+ * https://rt.cpan.org/Ticket/Display.html?id=128562
+ */
+
+#define newOP_CUSTOM(func, flags) S_newOP_CUSTOM(aTHX_ func,
flags)
+#define newUNOP_CUSTOM(func, flags, first) S_newUNOP_CUSTOM(aTHX_
func, flags, first)
+#define newSVOP_CUSTOM(func, flags, sv) S_newSVOP_CUSTOM(aTHX_
func, flags, sv)
+#define newBINOP_CUSTOM(func, flags, first, last) S_newBINOP_CUSTOM(aTHX_
func, flags, first, last)
+#define newLOGOP_CUSTOM(func, flags, first, other) S_newLOGOP_CUSTOM(aTHX_
func, flags, first, other)
+
+static OP *S_newOP_CUSTOM(pTHX_ OP *(*func)(pTHX), U32 flags)
+{
+ OP *op = newOP(OP_CUSTOM, flags);
+ op->op_ppaddr = func;
+ return op;
+}
+
+static OP *S_newUNOP_CUSTOM(pTHX_ OP *(*func)(pTHX), U32 flags, OP *first)
+{
+ UNOP *unop;
+#if HAVE_PERL_VERSION(5,22,0)
+ unop = (UNOP *)newUNOP(OP_CUSTOM, flags, first);
+#else
+ NewOp(1101, unop, 1, UNOP);
+ unop->op_type = (OPCODE)OP_CUSTOM;
+ unop->op_first = first;
+ unop->op_flags = (U8)(flags | OPf_KIDS);
+ unop->op_private = (U8)(1 | (flags >> 8));
+#endif
+ unop->op_ppaddr = func;
+ return (OP *)unop;
+}
+
+static OP *S_newSVOP_CUSTOM(pTHX_ OP *(*func)(pTHX), U32 flags, SV *sv)
+{
+ SVOP *svop;
+#if HAVE_PERL_VERSION(5,22,0)
+ svop = (SVOP *)newSVOP(OP_CUSTOM, flags, sv);
+#else
+ NewOp(1101, svop, 1, SVOP);
+ svop->op_type = (OPCODE)OP_CUSTOM;
+ svop->op_sv = sv;
+ svop->op_next = (OP *)svop;
+ svop->op_flags = 0;
+ svop->op_private = 0;
+#endif
+ svop->op_ppaddr = func;
+ return (OP *)svop;
+}
+
+static OP *S_newBINOP_CUSTOM(pTHX_ OP *(*func)(pTHX), U32 flags, OP *first, OP
*last)
+{
+ BINOP *binop;
+#if HAVE_PERL_VERSION(5,22,0)
+ binop = (BINOP *)newBINOP(OP_CUSTOM, flags, first, last);
+#else
+ NewOp(1101, binop, 1, BINOP);
+ binop->op_type = (OPCODE)OP_CUSTOM;
+ binop->op_first = first;
+ first->op_sibling = last;
+ binop->op_last = last;
+ binop->op_flags = (U8)(flags | OPf_KIDS);
+ binop->op_private = (U8)(2 | (flags >> 8));
+#endif
+ binop->op_ppaddr = func;
+ return (OP *)binop;
+}
+
+static OP *S_newLOGOP_CUSTOM(pTHX_ OP *(*func)(pTHX), U32 flags, OP *first, OP
*other)
+{
+ OP *o;
+#if HAVE_PERL_VERSION(5,22,0)
+ o = newLOGOP(OP_CUSTOM, flags, first, other);
+#else
+ /* Parts of this code copypasted from perl 5.20.0's op.c S_new_logop()
+ */
+ LOGOP *logop;
+
+ first = op_contextualize(first, G_SCALAR);
+
+ NewOp(1101, logop, 1, LOGOP);
+
+ logop->op_type = (OPCODE)OP_CUSTOM;
+ logop->op_ppaddr = NULL; /* Because caller only overrides it anyway */
+ logop->op_first = first;
+ logop->op_flags = (U8)(flags | OPf_KIDS);
+ logop->op_other = LINKLIST(other);
+ /* logop->op_private has nothing interesting for OP_CUSTOM */
+
+ /* Link in postfix order */
+ logop->op_next = LINKLIST(first);
+ first->op_next = (OP *)logop;
+ first->op_sibling = other;
+
+ /* No CHECKOP for OP_CUSTOM */
+ o = newUNOP(OP_NULL, 0, (OP *)logop);
+ other->op_next = o;
+#endif
+
+ /* the returned op is actually an UNOP that's either NULL or NOT; the real
+ * logop is the op_next of it
+ */
+ cUNOPx(o)->op_first->op_ppaddr = func;
+
+ return o;
+}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.25/hax/op_sibling_splice.c.inc
new/Syntax-Keyword-Try-0.26/hax/op_sibling_splice.c.inc
--- old/Syntax-Keyword-Try-0.25/hax/op_sibling_splice.c.inc 1970-01-01
01:00:00.000000000 +0100
+++ new/Syntax-Keyword-Try-0.26/hax/op_sibling_splice.c.inc 2021-10-12
19:12:24.000000000 +0200
@@ -0,0 +1,44 @@
+/* vi: set ft=c : */
+
+#ifndef op_sibling_splice
+# define op_sibling_splice(parent, start, del_count, insert)
S_op_sibling_splice(aTHX_ parent, start, del_count, insert)
+static OP *S_op_sibling_splice(pTHX_ OP *parent, OP *start, int del_count, OP
*insert)
+{
+ OP *deleted = NULL;
+
+ if(!insert && !del_count)
+ return NULL;
+
+ OP **prevp;
+ if(start)
+ prevp = &(start->op_sibling);
+ else
+ prevp = &(cLISTOPx(parent)->op_first);
+
+ OP *after = *prevp;
+
+ if(del_count) {
+ croak("Back-compat op_sibling_splice with del_count != 0 not yet
implemented");
+ /* THIS IS AS YET UNTESTED
+ deleted = *prevp;
+ OP *o = deleted;
+ while(del_count > 1)
+ o = o->op_sibling, del_count--;
+ after = o->op_sibling;
+ o->op_sibling = NULL;
+ */
+ }
+
+ if(insert) {
+ *prevp = insert;
+ OP *o = insert;
+ while(o->op_sibling)
+ o = o->op_sibling;
+ o->op_sibling = after;
+ }
+ else
+ *prevp = after;
+
+ return deleted;
+}
+#endif
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.25/hax/optree-additions.c.inc
new/Syntax-Keyword-Try-0.26/hax/optree-additions.c.inc
--- old/Syntax-Keyword-Try-0.25/hax/optree-additions.c.inc 1970-01-01
01:00:00.000000000 +0100
+++ new/Syntax-Keyword-Try-0.26/hax/optree-additions.c.inc 2021-10-12
19:12:24.000000000 +0200
@@ -0,0 +1,82 @@
+/* vi: set ft=c : */
+
+#define newAELEMOP(flags, first, key) S_newAELEMOP(aTHX_ flags, first, key)
+static OP *S_newAELEMOP(pTHX_ U32 flags, OP *first, I32 key)
+{
+#if HAVE_PERL_VERSION(5,16,0)
+ if(key >= -128 && key < 128 && first->op_type == OP_PADAV) {
+ OP *o = newOP(OP_AELEMFAST_LEX, flags);
+ o->op_private = (I8)key;
+ o->op_targ = first->op_targ;
+ op_free(first);
+ return o;
+ }
+#endif
+
+ return newBINOP(OP_AELEM, flags, first, newSVOP(OP_CONST, 0, newSViv(key)));
+}
+
+#define newPADxVOP(type, padix, flags, private) S_newPADxVOP(aTHX_ type,
padix, flags, private)
+static OP *S_newPADxVOP(pTHX_ I32 type, PADOFFSET padix, I32 flags, U32
private)
+{
+ OP *op = newOP(type, flags);
+ op->op_targ = padix;
+ op->op_private = private;
+ return op;
+}
+
+#if HAVE_PERL_VERSION(5, 22, 0)
+# define HAVE_UNOP_AUX
+#endif
+
+#ifndef HAVE_UNOP_AUX
+typedef struct UNOP_with_IV {
+ UNOP baseop;
+ IV iv;
+} UNOP_with_IV;
+
+#define newUNOP_with_IV(type, flags, first, iv) S_newUNOP_with_IV(aTHX_ type,
flags, first, iv)
+static OP *S_newUNOP_with_IV(pTHX_ I32 type, I32 flags, OP *first, IV iv)
+{
+ /* Cargoculted from perl's op.c:Perl_newUNOP()
+ */
+ UNOP_with_IV *op = PerlMemShared_malloc(sizeof(UNOP_with_IV) * 1);
+ NewOp(1101, op, 1, UNOP_with_IV);
+
+ if(!first)
+ first = newOP(OP_STUB, 0);
+ UNOP *unop = (UNOP *)op;
+ unop->op_type = (OPCODE)type;
+ unop->op_first = first;
+ unop->op_ppaddr = NULL;
+ unop->op_flags = (U8)flags | OPf_KIDS;
+ unop->op_private = (U8)(1 | (flags >> 8));
+
+ op->iv = iv;
+
+ return (OP *)op;
+}
+#endif
+
+#define newMETHOD_REDIR_OP(rclass, methname, flags)
S_newMETHOD_REDIR_OP(aTHX_ rclass, methname, flags)
+static OP *S_newMETHOD_REDIR_OP(pTHX_ SV *rclass, SV *methname, I32 flags)
+{
+#if HAVE_PERL_VERSION(5, 22, 0)
+ OP *op = newMETHOP_named(OP_METHOD_REDIR, flags, methname);
+# ifdef USE_ITHREADS
+ {
+ /* cargoculted from S_op_relocate_sv() */
+ PADOFFSET ix = pad_alloc(OP_CONST, SVf_READONLY);
+ PAD_SETSV(ix, rclass);
+ cMETHOPx(op)->op_rclass_targ = ix;
+ }
+# else
+ cMETHOPx(op)->op_rclass_sv = rclass;
+# endif
+#else
+ OP *op = newUNOP(OP_METHOD, flags,
+ newSVOP(OP_CONST, 0, newSVpvf("%" SVf "::%" SVf, rclass, methname)));
+#endif
+
+ return op;
+}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.25/hax/perl-additions.c.inc
new/Syntax-Keyword-Try-0.26/hax/perl-additions.c.inc
--- old/Syntax-Keyword-Try-0.25/hax/perl-additions.c.inc 2021-06-01
22:49:17.000000000 +0200
+++ new/Syntax-Keyword-Try-0.26/hax/perl-additions.c.inc 2021-10-12
19:12:24.000000000 +0200
@@ -1,4 +1,4 @@
-/* vi: set ft=c */
+/* vi: set ft=c : */
#ifndef av_count
# define av_count(av) (AvFILL(av) + 1)
@@ -40,124 +40,7 @@
SvROK_on(sv);
}
-#define newPADxVOP(type, padix, flags, private) S_newPADxVOP(aTHX_ type,
padix, flags, private)
-static OP *S_newPADxVOP(pTHX_ I32 type, PADOFFSET padix, I32 flags, U32
private)
-{
- OP *op = newOP(type, flags);
- op->op_targ = padix;
- op->op_private = private;
- return op;
-}
-
-/* Before perl 5.22 under -DDEBUGGING, various new*OP() functions throw assert
- * failures on OP_CUSTOM.
- * https://rt.cpan.org/Ticket/Display.html?id=128562
- */
-
-#define newOP_CUSTOM(func, flags) S_newOP_CUSTOM(aTHX_ func,
flags)
-#define newUNOP_CUSTOM(func, flags, first) S_newUNOP_CUSTOM(aTHX_
func, flags, first)
-#define newSVOP_CUSTOM(func, flags, sv) S_newSVOP_CUSTOM(aTHX_
func, flags, sv)
-#define newBINOP_CUSTOM(func, flags, first, last) S_newBINOP_CUSTOM(aTHX_
func, flags, first, last)
-#define newLOGOP_CUSTOM(func, flags, first, other) S_newLOGOP_CUSTOM(aTHX_
func, flags, first, other)
-
-static OP *S_newOP_CUSTOM(pTHX_ OP *(*func)(pTHX), U32 flags)
-{
- OP *op = newOP(OP_CUSTOM, flags);
- op->op_ppaddr = func;
- return op;
-}
-
-static OP *S_newUNOP_CUSTOM(pTHX_ OP *(*func)(pTHX), U32 flags, OP *first)
-{
- UNOP *unop;
-#if HAVE_PERL_VERSION(5,22,0)
- unop = (UNOP *)newUNOP(OP_CUSTOM, flags, first);
-#else
- NewOp(1101, unop, 1, UNOP);
- unop->op_type = (OPCODE)OP_CUSTOM;
- unop->op_first = first;
- unop->op_flags = (U8)(flags | OPf_KIDS);
- unop->op_private = (U8)(1 | (flags >> 8));
-#endif
- unop->op_ppaddr = func;
- return (OP *)unop;
-}
-
-static OP *S_newSVOP_CUSTOM(pTHX_ OP *(*func)(pTHX), U32 flags, SV *sv)
-{
- SVOP *svop;
-#if HAVE_PERL_VERSION(5,22,0)
- svop = (SVOP *)newSVOP(OP_CUSTOM, flags, sv);
-#else
- NewOp(1101, svop, 1, SVOP);
- svop->op_type = (OPCODE)OP_CUSTOM;
- svop->op_sv = sv;
- svop->op_next = (OP *)svop;
- svop->op_flags = 0;
- svop->op_private = 0;
-#endif
- svop->op_ppaddr = func;
- return (OP *)svop;
-}
-
-static OP *S_newBINOP_CUSTOM(pTHX_ OP *(*func)(pTHX), U32 flags, OP *first, OP
*last)
-{
- BINOP *binop;
-#if HAVE_PERL_VERSION(5,22,0)
- binop = (BINOP *)newBINOP(OP_CUSTOM, flags, first, last);
-#else
- NewOp(1101, binop, 1, BINOP);
- binop->op_type = (OPCODE)OP_CUSTOM;
- binop->op_first = first;
- first->op_sibling = last;
- binop->op_last = last;
- binop->op_flags = (U8)(flags | OPf_KIDS);
- binop->op_private = (U8)(2 | (flags >> 8));
-#endif
- binop->op_ppaddr = func;
- return (OP *)binop;
-}
-
-static OP *S_newLOGOP_CUSTOM(pTHX_ OP *(*func)(pTHX), U32 flags, OP *first, OP
*other)
-{
- OP *o;
-#if HAVE_PERL_VERSION(5,22,0)
- o = newLOGOP(OP_CUSTOM, flags, first, other);
-#else
- /* Parts of this code copypasted from perl 5.20.0's op.c S_new_logop()
- */
- LOGOP *logop;
-
- first = op_contextualize(first, G_SCALAR);
-
- NewOp(1101, logop, 1, LOGOP);
-
- logop->op_type = (OPCODE)OP_CUSTOM;
- logop->op_ppaddr = NULL; /* Because caller only overrides it anyway */
- logop->op_first = first;
- logop->op_flags = (U8)(flags | OPf_KIDS);
- logop->op_other = LINKLIST(other);
- /* logop->op_private has nothing interesting for OP_CUSTOM */
-
- /* Link in postfix order */
- logop->op_next = LINKLIST(first);
- first->op_next = (OP *)logop;
- first->op_sibling = other;
-
- /* No CHECKOP for OP_CUSTOM */
- o = newUNOP(OP_NULL, 0, (OP *)logop);
- other->op_next = o;
-#endif
-
- /* the returned op is actually an UNOP that's either NULL or NOT; the real
- * logop is the op_next of it
- */
- cUNOPx(o)->op_first->op_ppaddr = func;
-
- return o;
-}
-
-static char *PL_savetype_name[] = {
+static char *PL_savetype_name[] PERL_UNUSED_DECL = {
/* These have been present since 5.16 */
[SAVEt_ADELETE] = "ADELETE",
[SAVEt_AELEM] = "AELEM",
@@ -231,3 +114,150 @@
[SAVEt_HINTS_HH] = "HINTS_HH",
#endif
};
+
+#define dKWARG(count) \
+ U32 kwargi = count; \
+ U32 kwarg; \
+ SV *kwval; \
+ /* TODO: complain about odd number of args */
+
+#define KWARG_NEXT(args) \
+ S_kwarg_next(aTHX_ args, &kwargi, items, ax, &kwarg, &kwval)
+static bool S_kwarg_next(pTHX_ const char *args[], U32 *kwargi, U32 argc, U32
ax, U32 *kwarg, SV **kwval)
+{
+ if(*kwargi >= argc)
+ return FALSE;
+
+ SV *argname = ST(*kwargi); (*kwargi)++;
+ if(!SvOK(argname))
+ croak("Expected string for next argument name, got undef");
+
+ *kwarg = 0;
+ while(args[*kwarg]) {
+ if(strEQ(SvPV_nolen(argname), args[*kwarg])) {
+ *kwval = ST(*kwargi); (*kwargi)++;
+ return TRUE;
+ }
+ (*kwarg)++;
+ }
+
+ croak("Unrecognised argument name '%" SVf "'", SVfARG(argname));
+}
+
+#define import_pragma(pragma, arg) S_import_pragma(aTHX_ pragma, arg)
+static void S_import_pragma(pTHX_ const char *pragma, const char *arg)
+{
+ dSP;
+ bool unimport = FALSE;
+
+ if(pragma[0] == '-') {
+ unimport = TRUE;
+ pragma++;
+ }
+
+ SAVETMPS;
+
+ EXTEND(SP, 2);
+ PUSHMARK(SP);
+ mPUSHp(pragma, strlen(pragma));
+ if(arg)
+ mPUSHp(arg, strlen(arg));
+ PUTBACK;
+
+ call_method(unimport ? "unimport" : "import", G_VOID);
+
+ FREETMPS;
+}
+
+#define ensure_module_version(module, version) S_ensure_module_version(aTHX_
module, version)
+static void S_ensure_module_version(pTHX_ SV *module, SV *version)
+{
+ dSP;
+
+ ENTER;
+
+ PUSHMARK(SP);
+ PUSHs(module);
+ PUSHs(version);
+ PUTBACK;
+
+ call_method("VERSION", G_VOID);
+
+ LEAVE;
+}
+
+#if HAVE_PERL_VERSION(5, 16, 0)
+ /* TODO: perl 5.14 lacks HvNAMEUTF8, gv_fetchmeth_pvn() */
+# define fetch_superclass_method_pv(stash, pv, len, level)
S_fetch_superclass_method_pv(aTHX_ stash, pv, len, level)
+static CV *S_fetch_superclass_method_pv(pTHX_ HV *stash, const char *pv,
STRLEN len, U32 level)
+{
+# if HAVE_PERL_VERSION(5, 18, 0)
+ GV *gv = gv_fetchmeth_pvn(stash, pv, len, level, GV_SUPER);
+# else
+ SV *superclassname = newSVpvf("%*s::SUPER", HvNAMELEN_get(stash),
HvNAME_get(stash));
+ if(HvNAMEUTF8(stash))
+ SvUTF8_on(superclassname);
+ SAVEFREESV(superclassname);
+
+ HV *superstash = gv_stashsv(superclassname, GV_ADD);
+ GV *gv = gv_fetchmeth_pvn(superstash, pv, len, level, 0);
+# endif
+
+ if(!gv)
+ return NULL;
+ return GvCV(gv);
+}
+#endif /* HAVE_PERL_VERSION(5, 16, 0) */
+
+#define get_class_isa(stash) S_get_class_isa(aTHX_ stash)
+static AV *S_get_class_isa(pTHX_ HV *stash)
+{
+ GV **gvp = (GV **)hv_fetchs(stash, "ISA", 0);
+ if(!gvp || !GvAV(*gvp))
+ croak("Expected %s to have a @ISA list", HvNAME(stash));
+
+ return GvAV(*gvp);
+}
+
+#define find_cop_for_lvintro(padix, o, copp) S_find_cop_for_lvintro(aTHX_
padix, o, copp)
+static COP *S_find_cop_for_lvintro(pTHX_ PADOFFSET padix, OP *o, COP **copp)
+{
+ for( ; o; o = OpSIBLING(o)) {
+ if(OP_CLASS(o) == OA_COP) {
+ *copp = (COP *)o;
+ }
+ else if(o->op_type == OP_PADSV && o->op_targ == padix && o->op_private &
OPpLVAL_INTRO) {
+ return *copp;
+ }
+ else if(o->op_flags & OPf_KIDS) {
+ COP *ret = find_cop_for_lvintro(padix, cUNOPx(o)->op_first, copp);
+ if(ret)
+ return ret;
+ }
+ }
+
+ return NULL;
+}
+
+#define lex_consume_unichar(c) MY_lex_consume_unichar(aTHX_ c)
+static bool MY_lex_consume_unichar(pTHX_ U32 c)
+{
+ if(lex_peek_unichar(0) != c)
+ return FALSE;
+
+ lex_read_unichar(0);
+ return TRUE;
+}
+
+#if HAVE_PERL_VERSION(5, 16, 0)
+ /* TODO: perl 5.14 lacks HvNAMEUTF8, HvNAMELEN, sv_derived_from_pvn */
+# define sv_derived_from_hv(sv, hv) MY_sv_derived_from_hv(aTHX_ sv, hv)
+static bool MY_sv_derived_from_hv(pTHX_ SV *sv, HV *hv)
+{
+ char *hvname = HvNAME(hv);
+ if(!hvname)
+ return FALSE;
+
+ return sv_derived_from_pvn(sv, hvname, HvNAMELEN(hv), HvNAMEUTF8(hv) ?
SVf_UTF8 : 0);
+}
+#endif /* HAVE_PERL_VERSION(5, 16, 0) */
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.25/hax/perl-backcompat.c.inc
new/Syntax-Keyword-Try-0.26/hax/perl-backcompat.c.inc
--- old/Syntax-Keyword-Try-0.25/hax/perl-backcompat.c.inc 2021-06-01
22:49:17.000000000 +0200
+++ new/Syntax-Keyword-Try-0.26/hax/perl-backcompat.c.inc 2021-10-12
19:12:24.000000000 +0200
@@ -1,12 +1,20 @@
-/* vi: set ft=c */
+/* vi: set ft=c : */
#define HAVE_PERL_VERSION(R, V, S) \
(PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) ||
(PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))
+#ifndef NOT_REACHED
+# define NOT_REACHED assert(0)
+#endif
+
#ifndef SvTRUE_NN
# define SvTRUE_NN(sv) SvTRUE(sv)
#endif
+#ifndef G_LIST
+# define G_LIST G_ARRAY
+#endif
+
#if !HAVE_PERL_VERSION(5, 18, 0)
typedef AV PADNAMELIST;
# define PadlistARRAY(pl) ((PAD **)AvARRAY(pl))
@@ -43,6 +51,10 @@
# define intro_my() Perl_intro_my(aTHX)
#endif
+#ifndef pad_alloc
+# define pad_alloc(a,b) Perl_pad_alloc(aTHX_ a,b)
+#endif
+
#ifndef CX_CUR
# define CX_CUR() (&cxstack[cxstack_ix])
#endif
@@ -54,7 +66,7 @@
#endif
#ifndef OpSIBLING
-# define OpSIBLING(op) (op->op_sibling)
+# define OpSIBLING(op) ((op)->op_sibling)
#endif
#ifndef OpMORESIB_set
@@ -71,16 +83,33 @@
static OP *S_op_convert_list(pTHX_ I32 type, I32 flags, OP *o)
{
/* A minimal recreation just for our purposes */
+ assert(
+ /* A hardcoded list of the optypes we know this will work for */
+ type == OP_ENTERSUB ||
+ type == OP_JOIN ||
+ type == OP_PUSH ||
+ 0);
+
o->op_type = type;
o->op_flags |= flags;
o->op_ppaddr = PL_ppaddr[type];
o = PL_check[type](aTHX_ o);
+ /* op_std_init() */
+ if(PL_opargs[type] & OA_RETSCALAR)
+ o = op_contextualize(o, G_SCALAR);
+ if(PL_opargs[type] & OA_TARGET && !o->op_targ)
+ o->op_targ = pad_alloc(type, SVs_PADTMP);
+
return o;
}
#endif
+#ifndef newMETHOP_named
+# define newMETHOP_named(type, flags, name) newSVOP(type, flags, name)
+#endif
+
#ifndef PARENT_PAD_INDEX_set
# if HAVE_PERL_VERSION(5, 22, 0)
# define PARENT_PAD_INDEX_set(pn,val) (PARENT_PAD_INDEX(pn) = val)
@@ -102,3 +131,8 @@
return Perl_pad_add_name(aTHX_ SvPV_nolen(namesv), SvCUR(namesv), flags,
typestash, ourstash);
}
#endif
+
+#if !HAVE_PERL_VERSION(5, 26, 0)
+# define isIDFIRST_utf8_safe(s, e) (PERL_UNUSED_ARG(e), isIDFIRST_utf8(s))
+# define isIDCONT_utf8_safe(s, e) (PERL_UNUSED_ARG(e), isIDCONT_utf8(s))
+#endif
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/Syntax-Keyword-Try-0.25/lib/Syntax/Keyword/Try/Deparse.pm
new/Syntax-Keyword-Try-0.26/lib/Syntax/Keyword/Try/Deparse.pm
--- old/Syntax-Keyword-Try-0.25/lib/Syntax/Keyword/Try/Deparse.pm
2021-06-01 22:49:17.000000000 +0200
+++ new/Syntax-Keyword-Try-0.26/lib/Syntax/Keyword/Try/Deparse.pm
2021-10-12 19:12:24.000000000 +0200
@@ -3,7 +3,7 @@
#
# (C) Paul Evans, 2021 -- [email protected]
-package Syntax::Keyword::Try::Deparse 0.25;
+package Syntax::Keyword::Try::Deparse 0.26;
use v5.14;
use warnings;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.25/lib/Syntax/Keyword/Try.pm
new/Syntax-Keyword-Try-0.26/lib/Syntax/Keyword/Try.pm
--- old/Syntax-Keyword-Try-0.25/lib/Syntax/Keyword/Try.pm 2021-06-01
22:49:17.000000000 +0200
+++ new/Syntax-Keyword-Try-0.26/lib/Syntax/Keyword/Try.pm 2021-10-12
19:12:24.000000000 +0200
@@ -3,7 +3,7 @@
#
# (C) Paul Evans, 2016-2021 -- [email protected]
-package Syntax::Keyword::Try 0.25;
+package Syntax::Keyword::Try 0.26;
use v5.14;
use warnings;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.25/lib/Syntax/Keyword/Try.xs
new/Syntax-Keyword-Try-0.26/lib/Syntax/Keyword/Try.xs
--- old/Syntax-Keyword-Try-0.25/lib/Syntax/Keyword/Try.xs 2021-06-01
22:49:17.000000000 +0200
+++ new/Syntax-Keyword-Try-0.26/lib/Syntax/Keyword/Try.xs 2021-10-12
19:12:24.000000000 +0200
@@ -26,36 +26,68 @@
#endif /* <5.19.4 */
#include "perl-additions.c.inc"
+#include "optree-additions.c.inc"
+#include "op_sibling_splice.c.inc"
+#include "newOP_CUSTOM.c.inc"
static OP *pp_entertrycatch(pTHX);
static OP *pp_catch(pTHX);
/*
- * A variant of dounwind() which preserves the topmost scalar or list value on
- * the stack in non-void context
+ * A modified version of pp_return for returning from inside a try block.
+ * To do this, we unwind the context stack to just past the CXt_EVAL and then
+ * chain to the regular OP_RETURN func
*/
-#define dounwind_keeping_stack(cxix) MY_dounwind_keeping_stack(aTHX_ cxix)
-static void MY_dounwind_keeping_stack(pTHX_ I32 cxix)
+static OP *pp_returnintry(pTHX)
{
- I32 gimme;
+ I32 cxix;
+
+ for (cxix = cxstack_ix; cxix; cxix--) {
+ if(CxTYPE(&cxstack[cxix]) == CXt_SUB)
+ break;
+
+ if(CxTYPE(&cxstack[cxix]) == CXt_EVAL && CxTRYBLOCK(&cxstack[cxix])) {
+ /* If this CXt_EVAL frame came from our own ENTERTRYCATCH, then the
+ * retop should point at an OP_CUSTOM and its first grand-child will be
+ * our custom modified ENTERTRY. We can skip over it and continue in
+ * this case.
+ */
+ OP *retop = cxstack[cxix].blk_eval.retop;
+ OP *leave, *enter;
+ if(retop->op_type == OP_CUSTOM && retop->op_ppaddr == &pp_catch &&
+ (leave = cLOGOPx(retop)->op_first) && leave->op_type == OP_LEAVETRY &&
+ (enter = cLOGOPx(leave)->op_first) && enter->op_type == OP_ENTERTRY &&
+ enter->op_ppaddr == &pp_entertrycatch) {
+ continue;
+ }
+ /* We have to stop at any other kind of CXt_EVAL */
+ break;
+ }
+ }
+ if(!cxix)
+ croak("Unable to find an CXt_SUB to pop back to");
+
+ I32 gimme = cxstack[cxix].blk_gimme;
SV *retval;
/* chunks of this code inspired by
* ZEFRAM/Scope-Escape-0.005/lib/Scope/Escape.xs
*/
- switch(gimme = cxstack[cxix].blk_gimme) {
+ switch(gimme) {
case G_VOID:
+ (void)POPMARK;
break;
case G_SCALAR: {
dSP;
- retval = TOPs;
+ dMARK;
+ retval = (MARK == SP) ? &PL_sv_undef : TOPs;
SvREFCNT_inc(retval);
sv_2mortal(retval);
break;
}
- case G_ARRAY: {
+ case G_LIST: {
dSP;
dMARK;
SV **retvals = MARK+1;
@@ -76,17 +108,21 @@
/* Now put the value back */
switch(gimme) {
- case G_VOID:
+ case G_VOID: {
+ dSP;
+ PUSHMARK(SP);
break;
+ }
case G_SCALAR: {
dSP;
+ PUSHMARK(SP);
XPUSHs(retval);
PUTBACK;
break;
}
- case G_ARRAY: {
+ case G_LIST: {
dSP;
PUSHMARK(SP);
AV *retav = (AV *)retval;
@@ -98,43 +134,6 @@
break;
}
}
-}
-
-/*
- * A modified version of pp_return for returning from inside a try block.
- * To do this, we unwind the context stack to just past the CXt_EVAL and then
- * chain to the regular OP_RETURN func
- */
-static OP *pp_returnintry(pTHX)
-{
- I32 cxix;
-
- for (cxix = cxstack_ix; cxix; cxix--) {
- if(CxTYPE(&cxstack[cxix]) == CXt_SUB)
- break;
-
- if(CxTYPE(&cxstack[cxix]) == CXt_EVAL && CxTRYBLOCK(&cxstack[cxix])) {
- /* If this CXt_EVAL frame came from our own ENTERTRYCATCH, then the
- * retop should point at an OP_CUSTOM and its first grand-child will be
- * our custom modified ENTERTRY. We can skip over it and continue in
- * this case.
- */
- OP *retop = cxstack[cxix].blk_eval.retop;
- OP *leave, *enter;
- if(retop->op_type == OP_CUSTOM && retop->op_ppaddr == &pp_catch &&
- (leave = cLOGOPx(retop)->op_first) && leave->op_type == OP_LEAVETRY &&
- (enter = cLOGOPx(leave)->op_first) && enter->op_type == OP_ENTERTRY &&
- enter->op_ppaddr == &pp_entertrycatch) {
- continue;
- }
- /* We have to stop at any other kind of CXt_EVAL */
- break;
- }
- }
- if(!cxix)
- croak("Unable to find an CXt_SUB to pop back to");
-
- dounwind_keeping_stack(cxix);
return PL_ppaddr[OP_RETURN](aTHX);
}
@@ -321,13 +320,6 @@
return cLOGOP->op_next;
}
-/* A variant of OP_LEAVE which keeps the values on the stack */
-static OP *pp_leave_keeping_stack(pTHX)
-{
- dounwind_keeping_stack(cxstack_ix - 1);
- return cUNOP->op_next;
-}
-
#define newENTERTRYCATCHOP(flags, try, catch) MY_newENTERTRYCATCHOP(aTHX_
flags, try, catch)
static OP *MY_newENTERTRYCATCHOP(pTHX_ U32 flags, OP *try, OP *catch)
{
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.25/t/12return.t
new/Syntax-Keyword-Try-0.26/t/12return.t
--- old/Syntax-Keyword-Try-0.25/t/12return.t 2021-06-01 22:49:17.000000000
+0200
+++ new/Syntax-Keyword-Try-0.26/t/12return.t 2021-10-12 19:12:24.000000000
+0200
@@ -10,18 +10,25 @@
# return from try
{
my $after;
+ ( sub {
+ try { return }
+ catch ($e) {}
+ $after++;
+ } )->();
+ ok( !$after, 'code after try{return} in void context is not invoked' );
+}
+# return SCALAR from try
+{
is(
- ( sub {
+ scalar ( sub {
try { return "result" }
catch ($e) {}
- $after++;
return "nope";
} )->(),
"result",
- 'return in try leaves containing function'
+ 'return SCALAR in try yields correct value'
);
- ok( !$after, 'code after try{return} is not invoked' );
}
# return LIST from try
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.25/t/16final-expr.t
new/Syntax-Keyword-Try-0.26/t/16final-expr.t
--- old/Syntax-Keyword-Try-0.25/t/16final-expr.t 2021-06-01
22:49:17.000000000 +0200
+++ new/Syntax-Keyword-Try-0.26/t/16final-expr.t 2021-10-12
19:12:24.000000000 +0200
@@ -35,6 +35,12 @@
catch ($e) { 4, 5, 6 }
};
is_deeply(\@list, [4, 5, 6], 'do { try/catch } in list context');
+
+ $scalar = do {
+ try { die "Oops" }
+ catch ($e) { my $x = 123; 456 }
+ };
+ is($scalar, 456, 'do { try/catch } with multiple statements');
}
done_testing;
