[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 (file)
--- 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 (file)
--- 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 (file)
--- 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<PERL_MAGIC_ext> and C<PERL_MAGIC_uvar> 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 (file)
--- 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 (file)
--- a/sv.h
+++ b/sv.h
@@ -578,6 +578,7 @@ Set the length of the string which is in the SV.  See C<SvCUR>.
 #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 (file)
--- 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);