A bug introduced in #8217 (the undefined variable in the

[p5sagit/p5-mst-13.2.git] / util.c

diff --git a/util.c b/util.c
index 02d0ed5..ca7cacf 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1,6 +1,6 @@
 /*    util.c
  *
- *    Copyright (c) 1991-2000, Larry Wall
+ *    Copyright (c) 1991-2001, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -26,11 +26,6 @@
 #endif
 #endif
 
-/* XXX If this causes problems, set i_unistd=undef in the hint file.  */
-#ifdef I_UNISTD
-#  include <unistd.h>
-#endif
-
 #ifdef I_VFORK
 #  include <vfork.h>
 #endif
@@ -1267,7 +1262,6 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
 char *
 Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift, I32 *old_posp, I32 last)
 {
-    dTHR;
     register unsigned char *s, *x;
     register unsigned char *big;
     register I32 pos;
@@ -1437,7 +1431,6 @@ Perl_savepvn(pTHX_ const char *sv, register I32 len)
 STATIC SV *
 S_mess_alloc(pTHX)
 {
-    dTHR;
     SV *sv;
     XPVMG *any;
 
@@ -1523,7 +1516,6 @@ Perl_vmess(pTHX_ const char *pat, va_list *args)
 
     sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
     if (!SvCUR(sv) || *(SvEND(sv) - 1) != '\n') {
-       dTHR;
        if (CopLINE(PL_curcop))
            Perl_sv_catpvf(aTHX_ sv, " at %s line %"IVdf,
                           CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
@@ -1547,7 +1539,6 @@ Perl_vmess(pTHX_ const char *pat, va_list *args)
 OP *
 Perl_vdie(pTHX_ const char* pat, va_list *args)
 {
-    dTHR;
     char *message;
     int was_in_eval = PL_in_eval;
     HV *stash;
@@ -1648,7 +1639,6 @@ Perl_die(pTHX_ const char* pat, ...)
 void
 Perl_vcroak(pTHX_ const char* pat, va_list *args)
 {
-    dTHR;
     char *message;
     HV *stash;
     GV *gv;
@@ -1781,7 +1771,6 @@ Perl_vwarn(pTHX_ const char* pat, va_list *args)
 
     if (PL_warnhook) {
        /* sv_2cv might call Perl_warn() */
-       dTHR;
        SV *oldwarnhook = PL_warnhook;
        ENTER;
        SAVESPTR(PL_warnhook);
@@ -1879,7 +1868,6 @@ Perl_warner(pTHX_ U32  err, const char* pat,...)
 void
 Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
 {
-    dTHR;
     char *message;
     HV *stash;
     GV *gv;
@@ -1936,7 +1924,6 @@ Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
     else {
         if (PL_warnhook) {
             /* sv_2cv might call Perl_warn() */
-            dTHR;
             SV *oldwarnhook = PL_warnhook;
             ENTER;
             SAVESPTR(PL_warnhook);
@@ -2468,8 +2455,12 @@ Perl_my_popen(pTHX_ char *cmd, char *mode)
        PerlLIO_close(pp[0]);
        did_pipes = 0;
        if (n) {                        /* Error */
+           int pid2, status;
            if (n != sizeof(int))
                Perl_croak(aTHX_ "panic: kid popen errno read");
+           do {
+               pid2 = wait4pid(pid, &status, 0);
+           } while (pid2 == -1 && errno == EINTR);
            errno = errkid;             /* Propagate errno from kid */
            return Nullfp;
        }
@@ -2557,8 +2548,10 @@ Perl_rsignal(pTHX_ int signo, Sighandler_t handler)
     sigemptyset(&act.sa_mask);
     act.sa_flags = 0;
 #ifdef SA_RESTART
+#if !defined(USE_PERLIO) || defined(PERL_OLD_SIGNALS)
     act.sa_flags |= SA_RESTART;        /* SVR4, 4.3+BSD */
 #endif
+#endif
 #ifdef SA_NOCLDWAIT
     if (signo == SIGCHLD && handler == (Sighandler_t)SIG_IGN)
        act.sa_flags |= SA_NOCLDWAIT;
@@ -2589,8 +2582,10 @@ Perl_rsignal_save(pTHX_ int signo, Sighandler_t handler, Sigsave_t *save)
     sigemptyset(&act.sa_mask);
     act.sa_flags = 0;
 #ifdef SA_RESTART
+#if !defined(USE_PERLIO) || defined(PERL_OLD_SIGNALS)
     act.sa_flags |= SA_RESTART;        /* SVR4, 4.3+BSD */
 #endif
+#endif
 #ifdef SA_NOCLDWAIT
     if (signo == SIGCHLD && handler == (Sighandler_t)SIG_IGN)
        act.sa_flags |= SA_NOCLDWAIT;
@@ -2672,7 +2667,7 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
     LOCK_FDPID_MUTEX;
     svp = av_fetch(PL_fdpid,PerlIO_fileno(ptr),TRUE);
     UNLOCK_FDPID_MUTEX;
-    pid = SvIVX(*svp);
+    pid = (SvTYPE(*svp) == SVt_IV) ? SvIVX(*svp) : -1;
     SvREFCNT_dec(*svp);
     *svp = &PL_sv_undef;
 #ifdef OS2
@@ -2970,7 +2965,6 @@ Perl_scan_bin(pTHX_ char *start, STRLEN len, STRLEN *retlen)
                continue;
            }
            else {
-               dTHR;
                if (ckWARN(WARN_DIGIT))
                    Perl_warner(aTHX_ WARN_DIGIT,
                                "Illegal binary digit '%c' ignored", *s);
@@ -2981,7 +2975,6 @@ Perl_scan_bin(pTHX_ char *start, STRLEN len, STRLEN *retlen)
            register UV xuv = ruv << 1;
 
            if ((xuv >> 1) != ruv) {
-               dTHR;
                overflowed = TRUE;
                rnv = (NV) ruv;
                if (ckWARN_d(WARN_OVERFLOW))
@@ -3009,7 +3002,6 @@ Perl_scan_bin(pTHX_ char *start, STRLEN len, STRLEN *retlen)
        || (!overflowed && ruv > 0xffffffff  )
 #endif
        ) {
-       dTHR;
        if (ckWARN(WARN_PORTABLE))
            Perl_warner(aTHX_ WARN_PORTABLE,
                        "Binary number > 0b11111111111111111111111111111111 non-portable");
@@ -3039,7 +3031,6 @@ Perl_scan_oct(pTHX_ char *start, STRLEN len, STRLEN *retlen)
                 * as soon as non-octal characters are seen, complain only iff
                 * someone seems to want to use the digits eight and nine). */
                if (*s == '8' || *s == '9') {
-                   dTHR;
                    if (ckWARN(WARN_DIGIT))
                        Perl_warner(aTHX_ WARN_DIGIT,
                                    "Illegal octal digit '%c' ignored", *s);
@@ -3051,7 +3042,6 @@ Perl_scan_oct(pTHX_ char *start, STRLEN len, STRLEN *retlen)
            register UV xuv = ruv << 3;
 
            if ((xuv >> 3) != ruv) {
-               dTHR;
                overflowed = TRUE;
                rnv = (NV) ruv;
                if (ckWARN_d(WARN_OVERFLOW))
@@ -3079,7 +3069,6 @@ Perl_scan_oct(pTHX_ char *start, STRLEN len, STRLEN *retlen)
        || (!overflowed && ruv > 0xffffffff  )
 #endif
        ) {
-       dTHR;
        if (ckWARN(WARN_PORTABLE))
            Perl_warner(aTHX_ WARN_PORTABLE,
                        "Octal number > 037777777777 non-portable");
@@ -3118,7 +3107,6 @@ Perl_scan_hex(pTHX_ char *start, STRLEN len, STRLEN *retlen)
                ++s;
            }
            else {
-               dTHR;
                if (ckWARN(WARN_DIGIT))
                    Perl_warner(aTHX_ WARN_DIGIT,
                                "Illegal hexadecimal digit '%c' ignored", *s);
@@ -3129,7 +3117,6 @@ Perl_scan_hex(pTHX_ char *start, STRLEN len, STRLEN *retlen)
            register UV xuv = ruv << 4;
 
            if ((xuv >> 4) != ruv) {
-               dTHR;
                overflowed = TRUE;
                rnv = (NV) ruv;
                if (ckWARN_d(WARN_OVERFLOW))
@@ -3157,7 +3144,6 @@ Perl_scan_hex(pTHX_ char *start, STRLEN len, STRLEN *retlen)
        || (!overflowed && ruv > 0xffffffff  )
 #endif
        ) {
-       dTHR;
        if (ckWARN(WARN_PORTABLE))
            Perl_warner(aTHX_ WARN_PORTABLE,
                        "Hexadecimal number > 0xffffffff non-portable");
@@ -3169,7 +3155,6 @@ Perl_scan_hex(pTHX_ char *start, STRLEN len, STRLEN *retlen)
 char*
 Perl_find_script(pTHX_ char *scriptname, bool dosearch, char **search_ext, I32 flags)
 {
-    dTHR;
     char *xfound = Nullch;
     char *xfailed = Nullch;
     char tmpbuf[MAXPATHLEN];
@@ -3664,10 +3649,9 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t)
     PL_tainted = t->Ttainted;
     PL_curpm = t->Tcurpm;         /* XXX No PMOP ref count */
     PL_nrs = newSVsv(t->Tnrs);
-    PL_rs = SvREFCNT_inc(PL_nrs);
+    PL_rs = t->Tnrs ? SvREFCNT_inc(PL_nrs) : Nullsv;
     PL_last_in_gv = Nullgv;
-    PL_ofslen = t->Tofslen;
-    PL_ofs = savepvn(t->Tofs, PL_ofslen);
+    PL_ofs_sv = t->Tofs_sv ? SvREFCNT_inc(PL_ofs_sv) : Nullsv;
     PL_defoutgv = (GV*)SvREFCNT_inc(t->Tdefoutgv);
     PL_chopset = t->Tchopset;
     PL_bodytarget = newSVsv(t->Tbodytarget);
@@ -3981,7 +3965,15 @@ Perl_report_evil_fh(pTHX_ GV *gv, IO *io, I32 op)
        name = SvPVX(sv);
     }
 
-    if (name && *name) {
+    if (op == OP_phoney_OUTPUT_ONLY || op == OP_phoney_INPUT_ONLY) {
+       if (name && *name)
+           Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for %sput",
+                       name,
+                       (op == OP_phoney_INPUT_ONLY ? "in" : "out"));
+       else
+           Perl_warner(aTHX_ WARN_IO, "Filehandle opened only for %sput",
+                       (op == OP_phoney_INPUT_ONLY ? "in" : "out"));
+    } else if (name && *name) {
        Perl_warner(aTHX_ warn_type,
                    "%s%s on %s %s %s", func, pars, vile, type, name);
        if (io && IoDIRP(io) && !(IoFLAGS(io) & IOf_FAKE_DIRP))