Remove length magic on scalars
authorFather Chrysostomos <sprout@cpan.org>
Fri, 28 Sep 2012 21:47:05 +0000 (14:47 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Mon, 1 Oct 2012 19:51:56 +0000 (12:51 -0700)
It is not possible to know how to interpret the returned length
without accessing the UTF8 flag, which is not reliable until
the SV has been stringified, which requires get-magic.  So length
magic has not made senses since utf8 support was added.  I have
removed all uses of length magic from the core, so this is now
dead code.

embed.fnc
embed.h
mg.c
mg_vtable.h
proto.h
regen/mg_vtable.pl

index feef3d0..555114f 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -742,7 +742,6 @@ p   |int    |magic_getsubstr|NN SV* sv|NN MAGIC* mg
 p      |int    |magic_gettaint |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_getuvar  |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_getvec   |NN SV* sv|NN MAGIC* mg
-p      |U32    |magic_len      |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_nextpack |NN SV *sv|NN MAGIC *mg|NN SV *key
 p      |U32    |magic_regdata_cnt|NN SV* sv|NN MAGIC* mg
 p      |int    |magic_regdatum_get|NN SV* sv|NN MAGIC* mg
diff --git a/embed.h b/embed.h
index f5aa4b8..7146cec 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define magic_getuvar(a,b)     Perl_magic_getuvar(aTHX_ a,b)
 #define magic_getvec(a,b)      Perl_magic_getvec(aTHX_ a,b)
 #define magic_killbackrefs(a,b)        Perl_magic_killbackrefs(aTHX_ a,b)
-#define magic_len(a,b)         Perl_magic_len(aTHX_ a,b)
 #define magic_nextpack(a,b,c)  Perl_magic_nextpack(aTHX_ a,b,c)
 #define magic_regdata_cnt(a,b) Perl_magic_regdata_cnt(aTHX_ a,b)
 #define magic_regdatum_get(a,b)        Perl_magic_regdatum_get(aTHX_ a,b)
diff --git a/mg.c b/mg.c
index b792b2c..d52973b 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -689,85 +689,6 @@ Perl_magic_regdatum_set(pTHX_ SV *sv, MAGIC *mg)
     NORETURN_FUNCTION_END;
 }
 
-U32
-Perl_magic_len(pTHX_ SV *sv, MAGIC *mg)
-{
-    dVAR;
-    I32 paren;
-    I32 i;
-    const REGEXP * rx;
-    const char * const remaining = mg->mg_ptr + 1;
-
-    PERL_ARGS_ASSERT_MAGIC_LEN;
-
-    switch (*mg->mg_ptr) {
-    case '\020':               
-      if (*remaining == '\0') { /* ^P */
-          break;
-      } else if (strEQ(remaining, "REMATCH")) { /* $^PREMATCH */
-          goto do_prematch;
-      } else if (strEQ(remaining, "OSTMATCH")) { /* $^POSTMATCH */
-          goto do_postmatch;
-      }
-      break;
-    case '\015': /* $^MATCH */
-       if (strEQ(remaining, "ATCH")) {
-        goto do_match;
-    } else {
-        break;
-    }
-    case '`':
-      do_prematch:
-      paren = RX_BUFF_IDX_PREMATCH;
-      goto maybegetparen;
-    case '\'':
-      do_postmatch:
-      paren = RX_BUFF_IDX_POSTMATCH;
-      goto maybegetparen;
-    case '&':
-      do_match:
-      paren = RX_BUFF_IDX_FULLMATCH;
-      goto maybegetparen;
-    case '1': case '2': case '3': case '4':
-    case '5': case '6': case '7': case '8': case '9':
-      paren = atoi(mg->mg_ptr);
-    maybegetparen:
-       if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
-      getparen:
-        i = CALLREG_NUMBUF_LENGTH((REGEXP * const)rx, sv, paren);
-
-               if (i < 0)
-                   Perl_croak(aTHX_ "panic: magic_len: %"IVdf, (IV)i);
-               return i;
-       } else {
-               if (ckWARN(WARN_UNINITIALIZED))
-                   report_uninit(sv);
-               return 0;
-       }
-    case '+':
-       if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
-           paren = RX_LASTPAREN(rx);
-           if (paren)
-               goto getparen;
-       }
-       return 0;
-    case '\016': /* ^N */
-       if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
-           paren = RX_LASTCLOSEPAREN(rx);
-           if (paren)
-               goto getparen;
-       }
-       return 0;
-    }
-    magic_get(sv,mg);
-    if (!SvPOK(sv) && SvNIOK(sv)) {
-       sv_2pv(sv, 0);
-    }
-    if (SvPOK(sv))
-       return SvCUR(sv);
-    return 0;
-}
-
 #define SvRTRIM(sv) STMT_START { \
     if (SvPOK(sv)) { \
         STRLEN len = SvCUR(sv); \
index 8526fc5..316c555 100644 (file)
@@ -177,7 +177,7 @@ EXT_MGVTBL PL_magic_vtables[magic_vtable_max] = {
   { 0, 0, 0, 0, 0, 0, 0, 0 },
 #endif
   { Perl_magic_getsubstr, Perl_magic_setsubstr, 0, 0, 0, 0, 0, 0 },
-  { Perl_magic_get, Perl_magic_set, Perl_magic_len, 0, 0, 0, 0, 0 },
+  { Perl_magic_get, Perl_magic_set, 0, 0, 0, 0, 0, 0 },
   { Perl_magic_gettaint, Perl_magic_settaint, 0, 0, 0, 0, 0, 0 },
   { 0, Perl_magic_setutf8, 0, 0, 0, 0, 0, 0 },
   { Perl_magic_getuvar, Perl_magic_setuvar, 0, 0, 0, 0, 0, 0 },
diff --git a/proto.h b/proto.h
index f104a22..55c4d56 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -2152,12 +2152,6 @@ PERL_CALLCONV int        Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg)
 #define PERL_ARGS_ASSERT_MAGIC_KILLBACKREFS    \
        assert(sv); assert(mg)
 
-PERL_CALLCONV U32      Perl_magic_len(pTHX_ SV* sv, MAGIC* mg)
-                       __attribute__nonnull__(pTHX_1)
-                       __attribute__nonnull__(pTHX_2);
-#define PERL_ARGS_ASSERT_MAGIC_LEN     \
-       assert(sv); assert(mg)
-
 PERL_CALLCONV SV*      Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags, U32 argc, ...)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2)
index 5c42153..e095614 100644 (file)
@@ -113,7 +113,7 @@ my %mg =
 # These have a subtly different "namespace" from the magic types.
 my %sig =
     (
-     'sv' => {get => 'get', set => 'set', len => 'len'},
+     'sv' => {get => 'get', set => 'set'},
      'env' => {set => 'set_all_env', clear => 'clear_all_env'},
      'envelem' => {set => 'setenv', clear => 'clearenv'},
      'sigelem' => {get => 'getsig', set => 'setsig', clear => 'clearsig',