From: John Peacock Date: Sat, 10 Aug 2002 15:56:22 +0000 (-0400) Subject: [REVISED PATCH] Magic v-strings X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=92f0c2656233063d579e19d8c63f7cbf6ce7b9a2;p=p5sagit%2Fp5-mst-13.2.git [REVISED PATCH] Magic v-strings Message-id: <3D556FE6.6000404@rowman.com> plus a bit of cleanup p4raw-id: //depot/perl@17742 --- diff --git a/dump.c b/dump.c index 0081135..e287a79 100644 --- a/dump.c +++ b/dump.c @@ -768,6 +768,7 @@ static struct { char type; char *name; } magic_names[] = { { PERL_MAGIC_taint, "taint(t)" }, { PERL_MAGIC_uvar_elem, "uvar_elem(v)" }, { PERL_MAGIC_vec, "vec(v)" }, + { PERL_MAGIC_vstring, "v-string(V)" }, { PERL_MAGIC_substr, "substr(x)" }, { PERL_MAGIC_defelem, "defelem(y)" }, { PERL_MAGIC_ext, "ext(~)" }, diff --git a/perl.h b/perl.h index 0943e2f..e5e97b8 100644 --- a/perl.h +++ b/perl.h @@ -2620,6 +2620,7 @@ Gid_t getegid (void); #define PERL_MAGIC_uvar 'U' /* Available for use by extensions */ #define PERL_MAGIC_uvar_elem 'u' /* Reserved for use by extensions */ #define PERL_MAGIC_vec 'v' /* vec() lvalue */ +#define PERL_MAGIC_vstring 'V' /* SV was vstring literal */ #define PERL_MAGIC_substr 'x' /* substr() lvalue */ #define PERL_MAGIC_defelem 'y' /* Shadow "foreach" iterator variable / smart parameter vivification */ diff --git a/pod/perlguts.pod b/pod/perlguts.pod index d93eadf..1601e3d 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -963,6 +963,7 @@ The current kinds of Magic Virtual Tables are: t PERL_MAGIC_taint vtbl_taint Taintedness U PERL_MAGIC_uvar vtbl_uvar Available for use by extensions v PERL_MAGIC_vec vtbl_vec vec() lvalue + V PERL_MAGIC_vstring (none) v-string scalars x PERL_MAGIC_substr vtbl_substr substr() lvalue y PERL_MAGIC_defelem vtbl_defelem Shadow "foreach" iterator variable / smart parameter @@ -974,10 +975,10 @@ The current kinds of Magic Virtual Tables are: ~ PERL_MAGIC_ext (none) Available for use by extensions When an uppercase and lowercase letter both exist in the table, then the -uppercase letter is used to represent some kind of composite type (a list -or a hash), and the lowercase letter is used to represent an element of -that composite type. Some internals code makes use of this case -relationship. +uppercase letter is typically used to represent some kind of composite type +(a list or a hash), and the lowercase letter is used to represent an element +of that composite type. Some internals code makes use of this case +relationship. However, 'v' and 'V' (vec and v-string) are in no way related. The C and C magic types are defined specifically for use by extensions and will not be used by perl itself. diff --git a/sv.c b/sv.c index 54e7d03..49f5c75 100644 --- a/sv.c +++ b/sv.c @@ -4023,6 +4023,11 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) SvIsUV_on(dstr); SvIVX(dstr) = SvIVX(sstr); } + if (SvVOK(sstr)) { + MAGIC *mg = SvMAGIC(sstr); + sv_magicext(dstr, NULL, PERL_MAGIC_vstring, NULL, + mg->mg_ptr, mg->mg_len); + } } else if (sflags & SVp_IOK) { if (sflags & SVf_IOK) diff --git a/sv.h b/sv.h index da8c275..d839ee0 100644 --- a/sv.h +++ b/sv.h @@ -578,6 +578,7 @@ Set the length of the string which is in the SV. See C. #define SvIOK_notUV(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV)) \ == SVf_IOK) +#define SvVOK(sv) (SvMAGICAL(sv) && mg_find(sv,'V')) #define SvIsUV(sv) (SvFLAGS(sv) & SVf_IVisUV) #define SvIsUV_on(sv) (SvFLAGS(sv) |= SVf_IVisUV) #define SvIsUV_off(sv) (SvFLAGS(sv) &= ~SVf_IVisUV) diff --git a/util.c b/util.c index 99c79fb..eb5710d 100644 --- a/util.c +++ b/util.c @@ -325,7 +325,7 @@ S_xstat(pTHX_ int flag) PerlIO_printf(Perl_debug_log, " . "); } } - PerlIO_printf(Perl_debug_log, "\n"); + PerlIO_printf(Perl_debug_log, "\n"); } } @@ -2861,7 +2861,7 @@ Perl_find_script(pTHX_ char *scriptname, bool dosearch, char **search_ext, I32 f #endif { bool seen_dot = 0; - + PL_bufend = s + strlen(s); while (s < PL_bufend) { #ifdef MACOS_TRADITIONAL @@ -4087,21 +4087,20 @@ Perl_new_vstring(pTHX_ char *s, SV *sv) for (;;) { rev = 0; { - /* this is atoi() that tolerates underscores */ - char *end = pos; - UV mult = 1; - if ( s > pos && *(s-1) == '_') { - mult = 10; - } - while (--end >= s) { - UV orev; - orev = rev; - rev += (*end - '0') * mult; - mult *= 10; - if (orev > rev && ckWARN_d(WARN_OVERFLOW)) - Perl_warner(aTHX_ packWARN(WARN_OVERFLOW), - "Integer overflow in decimal number"); - } + /* this is atoi() that tolerates underscores */ + char *end = pos; + UV mult = 1; + while (--end >= s) { + UV orev; + if (*end == '_') + continue; + orev = rev; + rev += (*end - '0') * mult; + mult *= 10; + if (orev > rev && ckWARN_d(WARN_OVERFLOW)) + Perl_warner(aTHX_ packWARN(WARN_OVERFLOW), + "Integer overflow in decimal number"); + } } #ifdef EBCDIC if (rev > 0x7FFFFFFF) @@ -4112,13 +4111,13 @@ Perl_new_vstring(pTHX_ char *s, SV *sv) sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf); if (!UNI_IS_INVARIANT(NATIVE_TO_UNI(rev))) SvUTF8_on(sv); - if ( (*pos == '.' || *pos == '_') && isDIGIT(pos[1])) + if (*pos == '.' && isDIGIT(pos[1])) s = ++pos; else { s = pos; break; } - while (isDIGIT(*pos) ) + while (isDIGIT(*pos) || *pos == '_') pos++; } SvPOK_on(sv);