This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Use new feature-testing macros
authorFather Chrysostomos <sprout@cpan.org>
Fri, 23 Dec 2011 04:37:59 +0000 (20:37 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Sat, 24 Dec 2011 17:25:17 +0000 (09:25 -0800)
Instead of using FEATURE_IS_ENABLED("say"), etc., now use
FEATURE_SAY_IS_ENABLED instead.  These new macros, in feature.h, also
check feature bundle hints in PL_hints, so we can start using those
hints.  Two commits ago, feature.pm started setting them.

ext/arybase/arybase.xs
gv.c
keywords.c
keywords.h
op.c
regen/keywords.pl

index 14fd03c..296733a 100644 (file)
@@ -3,6 +3,7 @@
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
+#include "feature.h"
 
 /* ... op => info map ................................................. */
 
@@ -107,7 +108,7 @@ STATIC SV * ab_hint(pTHX_ const bool create) {
 STATIC IV current_base(pTHX) {
 #define current_base() current_base(aTHX)
  SV *hsv = ab_hint(0);
- assert(FEATURE_IS_ENABLED_d("arybase"));
+ assert(FEATURE_ARYBASE_IS_ENABLED);
  if (!hsv || !SvOK(hsv)) return 0;
  return SvIV(hsv);
 }
@@ -173,7 +174,7 @@ STATIC void ab_process_assignment(pTHX_ OP *left, OP *right) {
 
 STATIC OP *ab_ck_sassign(pTHX_ OP *o) {
  o = (*ab_old_ck_sassign)(aTHX_ o);
- if (o->op_type == OP_SASSIGN && FEATURE_IS_ENABLED_d("arybase")) {
+ if (o->op_type == OP_SASSIGN && FEATURE_ARYBASE_IS_ENABLED) {
   OP *right = cBINOPx(o)->op_first;
   OP *left = right->op_sibling;
   if (left) ab_process_assignment(left, right);
@@ -183,7 +184,7 @@ STATIC OP *ab_ck_sassign(pTHX_ OP *o) {
 
 STATIC OP *ab_ck_aassign(pTHX_ OP *o) {
  o = (*ab_old_ck_aassign)(aTHX_ o);
- if (o->op_type == OP_AASSIGN && FEATURE_IS_ENABLED_d("arybase")) {
+ if (o->op_type == OP_AASSIGN && FEATURE_ARYBASE_IS_ENABLED) {
   OP *right = cBINOPx(o)->op_first;
   OP *left = cBINOPx(right->op_sibling)->op_first->op_sibling;
   right = cBINOPx(right)->op_first->op_sibling;
@@ -352,7 +353,7 @@ static OP *ab_ck_base(pTHX_ OP *o)
       PL_op->op_type);
  }
  o = (*old_ck)(aTHX_ o);
- if (!FEATURE_IS_ENABLED_d("arybase")) return o;
+ if (!FEATURE_ARYBASE_IS_ENABLED) return o;
  /* We need two switch blocks, as the type may have changed. */
  switch (o->op_type) {
  case OP_AELEM    :
@@ -425,7 +426,7 @@ BOOT:
 void
 FETCH(...)
     PREINIT:
-       SV *ret = FEATURE_IS_ENABLED_d("arybase")
+       SV *ret = FEATURE_ARYBASE_IS_ENABLED
                   ? cop_hints_fetch_pvs(PL_curcop, "$[", 0)
                   : 0;
     PPCODE:
@@ -435,7 +436,7 @@ FETCH(...)
 void
 STORE(SV *sv, IV newbase)
     CODE:
-      if (FEATURE_IS_ENABLED_d("arybase")) {
+      if (FEATURE_ARYBASE_IS_ENABLED) {
        SV *base = cop_hints_fetch_pvs(PL_curcop, "$[", 0);
        if (SvOK(base) ? SvIV(base) == newbase : !newbase) XSRETURN_EMPTY;
        Perl_croak(aTHX_ "That use of $[ is unsupported");
@@ -453,7 +454,7 @@ FETCH(SV *sv)
        if (!SvROK(sv) || SvTYPE(SvRV(sv)) >= SVt_PVAV)
            Perl_croak(aTHX_ "Not a SCALAR reference");
        {
-           SV *base = FEATURE_IS_ENABLED_d("arybase")
+           SV *base = FEATURE_ARYBASE_IS_ENABLED
                         ? cop_hints_fetch_pvs(PL_curcop, "$[", 0)
                         : 0;
            SvGETMAGIC(SvRV(sv));
@@ -469,7 +470,7 @@ STORE(SV *sv, SV *newbase)
        if (!SvROK(sv) || SvTYPE(SvRV(sv)) >= SVt_PVAV)
            Perl_croak(aTHX_ "Not a SCALAR reference");
        {
-           SV *base = FEATURE_IS_ENABLED_d("arybase")
+           SV *base = FEATURE_ARYBASE_IS_ENABLED
                        ? cop_hints_fetch_pvs(PL_curcop, "$[", 0)
                        : 0;
            SvGETMAGIC(newbase);
diff --git a/gv.c b/gv.c
index d683faa..7d68669 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -37,6 +37,7 @@ Perl stores its global variables.
 #include "perl.h"
 #include "overload.c"
 #include "keywords.h"
+#include "feature.h"
 
 static const char S_autoload[] = "AUTOLOAD";
 static const STRLEN S_autolen = sizeof(S_autoload)-1;
@@ -1940,7 +1941,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
            goto magicalize;
        case '[':               /* $[ */
            if ((sv_type == SVt_PV || sv_type == SVt_PVGV)
-            && FEATURE_IS_ENABLED_d("arybase")) {
+            && FEATURE_ARYBASE_IS_ENABLED) {
                if (addmg) (void)hv_store(stash,name,len,(SV *)gv,0);
                require_tie_mod(gv,name,newSVpvs("arybase"),"FETCH",0);
                addmg = 0;
index a37752f..169a41c 100644 (file)
@@ -8,6 +8,7 @@
 #define PERL_IN_KEYWORDS_C
 #include "perl.h"
 #include "keywords.h"
+#include "feature.h"
 
 I32
 Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
@@ -416,7 +417,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
             case 'a':
               if (name[2] == 'y')
               {                                   /* say              */
-                return (all_keywords || FEATURE_IS_ENABLED("say") ? KEY_say : 0);
+                return (all_keywords || FEATURE_SAY_IS_ENABLED ? KEY_say : 0);
               }
 
               goto unknown;
@@ -940,7 +941,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
               if (name[2] == 'e' &&
                   name[3] == 'n')
               {                                   /* when             */
-                return (all_keywords || FEATURE_IS_ENABLED("switch") ? KEY_when : 0);
+                return (all_keywords || FEATURE_SWITCH_IS_ENABLED ? KEY_when : 0);
               }
 
               goto unknown;
@@ -1023,7 +1024,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
                   name[3] == 'a' &&
                   name[4] == 'k')
               {                                   /* break            */
-                return (all_keywords || FEATURE_IS_ENABLED("switch") ? -KEY_break : 0);
+                return (all_keywords || FEATURE_SWITCH_IS_ENABLED ? -KEY_break : 0);
               }
 
               goto unknown;
@@ -1151,7 +1152,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
               name[3] == 'e' &&
               name[4] == 'n')
           {                                       /* given            */
-            return (all_keywords || FEATURE_IS_ENABLED("switch") ? KEY_given : 0);
+            return (all_keywords || FEATURE_SWITCH_IS_ENABLED ? KEY_given : 0);
           }
 
           goto unknown;
@@ -1319,7 +1320,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
                   if (name[3] == 't' &&
                       name[4] == 'e')
                   {                               /* state            */
-                    return (all_keywords || FEATURE_IS_ENABLED("state") ? KEY_state : 0);
+                    return (all_keywords || FEATURE_STATE_IS_ENABLED ? KEY_state : 0);
                   }
 
                   goto unknown;
@@ -1944,7 +1945,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
                     name[5] == '_' &&
                     name[6] == '_')
                 {                                 /* __SUB__          */
-                  return (all_keywords || FEATURE_IS_ENABLED("__SUB__") ? -KEY___SUB__ : 0);
+                  return (all_keywords || FEATURE___SUB___IS_ENABLED ? -KEY___SUB__ : 0);
                 }
 
                 goto unknown;
@@ -2007,7 +2008,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
                         name[5] == 'l' &&
                         name[6] == 't')
                     {                             /* default          */
-                      return (all_keywords || FEATURE_IS_ENABLED("switch") ? KEY_default : 0);
+                      return (all_keywords || FEATURE_SWITCH_IS_ENABLED ? KEY_default : 0);
                     }
 
                     goto unknown;
@@ -2805,7 +2806,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
                   name[7] == 'e' &&
                   name[8] == 's')
               {                                   /* evalbytes        */
-                return (all_keywords || FEATURE_IS_ENABLED("evalbytes") ? -KEY_evalbytes : 0);
+                return (all_keywords || FEATURE_EVALBYTES_IS_ENABLED ? -KEY_evalbytes : 0);
               }
 
               goto unknown;
@@ -3440,5 +3441,5 @@ unknown:
 }
 
 /* Generated from:
- * 76ce12941a02bdb120222155311eb8772ba4a4e8965a42ba347a077cac5b426e regen/keywords.pl
+ * 29732a698b229f9e5f475fbb191f71c335c9e8d05b6168fe29e61c34c4f10bd2 regen/keywords.pl
  * ex: set ro: */
index 142ee0f..ea200fc 100644 (file)
 #define KEY_y                  254
 
 /* Generated from:
- * 76ce12941a02bdb120222155311eb8772ba4a4e8965a42ba347a077cac5b426e regen/keywords.pl
+ * 29732a698b229f9e5f475fbb191f71c335c9e8d05b6168fe29e61c34c4f10bd2 regen/keywords.pl
  * ex: set ro: */
diff --git a/op.c b/op.c
index 46b0522..941da4f 100644 (file)
--- a/op.c
+++ b/op.c
@@ -102,6 +102,7 @@ recursive, but it's recursive on basic blocks, not on tree nodes.
 #define PERL_IN_OP_C
 #include "perl.h"
 #include "keywords.h"
+#include "feature.h"
 
 #define CALL_PEEP(o) PL_peepp(aTHX_ o)
 #define CALL_RPEEP(o) PL_rpeepp(aTHX_ o)
@@ -7554,7 +7555,7 @@ Perl_ck_eval(pTHX_ OP *o)
        o->op_private |= OPpEVAL_HAS_HH;
 
        if (!(o->op_private & OPpEVAL_BYTES)
-        && FEATURE_IS_ENABLED("unieval"))
+        && FEATURE_UNIEVAL_IS_ENABLED)
            o->op_private |= OPpEVAL_UNICODE;
     }
     return o;
index 2cfc5d8..3e0b0d3 100755 (executable)
@@ -68,6 +68,7 @@ print $c <<"END";
 #define PERL_IN_KEYWORDS_C
 #include "perl.h"
 #include "keywords.h"
+#include "feature.h"
 
 I32
 Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
@@ -95,7 +96,7 @@ END
   elsif (my $feature = $feature_kw{$k}) {
     $feature =~ s/([\\"])/\\$1/g;
     return <<END;
-return (all_keywords || FEATURE_IS_ENABLED("$feature") ? ${sign}KEY_$k : 0);
+return (all_keywords || FEATURE_\U$feature\E_IS_ENABLED ? ${sign}KEY_$k : 0);
 END
   }
   return <<END;