From 7d7ce6cc2a05b5d6292e7a0c0a2a74bb771565de Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Thu, 2 Jan 2003 01:39:31 +0000 Subject: [PATCH] The magic v-string patch from John Peacock for 5.8; permits the programmer to know when a given scalar was originally encoded as a v-string; Scalar::Util has already been enhanced to expose this at the Perl level. p4raw-id: //depot/maint-5.8/perl@18387 --- dump.c | 1 + perl.h | 1 + pod/perlguts.pod | 9 +++++---- sv.c | 15 +++++++++++++++ sv.h | 1 + t/op/ver.t | 11 ++++++++++- util.c | 13 +++++++------ 7 files changed, 40 insertions(+), 11 deletions(-) diff --git a/dump.c b/dump.c index 8127ba0..a26da0c 100644 --- a/dump.c +++ b/dump.c @@ -770,6 +770,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_utf8, "utf8(w)" }, { PERL_MAGIC_substr, "substr(x)" }, { PERL_MAGIC_defelem, "defelem(y)" }, diff --git a/perl.h b/perl.h index 10bd07d..0c9dca4 100644 --- a/perl.h +++ b/perl.h @@ -2655,6 +2655,7 @@ Gid_t getegid (void); #define PERL_MAGIC_taint 't' /* Taintedness */ #define PERL_MAGIC_uvar 'U' /* Available for use by extensions */ #define PERL_MAGIC_uvar_elem 'u' /* Reserved for use by extensions */ +#define PERL_MAGIC_vstring 'V' /* SV was vstring literal */ #define PERL_MAGIC_vec 'v' /* vec() lvalue */ #define PERL_MAGIC_utf8 'w' /* Cached UTF-8 information */ #define PERL_MAGIC_substr 'x' /* substr() lvalue */ diff --git a/pod/perlguts.pod b/pod/perlguts.pod index 29b5181..39f2392 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 9bdfe15..07d7453 100644 --- a/sv.c +++ b/sv.c @@ -3581,6 +3581,12 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) dtype = SvTYPE(dstr); SvAMAGIC_off(dstr); + if ( SvVOK(dstr) ) + { + /* need to nuke the magic */ + mg_free(dstr); + SvRMAGICAL_off(dstr); + } /* There's a lot of redundancy below but we're going for speed here */ @@ -3962,6 +3968,12 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) SvIsUV_on(dstr); SvIVX(dstr) = SvIVX(sstr); } + if ( SvVOK(sstr) ) { + MAGIC *smg = mg_find(sstr,PERL_MAGIC_vstring); + sv_magic(dstr, NULL, PERL_MAGIC_vstring, + smg->mg_ptr, smg->mg_len); + SvRMAGICAL_on(dstr); + } } else if (sflags & SVp_IOK) { if (sflags & SVf_IOK) @@ -4650,6 +4662,9 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam case PERL_MAGIC_vec: vtable = &PL_vtbl_vec; break; + case PERL_MAGIC_vstring: + vtable = 0; + break; case PERL_MAGIC_utf8: vtable = &PL_vtbl_utf8; break; diff --git a/sv.h b/sv.h index 9665efe..e65eded 100644 --- a/sv.h +++ b/sv.h @@ -577,6 +577,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/t/op/ver.t b/t/op/ver.t index 1634cc3..7fe3e67 100755 --- a/t/op/ver.t +++ b/t/op/ver.t @@ -11,7 +11,7 @@ $DOWARN = 1; # enable run-time warnings now use Config; require "test.pl"; -plan( tests => 47 ); +plan( tests => 50 ); eval { use v5.5.640; }; is( $@, '', "use v5.5.640; $@"); @@ -245,3 +245,12 @@ SKIP: { } } } + +# Tests for magic v-strings + +$v = 1.2.3; +is( ref(\$v), 'SCALAR', 'v-strings are just scalars' ); + +$v = v1.2_3; +is( ref(\$v), 'SCALAR', 'v-strings with v are just scalars' ); +is( sprintf("%vd", $v), '1.23', 'v-string ignores underscores' ); diff --git a/util.c b/util.c index 8bc748e..debc8c2 100644 --- a/util.c +++ b/util.c @@ -3933,6 +3933,7 @@ char * Perl_new_vstring(pTHX_ char *s, SV *sv) { char *pos = s; + char *start = s; if (*pos == 'v') pos++; /* get past 'v' */ while (isDIGIT(*pos) || *pos == '_') pos++; @@ -3951,11 +3952,10 @@ Perl_new_vstring(pTHX_ char *s, SV *sv) /* this is atoi() that tolerates underscores */ char *end = pos; UV mult = 1; - if ( s > pos && *(s-1) == '_') { - mult = 10; - } while (--end >= s) { UV orev; + if (*end == '_' ) + continue; orev = rev; rev += (*end - '0') * mult; mult *= 10; @@ -3973,17 +3973,18 @@ 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); - SvREADONLY_on(sv); + sv_magic(sv,NULL,PERL_MAGIC_vstring,(const char*)start, pos-start); + SvRMAGICAL_on(sv); } return s; } -- 1.8.3.1