Change 18387 by jhi@lyta on 2003/01/02 01:39:31
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.
Affected files ...
... //depot/maint-5.8/perl/dump.c#7 edit
... //depot/maint-5.8/perl/perl.h#11 edit
... //depot/maint-5.8/perl/pod/perlguts.pod#4 edit
... //depot/maint-5.8/perl/sv.c#15 edit
... //depot/maint-5.8/perl/sv.h#4 edit
... //depot/maint-5.8/perl/t/op/ver.t#2 edit
... //depot/maint-5.8/perl/util.c#11 edit
Differences ...
==== //depot/maint-5.8/perl/dump.c#7 (text) ====
Index: perl/dump.c
--- perl/dump.c#6~18359~ Sat Dec 28 14:33:16 2002
+++ perl/dump.c Wed Jan 1 17:39:31 2003
@@ -770,6 +770,7 @@
{ 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)" },
==== //depot/maint-5.8/perl/perl.h#11 (text) ====
Index: perl/perl.h
--- perl/perl.h#10~18353~ Wed Dec 25 18:07:06 2002
+++ perl/perl.h Wed Jan 1 17:39:31 2003
@@ -2655,6 +2655,7 @@
#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 */
==== //depot/maint-5.8/perl/pod/perlguts.pod#4 (text) ====
Index: perl/pod/perlguts.pod
--- perl/pod/perlguts.pod#3~18243~ Tue Dec 3 15:39:28 2002
+++ perl/pod/perlguts.pod Wed Jan 1 17:39:31 2003
@@ -963,6 +963,7 @@
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 @@
~ 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.
==== //depot/maint-5.8/perl/sv.c#15 (text) ====
Index: perl/sv.c
--- perl/sv.c#14~18381~ Wed Jan 1 07:02:04 2003
+++ perl/sv.c Wed Jan 1 17:39:31 2003
@@ -3581,6 +3581,12 @@
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 @@
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)
@@ -4649,6 +4661,9 @@
break;
case PERL_MAGIC_vec:
vtable = &PL_vtbl_vec;
+ break;
+ case PERL_MAGIC_vstring:
+ vtable = 0;
break;
case PERL_MAGIC_utf8:
vtable = &PL_vtbl_utf8;
==== //depot/maint-5.8/perl/sv.h#4 (text) ====
Index: perl/sv.h
--- perl/sv.h#3~18173~ Fri Nov 22 18:02:33 2002
+++ perl/sv.h Wed Jan 1 17:39:31 2003
@@ -577,6 +577,7 @@
#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)
==== //depot/maint-5.8/perl/t/op/ver.t#2 (xtext) ====
Index: perl/t/op/ver.t
--- perl/t/op/ver.t#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/t/op/ver.t Wed Jan 1 17:39:31 2003
@@ -11,7 +11,7 @@
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 @@
}
}
}
+
+# 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' );
==== //depot/maint-5.8/perl/util.c#11 (text) ====
Index: perl/util.c
--- perl/util.c#10~18353~ Wed Dec 25 18:07:06 2002
+++ perl/util.c Wed Jan 1 17:39:31 2003
@@ -3933,6 +3933,7 @@
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 @@
/* 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 @@
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;
}
End of Patch.
