/* util.c
*
- * Copyright (c) 1991-2002, Larry Wall
+ * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ * 2000, 2001, 2002, 2003, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
I32 rarest = 0;
U32 frequency = 256;
- if (flags & FBMcf_TAIL)
+ if (flags & FBMcf_TAIL) {
+ MAGIC *mg = SvUTF8(sv) && SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : NULL;
sv_catpvn(sv, "\n", 1); /* Taken into account in fbm_instr() */
+ if (mg && mg->mg_len >= 0)
+ mg->mg_len++;
+ }
s = (U8*)SvPV_force(sv, len);
(void)SvUPGRADE(sv, SVt_PVBM);
if (len == 0) /* TAIL might be on a zero-length string. */
}
/* if STDERR is tied, use it instead */
- if (PL_stderrgv && (io = GvIOp(PL_stderrgv))
+ if (PL_stderrgv && SvREFCNT(PL_stderrgv) && (io = GvIO(PL_stderrgv))
&& (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) {
dSP; ENTER;
PUSHMARK(SP);
sigemptyset(&act.sa_mask);
act.sa_flags = 0;
#ifdef SA_RESTART
-#if defined(PERL_OLD_SIGNALS)
- act.sa_flags |= SA_RESTART; /* SVR4, 4.3+BSD */
-#endif
+ if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG)
+ act.sa_flags |= SA_RESTART; /* SVR4, 4.3+BSD */
#endif
-#ifdef SA_NOCLDWAIT
+#if defined(SA_NOCLDWAIT) && !defined(BSDish) /* See [perl #18849] */
if (signo == SIGCHLD && handler == (Sighandler_t)SIG_IGN)
act.sa_flags |= SA_NOCLDWAIT;
#endif
sigemptyset(&act.sa_mask);
act.sa_flags = 0;
#ifdef SA_RESTART
-#if defined(PERL_OLD_SIGNALS)
- act.sa_flags |= SA_RESTART; /* SVR4, 4.3+BSD */
+ if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG)
+ act.sa_flags |= SA_RESTART; /* SVR4, 4.3+BSD */
#endif
-#endif
-#ifdef SA_NOCLDWAIT
+#if defined(SA_NOCLDWAIT) && !defined(BSDish) /* See [perl #18849] */
if (signo == SIGCHLD && handler == (Sighandler_t)SIG_IGN)
act.sa_flags |= SA_NOCLDWAIT;
#endif
}
#ifdef EBCDIC
if (rev > 0x7FFFFFFF)
- Perl_croak(aTHX "In EBCDIC the v-string components cannot exceed 2147483647");
+ Perl_croak(aTHX_ "In EBCDIC the v-string components cannot exceed 2147483647");
#endif
/* Append native character for the rev point */
tmpend = uvchr_to_utf8(tmpbuf, rev);
orev = rev;
rev += (*s - '0') * mult;
mult /= 10;
- if ( abs(orev) > abs(rev) )
+ if ( PERL_ABS(orev) > PERL_ABS(rev) )
Perl_croak(aTHX_ "Integer overflow in version");
s++;
}
orev = rev;
rev += (*end - '0') * mult;
mult *= 10;
- if ( abs(orev) > abs(rev) )
+ if ( PERL_ABS(orev) > PERL_ABS(rev) )
Perl_croak(aTHX_ "Integer overflow in version");
}
}
return sv;
}
digit = SvIVX(*av_fetch((AV *)vs, 0, 0));
- Perl_sv_setpvf(aTHX_ sv,"%d.",abs(digit));
+ Perl_sv_setpvf(aTHX_ sv,"%d.", PERL_ABS(digit));
for ( i = 1 ; i <= len ; i++ )
{
digit = SvIVX(*av_fetch((AV *)vs, i, 0));
- Perl_sv_catpvf(aTHX_ sv,"%03d",abs(digit));
+ Perl_sv_catpvf(aTHX_ sv,"%03d", PERL_ABS(digit));
}
if ( len == 0 )
Perl_sv_catpv(aTHX_ sv,"000");
return sv;
}
digit = SvIVX(*av_fetch((AV *)vs, 0, 0));
- Perl_sv_setpvf(aTHX_ sv,"%d",digit);
+ Perl_sv_setpvf(aTHX_ sv,"%"IVdf,(IV)digit);
for ( i = 1 ; i <= len ; i++ )
{
digit = SvIVX(*av_fetch((AV *)vs, i, 0));
if ( digit < 0 )
- Perl_sv_catpvf(aTHX_ sv,"_%d",-digit);
+ Perl_sv_catpvf(aTHX_ sv,"_%"IVdf,(IV)-digit);
else
- Perl_sv_catpvf(aTHX_ sv,".%d",digit);
+ Perl_sv_catpvf(aTHX_ sv,".%"IVdf,(IV)digit);
}
if ( len == 0 )
Perl_sv_catpv(aTHX_ sv,".0");
I32 right = SvIV(*av_fetch((AV *)rsv,i,0));
bool lbeta = left < 0 ? 1 : 0;
bool rbeta = right < 0 ? 1 : 0;
- left = abs(left);
- right = abs(right);
+ left = PERL_ABS(left);
+ right = PERL_ABS(right);
if ( left < right || (left == right && lbeta && !rbeta) )
retval = -1;
if ( left > right || (left == right && rbeta && !lbeta) )
{
}
+U32
+Perl_parse_unicode_opts(pTHX_ char **popt)
+{
+ char *p = *popt;
+ U32 opt = 0;
+
+ if (*p) {
+ if (isDIGIT(*p)) {
+ opt = (U32) atoi(p);
+ while (isDIGIT(*p)) p++;
+ if (*p && *p != '\n' && *p != '\r')
+ Perl_croak(aTHX_ "Unknown Unicode option letter '%c'", *p);
+ }
+ else {
+ for (; *p; p++) {
+ switch (*p) {
+ case PERL_UNICODE_STDIN:
+ opt |= PERL_UNICODE_STDIN_FLAG; break;
+ case PERL_UNICODE_STDOUT:
+ opt |= PERL_UNICODE_STDOUT_FLAG; break;
+ case PERL_UNICODE_STDERR:
+ opt |= PERL_UNICODE_STDERR_FLAG; break;
+ case PERL_UNICODE_STD:
+ opt |= PERL_UNICODE_STD_FLAG; break;
+ case PERL_UNICODE_IN:
+ opt |= PERL_UNICODE_IN_FLAG; break;
+ case PERL_UNICODE_OUT:
+ opt |= PERL_UNICODE_OUT_FLAG; break;
+ case PERL_UNICODE_INOUT:
+ opt |= PERL_UNICODE_INOUT_FLAG; break;
+ case PERL_UNICODE_LOCALE:
+ opt |= PERL_UNICODE_LOCALE_FLAG; break;
+ case PERL_UNICODE_ARGV:
+ opt |= PERL_UNICODE_ARGV_FLAG; break;
+ default:
+ if (*p != '\n' && *p != '\r')
+ Perl_croak(aTHX_
+ "Unknown Unicode option letter '%c'", *p);
+ }
+ }
+ }
+ }
+ else
+ opt = PERL_UNICODE_DEFAULT_FLAGS;
+
+ if (opt & ~PERL_UNICODE_ALL_FLAGS)
+ Perl_croak(aTHX_ "Unknown Unicode option value %"UVuf,
+ (UV) (opt & ~PERL_UNICODE_ALL_FLAGS));
+
+ *popt = p;
+
+ return opt;
+}
+