Hello community,
here is the log from the commit of package perl-Syntax-Keyword-Try for
openSUSE:Factory checked in at 2020-07-06 16:29:39
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-Syntax-Keyword-Try (Old)
and /work/SRC/openSUSE:Factory/.perl-Syntax-Keyword-Try.new.3060 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Syntax-Keyword-Try"
Mon Jul 6 16:29:39 2020 rev:3 rq:818858 version:0.13
Changes:
--------
---
/work/SRC/openSUSE:Factory/perl-Syntax-Keyword-Try/perl-Syntax-Keyword-Try.changes
2019-09-09 23:53:21.373267536 +0200
+++
/work/SRC/openSUSE:Factory/.perl-Syntax-Keyword-Try.new.3060/perl-Syntax-Keyword-Try.changes
2020-07-06 16:31:48.343625407 +0200
@@ -1,0 +2,21 @@
+Wed Jul 1 03:13:23 UTC 2020 - Tina Müller <timueller+p...@suse.de>
+
+- updated to 0.13
+ see /usr/share/doc/packages/perl-Syntax-Keyword-Try/Changes
+
+ 0.13 2020-06-29
+ [BUGFIXES]
+ * Pack correct MANIFEST to include hax/ files
+
+ 0.12 2020-06-29
+ [CHANGES]
+ * Optional and experimental allocation of a new lexical under
+ `catch my $VAR` syntax (RT130702). However, this syntax may not
+ survive long, as part of the ongoing typed catch design work.
+
+ [BUGFIXES]
+ * Work around perl versions prior to 5.22 built with -DDEBUGGING
+ getting upset about new*OP() being invoked with OP_CUSTOM
+ (RT128562)
+
+-------------------------------------------------------------------
Old:
----
Syntax-Keyword-Try-0.11.tar.gz
New:
----
Syntax-Keyword-Try-0.13.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-Syntax-Keyword-Try.spec ++++++
--- /var/tmp/diff_new_pack.7whr0o/_old 2020-07-06 16:31:51.579635349 +0200
+++ /var/tmp/diff_new_pack.7whr0o/_new 2020-07-06 16:31:51.587635374 +0200
@@ -1,7 +1,7 @@
#
# spec file for package perl-Syntax-Keyword-Try
#
-# Copyright (c) 2019 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2020 SUSE LLC
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -17,13 +17,13 @@
Name: perl-Syntax-Keyword-Try
-Version: 0.11
+Version: 0.13
Release: 0
%define cpan_name Syntax-Keyword-Try
Summary: C<try/catch/finally> syntax for perl
License: Artistic-1.0 OR GPL-1.0-or-later
Group: Development/Libraries/Perl
-Url: https://metacpan.org/release/%{cpan_name}
+URL: https://metacpan.org/release/%{cpan_name}
Source0:
https://cpan.metacpan.org/authors/id/P/PE/PEVANS/%{cpan_name}-%{version}.tar.gz
Source1: cpanspec.yml
BuildRoot: %{_tmppath}/%{name}-%{version}-build
++++++ Syntax-Keyword-Try-0.11.tar.gz -> Syntax-Keyword-Try-0.13.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.11/Build.PL
new/Syntax-Keyword-Try-0.13/Build.PL
--- old/Syntax-Keyword-Try-0.11/Build.PL 2019-09-07 02:20:31.000000000
+0200
+++ new/Syntax-Keyword-Try-0.13/Build.PL 2020-06-29 21:23:56.000000000
+0200
@@ -22,6 +22,8 @@
x_IRC => "irc://irc.perl.org/#io-async",
},
},
+
+ extra_compiler_flags => [qw( -Ihax )],
);
$build->create_build_script;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.11/Changes
new/Syntax-Keyword-Try-0.13/Changes
--- old/Syntax-Keyword-Try-0.11/Changes 2019-09-07 02:20:31.000000000 +0200
+++ new/Syntax-Keyword-Try-0.13/Changes 2020-06-29 21:23:56.000000000 +0200
@@ -1,5 +1,20 @@
Revision history for Syntax-Keyword-Try
+0.13 2020-06-29
+ [BUGFIXES]
+ * Pack correct MANIFEST to include hax/ files
+
+0.12 2020-06-29
+ [CHANGES]
+ * Optional and experimental allocation of a new lexical under
+ `catch my $VAR` syntax (RT130702). However, this syntax may not
+ survive long, as part of the ongoing typed catch design work.
+
+ [BUGFIXES]
+ * Work around perl versions prior to 5.22 built with -DDEBUGGING
+ getting upset about new*OP() being invoked with OP_CUSTOM
+ (RT128562)
+
0.11 2019-09-07
[CHANGES]
* Use wrap_keyword_plugin() instead of direct access to
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.11/LICENSE
new/Syntax-Keyword-Try-0.13/LICENSE
--- old/Syntax-Keyword-Try-0.11/LICENSE 2019-09-07 02:20:31.000000000 +0200
+++ new/Syntax-Keyword-Try-0.13/LICENSE 2020-06-29 21:23:56.000000000 +0200
@@ -1,4 +1,4 @@
-This software is copyright (c) 2019 by Paul Evans <leon...@leonerd.org.uk>.
+This software is copyright (c) 2020 by Paul Evans <leon...@leonerd.org.uk>.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
@@ -12,7 +12,7 @@
--- The GNU General Public License, Version 1, February 1989 ---
-This software is Copyright (c) 2019 by Paul Evans <leon...@leonerd.org.uk>.
+This software is Copyright (c) 2020 by Paul Evans <leon...@leonerd.org.uk>.
This is free software, licensed under:
@@ -272,7 +272,7 @@
--- The Artistic License 1.0 ---
-This software is Copyright (c) 2019 by Paul Evans <leon...@leonerd.org.uk>.
+This software is Copyright (c) 2020 by Paul Evans <leon...@leonerd.org.uk>.
This is free software, licensed under:
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.11/MANIFEST
new/Syntax-Keyword-Try-0.13/MANIFEST
--- old/Syntax-Keyword-Try-0.11/MANIFEST 2019-09-07 02:20:31.000000000
+0200
+++ new/Syntax-Keyword-Try-0.13/MANIFEST 2020-06-29 21:23:56.000000000
+0200
@@ -1,5 +1,8 @@
Build.PL
Changes
+hax/lexer-additions.c.inc
+hax/perl-additions.c.inc
+hax/wrap_keyword_plugin.c.inc
lib/Syntax/Keyword/Try.pm
lib/Syntax/Keyword/Try.xs
LICENSE
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.11/META.json
new/Syntax-Keyword-Try-0.13/META.json
--- old/Syntax-Keyword-Try-0.11/META.json 2019-09-07 02:20:31.000000000
+0200
+++ new/Syntax-Keyword-Try-0.13/META.json 2020-06-29 21:23:56.000000000
+0200
@@ -38,7 +38,7 @@
"provides" : {
"Syntax::Keyword::Try" : {
"file" : "lib/Syntax/Keyword/Try.pm",
- "version" : "0.11"
+ "version" : "0.13"
}
},
"release_status" : "stable",
@@ -48,6 +48,6 @@
],
"x_IRC" : "irc://irc.perl.org/#io-async"
},
- "version" : "0.11",
+ "version" : "0.13",
"x_serialization_backend" : "JSON::PP version 4.04"
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.11/META.yml
new/Syntax-Keyword-Try-0.13/META.yml
--- old/Syntax-Keyword-Try-0.11/META.yml 2019-09-07 02:20:31.000000000
+0200
+++ new/Syntax-Keyword-Try-0.13/META.yml 2020-06-29 21:23:56.000000000
+0200
@@ -17,11 +17,11 @@
provides:
Syntax::Keyword::Try:
file: lib/Syntax/Keyword/Try.pm
- version: '0.11'
+ version: '0.13'
requires:
perl: '5.014'
resources:
IRC: irc://irc.perl.org/#io-async
license: http://dev.perl.org/licenses/
-version: '0.11'
+version: '0.13'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.11/README
new/Syntax-Keyword-Try-0.13/README
--- old/Syntax-Keyword-Try-0.11/README 2019-09-07 02:20:31.000000000 +0200
+++ new/Syntax-Keyword-Try-0.13/README 2020-06-29 21:23:56.000000000 +0200
@@ -77,10 +77,23 @@
STATEMENTS...
}
+ Or
+
+ ...
+ catch my $var {
+ STATEMENTS...
+ }
+
+ Experimental; since version 0.12.
+
A catch statement provides a block of code to the preceding try
statement that will be invoked in the case that the main block of code
throws an exception. The catch block can inspect the raised exception
- by looking in $@ in the usual way.
+ by looking in $@ in the usual way. Optionally, a new lexical variable
+ can be introduced to store the exception in. This new form is
+ experimental and is likely to change in a future version, as part of
+ the wider attempt to introduce typed dispatch. Using it will provoke an
+ experimental category warning on supporting perl versions.
Presence of this catch statement causes any exception thrown by the
preceding try block to be non-fatal to the surrounding code. If the
@@ -255,11 +268,52 @@
typed dispatch where different classes of exception are caught by
different blocks of code, or propagated up entirely to callers.
- The author considers the lack of such ability in this module to be a
- feature. That kind of dispatch on type matching of a controlling
- expression is too useful a behaviour to be constrained to exception
- catching. If the language is to provide such a facility, it should be
- more universally applicable as a stand-alone independent ability.
+ This is likely to be the next experimental development on this module,
+ in ongoing preparation for a time when it can be moved into core perl
+ syntax. While at first I was heistant to implement this as a
+ special-case in try/catch syntax, my other work thinking about the
+ codenamed "dumbmatch" syntax feature leads me to thinking that actually
+ typed dispatch of catch blocks is sufficiently different from value
+ dispatch in a more general case (such as "dumbmatch"). Exception
+ dispatch in perl needs to handle both isa and string regexp testing at
+ the same site.
+
+ My latest thinking on this front may involve some syntax such as:
+
+ try {
+ ...
+ }
+ catch my $e
+ (isa Some::Exception::Class) { ... },
+ (=~ m/^An error message /) { ... }
+
+ or
+
+ try {
+ ...
+ }
+ catch ($e isa Some::Exception::Class) { ... },
+ ($e =~ m/^An error message /) { ... }
+
+ Or maybe the catch keyword would be repeated per line, though that then
+ involves repeating the error variable name also:
+
+ try {
+ ...
+ }
+ catch my $e (isa Some::Exception::Class) { ... }
+ catch my $e (=~ m/^An error message /) { ... }
+
+ or
+
+ try {
+ ...
+ }
+ catch ($e isa Some::Exception::Class) { ... }
+ catch ($e =~ m/^An error message /) { ... }
+
+ The design thoughts continue on the RT ticket
+ https://rt.cpan.org/Ticket/Display.html?id=123918.
WITH OTHER MODULES
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.11/hax/lexer-additions.c.inc
new/Syntax-Keyword-Try-0.13/hax/lexer-additions.c.inc
--- old/Syntax-Keyword-Try-0.11/hax/lexer-additions.c.inc 1970-01-01
01:00:00.000000000 +0100
+++ new/Syntax-Keyword-Try-0.13/hax/lexer-additions.c.inc 2020-06-29
21:23:56.000000000 +0200
@@ -0,0 +1,43 @@
+/* vi: set ft=c inde=: */
+
+/* Perls before 5.18 lack isIDCONT_uni, but baring minor differences of weird
+ * Unicode characters, isALNUM_uni is close enough
+ */
+#ifndef isIDCONT_uni
+#define isIDCONT_uni(c) isALNUM_uni(c)
+#endif
+
+#define lex_consume(s) MY_lex_consume(aTHX_ s)
+static int MY_lex_consume(pTHX_ char *s)
+{
+ /* I want strprefix() */
+ size_t i;
+ for(i = 0; s[i]; i++) {
+ if(s[i] != PL_parser->bufptr[i])
+ return 0;
+ }
+
+ lex_read_to(PL_parser->bufptr + i);
+ return i;
+}
+
+#define parse_lexvar() MY_parse_lexvar(aTHX)
+static PADOFFSET MY_parse_lexvar(pTHX)
+{
+ char *lexname = PL_parser->bufptr;
+
+ if(lex_read_unichar(0) != '$')
+ croak("Expected a lexical scalar at %s", lexname);
+
+ if(!isIDFIRST_uni(lex_peek_unichar(0)))
+ croak("Expected a lexical scalar at %s", lexname);
+ lex_read_unichar(0);
+ while(isIDCONT_uni(lex_peek_unichar(0)))
+ lex_read_unichar(0);
+
+ /* Forbid $_ */
+ if(PL_parser->bufptr - lexname == 2 && lexname[1] == '_')
+ croak("Can't use global $_ in \"my\"");
+
+ return pad_add_name_pvn(lexname, PL_parser->bufptr - lexname, 0, NULL, NULL);
+}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.11/hax/perl-additions.c.inc
new/Syntax-Keyword-Try-0.13/hax/perl-additions.c.inc
--- old/Syntax-Keyword-Try-0.11/hax/perl-additions.c.inc 1970-01-01
01:00:00.000000000 +0100
+++ new/Syntax-Keyword-Try-0.13/hax/perl-additions.c.inc 2020-06-29
21:23:56.000000000 +0200
@@ -0,0 +1,95 @@
+/* vi: set ft=c inde=: */
+
+#ifndef av_count
+# define av_count(av) (av_top_index(av) + 1)
+#endif
+
+#if HAVE_PERL_VERSION(5, 22, 0)
+# define PadnameIsNULL(pn) (!(pn))
+#else
+# define PadnameIsNULL(pn) (!(pn) || (pn) == &PL_sv_undef)
+#endif
+
+#define save_strndup(s, l) S_save_strndup(aTHX_ s, l)
+static char *S_save_strndup(pTHX_ char *s, STRLEN l)
+{
+ /* savepvn doesn't put anything on the save stack, despite its name */
+ char *ret = savepvn(s, l);
+ SAVEFREEPV(ret);
+ return ret;
+}
+
+#define sv_setrv(s, r) S_sv_setrv(aTHX_ s, r)
+static void S_sv_setrv(pTHX_ SV *sv, SV *rv)
+{
+ sv_setiv(sv, (IV)rv);
+#if !HAVE_PERL_VERSION(5, 24, 0)
+ SvIOK_off(sv);
+#endif
+ SvROK_on(sv);
+}
+
+static OP *newPADxVOP(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
+ */
+
+#if HAVE_PERL_VERSION(5,22,0)
+# define newLOGOP_CUSTOM(flags, first, other) newLOGOP(OP_CUSTOM, flags,
first, other)
+# define newSVOP_CUSTOM(flags, sv) newSVOP(OP_CUSTOM, flags, sv)
+#else
+# define newLOGOP_CUSTOM(flags, first, other) S_newLOGOP_CUSTOM(aTHX_ flags,
first, other)
+# define newSVOP_CUSTOM(flags, sv) S_newSVOP_CUSTOM(aTHX_ flags,
sv)
+
+static OP *S_newLOGOP_CUSTOM(pTHX_ U32 flags, OP *first, OP *other)
+{
+ /* Parts of this code copypasted from perl 5.20.0's op.c S_new_logop()
+ */
+ LOGOP *logop;
+ OP *o;
+
+ 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;
+
+ return o;
+}
+
+static OP *S_newSVOP_CUSTOM(pTHX_ U32 flags, SV *sv)
+{
+ SVOP *svop;
+ NewOp(1101, svop, 1, SVOP);
+ svop->op_type = (OPCODE)OP_CUSTOM;
+ svop->op_ppaddr = NULL; /* Because caller only overrides it anyway */
+ svop->op_sv = sv;
+ svop->op_next = (OP *)svop;
+ svop->op_flags = 0;
+ svop->op_private = 0;
+ return (OP *)svop;
+}
+
+#endif
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/Syntax-Keyword-Try-0.11/hax/wrap_keyword_plugin.c.inc
new/Syntax-Keyword-Try-0.13/hax/wrap_keyword_plugin.c.inc
--- old/Syntax-Keyword-Try-0.11/hax/wrap_keyword_plugin.c.inc 1970-01-01
01:00:00.000000000 +0100
+++ new/Syntax-Keyword-Try-0.13/hax/wrap_keyword_plugin.c.inc 2020-06-29
21:23:56.000000000 +0200
@@ -0,0 +1,28 @@
+/* vi: set ft=c inde=: */
+
+#ifndef OP_CHECK_MUTEX_LOCK /* < 5.15.8 */
+# define OP_CHECK_MUTEX_LOCK ((void)0)
+# define OP_CHECK_MUTEX_UNLOCK ((void)0)
+#endif
+
+#define wrap_keyword_plugin(func, var) S_wrap_keyword_plugin(aTHX_ func, var)
+
+static void S_wrap_keyword_plugin(pTHX_ Perl_keyword_plugin_t func,
Perl_keyword_plugin_t *var)
+{
+ /* BOOT can potentially race with other threads (RT123547) */
+
+ /* Perl doesn't really provide us a nice mutex for doing this so this is the
+ * best we can find. See also
+ * https://rt.perl.org/Public/Bug/Display.html?id=132413
+ */
+ if(*var)
+ return;
+
+ OP_CHECK_MUTEX_LOCK;
+ if(!*var) {
+ *var = PL_keyword_plugin;
+ PL_keyword_plugin = func;
+ }
+
+ OP_CHECK_MUTEX_UNLOCK;
+}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.11/lib/Syntax/Keyword/Try.pm
new/Syntax-Keyword-Try-0.13/lib/Syntax/Keyword/Try.pm
--- old/Syntax-Keyword-Try-0.11/lib/Syntax/Keyword/Try.pm 2019-09-07
02:20:31.000000000 +0200
+++ new/Syntax-Keyword-Try-0.13/lib/Syntax/Keyword/Try.pm 2020-06-29
21:23:56.000000000 +0200
@@ -8,7 +8,7 @@
use strict;
use warnings;
-our $VERSION = '0.11';
+our $VERSION = '0.13';
use Carp;
@@ -95,10 +95,23 @@
STATEMENTS...
}
+Or
+
+ ...
+ catch my $var {
+ STATEMENTS...
+ }
+
+I<Experimental; since version 0.12.>
+
A C<catch> statement provides a block of code to the preceding C<try>
statement that will be invoked in the case that the main block of code throws
an exception. The C<catch> block can inspect the raised exception by looking
-in C<$@> in the usual way.
+in C<$@> in the usual way. Optionally, a new lexical variable can be
+introduced to store the exception in. This new form is experimental and is
+likely to change in a future version, as part of the wider attempt to
+introduce typed dispatch. Using it will provoke an C<experimental> category
+warning on supporting perl versions.
Presence of this C<catch> statement causes any exception thrown by the
preceding C<try> block to be non-fatal to the surrounding code. If the
@@ -286,11 +299,51 @@
typed dispatch where different classes of exception are caught by different
blocks of code, or propagated up entirely to callers.
-The author considers the lack of such ability in this module to be a feature.
-That kind of dispatch on type matching of a controlling expression is too
-useful a behaviour to be constrained to exception catching. If the language is
-to provide such a facility, it should be more universally applicable as a
-stand-alone independent ability.
+This is likely to be the next experimental development on this module, in
+ongoing preparation for a time when it can be moved into core perl syntax.
+While at first I was heistant to implement this as a special-case in
+C<try/catch> syntax, my other work thinking about the codenamed "dumbmatch"
+syntax feature leads me to thinking that actually typed dispatch of C<catch>
+blocks is sufficiently different from value dispatch in a more general case
+(such as "dumbmatch"). Exception dispatch in perl needs to handle both C<isa>
+and string regexp testing at the same site.
+
+My latest thinking on this front may involve some syntax such as:
+
+ try {
+ ...
+ }
+ catch my $e
+ (isa Some::Exception::Class) { ... },
+ (=~ m/^An error message /) { ... }
+
+or
+
+ try {
+ ...
+ }
+ catch ($e isa Some::Exception::Class) { ... },
+ ($e =~ m/^An error message /) { ... }
+
+Or maybe the C<catch> keyword would be repeated per line, though that then
+involves repeating the error variable name also:
+
+ try {
+ ...
+ }
+ catch my $e (isa Some::Exception::Class) { ... }
+ catch my $e (=~ m/^An error message /) { ... }
+
+or
+
+ try {
+ ...
+ }
+ catch ($e isa Some::Exception::Class) { ... }
+ catch ($e =~ m/^An error message /) { ... }
+
+The design thoughts continue on the RT ticket
+L<https://rt.cpan.org/Ticket/Display.html?id=123918>.
=cut
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.11/lib/Syntax/Keyword/Try.xs
new/Syntax-Keyword-Try-0.13/lib/Syntax/Keyword/Try.xs
--- old/Syntax-Keyword-Try-0.11/lib/Syntax/Keyword/Try.xs 2019-09-07
02:20:31.000000000 +0200
+++ new/Syntax-Keyword-Try-0.13/lib/Syntax/Keyword/Try.xs 2020-06-29
21:23:56.000000000 +0200
@@ -21,6 +21,10 @@
#define block_start(a) Perl_block_start(aTHX_ a)
#endif
+#ifndef intro_my
+#define intro_my() Perl_intro_my(aTHX)
+#endif
+
#ifndef OpSIBLING
#define OpSIBLING(op) (op->op_sibling)
#endif
@@ -29,51 +33,39 @@
#define OpMORESIB_set(op,sib) ((op)->op_sibling = (sib))
#endif
-/* borrowed from ZEFRAM/Scope-Escape-0.005/lib/Scope/Escape.xs */
-#define PERL_VERSION_DECIMAL(r,v,s) (r*1000000 + v*1000 + s)
-#define PERL_DECIMAL_VERSION \
- PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)
-#define PERL_VERSION_GE(r,v,s) \
- (PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s))
+#define HAVE_PERL_VERSION(R, V, S) \
+ (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) ||
(PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))
-#if PERL_VERSION_GE(5,26,0)
+#if HAVE_PERL_VERSION(5,26,0)
# define HAVE_OP_SIBPARENT
#endif
-#if PERL_VERSION_GE(5,19,4)
+#if HAVE_PERL_VERSION(5,19,4)
typedef SSize_t array_ix_t;
#else /* <5.19.4 */
typedef I32 array_ix_t;
#endif /* <5.19.4 */
#ifndef wrap_keyword_plugin
-# ifndef OP_CHECK_MUTEX_LOCK /* < 5.15.8 */
-# define OP_CHECK_MUTEX_LOCK ((void)0)
-# define OP_CHECK_MUTEX_UNLOCK ((void)0)
-# endif
-
-# define wrap_keyword_plugin(func, var) S_wrap_keyword_plugin(aTHX_ func,
var)
-static void S_wrap_keyword_plugin(pTHX_ Perl_keyword_plugin_t func,
Perl_keyword_plugin_t *var)
-{
- /* BOOT can potentially race with other threads (RT123547) */
-
- /* Perl doesn't really provide us a nice mutex for doing this so this is the
- * best we can find. See also
- * https://rt.perl.org/Public/Bug/Display.html?id=132413
- */
- if(*var)
- return;
+# include "wrap_keyword_plugin.c.inc"
+#endif
- OP_CHECK_MUTEX_LOCK;
- if(!*var) {
- *var = PL_keyword_plugin;
- PL_keyword_plugin = func;
- }
+/* On Perl 5.14 this had a different name */
+#ifndef pad_add_name_pvn
+#define pad_add_name_pvn(name, len, flags, typestash, ourstash)
MY_pad_add_name(aTHX_ name, len, flags, typestash, ourstash)
+PADOFFSET MY_pad_add_name(pTHX_ const char *name, STRLEN len, U32 flags, HV
*typestash, HV *ourstash)
+{
+ /* perl 5.14's Perl_pad_add_name requires a NUL-terminated name */
+ SV *namesv = sv_2mortal(newSVpvn(name, len));
- OP_CHECK_MUTEX_UNLOCK;
+ return Perl_pad_add_name(aTHX_ SvPV_nolen(namesv), SvCUR(namesv), flags,
typestash, ourstash);
}
#endif
+#include "lexer-additions.c.inc"
+
+#include "perl-additions.c.inc"
+
static OP *pp_entertrycatch(pTHX);
static OP *pp_catch(pTHX);
@@ -218,9 +210,9 @@
#define newPUSHFINALLYOP(finally) MY_newPUSHFINALLYOP(aTHX_ finally)
static OP *MY_newPUSHFINALLYOP(pTHX_ CV *finally)
{
- OP *op = newSVOP(OP_CUSTOM, 0, (SV *)finally);
+ OP *op = newSVOP_CUSTOM(0, (SV *)finally);
op->op_ppaddr = &pp_pushfinally;
- return op;
+ return (OP *)op;
}
#define newLOCALISEOP(gv) MY_newLOCALISEOP(aTHX_ gv)
@@ -231,20 +223,6 @@
return op;
}
-#define lex_consume(s) MY_lex_consume(aTHX_ s)
-static int MY_lex_consume(pTHX_ char *s)
-{
- /* I want strprefix() */
- size_t i;
- for(i = 0; s[i]; i++) {
- if(s[i] != PL_parser->bufptr[i])
- return 0;
- }
-
- lex_read_to(PL_parser->bufptr + i);
- return i;
-}
-
#define newSTATEOP_nowarnings() MY_newSTATEOP_nowarnings(aTHX)
static OP *MY_newSTATEOP_nowarnings(pTHX)
{
@@ -424,7 +402,7 @@
*/
((UNOP *)enter)->op_first->op_ppaddr = &pp_entertrycatch;
- ret = newLOGOP(OP_CUSTOM, 0,
+ ret = newLOGOP_CUSTOM(0,
enter,
newLISTOP(OP_SCOPE, 0, catch, NULL)
);
@@ -463,16 +441,43 @@
lex_read_space(0);
if(lex_consume("catch")) {
+ PADOFFSET catchvar = 0;
+ I32 save_ix = block_start(TRUE);
lex_read_space(0);
- catch = parse_scoped_block(0);
+
+ if(lex_consume("my")) {
+#ifdef WARN_EXPERIMENTAL
+ Perl_ck_warner(aTHX_ packWARN(WARN_EXPERIMENTAL),
+ "'catch my VAR' syntax is experimental and may be changed or removed
without notice");
+#endif
+ lex_read_space(0);
+ catchvar = parse_lexvar();
+
+ lex_read_space(0);
+
+ intro_my();
+ }
+
+ catch = block_end(save_ix, parse_block(0));
lex_read_space(0);
+
+ if(catchvar) {
+ OP *errsv_op = newGVOP(OP_GVSV, 0, PL_errgv);
+ OP *catchvar_op = newOP(OP_PADSV, 0);
+ catchvar_op->op_targ = catchvar;
+
+ catch = op_prepend_elem(OP_LINESEQ,
+ /* $var = $@ */
+ newBINOP(OP_SASSIGN, 0, errsv_op, catchvar_op),
+ catch);
+ }
}
if(lex_consume("finally")) {
I32 floor_ix, save_ix;
OP *body;
-#if !PERL_VERSION_GE(5,24,0)
+#if !HAVE_PERL_VERSION(5,24,0)
if(is_value)
croak("try do {} finally {} is not supported on this version of perl");
#endif
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.11/t/01trycatch.t
new/Syntax-Keyword-Try-0.13/t/01trycatch.t
--- old/Syntax-Keyword-Try-0.11/t/01trycatch.t 2019-09-07 02:20:31.000000000
+0200
+++ new/Syntax-Keyword-Try-0.13/t/01trycatch.t 2020-06-29 21:23:56.000000000
+0200
@@ -5,6 +5,8 @@
use Test::More;
+use constant HAVE_WARN_EXPERIMENTAL => $] >= 5.018;
+
use Syntax::Keyword::Try;
# try success
@@ -94,4 +96,16 @@
like( $caught, qr/^oopsie at /, 'exception was seen by catch{}' );
}
+# catch into new lexical
+{
+ no if HAVE_WARN_EXPERIMENTAL, warnings => 'experimental';
+
+ try {
+ die "caught\n";
+ }
+ catch my $e {
+ is( $e, "caught\n", 'exception is caught into new lexical' );
+ }
+}
+
done_testing;
