summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doio.c15
-rw-r--r--regcomp.c8
-rw-r--r--regcomp.h16
-rwxr-xr-xt/io/openpid.t8
-rw-r--r--utf8.c28
5 files changed, 58 insertions, 17 deletions
diff --git a/doio.c b/doio.c
index a1adf63b1d..674bd7b1fb 100644
--- a/doio.c
+++ b/doio.c
@@ -585,9 +585,18 @@ Perl_nextargv(pTHX_ register GV *gv)
}
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);
diff --git a/regcomp.c b/regcomp.c
index 8ce8426597..9c9fc1415f 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -409,7 +409,7 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da
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;
@@ -484,7 +484,7 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da
/* 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;
@@ -631,7 +631,7 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da
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++;
@@ -896,7 +896,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
/* 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)
diff --git a/regcomp.h b/regcomp.h
index c679ca4d46..61726bba6f 100644
--- a/regcomp.h
+++ b/regcomp.h
@@ -230,7 +230,7 @@ struct regnode_2 {
*/
#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
@@ -263,22 +263,22 @@ START_EXTERN_C
#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,
diff --git a/t/io/openpid.t b/t/io/openpid.t
index 334bc0d65b..21ec0830d4 100755
--- a/t/io/openpid.t
+++ b/t/io/openpid.t
@@ -14,6 +14,7 @@ BEGIN {
use FileHandle;
+use Config;
autoflush STDOUT 1;
$SIG{PIPE} = 'IGNORE';
@@ -49,12 +50,15 @@ print "ok 4\n";
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";
@@ -63,7 +67,7 @@ chomp($from_pid2 = scalar(<FH2>));
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";
diff --git a/utf8.c b/utf8.c
index bb0525d892..a4703769de 100644
--- a/utf8.c
+++ b/utf8.c
@@ -285,6 +285,14 @@ Perl_is_uni_alpha(pTHX_ U32 c)
}
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];
@@ -348,6 +356,14 @@ Perl_is_uni_punct(pTHX_ U32 c)
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)
{
@@ -399,6 +415,12 @@ Perl_is_uni_alpha_lc(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 */
@@ -446,6 +468,12 @@ Perl_is_uni_punct_lc(pTHX_ U32 c)
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)
{