X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/e0218a61b599e8e5c97718ac68ef92ad34b20839..4cec2b33f0aa04d807b9b31c6b4212fe462cd7d4:/util.c?ds=sidebyside

diff --git a/util.c b/util.c
index f23e9cb..6e39cb6 100644
--- a/util.c
+++ b/util.c
@@ -2129,7 +2129,7 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode)
     register I32 This, that;
     register Pid_t pid;
     SV *sv;
-    I32 doexec = !(*cmd == '-' && cmd[1] == '\0');
+    const I32 doexec = !(*cmd == '-' && cmd[1] == '\0');
     I32 did_pipes = 0;
     int pp[2];
 
@@ -3882,11 +3882,12 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
     const char *pos;
     const char *last;
     int saw_period = 0;
-    int saw_under = 0;
+    int alpha = 0;
     int width = 3;
     AV *av = newAV();
-    SV* hv = newSVrv(rv, "version"); /* create an SV and upgrade the RV */
+    SV *hv = newSVrv(rv, "version"); /* create an SV and upgrade the RV */
     (void)sv_upgrade(hv, SVt_PVHV); /* needs to be an HV type */
+
 #ifndef NODEFAULT_SHAREKEYS
     HvSHAREKEYS_on(hv);         /* key-sharing on by default */
 #endif
@@ -3906,16 +3907,16 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
     {
 	if ( *pos == '.' )
 	{
-	    if ( saw_under )
+	    if ( alpha )
 		Perl_croak(aTHX_ "Invalid version format (underscores before decimal)");
 	    saw_period++ ;
 	    last = pos;
 	}
 	else if ( *pos == '_' )
 	{
-	    if ( saw_under )
+	    if ( alpha )
 		Perl_croak(aTHX_ "Invalid version format (multiple underscores)");
-	    saw_under = 1;
+	    alpha = 1;
 	    width = pos - last - 1; /* natural width of sub-version */
 	}
 	pos++;
@@ -3927,9 +3928,9 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
     pos = s;
 
     if ( qv )
-	hv_store((HV *)hv, "qv", 2, &PL_sv_yes, 0);
-    if ( saw_under )
-	hv_store((HV *)hv, "alpha", 5, &PL_sv_yes, 0);
+	hv_store((HV *)hv, "qv", 2, newSViv(qv), 0);
+    if ( alpha )
+	hv_store((HV *)hv, "alpha", 5, newSViv(alpha), 0);
     if ( !qv && width < 3 )
 	hv_store((HV *)hv, "width", 5, newSViv(width), 0);
     
@@ -4018,7 +4019,7 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
 	av_push(av, newSViv(0));
 
     /* And finally, store the AV in the hash */
-    hv_store((HV *)hv, "version", 7, (SV *)av, 0);
+    hv_store((HV *)hv, "version", 7, newRV_noinc((SV *)av), 0);
     return s;
 }
 
@@ -4067,7 +4068,7 @@ Perl_new_version(pTHX_ SV *ver)
 	    hv_store((HV *)hv, "width", 5, newSViv(width), 0);
 	}
 
-	sav = (AV *)*hv_fetch((HV*)ver, "version", 7, FALSE);
+	sav = (AV *)SvRV(*hv_fetch((HV*)ver, "version", 7, FALSE));
 	/* This will get reblessed later if a derived class*/
 	for ( key = 0; key <= av_len(sav); key++ )
 	{
@@ -4075,7 +4076,7 @@ Perl_new_version(pTHX_ SV *ver)
 	    av_push(av, newSViv(rev));
 	}
 
-	hv_store((HV *)hv, "version", 7, (SV *)av, 0);
+	hv_store((HV *)hv, "version", 7, newRV_noinc((SV *)av), 0);
 	return rv;
     }
 #ifdef SvVOK
@@ -4148,11 +4149,11 @@ confused by derived classes which may contain additional hash entries):
 
 =over 4
 
-=item * The SV contains a hash (or a reference to one)
+=item * The SV contains a [reference to a] hash
 
 =item * The hash contains a "version" key
 
-=item * The "version" key has an AV as its value
+=item * The "version" key has [a reference to] an AV as its value
 
 =back
 
@@ -4169,7 +4170,7 @@ Perl_vverify(pTHX_ SV *vs)
     /* see if the appropriate elements exist */
     if ( SvTYPE(vs) == SVt_PVHV
 	 && hv_exists((HV*)vs, "version", 7)
-	 && (sv = *hv_fetch((HV*)vs, "version", 7, FALSE))
+	 && (sv = SvRV(*hv_fetch((HV*)vs, "version", 7, FALSE)))
 	 && SvTYPE(sv) == SVt_PVAV )
 	return TRUE;
     else
@@ -4214,7 +4215,7 @@ Perl_vnumify(pTHX_ SV *vs)
 
 
     /* attempt to retrieve the version array */
