EBCDIC: the non-printable characters are different.
[p5sagit/p5-mst-13.2.git] / pp_sys.c
index b14ab9c..e7e4121 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1,6 +1,6 @@
 /*    pp_sys.c
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-2002, 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.
@@ -838,24 +838,26 @@ PP(pp_untie)
        SV *obj = SvRV(mg->mg_obj);
        GV *gv;
        CV *cv = NULL;
-       if ((gv = gv_fetchmethod_autoload(SvSTASH(obj), "UNTIE", FALSE)) &&
-            isGV(gv) && (cv = GvCV(gv))) {
-           PUSHMARK(SP);
-           XPUSHs(SvTIED_obj((SV*)gv, mg));
-           XPUSHs(sv_2mortal(newSViv(SvREFCNT(obj)-1)));
-           PUTBACK;
-           ENTER;
-           call_sv((SV *)cv, G_VOID);
-           LEAVE;
-           SPAGAIN;
-        }
-        else if (ckWARN(WARN_UNTIE)) {
-           if (mg && SvREFCNT(obj) > 1)
-               Perl_warner(aTHX_ WARN_UNTIE,
-                   "untie attempted while %"UVuf" inner references still exist",
-                   (UV)SvREFCNT(obj) - 1 ) ;
+        if (obj) {
+           if ((gv = gv_fetchmethod_autoload(SvSTASH(obj), "UNTIE", FALSE)) &&
+               isGV(gv) && (cv = GvCV(gv))) {
+              PUSHMARK(SP);
+              XPUSHs(SvTIED_obj((SV*)gv, mg));
+              XPUSHs(sv_2mortal(newSViv(SvREFCNT(obj)-1)));
+              PUTBACK;
+              ENTER;
+              call_sv((SV *)cv, G_VOID);
+              LEAVE;
+              SPAGAIN;
+            }
+           else if (ckWARN(WARN_UNTIE)) {
+              if (mg && SvREFCNT(obj) > 1)
+                 Perl_warner(aTHX_ WARN_UNTIE,
+                     "untie attempted while %"UVuf" inner references still exist",
+                      (UV)SvREFCNT(obj) - 1 ) ;
+           }
         }
-       sv_unmagic(sv, how);
+       sv_unmagic(sv, how) ;
     }
     RETPUSHYES;
 }
@@ -1892,7 +1894,7 @@ PP(pp_eof)
     if (MAXARG == 0) {
        if (PL_op->op_flags & OPf_SPECIAL) {    /* eof() */
            IO *io;
-           gv = PL_last_in_gv = PL_argvgv;
+           gv = PL_last_in_gv = GvEGV(PL_argvgv);
            io = GvIO(gv);
            if (io && !IoIFP(io)) {
                if ((IoFLAGS(io) & IOf_START) && av_len(GvAVn(gv)) < 0) {
@@ -2280,7 +2282,7 @@ PP(pp_socket)
 
 PP(pp_sockpair)
 {
-#if defined (HAS_SOCKETPAIR) || defined (HAS_SOCKET)
+#if defined (HAS_SOCKETPAIR) || (defined (HAS_SOCKET) && defined(SOCK_DGRAM))
     dSP;
     GV *gv1;
     GV *gv2;
@@ -2724,12 +2726,12 @@ PP(pp_stat)
     if (PL_op->op_flags & OPf_REF) {
        gv = cGVOP_gv;
        if (PL_op->op_type == OP_LSTAT) {
-           if (PL_laststype != OP_LSTAT)
-               Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat");
-           if (ckWARN(WARN_IO) && gv != PL_defgv)
-               Perl_warner(aTHX_ WARN_IO,
+           if (gv != PL_defgv) {
+               if (ckWARN(WARN_IO))
+                   Perl_warner(aTHX_ WARN_IO,
                        "lstat() on filehandle %s", GvENAME(gv));
-               /* Perl_my_lstat (-l) croak's on filehandle, why warn here? */
+           } else if (PL_laststype != OP_LSTAT)
+               Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat");
        }
 
       do_fstat:
@@ -2754,6 +2756,9 @@ PP(pp_stat)
        }
        else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
            gv = (GV*)SvRV(sv);
+           if (PL_op->op_type == OP_LSTAT && ckWARN(WARN_IO))
+               Perl_warner(aTHX_ WARN_IO,
+                       "lstat() on filehandle %s", GvENAME(gv));
            goto do_fstat;
        }
        sv_setpv(PL_statname, SvPV(sv,n_a));
@@ -3309,6 +3314,7 @@ PP(pp_fttext)
       really_filename:
        PL_statgv = Nullgv;
        PL_laststatval = -1;
+       PL_laststype = OP_STAT;
        sv_setpv(PL_statname, SvPV(sv, n_a));
        if (!(fp = PerlIO_open(SvPVX(PL_statname), "r"))) {
            if (ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n'))