tmpRef = (SV*)GvCVu(gv);
break;
case 'F':
- if (strEQ(elem, "FILEHANDLE")) /* XXX deprecate in 5.005 */
+ if (strEQ(elem, "FILEHANDLE")) {
+ /* finally deprecated in 5.8.0 */
+ deprecate("*glob{FILEHANDLE}");
tmpRef = (SV*)GvIOp(gv);
+ }
else
if (strEQ(elem, "FORMAT"))
tmpRef = (SV*)GvFORM(gv);
sv_setsv(TARG, sv);
*SvPV_force(TARG, len) = *s == '-' ? '+' : '-';
}
- else if (DO_UTF8(sv) && UTF8_IS_START(*s) && isIDFIRST_utf8((U8*)s)) {
- sv_setpvn(TARG, "-", 1);
- sv_catsv(TARG, sv);
+ else if (DO_UTF8(sv)) {
+ SvIV_please(sv);
+ if (SvIOK(sv))
+ goto oops_its_an_int;
+ if (SvNOK(sv))
+ sv_setnv(TARG, -SvNV(sv));
+ else {
+ sv_setpvn(TARG, "-", 1);
+ sv_catsv(TARG, sv);
+ }
}
else {
- SvIV_please(sv);
- if (SvIOK(sv))
- goto oops_its_an_int;
- sv_setnv(TARG, -SvNV(sv));
+ SvIV_please(sv);
+ if (SvIOK(sv))
+ goto oops_its_an_int;
+ sv_setnv(TARG, -SvNV(sv));
}
SETTARG;
}
RETURN;
}
+
PP(pp_hex)
{
dSP; dTARGET;
char *tmps;
- STRLEN argtype;
+ I32 flags = PERL_SCAN_ALLOW_UNDERSCORES;
STRLEN len;
+ NV result_nv;
+ UV result_uv;
tmps = (SvPVx(POPs, len));
- argtype = 1; /* allow underscores */
- XPUSHn(scan_hex(tmps, len, &argtype));
+ result_uv = grok_hex (tmps, &len, &flags, &result_nv);
+ if (flags & PERL_SCAN_GREATER_THAN_UV_MAX) {
+ XPUSHn(result_nv);
+ }
+ else {
+ XPUSHu(result_uv);
+ }
RETURN;
}
PP(pp_oct)
{
dSP; dTARGET;
- NV value;
- STRLEN argtype;
char *tmps;
+ I32 flags = PERL_SCAN_ALLOW_UNDERSCORES;
STRLEN len;
+ NV result_nv;
+ UV result_uv;
tmps = (SvPVx(POPs, len));
while (*tmps && len && isSPACE(*tmps))
- tmps++, len--;
+ tmps++, len--;
if (*tmps == '0')
- tmps++, len--;
- argtype = 1; /* allow underscores */
+ tmps++, len--;
if (*tmps == 'x')
- value = scan_hex(++tmps, --len, &argtype);
+ result_uv = grok_hex (tmps, &len, &flags, &result_nv);
else if (*tmps == 'b')
- value = scan_bin(++tmps, --len, &argtype);
+ result_uv = grok_bin (tmps, &len, &flags, &result_nv);
else
- value = scan_oct(tmps, len, &argtype);
- XPUSHn(value);
+ result_uv = grok_oct (tmps, &len, &flags, &result_nv);
+
+ if (flags & PERL_SCAN_GREATER_THAN_UV_MAX) {
+ XPUSHn(result_nv);
+ }
+ else {
+ XPUSHu(result_uv);
+ }
RETURN;
}
dSP; dTARGET; dPOPTOPssrl;
STRLEN n_a;
#ifdef HAS_CRYPT
- char *tmps = SvPV(left, n_a);
+ STRLEN len;
+ char *tmps = SvPV(left, len);
+ char *t = 0;
+ if (DO_UTF8(left)) {
+ /* If Unicode take the crypt() of the low 8 bits
+ * of the characters of the string. */
+ char *s = tmps;
+ char *send = tmps + len;
+ STRLEN i = 0;
+ Newz(688, t, len, char);
+ while (s < send) {
+ t[i++] = utf8_to_uvchr((U8*)s, 0) & 0xFF;
+ s += UTF8SKIP(s);
+ }
+ tmps = t;
+ }
#ifdef FCRYPT
sv_setpv(TARG, fcrypt(tmps, SvPV(right, n_a)));
#else
sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a)));
#endif
+ Safefree(t);
#else
DIE(aTHX_
"The crypt() function is unimplemented due to excessive paranoia.");
register U8 *s;
STRLEN slen;
- if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && UTF8_IS_START(*s)) {
+ if (DO_UTF8(sv)) {
+ U8 tmpbuf[UTF8_MAXLEN*2+1];
STRLEN ulen;
- U8 tmpbuf[UTF8_MAXLEN+1];
- U8 *tend;
- UV uv;
+ STRLEN tculen;
- if (IN_LOCALE_RUNTIME) {
- TAINT;
- SvTAINTED_on(sv);
- uv = toTITLE_LC_uvchr(utf8n_to_uvchr(s, slen, &ulen, 0));
- }
- else {
- uv = toTITLE_utf8(s);
- ulen = UNISKIP(uv);
- }
-
- tend = uvchr_to_utf8(tmpbuf, uv);
+ s = (U8*)SvPV(sv, slen);
+ utf8_to_uvchr(s, &ulen);
- if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
+ toTITLE_utf8(s, tmpbuf, &tculen);
+ utf8_to_uvchr(tmpbuf, 0);
+
+ if (!SvPADTMP(sv) || SvREADONLY(sv)) {
dTARGET;
- sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
+ sv_setpvn(TARG, (char*)tmpbuf, tculen);
sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
SvUTF8_on(TARG);
SETs(TARG);
}
else {
s = (U8*)SvPV_force(sv, slen);
- Copy(tmpbuf, s, ulen, U8);
+ Copy(tmpbuf, s, tculen, U8);
}
}
else {
if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && UTF8_IS_START(*s)) {
STRLEN ulen;
- U8 tmpbuf[UTF8_MAXLEN+1];
+ U8 tmpbuf[UTF8_MAXLEN*2+1];
U8 *tend;
UV uv;
- if (IN_LOCALE_RUNTIME) {
- TAINT;
- SvTAINTED_on(sv);
- uv = toLOWER_LC_uvchr(utf8n_to_uvchr(s, slen, &ulen, 0));
- }
- else {
- uv = toLOWER_utf8(s);
- ulen = UNISKIP(uv);
- }
+ toLOWER_utf8(s, tmpbuf, &ulen);
+ uv = utf8_to_uvchr(tmpbuf, 0);
tend = uvchr_to_utf8(tmpbuf, uv);
STRLEN ulen;
register U8 *d;
U8 *send;
+ U8 tmpbuf[UTF8_MAXLEN*2+1];
s = (U8*)SvPV(sv,len);
if (!len) {
(void)SvPOK_only(TARG);
d = (U8*)SvPVX(TARG);
send = s + len;
- if (IN_LOCALE_RUNTIME) {
- TAINT;
- SvTAINTED_on(TARG);
- while (s < send) {
- d = uvchr_to_utf8(d, toUPPER_LC_uvchr( utf8n_to_uvchr(s, len, &ulen, 0)));
- s += ulen;
- }
- }
- else {
- while (s < send) {
- d = uvchr_to_utf8(d, toUPPER_utf8( s ));
- s += UTF8SKIP(s);
- }
+ while (s < send) {
+ toUPPER_utf8(s, tmpbuf, &ulen);
+ Copy(tmpbuf, d, ulen, U8);
+ d += ulen;
+ s += UTF8SKIP(s);
}
*d = '\0';
SvUTF8_on(TARG);
STRLEN ulen;
register U8 *d;
U8 *send;
+ U8 tmpbuf[UTF8_MAXLEN*2+1];
s = (U8*)SvPV(sv,len);
if (!len) {
(void)SvPOK_only(TARG);
d = (U8*)SvPVX(TARG);
send = s + len;
- if (IN_LOCALE_RUNTIME) {
- TAINT;
- SvTAINTED_on(TARG);
- while (s < send) {
- d = uvchr_to_utf8(d, toLOWER_LC_uvchr( utf8n_to_uvchr(s, len, &ulen, 0)));
- s += ulen;
- }
- }
- else {
- while (s < send) {
- d = uvchr_to_utf8(d, toLOWER_utf8(s));
- s += UTF8SKIP(s);
+ while (s < send) {
+ UV uv = toLOWER_utf8(s, tmpbuf, &ulen);
+#define GREEK_CAPITAL_LETTER_SIGMA 0x03A3 /* Unicode */
+ if (uv == GREEK_CAPITAL_LETTER_SIGMA) {
+ /*
+ * Now if the sigma is NOT followed by
+ * /$ignorable_sequence$cased_letter/;
+ * and it IS preceded by
+ * /$cased_letter$ignorable_sequence/;
+ * where $ignorable_sequence is
+ * [\x{2010}\x{AD}\p{Mn}]*
+ * and $cased_letter is
+ * [\p{Ll}\p{Lo}\p{Lt}]
+ * then it should be mapped to 0x03C2,
+ * (GREEK SMALL LETTER FINAL SIGMA),
+ * instead of staying 0x03A3.
+ * See lib/unicore/SpecCase.txt.
+ */
}
+ Copy(tmpbuf, d, ulen, U8);
+ d += ulen;
+ s += UTF8SKIP(s);
}
*d = '\0';
SvUTF8_on(TARG);
if (pm->op_pmreplroot) {
#ifdef USE_ITHREADS
- ary = GvAVn((GV*)PL_curpad[(PADOFFSET)pm->op_pmreplroot]);
+ ary = GvAVn((GV*)PL_curpad[INT2PTR(PADOFFSET, pm->op_pmreplroot)]);
#else
ary = GvAVn((GV*)pm->op_pmreplroot);
#endif
projects / p5sagit/p5-mst-13.2.git / blobdiff