Merge 4261f1e into b00088e

MANIFEST

@@ -5850,6 +5850,7 @@ t/op/crypt.t			See if crypt works
 t/op/current_sub.t		__SUB__ tests
 t/op/dbm.t			See if dbmopen/dbmclose work
 t/op/decl-refs.t		See if my \$foo works
+t/op/defer.t			See if defer blocks work
 t/op/defined.t			See if defined() edge cases work
 t/op/defins.t			See if auto-insert of defined() works
 t/op/delete.t			See if delete works

cop.h

@@ -1047,6 +1047,7 @@ struct context {
 #define CXt_FORMAT     10
 #define CXt_EVAL       11 /* eval'', eval{}, try{} */
 #define CXt_SUBST      12
+#define CXt_DEFER      13
 /* SUBST doesn't feature in all switch statements.  */
 
 /* private flags for CXt_SUB and CXt_FORMAT */

embed.fnc

@@ -1460,6 +1460,7 @@ ApdR	|OP*	|newSTATEOP	|I32 flags|NULLOK char* label|NULLOK OP* o
 AdpbM	|CV*	|newSUB		|I32 floor|NULLOK OP* o|NULLOK OP* proto \
 				|NULLOK OP* block
 ApdRx	|OP*	|newTRYCATCHOP	|I32 flags|NN OP* tryblock|NN OP *catchvar|NN OP* catchblock
+ApdRx	|OP*	|newDEFEROP	|I32 flags|NN OP *block
 pd	|CV *	|newXS_len_flags|NULLOK const char *name|STRLEN len \
 				|NN XSUBADDR_t subaddr\
 				|NULLOK const char *const filename \

embed.h

@@ -352,6 +352,7 @@
 #define newCONSTSUB(a,b,c)	Perl_newCONSTSUB(aTHX_ a,b,c)
 #define newCONSTSUB_flags(a,b,c,d,e)	Perl_newCONSTSUB_flags(aTHX_ a,b,c,d,e)
 #define newCVREF(a,b)		Perl_newCVREF(aTHX_ a,b)
+#define newDEFEROP(a,b)		Perl_newDEFEROP(aTHX_ a,b)
 #define newDEFSVOP()		Perl_newDEFSVOP(aTHX)
 #define newFORM(a,b,c)		Perl_newFORM(aTHX_ a,b,c)
 #define newFOROP(a,b,c,d,e)	Perl_newFOROP(aTHX_ a,b,c,d,e)

ext/Opcode/Opcode.pm

@@ -441,6 +441,8 @@ These are a hotchpotch of opcodes still waiting to be considered
     break continue
     smartmatch
 
+    pushdefer
+
     custom -- where should this go
 
 =item :base_math

feature.h

@@ -16,20 +16,21 @@
 #define FEATURE_BITWISE_BIT              0x0002
 #define FEATURE___SUB___BIT              0x0004
 #define FEATURE_MYREF_BIT                0x0008
-#define FEATURE_EVALBYTES_BIT            0x0010
-#define FEATURE_FC_BIT                   0x0020
-#define FEATURE_INDIRECT_BIT             0x0040
-#define FEATURE_ISA_BIT                  0x0080
-#define FEATURE_MULTIDIMENSIONAL_BIT     0x0100
-#define FEATURE_POSTDEREF_QQ_BIT         0x0200
-#define FEATURE_REFALIASING_BIT          0x0400
-#define FEATURE_SAY_BIT                  0x0800
-#define FEATURE_SIGNATURES_BIT           0x1000
-#define FEATURE_STATE_BIT                0x2000
-#define FEATURE_SWITCH_BIT               0x4000
-#define FEATURE_TRY_BIT                  0x8000
-#define FEATURE_UNIEVAL_BIT              0x10000
-#define FEATURE_UNICODE_BIT              0x20000
+#define FEATURE_DEFER_BIT                0x0010
+#define FEATURE_EVALBYTES_BIT            0x0020
+#define FEATURE_FC_BIT                   0x0040
+#define FEATURE_INDIRECT_BIT             0x0080
+#define FEATURE_ISA_BIT                  0x0100
+#define FEATURE_MULTIDIMENSIONAL_BIT     0x0200
+#define FEATURE_POSTDEREF_QQ_BIT         0x0400
+#define FEATURE_REFALIASING_BIT          0x0800
+#define FEATURE_SAY_BIT                  0x1000
+#define FEATURE_SIGNATURES_BIT           0x2000
+#define FEATURE_STATE_BIT                0x4000
+#define FEATURE_SWITCH_BIT               0x8000
+#define FEATURE_TRY_BIT                  0x10000
+#define FEATURE_UNIEVAL_BIT              0x20000
+#define FEATURE_UNICODE_BIT              0x40000
 
 #define FEATURE_BUNDLE_DEFAULT	0
 #define FEATURE_BUNDLE_510	1
@@ -80,6 +81,12 @@
 	 FEATURE_IS_ENABLED_MASK(FEATURE_TRY_BIT) \
     )
 
+#define FEATURE_DEFER_IS_ENABLED \
+    ( \
+	CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \
+	 FEATURE_IS_ENABLED_MASK(FEATURE_DEFER_BIT) \
+    )
+
 #define FEATURE_STATE_IS_ENABLED \
     ( \
 	(CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_510 && \
@@ -268,6 +275,14 @@ S_magic_sethint_feature(pTHX_ SV *keysv, const char *keypv, STRLEN keylen,
             }
             return;
 
+        case 'd':
+            if (keylen == sizeof("feature_defer")-1
+                 && memcmp(subf+1, "efer", keylen - sizeof("feature_")) == 0) {
+                mask = FEATURE_DEFER_BIT;
+                break;
+            }
+            return;
+
         case 'e':
             if (keylen == sizeof("feature_evalbytes")-1
                  && memcmp(subf+1, "valbytes", keylen - sizeof("feature_")) == 0) {

gv.c

@@ -545,7 +545,7 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
         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_catch : case KEY_cmp:
-    case KEY_default : case KEY_DESTROY:
+    case KEY_default : case KEY_defer  : case KEY_DESTROY:
     case KEY_do      : case KEY_dump   : case KEY_else  : case KEY_elsif  :
     case KEY_END     : case KEY_eq     : case KEY_eval  :
     case KEY_for     : case KEY_foreach: case KEY_format: case KEY_ge     :

keywords.c

@@ -978,7 +978,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
           goto unknown;
       }
 
-    case 5: /* 40 tokens of length 5 */
+    case 5: /* 41 tokens of length 5 */
       switch (name[0])
       {
         case 'B':
@@ -1142,6 +1142,17 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
               goto unknown;
           }
 
+        case 'd':
+          if (name[1] == 'e' &&
+              name[2] == 'f' &&
+              name[3] == 'e' &&
+              name[4] == 'r')
+          {                                       /* defer            */
+            return (all_keywords || FEATURE_DEFER_IS_ENABLED ? KEY_defer : 0);
+          }
+
+          goto unknown;
+
         case 'e':
           if (name[1] == 'l' &&
               name[2] == 's' &&
@@ -3475,5 +3486,5 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
 }
 
 /* Generated from:
- * 3a4f2004642b00b871c01cbdc018f6ca5ead6b4e0b2b184120c60b0b62a229dd regen/keywords.pl
+ * de1ee232f68ea8ae75d09f4f70b58fee8a6e6244dec3ab68baab54f7af9ce306 regen/keywords.pl
  * ex: set ro: */