-    if ( !(av = (AV *)*hv_fetch((HV*)vs, "version", 7, FALSE) ) ) {
+    if ( !(av = (AV *)SvRV(*hv_fetch((HV*)vs, "version", 7, FALSE)) ) ) {
 	sv_catpvn(sv,"0",1);
 	return sv;
     }
@@ -4227,17 +4228,17 @@ Perl_vnumify(pTHX_ SV *vs)
     }
 
     digit = SvIV(*av_fetch(av, 0, 0));
-    sv_setpvf(sv, "%d.", (int)PERL_ABS(digit));
+    Perl_sv_setpvf(aTHX_ sv, "%d.", (int)PERL_ABS(digit));
     for ( i = 1 ; i < len ; i++ )
     {
 	digit = SvIV(*av_fetch(av, i, 0));
 	if ( width < 3 ) {
 	    const int denom = (int)pow(10,(3-width));
 	    const div_t term = div((int)PERL_ABS(digit),denom);
-	    sv_catpvf(sv, "%0*d_%d", width, term.quot, term.rem);
+	    Perl_sv_catpvf(aTHX_ sv, "%0*d_%d", width, term.quot, term.rem);
 	}
 	else {
-	    sv_catpvf(sv, "%0*d", width, (int)digit);
+	    Perl_sv_catpvf(aTHX_ sv, "%0*d", width, (int)digit);
 	}
     }
 
@@ -4246,7 +4247,7 @@ Perl_vnumify(pTHX_ SV *vs)
 	digit = SvIV(*av_fetch(av, len, 0));
 	if ( alpha && width == 3 ) /* alpha version */
 	    sv_catpvn(sv,"_",1);
-	sv_catpvf(sv, "%0*d", width, (int)digit);
+	Perl_sv_catpvf(aTHX_ sv, "%0*d", width, (int)digit);
     }
     else /* len == 0 */
     {
@@ -4284,7 +4285,7 @@ Perl_vnormal(pTHX_ SV *vs)
 
     if ( hv_exists((HV*)vs, "alpha", 5 ) )
 	alpha = TRUE;
-    av = (AV *)*hv_fetch((HV*)vs, "version", 7, FALSE);
+    av = (AV *)SvRV(*hv_fetch((HV*)vs, "version", 7, FALSE));
 
     len = av_len(av);
     if ( len == -1 )
@@ -4293,10 +4294,10 @@ Perl_vnormal(pTHX_ SV *vs)
 	return sv;
     }
     digit = SvIV(*av_fetch(av, 0, 0));
-    sv_setpvf(sv, "v%"IVdf, (IV)digit);
-    for ( i = 1 ; i <= len-1 ; i++ ) {
+    Perl_sv_setpvf(aTHX_ sv, "v%"IVdf, (IV)digit);
+    for ( i = 1 ; i < len ; i++ ) {
 	digit = SvIV(*av_fetch(av, i, 0));
-	sv_catpvf(sv, ".%"IVdf, (IV)digit);
+	Perl_sv_catpvf(aTHX_ sv, ".%"IVdf, (IV)digit);
     }
 
     if ( len > 0 )
@@ -4304,9 +4305,9 @@ Perl_vnormal(pTHX_ SV *vs)
 	/* handle last digit specially */
 	digit = SvIV(*av_fetch(av, len, 0));
 	if ( alpha )
-	    sv_catpvf(sv, "_%"IVdf, (IV)digit);
+	    Perl_sv_catpvf(aTHX_ sv, "_%"IVdf, (IV)digit);
 	else
-	    sv_catpvf(sv, ".%"IVdf, (IV)digit);
+	    Perl_sv_catpvf(aTHX_ sv, ".%"IVdf, (IV)digit);
     }
 
     if ( len <= 2 ) { /* short version, must be at least three */
@@ -4330,7 +4331,6 @@ the original version contained 1 or more dots, respectively
 SV *
 Perl_vstringify(pTHX_ SV *vs)
 {
-    I32 qv = 0;
     if ( SvROK(vs) )
 	vs = SvRV(vs);
     
@@ -4338,9 +4338,6 @@ Perl_vstringify(pTHX_ SV *vs)
 	Perl_croak(aTHX_ "Invalid version object");
 
     if ( hv_exists((HV *)vs, "qv", 2) )
-	qv = 1;
-    
-    if ( qv )
 	return vnormal(vs);
     else
 	return vnumify(vs);
@@ -4376,12 +4373,12 @@ Perl_vcmp(pTHX_ SV *lhv, SV *rhv)
 	Perl_croak(aTHX_ "Invalid version object");
 
     /* get the left hand term */
-    lav = (AV *)*hv_fetch((HV*)lhv, "version", 7, FALSE);
+    lav = (AV *)SvRV(*hv_fetch((HV*)lhv, "version", 7, FALSE));
     if ( hv_exists((HV*)lhv, "alpha", 5 ) )
 	lalpha = TRUE;
 
     /* and the right hand term */
-    rav = (AV *)*hv_fetch((HV*)rhv, "version", 7, FALSE);
+    rav = (AV *)SvRV(*hv_fetch((HV*)rhv, "version", 7, FALSE));
     if ( hv_exists((HV*)rhv, "alpha", 5 ) )
 	ralpha = TRUE;