Initial attempt at feature 'try'

 * Add feature, experimental warning, keyword
 * Basic parsing
 * Basic implementation as optree fragment

See also
  Perl#18504

# Conflicts:
#	ext/Opcode/Opcode.pm

Author: Max Maischein

MANIFEST

@@ -5961,6 +5961,7 @@ t/op/time.t			See if time functions work
 t/op/time_loop.t		Test that very large values don't hang gmtime and localtime.
 t/op/tr.t			See if tr works
 t/op/tr_latin1.t		See if tr works, but file isn't encoded in UTF-8
+t/op/try.t			See if try works
 t/op/undef.t			See if undef works
 t/op/universal.t		See if UNIVERSAL class works
 t/op/unlink.t			See if unlink works

cop.h

@@ -940,7 +940,7 @@ struct context {
                              or plain block { ...; } */
 #define CXt_SUB		9
 #define CXt_FORMAT     10
-#define CXt_EVAL       11
+#define CXt_EVAL       11 /* eval'', eval{}, try{} */
 #define CXt_SUBST      12
 /* SUBST doesn't feature in all switch statements.  */
 
@@ -954,6 +954,7 @@ struct context {
 /* private flags for CXt_EVAL */
 #define CXp_REAL	0x20	/* truly eval'', not a lookalike */
 #define CXp_EVALBLOCK	0x40	/* eval{}, not eval'' or similar */
+#define CXp_TRY         0x80    /* try {} block */
 
 /* private flags for CXt_LOOP */
 
@@ -977,6 +978,8 @@ struct context {
 			 == (CXt_EVAL|CXp_REAL))
 #define CxEVALBLOCK(c)	(((c)->cx_type & (CXTYPEMASK|CXp_EVALBLOCK))	\
 			 == (CXt_EVAL|CXp_EVALBLOCK))
+#define CxTRY(c)        (((c)->cx_type & (CXTYPEMASK|CXp_TRY))          \
+                         == (CXt_EVAL|CXp_TRY))
 #define CxFOREACH(c)	(   CxTYPE(cx) >= CXt_LOOP_ARY                  \
                          && CxTYPE(cx) <= CXt_LOOP_LIST)
 

ext/Opcode/Opcode.pm

@@ -6,7 +6,7 @@ use strict;
 
 our @EXPORT_OK;
 
-our $VERSION = "1.50";
+$VERSION = "1.50";
 
 use Carp;
 use Exporter 'import';
@@ -343,7 +343,7 @@ invert_opset function.
 
     cond_expr flip flop andassign orassign dorassign and or dor xor
 
-    warn die lineseq nextstate scope enter leave
+    warn die lineseq nextstate scope enter leave catch
 
     rv2cv anoncode prototype coreargs avhvswitch anonconst
 
@@ -561,7 +561,7 @@ SystemV Interprocess Communications:
 This tag holds opcodes related to loading modules and getting information
 about calling environment and args.
 
-    require dofile 
+    require dofile
     caller runcv
 
 =item :still_to_be_decided

feature.h

@@ -27,8 +27,9 @@
 #define FEATURE_SIGNATURES_BIT           0x1000
 #define FEATURE_STATE_BIT                0x2000
 #define FEATURE_SWITCH_BIT               0x4000
-#define FEATURE_UNIEVAL_BIT              0x8000
-#define FEATURE_UNICODE_BIT              0x10000
+#define FEATURE_TRY_BIT                  0x8000
+#define FEATURE_UNIEVAL_BIT              0x10000
+#define FEATURE_UNICODE_BIT              0x20000
 
 #define FEATURE_BUNDLE_DEFAULT	0
 #define FEATURE_BUNDLE_510	1
@@ -72,6 +73,12 @@
 	 FEATURE_IS_ENABLED_MASK(FEATURE_SAY_BIT)) \
     )
 
