void
Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
{
- const register U8 *s;
+ register const U8 *s;
register U32 i;
STRLEN len;
I32 rarest = 0;
{ /* Do actual FBM. */
register const unsigned char *table = little + littlelen + FBM_TABLE_OFFSET;
- const register unsigned char *oldlittle;
+ register const unsigned char *oldlittle;
if (littlelen > (STRLEN)(bigend - big))
return Nullch;
char *
Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift, I32 *old_posp, I32 last)
{
- const register unsigned char *big;
+ register const unsigned char *big;
register I32 pos;
register I32 previous;
register I32 first;
- const register unsigned char *little;
+ register const unsigned char *little;
register I32 stop_pos;
- const register unsigned char *littleend;
+ register const unsigned char *littleend;
I32 found = 0;
if (*old_posp == -1
}
big -= previous;
do {
- const register unsigned char *s, *x;
+ register const unsigned char *s, *x;
if (pos >= stop_pos) break;
if (big[pos] != first)
continue;
my_setenv_format(environ[i], nam, nlen, val, vlen);
} else {
# endif
-# if defined(__CYGWIN__) || defined(EPOC) || defined(SYMBIAN)
- setenv(nam, val, 1);
+# if defined(__CYGWIN__) || defined(EPOC) || defined(__SYMBIAN32__)
+# if defined(HAS_UNSETENV)
+ if (val == NULL) {
+ (void)unsetenv(nam);
+ } else {
+ (void)setenv(nam, val, 1);
+ }
+# else /* ! HAS_UNSETENV */
+ (void)setenv(nam, val, 1);
+# endif /* HAS_UNSETENV */
# else
- char *new_env;
- const int nlen = strlen(nam);
- int vlen;
- if (!val) {
- val = "";
- }
- vlen = strlen(val);
- new_env = (char*)safesysmalloc((nlen + vlen + 2) * sizeof(char));
- /* all that work just for this */
- my_setenv_format(new_env, nam, nlen, val, vlen);
- (void)putenv(new_env);
+# if defined(HAS_UNSETENV)
+ if (val == NULL) {
+ (void)unsetenv(nam);
+ } else {
+ int nlen = strlen(nam);
+ int vlen = strlen(val);
+ char *new_env =
+ (char*)safesysmalloc((nlen + vlen + 2) * sizeof(char));
+ my_setenv_format(new_env, nam, nlen, val, vlen);
+ (void)putenv(new_env);
+ }
+# else /* ! HAS_UNSETENV */
+ char *new_env;
+ int nlen = strlen(nam), vlen;
+ if (!val) {
+ val = "";
+ }
+ vlen = strlen(val);
+ new_env = (char*)safesysmalloc((nlen + vlen + 2) * sizeof(char));
+ /* all that work just for this */
+ my_setenv_format(new_env, nam, nlen, val, vlen);
+ (void)putenv(new_env);
+# endif /* HAS_UNSETENV */
# endif /* __CYGWIN__ */
#ifndef PERL_USE_SAFE_PUTENV
}
Perl_setenv_getix(pTHX_ const char *nam)
{
register I32 i;
- const register I32 len = strlen(nam);
+ register const I32 len = strlen(nam);
for (i = 0; environ[i]; i++) {
if (
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];
#endif /* !HAS_RENAME */
char*
-Perl_find_script(pTHX_ const char *scriptname, bool dosearch, const char **search_ext, I32 flags)
+Perl_find_script(pTHX_ const char *scriptname, bool dosearch,
+ const char *const *const search_ext, I32 flags)
{
const char *xfound = Nullch;
char *xfailed = Nullch;
#endif
/* additional extensions to try in each dir if scriptname not found */
#ifdef SEARCH_EXTS
- const char *exts[] = { SEARCH_EXTS };
- const char **ext = search_ext ? search_ext : exts;
+ const char *const exts[] = { SEARCH_EXTS };
+ const char *const *const ext = search_ext ? search_ext : exts;
int extidx = 0, i = 0;
const char *curext = Nullch;
#else
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
{
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++;
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);
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;
}
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++ )
{
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
=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
/* 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
/* 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;
}
}
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);
}
}
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 */
{
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 )
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 )
/* 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 */
SV *
Perl_vstringify(pTHX_ SV *vs)
{
- I32 qv = 0;
if ( SvROK(vs) )
vs = SvRV(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);
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;
projects / p5sagit/p5-mst-13.2.git / blobdiff