sundry cleanups for clean build on windows
authorGurusamy Sarathy <gsar@cpan.org>
Thu, 8 Jul 1999 18:41:45 +0000 (18:41 +0000)
committerGurusamy Sarathy <gsar@cpan.org>
Thu, 8 Jul 1999 18:41:45 +0000 (18:41 +0000)
p4raw-id: //depot/perl@3659

doio.c
regcomp.c
regcomp.h
t/io/openpid.t
utf8.c

diff --git a/doio.c b/doio.c
index a1adf63..674bd7b 100644 (file)
--- 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);
index 8ce8426..9c9fc14 100644 (file)
--- 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)
index c679ca4..61726bb 100644 (file)
--- 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,
index 334bc0d..21ec083 100755 (executable)
@@ -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 bb0525d..a470376 100644 (file)
--- 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)
 {