+#define FEATURE_TRY_IS_ENABLED \
+    ( \
+	CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \
+	 FEATURE_IS_ENABLED_MASK(FEATURE_TRY_BIT) \
+    )
+
 #define FEATURE_STATE_IS_ENABLED \
     ( \
 	(CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_510 && \
@@ -337,6 +344,14 @@ S_magic_sethint_feature(pTHX_ SV *keysv, const char *keypv, STRLEN keylen,
             }
             return;
 
+        case 't':
+            if (keylen == sizeof("feature_try")-1
+                 && memcmp(subf+1, "ry", keylen - sizeof("feature_")) == 0) {
+                mask = FEATURE_TRY_BIT;
+                break;
+            }
+            return;
+
         case 'u':
             if (keylen == sizeof("feature_unicode")-1
                  && memcmp(subf+1, "nicode", keylen - sizeof("feature_")) == 0) {

gv.c

@@ -544,7 +544,7 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
      /* no support for \&CORE::infix;
         no support for funcs that do not parse like funcs */
     case KEY___DATA__: case KEY___END__: case KEY_and: case KEY_AUTOLOAD:
-    case KEY_BEGIN   : case KEY_CHECK  : case KEY_cmp:
+    case KEY_BEGIN   : case KEY_CHECK  : case KEY_catch : case KEY_cmp:
     case KEY_default : case KEY_DESTROY:
     case KEY_do      : case KEY_dump   : case KEY_else  : case KEY_elsif  :
     case KEY_END     : case KEY_eq     : case KEY_eval  :
@@ -559,7 +559,7 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
     case KEY_qx   : case KEY_redo : case KEY_require: case KEY_return:
     case KEY_s    : case KEY_say  : case KEY_sort   :
     case KEY_state: case KEY_sub  :
-    case KEY_tr   : case KEY_UNITCHECK: case KEY_unless:
+    case KEY_tr   : case KEY_try  : case KEY_UNITCHECK: case KEY_unless:
     case KEY_until: case KEY_use  : case KEY_when     : case KEY_while :
     case KEY_x    : case KEY_xor  : case KEY_y        :
         return NULL;

keywords.c

@@ -203,7 +203,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
           goto unknown;
       }
 
-    case 3: /* 29 tokens of length 3 */
+    case 3: /* 30 tokens of length 3 */
       switch (name[0])
       {
         case 'E':
@@ -463,13 +463,27 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
           }
 
         case 't':
-          if (name[1] == 'i' &&
-              name[2] == 'e')
-          {                                       /* tie              */
-            return -KEY_tie;
-          }
+          switch (name[1])
+          {
+            case 'i':
+              if (name[2] == 'e')
+              {                                   /* tie              */
+                return -KEY_tie;
+              }
 
-          goto unknown;
+              goto unknown;
+
+            case 'r':
+              if (name[2] == 'y')
+              {                                   /* try              */
+                return (all_keywords || FEATURE_TRY_IS_ENABLED ? KEY_try : 0);
+              }
+
+              goto unknown;
+
+            default:
+              goto unknown;
+          }
 
         case 'u':
           if (name[1] == 's' &&
@@ -964,7 +978,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
           goto unknown;
       }
 
-    case 5: /* 39 tokens of length 5 */
+    case 5: /* 40 tokens of length 5 */
       switch (name[0])
       {
         case 'B':
@@ -1046,6 +1060,16 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
         case 'c':
           switch (name[1])
           {
+            case 'a':
+              if (name[2] == 't' &&
+                  name[3] == 'c' &&
+                  name[4] == 'h')
+              {                                   /* catch            */
+                return (all_keywords || FEATURE_TRY_IS_ENABLED ? KEY_catch : 0);
+              }
+
+              goto unknown;
+
             case 'h':
               switch (name[2])
               {
@@ -3451,5 +3475,5 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
 }
 
 /* Generated from:
- * dd384f0c948716414a93d758d89a38e3c8116acfdc48eb7e34fa6737887097d5 regen/keywords.pl
+ * 3a4f2004642b00b871c01cbdc018f6ca5ead6b4e0b2b184120c60b0b62a229dd regen/keywords.pl
  * ex: set ro: */