summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2012-09-28 14:47:05 -0700
committerFather Chrysostomos <sprout@cpan.org>2012-10-01 12:51:56 -0700
commit9bb29b6866a80dfaa3765b219ca04942676a2fae (patch)
treeb7502edc78b227328733cfcbf76488e566301e64
parent158f7f72a5e9f438a9abd9881df85a8999adcb38 (diff)
downloadperl-9bb29b6866a80dfaa3765b219ca04942676a2fae.tar.gz
Remove length magic on scalars
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.
-rw-r--r--embed.fnc1
-rw-r--r--embed.h1
-rw-r--r--mg.c79
-rw-r--r--mg_vtable.h2
-rw-r--r--proto.h6
-rw-r--r--regen/mg_vtable.pl2
6 files changed, 2 insertions, 89 deletions
diff --git a/embed.fnc b/embed.fnc
index feef3d0333..555114f9eb 100644
--- 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 f5aa4b8cc2..7146cec425 100644
--- a/embed.h
+++ b/embed.h
@@ -1120,7 +1120,6 @@
#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 b792b2c5c3..d52973bdd9 100644
--- 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); \
diff --git a/mg_vtable.h b/mg_vtable.h
index 8526fc5ffd..316c555c5b 100644
--- a/mg_vtable.h
+++ b/mg_vtable.h
@@ -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 f104a223d4..55c4d5678b 100644
--- 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)
diff --git a/regen/mg_vtable.pl b/regen/mg_vtable.pl
index 5c42153fa4..e095614e83 100644
--- a/regen/mg_vtable.pl
+++ b/regen/mg_vtable.pl
@@ -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',