diff options
-rw-r--r-- | doio.c | 15 | ||||
-rw-r--r-- | regcomp.c | 8 | ||||
-rw-r--r-- | regcomp.h | 16 | ||||
-rwxr-xr-x | t/io/openpid.t | 8 | ||||
-rw-r--r-- | utf8.c | 28 |
5 files changed, 58 insertions, 17 deletions
@@ -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); @@ -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) @@ -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"; @@ -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) { |