Perl_sv_vcatpvfn_flags: calc (width - elen) once

[perl5.git] / pp_sys.c

diff --git a/pp_sys.c b/pp_sys.c
index 11193bc..74c8900 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -629,8 +629,7 @@ PP(pp_open)
        IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
 
        if (IoDIRP(io))
-           Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
-                            "Opening dirhandle %" HEKf " also as a file",
+           Perl_croak(aTHX_ "Cannot open %" HEKf " as a filehandle: it is already open as a dirhandle",
                             HEKfARG(GvENAME_HEK(gv)));
 
        mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
@@ -953,13 +952,26 @@ PP(pp_tie)
         */
        stash = gv_stashsv(*MARK, 0);
        if (!stash) {
-           SV *stashname = SvOK(*MARK) ? *MARK : &PL_sv_no;
-           if (!SvCUR(*MARK)) {
-               stashname = sv_2mortal(newSVpvs("main"));
+           if (SvROK(*MARK))
+               DIE(aTHX_ "Can't locate object method \"%s\" via package \"%" SVf "\"",
+                   methname, SVfARG(*MARK));
+           else if (isGV(*MARK)) {
+               /* If the glob doesn't name an existing package, using
+                * SVfARG(*MARK) would yield "*Foo::Bar" or *main::Foo. So
+                * generate the name for the error message explicitly. */
+               SV *stashname = sv_2mortal(newSV(0));
+               gv_fullname4(stashname, (GV *) *MARK, NULL, FALSE);
+               DIE(aTHX_ "Can't locate object method \"%s\" via package \"%" SVf "\"",
+                   methname, SVfARG(stashname));
+           }
+           else {
+               SV *stashname = !SvPOK(*MARK) ? &PL_sv_no
+                             : SvCUR(*MARK)  ? *MARK
+                             :                 sv_2mortal(newSVpvs("main"));
+               DIE(aTHX_ "Can't locate object method \"%s\" via package \"%" SVf "\""
+                   " (perhaps you forgot to load \"%" SVf "\"?)",
+                   methname, SVfARG(stashname), SVfARG(stashname));
            }
-           DIE(aTHX_ "Can't locate object method \"%s\" via package \"%" SVf "\""
-               " (perhaps you forgot to load \"%" SVf "\"?)",
-               methname, SVfARG(stashname), SVfARG(stashname));
        }
        else if (!(gv = gv_fetchmethod(stash, methname))) {
            /* The effective name can only be NULL for stashes that have
@@ -1419,7 +1431,6 @@ PP(pp_enterwrite)
     IO *io;
     GV *fgv;
     CV *cv = NULL;
-    SV *tmpsv = NULL;
 
     if (MAXARG == 0) {
        EXTEND(SP, 1);
@@ -1443,7 +1454,7 @@ PP(pp_enterwrite)
 
     cv = GvFORM(fgv);
     if (!cv) {
-       tmpsv = sv_newmortal();
+        SV * const tmpsv = sv_newmortal();
        gv_efullname4(tmpsv, fgv, NULL, FALSE);
        DIE(aTHX_ "Undefined format \"%" SVf "\" called", SVfARG(tmpsv));
     }
@@ -1647,7 +1658,7 @@ PP(pp_sysopen)
 
     /* Need TIEHANDLE method ? */
     const char * const tmps = SvPV_const(sv, len);
-    if (do_open_raw(gv, tmps, len, mode, perm)) {
+    if (do_open_raw(gv, tmps, len, mode, perm, NULL)) {
        IoLINES(GvIOp(gv)) = 0;
        PUSHs(&PL_sv_yes);
     }
@@ -1719,7 +1730,8 @@ PP(pp_sysread)
     if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTES) {
         if (PL_op->op_type == OP_SYSREAD || PL_op->op_type == OP_RECV) {
             Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
-                             "%s() is deprecated on :utf8 handles",
+                             "%s() is deprecated on :utf8 handles. "
+                             "This will be a fatal error in Perl 5.30",
                              OP_DESC(PL_op));
         }
        buffer = SvPVutf8_force(bufsv, blen);
@@ -1982,7 +1994,8 @@ PP(pp_syswrite)
 
     if (PerlIO_isutf8(IoIFP(io))) {
         Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
-                         "%s() is deprecated on :utf8 handles",
+                         "%s() is deprecated on :utf8 handles. "
+                         "This will be a fatal error in Perl 5.30",
                          OP_DESC(PL_op));
        if (!SvUTF8(bufsv)) {
            /* We don't modify the original scalar.  */
@@ -4007,9 +4020,8 @@ PP(pp_open_dir)
     IO * const io = GvIOn(gv);
 
     if ((IoIFP(io) || IoOFP(io)))
-       Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
-                        "Opening filehandle %" HEKf " also as a directory",
-                            HEKfARG(GvENAME_HEK(gv)) );
+       Perl_croak(aTHX_ "Cannot open %" HEKf " as a dirhandle: it is already open as a filehandle",
+                        HEKfARG(GvENAME_HEK(gv)));
     if (IoDIRP(io))
        PerlDir_close(IoDIRP(io));
     if (!(IoDIRP(io) = PerlDir_open(dirname)))
@@ -4424,10 +4436,9 @@ PP(pp_system)
            if (did_pipes) {
                int errkid;
                unsigned n = 0;
-               SSize_t n1;
 
                while (n < sizeof(int)) {
-                   n1 = PerlLIO_read(pp[0],
+                    const SSize_t n1 = PerlLIO_read(pp[0],
                                      (void*)(((char*)&errkid)+n),
                                      (sizeof(int)) - n);
                    if (n1 <= 0)
@@ -4836,7 +4847,6 @@ PP(pp_alarm)
 PP(pp_sleep)
 {
     dSP; dTARGET;
-    I32 duration;
     Time_t lasttime;
     Time_t when;
 
@@ -4844,7 +4854,7 @@ PP(pp_sleep)
     if (MAXARG < 1 || (!TOPs && !POPs))
        PerlProc_pause();
     else {
-       duration = POPi;
+        const I32 duration = POPi;
         if (duration < 0) {
           /* diag_listed_as: %s() with negative argument */
           Perl_ck_warner_d(aTHX_ packWARN(WARN_MISC),