}
return IoIFP(GvIOp(gv));
}
- else
- PerlIO_printf(PerlIO_stderr(), "Can't open %s: %s\n",
- SvPV(sv, oldlen), Strerror(errno));
+ else {
+ dTHR;
+ if (ckWARN_d(WARN_INPLACE)) {
+ if (!S_ISREG(PL_statbuf.st_mode))
+ Perl_warner(aTHX_ WARN_INPLACE,
+ "Can't do inplace edit: %s is not a regular file",
+ PL_oldname );
+ else
+ Perl_warner(aTHX_ WARN_INPLACE, "Can't open %s: %s\n",
+ PL_oldname, Strerror(errno));
+ }
+ }
}
if (PL_inplace) {
(void)do_close(PL_argvoutgv,FALSE);
if (data && (flags & SCF_DO_SUBSTR))
data->pos_min += l;
}
- else if (strchr(PL_varies,OP(scan))) {
+ else if (strchr((char*)PL_varies,OP(scan))) {
I32 mincount, maxcount, minnext, deltanext, pos_before, fl;
regnode *oscan = scan;
/* Skip open. */
nxt = regnext(nxt);
- if (!strchr(PL_simple,OP(nxt))
+ if (!strchr((char*)PL_simple,OP(nxt))
&& !(PL_regkind[(U8)OP(nxt)] == EXACT
&& *OPERAND(nxt) == 1))
goto nogo;
break;
}
}
- else if (strchr(PL_simple,OP(scan)) || PL_regkind[(U8)OP(scan)] == ANYUTF8) {
+ else if (strchr((char*)PL_simple,OP(scan)) || PL_regkind[(U8)OP(scan)] == ANYUTF8) {
if (flags & SCF_DO_SUBSTR) {
scan_commit(data);
data->pos_min++;
/* Starting-point info. */
again:
if (OP(first) == EXACT); /* Empty, get anchored substr later. */
- else if (strchr(PL_simple+4,OP(first)))
+ else if (strchr((char*)PL_simple+4,OP(first)))
r->regstclass = first;
else if (PL_regkind[(U8)OP(first)] == BOUND ||
PL_regkind[(U8)OP(first)] == NBOUND)
*/
#ifndef lint
#ifndef CHARMASK
-#define UCHARAT(p) ((int)*(unsigned char *)(p))
+#define UCHARAT(p) ((int)*(U8*)(p))
#else
#define UCHARAT(p) ((int)*(p)&CHARMASK)
#endif
#include "regnodes.h"
-/* The following have no fixed length. char* since we do strchr on it. */
+/* The following have no fixed length. U8 so we can do strchr() on it. */
#ifndef DOINIT
-EXTCONST char PL_varies[];
+EXTCONST U8 PL_varies[];
#else
-EXTCONST char PL_varies[] = {
+EXTCONST U8 PL_varies[] = {
BRANCH, BACK, STAR, PLUS, CURLY, CURLYX, REF, REFF, REFFL,
WHILEM, CURLYM, CURLYN, BRANCHJ, IFTHEN, SUSPEND, CLUMP, 0
};
#endif
-/* The following always have a length of 1. char* since we do strchr on it. */
-/* (Note that lenght 1 means "one character" under UTF8, not "one octet".) */
+/* The following always have a length of 1. U8 we can do strchr() on it. */
+/* (Note that length 1 means "one character" under UTF8, not "one octet".) */
#ifndef DOINIT
-EXTCONST char PL_simple[];
+EXTCONST U8 PL_simple[];
#else
-EXTCONST char PL_simple[] = {
+EXTCONST U8 PL_simple[] = {
REG_ANY, ANYUTF8, SANY, SANYUTF8, ANYOF, ANYOFUTF8,
ALNUM, ALNUMUTF8, ALNUML, ALNUMLUTF8,
NALNUM, NALNUMUTF8, NALNUML, NALNUMLUTF8,
use FileHandle;
+use Config;
autoflush STDOUT 1;
$SIG{PIPE} = 'IGNORE';
print "# pids were $pid1, $pid2, $pid3, $pid4\n";
+my $killsig = 'HUP';
+$killsig = 1 unless $Config{sig_name} =~ /\bHUP\b/;
+
# get message from first process and kill it
chomp($from_pid1 = scalar(<FH1>));
print "# child1 returned [$from_pid1]\nnot "
unless $from_pid1 eq 'first process';
print "ok 5\n";
-$kill_cnt = kill 'HUP', $pid1;
+$kill_cnt = kill $killsig, $pid1;
print "not " unless $kill_cnt == 1;
print "ok 6\n";
print "# child2 returned [$from_pid2]\nnot "
unless $from_pid2 eq 'second process';
print "ok 7\n";
-$kill_cnt = kill 'HUP', $pid2, $pid3;
+$kill_cnt = kill $killsig, $pid2, $pid3;
print "not " unless $kill_cnt == 2;
print "ok 8\n";
}
bool
+Perl_is_uni_ascii(pTHX_ U32 c)
+{
+ U8 tmpbuf[10];
+ uv_to_utf8(tmpbuf, (UV)c);
+ return is_utf8_ascii(tmpbuf);
+}
+
+bool
Perl_is_uni_space(pTHX_ U32 c)
{
U8 tmpbuf[10];
return is_utf8_punct(tmpbuf);
}
+bool
+Perl_is_uni_xdigit(pTHX_ U32 c)
+{
+ U8 tmpbuf[10];
+ uv_to_utf8(tmpbuf, (UV)c);
+ return is_utf8_xdigit(tmpbuf);
+}
+
U32
Perl_to_uni_upper(pTHX_ U32 c)
{
}
bool
+Perl_is_uni_ascii_lc(pTHX_ U32 c)
+{
+ return is_uni_ascii(c); /* XXX no locale support yet */
+}
+
+bool
Perl_is_uni_space_lc(pTHX_ U32 c)
{
return is_uni_space(c); /* XXX no locale support yet */
return is_uni_punct(c); /* XXX no locale support yet */
}
+bool
+Perl_is_uni_xdigit_lc(pTHX_ U32 c)
+{
+ return is_uni_xdigit(c); /* XXX no locale support yet */
+}
+
U32
Perl_to_uni_upper_lc(pTHX_ U32 c)
{