X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/1fddc1283eec7855a9c74204f8f4db3b35be302a..0332277c8f33d749dd96379675440b8a735c87d9:/doio.c

diff --git a/doio.c b/doio.c
index 9d06cbe..47b60ce 100644
--- a/doio.c
+++ b/doio.c
@@ -126,8 +126,9 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 	if (result == EOF && fd > PL_maxsysfd) {
 	    /* Why is this not Perl_warn*() call ? */
 	    PerlIO_printf(Perl_error_log,
-			  "Warning: unable to close filehandle %"SVf" properly.\n",
-			  SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(gv)))));
+		"Warning: unable to close filehandle %"HEKf" properly.\n",
+		 HEKfARG(GvENAME_HEK(gv))
+	    );
 	}
 	IoOFP(io) = IoIFP(io) = NULL;
     }
@@ -541,14 +542,16 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 	if ((IoTYPE(io) == IoTYPE_RDONLY) &&
 	    (fp == PerlIO_stdout() || fp == PerlIO_stderr())) {
 		Perl_warner(aTHX_ packWARN(WARN_IO),
-			    "Filehandle STD%s reopened as %"SVf" only for input",
+			    "Filehandle STD%s reopened as %"HEKf
+			    " only for input",
 			    ((fp == PerlIO_stdout()) ? "OUT" : "ERR"),
-			    SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(gv)))));
+			    HEKfARG(GvENAME_HEK(gv)));
 	}
 	else if ((IoTYPE(io) == IoTYPE_WRONLY) && fp == PerlIO_stdin()) {
 		Perl_warner(aTHX_ packWARN(WARN_IO),
-			    "Filehandle STDIN reopened as %"SVf" only for output",
-			    SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(gv)))));
+		    "Filehandle STDIN reopened as %"HEKf" only for output",
+		     HEKfARG(GvENAME_HEK(gv))
+		);
 	}
     }
 
@@ -1337,8 +1340,9 @@ Perl_my_lstat_flags(pTHX_ const U32 flags)
 	    return PL_laststatval;
 	}
 	if (ckWARN(WARN_IO)) {
-	    Perl_warner(aTHX_ packWARN(WARN_IO), "Use of -l on filehandle %"SVf,
-		    SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(cGVOP_gv)))));
+	    Perl_warner(aTHX_ packWARN(WARN_IO),
+		 	     "Use of -l on filehandle %"HEKf,
+			      HEKfARG(GvENAME_HEK(cGVOP_gv)));
 	}
 	return (PL_laststatval = -1);
     }
@@ -1567,6 +1571,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
     register I32 tot = 0;
     const char *const what = PL_op_name[type];
     const char *s;
+    STRLEN len;
     SV ** const oldmark = mark;
 
     PERL_ARGS_ASSERT_APPLY;
@@ -1677,12 +1682,14 @@ nothing in the core.
 	APPLY_TAINT_PROPER();
 	if (mark == sp)
 	    break;
-	s = SvPVx_nolen_const(*++mark);
+	s = SvPVx_const(*++mark, len);
 	if (isALPHA(*s)) {
-	    if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
+	    if (*s == 'S' && s[1] == 'I' && s[2] == 'G') {
 		s += 3;
-	    if ((val = whichsig(s)) < 0)
-		Perl_croak(aTHX_ "Unrecognized signal name \"%s\"",s);
+                len -= 3;
+            }
+           if ((val = whichsig_pvn(s, len)) < 0)
+               Perl_croak(aTHX_ "Unrecognized signal name \"%"SVf"\"", SVfARG(*mark));
 	}
 	else
 	    val = SvIV(*mark);
@@ -2372,7 +2379,13 @@ Perl_vms_start_glob
 #endif
 #endif /* !CSH */
 #endif /* !DOSISH */
-    save_hash(gv_fetchpvs("ENV", 0, SVt_PVHV));
+    {
+	GV * const envgv = gv_fetchpvs("ENV", 0, SVt_PVHV);
+	SV ** const home = hv_fetchs(GvHV(envgv), "HOME", 0);
+	if (home && *home) SvGETMAGIC(*home);
+	save_hash(gv_fetchpvs("ENV", 0, SVt_PVHV));
+	if (home && *home) SvSETMAGIC(*home);
+    }
     (void)do_open(PL_last_in_gv, (char*)SvPVX_const(tmpcmd), SvCUR(tmpcmd),
 		  FALSE, O_RDONLY, 0, NULL);
     fp = IoIFP(io);