Skip to content

Commit 1db6b57

Browse files
committed
Devel-PPPort: add SvVSTRING()
vstrings were originally added in perl-5.8.0-82-g92f0c26562, SvVSTRING_mg() was originally added in perl-5.8.0-8018-gb0a11fe104 so technically in the same release. I expect there were some uses of intermediate versions 19 years ago, but I don't think we need to worry about it now.
1 parent 5352940 commit 1db6b57

File tree

2 files changed

+64
-1
lines changed

2 files changed

+64
-1
lines changed

dist/Devel-PPPort/parts/embed.fnc

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1960,6 +1960,9 @@ Apd |void |sv_vcatpvfn_flags|NN SV *const sv|NN const char *const pat|const STRL
19601960
Apd |void |sv_vsetpvfn |NN SV *const sv|NN const char *const pat|const STRLEN patlen \
19611961
|NULLOK va_list *const args|NULLOK SV **const svargs \
19621962
|const Size_t sv_count|NULLOK bool *const maybe_tainted
1963+
Adp |const char *|sv_vstring_get \
1964+
|NN SV * const sv \
1965+
|NULLOK STRLEN *lenp
19631966
CpR |NV |str_to_version |NN SV *sv
19641967
Ap |void |regdump |NN const regexp* r
19651968
CiTop |struct regexp *|ReANY |NN const REGEXP * const re

dist/Devel-PPPort/parts/inc/magic

Lines changed: 61 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,9 @@ SvUV_nomg
2323
SvNV_nomg
2424
SvTRUE_nomg
2525

26+
sv_vstring_get
27+
SvVSTRING
28+
2629
=implementation
2730

2831
#undef SvGETMAGIC
@@ -254,10 +257,36 @@ sv_unmagicext(pTHX_ SV *const sv, const int type, const MGVTBL *vtbl)
254257
#endif
255258
#endif
256259

260+
__UNDEFINED__ SvVSTRING(sv, len) (sv_vstring_get(sv, &(len)))
261+
__UNDEFINED__ SvVOK(sv) (FALSE)
262+
263+
#if !defined(sv_vstring_get)
264+
265+
#if { NEED sv_vstring_get }
266+
267+
const char *
268+
sv_vstring_get(pTHX_ SV *sv, STRLEN *lenp)
269+
{
270+
#ifdef SvVSTRING_mg
271+
MAGIC *mg = SvVSTRING_mg(sv);
272+
if (!mg) return NULL;
273+
274+
if (lenp) *lenp = mg->mg_len;
275+
return mg->mg_ptr;
276+
#else
277+
return NULL;
278+
#endif
279+
}
280+
281+
#endif
282+
283+
#endif
284+
257285
=xsinit
258286

259287
#define NEED_mg_findext
260288
#define NEED_sv_unmagicext
289+
#define NEED_sv_vstring_get
261290

262291
#ifndef STATIC
263292
#define STATIC static
@@ -580,7 +609,26 @@ magic_SvPV_nomg_nolen(sv)
580609

581610
#endif
582611

583-
=tests plan => 63
612+
int
613+
SvVOK(sv)
614+
SV *sv
615+
616+
SV *
617+
SvVSTRING(sv)
618+
SV *sv
619+
CODE:
620+
{
621+
const char *vstr_pv;
622+
STRLEN vstr_len;
623+
if((vstr_pv = SvVSTRING(sv, vstr_len)))
624+
RETVAL = newSVpvn(vstr_pv, vstr_len);
625+
else
626+
RETVAL = &PL_sv_undef;
627+
}
628+
OUTPUT:
629+
RETVAL
630+
631+
=tests plan => 64
584632

585633
# Find proper magic
586634
ok(my $obj1 = Devel::PPPort->new_with_mg());
@@ -725,6 +773,18 @@ if (ivers($]) >= ivers("5.6")) {
725773
is tied($big)->{fetch}, 1;
726774
is tied($big)->{store}, 0;
727775

776+
SKIP:
777+
{
778+
my $vstr = eval "v1.23.456";
779+
780+
if (!Devel::PPPort::SvVOK($vstr)) {
781+
skip "No vstring magic", 1;
782+
last SKIP; # testutil skip() doesn't "last SKIP"
783+
}
784+
785+
is Devel::PPPort::SvVSTRING($vstr), "v1.23.456", 'SvVSTRING()';
786+
}
787+
728788
package TieScalarCounter;
729789

730790
sub TIESCALAR {

0 commit comments

Comments
 (0)