Hello community,
here is the log from the commit of package perl-Syntax-Keyword-Try for
openSUSE:Factory checked in at 2020-07-27 17:39:44
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-Syntax-Keyword-Try (Old)
and /work/SRC/openSUSE:Factory/.perl-Syntax-Keyword-Try.new.3592 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Syntax-Keyword-Try"
Mon Jul 27 17:39:44 2020 rev:5 rq:822842 version:0.15
Changes:
--------
---
/work/SRC/openSUSE:Factory/perl-Syntax-Keyword-Try/perl-Syntax-Keyword-Try.changes
2020-07-09 17:44:34.104592646 +0200
+++
/work/SRC/openSUSE:Factory/.perl-Syntax-Keyword-Try.new.3592/perl-Syntax-Keyword-Try.changes
2020-07-27 17:40:27.715003293 +0200
@@ -1,0 +2,9 @@
+Tue Jul 21 03:18:33 UTC 2020 - Tina Müller <[email protected]>
+
+- updated to 0.15
+ see /usr/share/doc/packages/perl-Syntax-Keyword-Try/Changes
+
+ 0.15 2020-07-21
+ * Experimental typed `catch (VAR ...)` conditions
+
+-------------------------------------------------------------------
Old:
----
Syntax-Keyword-Try-0.14.tar.gz
New:
----
Syntax-Keyword-Try-0.15.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-Syntax-Keyword-Try.spec ++++++
--- /var/tmp/diff_new_pack.koFcSm/_old 2020-07-27 17:40:29.039004537 +0200
+++ /var/tmp/diff_new_pack.koFcSm/_new 2020-07-27 17:40:29.039004537 +0200
@@ -17,7 +17,7 @@
Name: perl-Syntax-Keyword-Try
-Version: 0.14
+Version: 0.15
Release: 0
%define cpan_name Syntax-Keyword-Try
Summary: C<try/catch/finally> syntax for perl
++++++ Syntax-Keyword-Try-0.14.tar.gz -> Syntax-Keyword-Try-0.15.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.14/Changes
new/Syntax-Keyword-Try-0.15/Changes
--- old/Syntax-Keyword-Try-0.14/Changes 2020-07-07 23:39:09.000000000 +0200
+++ new/Syntax-Keyword-Try-0.15/Changes 2020-07-21 01:06:22.000000000 +0200
@@ -1,5 +1,8 @@
Revision history for Syntax-Keyword-Try
+0.15 2020-07-21
+ * Experimental typed `catch (VAR ...)` conditions
+
0.14 2020-07-07
* Optional experimental syntax of `catch (VAR)` instead of previous
experimental `catch my VAR`
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.14/MANIFEST
new/Syntax-Keyword-Try-0.15/MANIFEST
--- old/Syntax-Keyword-Try-0.14/MANIFEST 2020-07-07 23:39:09.000000000
+0200
+++ new/Syntax-Keyword-Try-0.15/MANIFEST 2020-07-21 01:06:22.000000000
+0200
@@ -14,6 +14,7 @@
t/01trycatch.t
t/02tryfinally.t
t/03trycatchfinally.t
+t/04catch-types.t
t/10snail.t
t/11loop.t
t/12return.t
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.14/META.json
new/Syntax-Keyword-Try-0.15/META.json
--- old/Syntax-Keyword-Try-0.14/META.json 2020-07-07 23:39:09.000000000
+0200
+++ new/Syntax-Keyword-Try-0.15/META.json 2020-07-21 01:06:22.000000000
+0200
@@ -38,7 +38,7 @@
"provides" : {
"Syntax::Keyword::Try" : {
"file" : "lib/Syntax/Keyword/Try.pm",
- "version" : "0.14"
+ "version" : "0.15"
}
},
"release_status" : "stable",
@@ -48,6 +48,6 @@
],
"x_IRC" : "irc://irc.perl.org/#io-async"
},
- "version" : "0.14",
+ "version" : "0.15",
"x_serialization_backend" : "JSON::PP version 4.04"
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.14/META.yml
new/Syntax-Keyword-Try-0.15/META.yml
--- old/Syntax-Keyword-Try-0.14/META.yml 2020-07-07 23:39:09.000000000
+0200
+++ new/Syntax-Keyword-Try-0.15/META.yml 2020-07-21 01:06:22.000000000
+0200
@@ -17,11 +17,11 @@
provides:
Syntax::Keyword::Try:
file: lib/Syntax/Keyword/Try.pm
- version: '0.14'
+ version: '0.15'
requires:
perl: '5.014'
resources:
IRC: irc://irc.perl.org/#io-async
license: http://dev.perl.org/licenses/
-version: '0.14'
+version: '0.15'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.14/README
new/Syntax-Keyword-Try-0.15/README
--- old/Syntax-Keyword-Try-0.14/README 2020-07-07 23:39:09.000000000 +0200
+++ new/Syntax-Keyword-Try-0.15/README 2020-07-21 01:06:22.000000000 +0200
@@ -84,16 +84,16 @@
STATEMENTS...
}
- Experimental; since version 0.12.
+ Experimental; since version 0.14.
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. 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.
+ experimental and is likely to be expanded on 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
@@ -110,6 +110,50 @@
If a catch statement is not given, then any exceptions raised by the
try block are raised to the caller in the usual way.
+ catch (Typed)
+
+ ...
+ catch ($var isa Class) { ... }
+
+ ...
+ catch ($var =~ m/^Regexp match/) { ... }
+
+ Experimental; since version 0.15.
+
+ Optionally, multiple catch statements can be provided, where each block
+ is given a guarding condition, to control whether or not it will catch
+ particular exception values. Two kinds of condition are supported:
+
+ *
+
+ catch ($var isa Class)
+
+ The block is invoked only if the caught exception is a blessed
+ object, and derives from the given package name.
+
+ On Perl version 5.32 onwards, this condition test is implemented
+ using the same op type that the core $var isa Class syntax is
+ provided by and works in exactly the same way.
+
+ On older perl versions it is emulated by a compatibility function.
+ Currently this function does not respect a ->isa method overload on
+ the exception instance. Usually this should not be a problem, as
+ exception class types rarely provide such a method.
+
+ *
+
+ catch ($var =~ m/regexp/)
+
+ The block is invoked only if the caught exception is a string that
+ matches the given regexp.
+
+ When an exception is caught, each condition is tested in the order they
+ are written in, until a matching case is found. If such a case is found
+ the corresponding block is invoked, and no further condition is tested.
+ If no contional block matched and there is a default (unconditional)
+ block at the end then that is invoked instead. If no such block exists,
+ then the exception is propagated up to the calling scope.
+
finally
...
@@ -260,41 +304,15 @@
Typed catch
- Like Try and Try::Tiny, this module makes no attempt to perform any
- kind of typed dispatch to distinguish kinds of exception caught by
- catch blocks.
+ Try and Try::Tiny make no attempt to perform any kind of typed dispatch
+ to distinguish kinds of exception caught by catch blocks.
TryCatch and Syntax::Feature::Try both attempt to provide a kind of
typed dispatch where different classes of exception are caught by
different blocks of code, or propagated up entirely to callers.
- 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 looking
- simplar to a sub with a signature that declares a single parameter,
- such as:
-
- try {
- ...
- }
- catch ($e isa Some::Exception::Class) { ... },
- ($e =~ m/^An error message /) { ... }
-
- Or maybe the catch keyword would be repeated per line:
-
- try {
- ...
- }
- catch ($e isa Some::Exception::Class) { ... }
- catch ($e =~ m/^An error message /) { ... }
+ This module provides such an ability, via the currently-experimental
+ catch (VAR cond...) syntax.
The design thoughts continue on the RT ticket
https://rt.cpan.org/Ticket/Display.html?id=123918.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.14/hax/perl-additions.c.inc
new/Syntax-Keyword-Try-0.15/hax/perl-additions.c.inc
--- old/Syntax-Keyword-Try-0.14/hax/perl-additions.c.inc 2020-07-07
23:39:09.000000000 +0200
+++ new/Syntax-Keyword-Try-0.15/hax/perl-additions.c.inc 2020-07-21
01:06:22.000000000 +0200
@@ -46,10 +46,12 @@
# define newLOGOP_CUSTOM(flags, first, other) newLOGOP(OP_CUSTOM, flags,
first, other)
# define newSVOP_CUSTOM(flags, sv) newSVOP(OP_CUSTOM, flags, sv)
# define newUNOP_CUSTOM(flags, first) newUNOP(OP_CUSTOM, flags,
first)
+# define newBINOP_CUSTOM(flags, first, last) newBINOP(OP_CUSTOM, flags,
first, last)
#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)
# define newUNOP_CUSTOM(flags, first) S_newUNOP_CUSTOM(aTHX_ flags,
first)
+# define newBINOP_CUSTOM(flags, first, last) S_newBINOP_CUSTOM(aTHX_ flags,
first, last)
static OP *S_newLOGOP_CUSTOM(pTHX_ U32 flags, OP *first, OP *other)
{
@@ -106,4 +108,17 @@
return (OP *)unop;
}
+static OP *S_newBINOP_CUSTOM(pTHX_ U32 flags, OP *first, OP *last)
+{
+ BINOP *binop;
+ NewOp(1101, binop, 1, BINOP);
+ binop->op_type = (OPCODE)OP_CUSTOM;
+ binop->op_ppaddr = NULL; /* Because caller only overrides it anyway */
+ 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));
+ return (OP *)binop;
+}
#endif
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.14/lib/Syntax/Keyword/Try.pm
new/Syntax-Keyword-Try-0.15/lib/Syntax/Keyword/Try.pm
--- old/Syntax-Keyword-Try-0.14/lib/Syntax/Keyword/Try.pm 2020-07-07
23:39:09.000000000 +0200
+++ new/Syntax-Keyword-Try-0.15/lib/Syntax/Keyword/Try.pm 2020-07-21
01:06:22.000000000 +0200
@@ -3,7 +3,7 @@
#
# (C) Paul Evans, 2016-2019 -- [email protected]
-package Syntax::Keyword::Try 0.14;
+package Syntax::Keyword::Try 0.15;
use v5.14;
use warnings;
@@ -100,14 +100,14 @@
STATEMENTS...
}
-I<Experimental; since version 0.12.>
+I<Experimental; since version 0.14.>
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. 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
+likely to be expanded on 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.
@@ -125,6 +125,54 @@
If a C<catch> statement is not given, then any exceptions raised by the C<try>
block are raised to the caller in the usual way.
+=head2 catch (Typed)
+
+ ...
+ catch ($var isa Class) { ... }
+
+ ...
+ catch ($var =~ m/^Regexp match/) { ... }
+
+I<Experimental; since version 0.15.>
+
+Optionally, multiple catch statements can be provided, where each block is
+given a guarding condition, to control whether or not it will catch particular
+exception values. Two kinds of condition are supported:
+
+=over 4
+
+=item *
+
+ catch ($var isa Class)
+
+The block is invoked only if the caught exception is a blessed object, and
+derives from the given package name.
+
+On Perl version 5.32 onwards, this condition test is implemented using the
+same op type that the core C<$var isa Class> syntax is provided by and works
+in exactly the same way.
+
+On older perl versions it is emulated by a compatibility function. Currently
+this function does not respect a C<< ->isa >> method overload on the exception
+instance. Usually this should not be a problem, as exception class types
+rarely provide such a method.
+
+=item *
+
+ catch ($var =~ m/regexp/)
+
+The block is invoked only if the caught exception is a string that matches
+the given regexp.
+
+=back
+
+When an exception is caught, each condition is tested in the order they are
+written in, until a matching case is found. If such a case is found the
+corresponding block is invoked, and no further condition is tested. If no
+contional block matched and there is a default (unconditional) block at the
+end then that is invoked instead. If no such block exists, then the exception
+is propagated up to the calling scope.
+
=head2 finally
...
@@ -290,38 +338,15 @@
=head2 Typed C<catch>
-Like L<Try> and L<Try::Tiny>, this module makes no attempt to perform any kind
-of typed dispatch to distinguish kinds of exception caught by C<catch> blocks.
+L<Try> and L<Try::Tiny> make no attempt to perform any kind of typed dispatch
+to distinguish kinds of exception caught by C<catch> blocks.
L<TryCatch> and L<Syntax::Feature::Try> both attempt to provide a kind of
typed dispatch where different classes of exception are caught by different
blocks of code, or propagated up entirely to callers.
-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 looking simplar to a
-C<sub> with a signature that declares a single parameter, such as:
-
- try {
- ...
- }
- catch ($e isa Some::Exception::Class) { ... },
- ($e =~ m/^An error message /) { ... }
-
-Or maybe the C<catch> keyword would be repeated per line:
-
- try {
- ...
- }
- catch ($e isa Some::Exception::Class) { ... }
- catch ($e =~ m/^An error message /) { ... }
+This module provides such an ability, via the currently-experimental
+C<catch (VAR cond...)> syntax.
The design thoughts continue on the RT ticket
L<https://rt.cpan.org/Ticket/Display.html?id=123918>.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.14/lib/Syntax/Keyword/Try.xs
new/Syntax-Keyword-Try-0.15/lib/Syntax/Keyword/Try.xs
--- old/Syntax-Keyword-Try-0.14/lib/Syntax/Keyword/Try.xs 2020-07-07
23:39:09.000000000 +0200
+++ new/Syntax-Keyword-Try-0.15/lib/Syntax/Keyword/Try.xs 2020-07-21
01:06:22.000000000 +0200
@@ -36,6 +36,10 @@
#define HAVE_PERL_VERSION(R, V, S) \
(PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) ||
(PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))
+#if HAVE_PERL_VERSION(5,32,0)
+# define HAVE_OP_ISA
+#endif
+
#if HAVE_PERL_VERSION(5,26,0)
# define HAVE_OP_SIBPARENT
#endif
@@ -413,9 +417,42 @@
return ret;
}
+#ifndef HAVE_OP_ISA
+static XOP xop_isa;
+
+/* Totally stolen from perl 5.32.0's pp.c */
+static bool sv_isa_sv(SV *sv, SV *class)
+{
+ if(!SvROK(sv) || !SvOBJECT(SvRV(sv)))
+ return FALSE;
+
+ /* TODO: ->isa invocation */
+
+#if HAVE_PERL_VERSION(5,16,0)
+ return sv_derived_from_sv(sv, class, 0);
+#else
+ return sv_derived_from(sv, SvPV_nolen(class));
+#endif
+}
+
+static OP *pp_isa(pTHX)
+{
+ dSP;
+
+ SV *left, *right;
+
+ right = POPs;
+ left = TOPs;
+
+ SETs(boolSV(sv_isa_sv(left, right)));
+ RETURN;
+}
+#endif
+
static int try_keyword(pTHX_ OP **op)
{
OP *try = NULL, *catch = NULL;
+ AV *condcatch = NULL;
CV *finally = NULL;
OP *ret = NULL;
bool is_value = FALSE;
@@ -440,23 +477,19 @@
try = parse_scoped_block(0);
lex_read_space(0);
- if(lex_consume("catch")) {
- PADOFFSET catchvar = 0;
- I32 save_ix = block_start(TRUE);
- lex_read_space(0);
-
- if(lex_consume("my")) {
- Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
- "'catch my VAR' syntax is deprecated and will be removed a later
version");
+ while(lex_consume("catch")) {
+ OP *assignop = NULL, *condop = NULL;
+ OP *body;
+ I32 save_ix;
- lex_read_space(0);
- catchvar = parse_lexvar();
+ if(catch)
+ croak("Already have a default catch {} block");
- lex_read_space(0);
+ save_ix = block_start(TRUE);
+ lex_read_space(0);
- intro_my();
- }
- else if(lex_consume("(")) {
+ if(lex_consume("(")) {
+ PADOFFSET catchvar = 0;
#ifdef WARN_EXPERIMENTAL
Perl_ck_warner(aTHX_ packWARN(WARN_EXPERIMENTAL),
"'catch (VAR)' syntax is experimental and may be changed or removed
without notice");
@@ -464,7 +497,42 @@
lex_read_space(0);
catchvar = parse_lexvar();
+ /* $var = $@ */
+ assignop = newBINOP(OP_SASSIGN, 0,
+ newGVOP(OP_GVSV, 0, PL_errgv), newPADxVOP(OP_PADSV, catchvar, 0, 0));
+
lex_read_space(0);
+ if(lex_consume("isa")) {
+ OP *type = parse_termexpr(0);
+#ifdef HAVE_OP_ISA
+ condop = newBINOP(OP_ISA, 0,
+ newPADxVOP(OP_PADSV, catchvar, 0, 0), type);
+#else
+ /* Allow a bareword on RHS of `isa` */
+ if(type->op_type == OP_CONST)
+ type->op_private &= ~(OPpCONST_BARE|OPpCONST_STRICT);
+
+ condop = newBINOP_CUSTOM(0,
+ newPADxVOP(OP_PADSV, catchvar, 0, 0), type);
+ condop->op_ppaddr = &pp_isa;
+#endif
+ }
+ else if(lex_consume("=~")) {
+ OP *regexp = parse_termexpr(0);
+
+ if(regexp->op_type != OP_MATCH || cPMOPx(regexp)->op_first)
+ croak("Expected a regexp match");
+#if HAVE_PERL_VERSION(5,22,0)
+ /* Perl 5.22+ uses op_targ on OP_MATCH directly */
+ regexp->op_targ = catchvar;
+#else
+ /* Older perls need a stacked OP_PADSV op */
+ cPMOPx(regexp)->op_first = newPADxVOP(OP_PADSV, catchvar, 0, 0);
+ regexp->op_flags |= OPf_KIDS|OPf_STACKED;
+#endif
+ condop = regexp;
+ }
+
if(!lex_consume(")"))
croak("Expected close paren for catch (VAR)");
@@ -473,19 +541,43 @@
intro_my();
}
- catch = block_end(save_ix, parse_block(0));
+ body = 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;
-
+ if(condop) {
+ if(!condcatch)
+ condcatch = newAV();
+
+ av_push(condcatch, (SV *)op_append_elem(OP_LINESEQ, assignop, condop));
+ av_push(condcatch, (SV *)body);
+ /* catch remains NULL for now */
+ }
+ else if(assignop) {
catch = op_prepend_elem(OP_LINESEQ,
- /* $var = $@ */
- newBINOP(OP_SASSIGN, 0, errsv_op, catchvar_op),
- catch);
+ assignop,
+ body);
}
+ else
+ catch = body;
+ }
+
+ if(condcatch) {
+ I32 i;
+
+ if(!catch)
+ /* A default fallthrough */
+ /* die $@ */
+ catch = newLISTOP(OP_DIE, 0,
+ newOP(OP_PUSHMARK, 0), newGVOP(OP_GVSV, 0, PL_errgv));
+
+ for(i = AvFILL(condcatch)-1; i >= 0; i -= 2) {
+ OP *body = (OP *)av_pop(condcatch),
+ *condop = (OP *)av_pop(condcatch);
+
+ catch = newCONDOP(0, condop, op_scope(body), catch);
+ }
+
+ SvREFCNT_dec(condcatch);
}
if(lex_consume("finally")) {
@@ -573,5 +665,12 @@
"arrange for a CV to be invoked at scope exit");
XopENTRY_set(&xop_pushfinally, xop_class, OA_SVOP);
Perl_custom_op_register(aTHX_ &pp_pushfinally, &xop_pushfinally);
+#ifndef HAVE_OP_ISA
+ XopENTRY_set(&xop_isa, xop_name, "isa");
+ XopENTRY_set(&xop_isa, xop_desc,
+ "check if a value is an object of the given class");
+ XopENTRY_set(&xop_isa, xop_class, OA_BINOP);
+ Perl_custom_op_register(aTHX_ &pp_isa, &xop_isa);
+#endif
wrap_keyword_plugin(&my_keyword_plugin, &next_keyword_plugin);
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.14/t/01trycatch.t
new/Syntax-Keyword-Try-0.15/t/01trycatch.t
--- old/Syntax-Keyword-Try-0.14/t/01trycatch.t 2020-07-07 23:39:09.000000000
+0200
+++ new/Syntax-Keyword-Try-0.15/t/01trycatch.t 2020-07-21 01:06:22.000000000
+0200
@@ -100,23 +100,12 @@
{
no if HAVE_WARN_EXPERIMENTAL, warnings => 'experimental';
- # new style
try {
die "caught\n";
}
catch ( $e ) {
is( $e, "caught\n", 'exception is caught into new lexical' );
}
-
- no warnings 'deprecated';
-
- # old style
- try {
- die "caught\n";
- }
- catch my $e {
- is( $e, "caught\n", 'exception is caught into new lexical (old style)' );
- }
}
done_testing;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Syntax-Keyword-Try-0.14/t/04catch-types.t
new/Syntax-Keyword-Try-0.15/t/04catch-types.t
--- old/Syntax-Keyword-Try-0.14/t/04catch-types.t 1970-01-01
01:00:00.000000000 +0100
+++ new/Syntax-Keyword-Try-0.15/t/04catch-types.t 2020-07-21
01:06:22.000000000 +0200
@@ -0,0 +1,59 @@
+#!/usr/bin/perl
+
+use v5.14;
+use warnings;
+
+use Test::More;
+
+use Syntax::Keyword::Try;
+use constant HAVE_WARN_EXPERIMENTAL => $] >= 5.018;
+no if HAVE_WARN_EXPERIMENTAL, warnings => 'experimental';
+
+sub func
+{
+ my ( $ret, $except ) = @_;
+
+ try {
+ die $except if $except;
+ return "ret => $ret";
+ }
+ catch ($e isa X) {
+ return "X => [@$e]";
+ }
+ catch ($e =~ m/^Cannot /) {
+ chomp $e;
+ return "cannot => $e";
+ }
+ catch ($e) {
+ return "default => $e";
+ }
+}
+
+is( func( 123 ), "ret => 123", 'typed catch succeeds' );
+
+is( func( 0, "failure\n" ), "default => failure\n",
+ 'typed catch default case' );
+is( func( 0, bless [45], "X" ), "X => [45]",
+ 'typed catch isa case' );
+is( func( 0, "Cannot do X\n" ), "cannot => Cannot do X",
+ 'typed catch regexp case' );
+
+sub fallthrough
+{
+ my ( $except ) = @_;
+
+ try {
+ die $except;
+ }
+ catch ($e isa X) {
+ return "X => [@$e]";
+ }
+ # no default
+}
+
+is( fallthrough( bless ["OK"], "X" ), "X => [OK]",
+ 'typed catch not fallthrough' );
+is( eval { fallthrough( "Oopsie\n" ); 1 } ? undef : $@, "Oopsie\n",
+ 'typed catch fallthrough' );
+
+done_testing;
