X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doio.c;h=6b0c9f2840ce66fc413be25d116763766d289aad;hb=9d0f7ed7530aacfa94e94c3784145f348ffa6be9;hp=65adf910d5735ec46dff9a47ae4bf07add60bb59;hpb=c8ae91a8d996e65182b5522ff8f511a834fac9c1;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/doio.c b/doio.c
index 65adf91..6b0c9f2 100644
--- a/doio.c
+++ b/doio.c
@@ -79,6 +79,8 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
     char mode[PERL_MODE_MAX];	/* file mode ("r\0", "rb\0", "ab\0" etc.) */
     SV *namesv;
 
+    PERL_ARGS_ASSERT_DO_OPENN;
+
     Zero(mode,sizeof(mode),char);
     PL_forkprocess = 1;		/* assume true if no fork */
 
@@ -176,7 +178,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 
         IoTYPE(io) = PerlIO_intmode2str(rawmode, &mode[ix], &writing);
 
-	namesv = sv_2mortal(newSVpv(oname,0));
+	namesv = newSVpvn_flags(oname, len, SVs_TEMP);
 	num_svs = 1;
 	svp = &namesv;
 	type = NULL;
@@ -259,9 +261,9 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 	    mode[0] = 'w';
 	    writing = 1;
             if (out_raw)
-                my_strlcat(mode, "b", PERL_MODE_MAX - 1);
+		mode[1] = 'b';
             else if (out_crlf)
-                my_strlcat(mode, "t", PERL_MODE_MAX - 1); 
+		mode[1] = 't';
 	    if (num_svs > 1) {
 		fp = PerlProc_popen_list(mode, num_svs, svp);
 	    }
@@ -290,9 +292,9 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 	    writing = 1;
 
             if (out_raw)
-                my_strlcat(mode, "b", PERL_MODE_MAX - 1);
+		mode[1] = 'b';
             else if (out_crlf)
-                my_strlcat(mode, "t", PERL_MODE_MAX - 1);
+		mode[1] = 't';
 	    if (*type == '&') {
 	      duplicity:
 		dodup = PERLIO_DUP_FD;
@@ -399,7 +401,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 		}
 		else  {
 		    if (!num_svs) {
-			namesv = sv_2mortal(newSVpvn(type,tend - type));
+			namesv = newSVpvn_flags(type, tend - type, SVs_TEMP);
 			num_svs = 1;
 			svp = &namesv;
 		        type = NULL;
@@ -416,9 +418,9 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 	    } while (isSPACE(*type));
 	    mode[0] = 'r';
             if (in_raw)
-                my_strlcat(mode, "b", PERL_MODE_MAX - 1);
+		mode[1] = 'b';
             else if (in_crlf)
-                my_strlcat(mode, "t", PERL_MODE_MAX - 1);
+		mode[1] = 't';
 	    if (*type == '&') {
 		goto duplicity;
 	    }
@@ -432,7 +434,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 	    }
 	    else {
 		if (!num_svs) {
-		    namesv = sv_2mortal(newSVpvn(type,tend - type));
+		    namesv = newSVpvn_flags(type, tend - type, SVs_TEMP);
 		    num_svs = 1;
 		    svp = &namesv;
 		    type = NULL;
@@ -470,9 +472,9 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 	    mode[0] = 'r';
 
             if (in_raw)
-                my_strlcat(mode, "b", PERL_MODE_MAX - 1);
+		mode[1] = 'b';
             else if (in_crlf)
-                my_strlcat(mode, "t", PERL_MODE_MAX - 1);
+		mode[1] = 't';
 
 	    if (num_svs > 1) {
 		fp = PerlProc_popen_list(mode,num_svs,svp);
@@ -501,9 +503,9 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 	    mode[0] = 'r';
 
             if (in_raw)
-                my_strlcat(mode, "b", PERL_MODE_MAX - 1);
+		mode[1] = 'b';
             else if (in_crlf)
-                my_strlcat(mode, "t", PERL_MODE_MAX - 1);
+		mode[1] = 't';
 
 	    if (*name == '-' && name[1] == '\0') {
 		fp = PerlIO_stdin();
@@ -511,7 +513,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 	    }
 	    else {
 		if (!num_svs) {
-		    namesv = sv_2mortal(newSVpvn(type,tend - type));
+		    namesv = newSVpvn_flags(type, tend - type, SVs_TEMP);
 		    num_svs = 1;
 		    svp = &namesv;
 		    type = NULL;
@@ -705,6 +707,8 @@ Perl_nextargv(pTHX_ register GV *gv)
     Gid_t filegid;
     IO * const io = GvIOp(gv);
 
+    PERL_ARGS_ASSERT_NEXTARGV;
+
     if (!PL_argvoutgv)
 	PL_argvoutgv = gv_fetchpvs("ARGVOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
     if (io && (IoFLAGS(io) & IOf_ARGV) && (IoFLAGS(io) & IOf_START)) {
@@ -952,6 +956,8 @@ Perl_io_close(pTHX_ IO *io, bool not_implicit)
     dVAR;
     bool retval = FALSE;
 
+    PERL_ARGS_ASSERT_IO_CLOSE;
+
     if (IoIFP(io)) {
 	if (IoTYPE(io) == IoTYPE_PIPE) {
 	    const int status = PerlProc_pclose(IoIFP(io));
@@ -991,6 +997,8 @@ Perl_do_eof(pTHX_ GV *gv)
     dVAR;
     register IO * const io = GvIO(gv);
 
+    PERL_ARGS_ASSERT_DO_EOF;
+
     if (!io)
 	return TRUE;
     else if ((IoTYPE(io) == IoTYPE_WRONLY) && ckWARN(WARN_IO))
@@ -1035,6 +1043,8 @@ Perl_do_tell(pTHX_ GV *gv)
     register IO *io = NULL;
     register PerlIO *fp;
 
+    PERL_ARGS_ASSERT_DO_TELL;
+
     if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) {
 #ifdef ULTRIX_STDIO_BOTCH
 	if (PerlIO_eof(fp))
@@ -1075,6 +1085,8 @@ Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence)
     register IO *io = NULL;
     register PerlIO *fp;
 
+    PERL_ARGS_ASSERT_DO_SYSSEEK;
+
     if (gv && (io = GvIO(gv)) && (fp = IoIFP(io)))
 	return PerlLIO_lseek(PerlIO_fileno(fp), pos, whence);
     if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
@@ -1196,6 +1208,9 @@ bool
 Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
 {
     dVAR;
+
+    PERL_ARGS_ASSERT_DO_PRINT;
+
     /* assuming fp is checked earlier */
     if (!sv)
 	return TRUE;
@@ -1328,6 +1343,7 @@ Perl_my_lstat(pTHX)
     static const char no_prev_lstat[] = "The stat preceding -l _ wasn't an lstat";
     dSP;
     SV *sv;
+    const char *file;
     if (PL_op->op_flags & OPf_REF) {
 	EXTEND(SP,1);
 	if (cGVOP_gv == PL_defgv) {
@@ -1354,10 +1370,10 @@ Perl_my_lstat(pTHX)
 		GvENAME((GV*) SvRV(sv)));
 	return (PL_laststatval = -1);
     }
-    /* XXX Do really need to be calling SvPV() all these times? */
-    sv_setpv(PL_statname,SvPV_nolen_const(sv));
-    PL_laststatval = PerlLIO_lstat(SvPV_nolen_const(sv),&PL_statcache);
-    if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(sv), '\n'))
+    file = SvPV_nolen_const(sv);
+    sv_setpv(PL_statname,file);
+    PL_laststatval = PerlLIO_lstat(file,&PL_statcache);
+    if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(file, '\n'))
 	Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "lstat");
     return PL_laststatval;
 }
@@ -1366,6 +1382,7 @@ static void
 S_exec_failed(pTHX_ const char *cmd, int fd, int do_report)
 {
     const int e = errno;
+    PERL_ARGS_ASSERT_EXEC_FAILED;
     if (ckWARN(WARN_EXEC))
 	Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
 		    cmd, Strerror(e));
@@ -1380,18 +1397,19 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
 	       int fd, int do_report)
 {
     dVAR;
+    PERL_ARGS_ASSERT_DO_AEXEC5;
 #if defined(MACOS_TRADITIONAL) || defined(__SYMBIAN32__) || defined(__LIBCATAMOUNT__)
     Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system");
 #else
     if (sp > mark) {
-	char **a;
+	const char **a;
 	const char *tmps = NULL;
-	Newx(PL_Argv, sp - mark + 1, char*);
+	Newx(PL_Argv, sp - mark + 1, const char*);
 	a = PL_Argv;
 
 	while (++mark <= sp) {
 	    if (*mark)
-		*a++ = (char*)SvPV_nolen_const(*mark);
+		*a++ = SvPV_nolen_const(*mark);
 	    else
 		*a++ = "";
 	}
@@ -1430,16 +1448,18 @@ bool
 Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
 {
     dVAR;
-    register char **a;
+    register const char **a;
     register char *s;
     char *buf;
     char *cmd;
-
     /* Make a copy so we can change it */
     const Size_t cmdlen = strlen(incmd) + 1;
+
+    PERL_ARGS_ASSERT_DO_EXEC3;
+
     Newx(buf, cmdlen, char);
     cmd = buf;
-    my_strlcpy(cmd, incmd, cmdlen);
+    memcpy(cmd, incmd, cmdlen);
 
     while (*cmd && isSPACE(*cmd))
 	cmd++;
@@ -1526,7 +1546,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
 	}
     }
 
-    Newx(PL_Argv, (s - cmd) / 2 + 2, char*);
+    Newx(PL_Argv, (s - cmd) / 2 + 2, const char*);
     PL_Cmd = savepvn(cmd, s-cmd);
     a = PL_Argv;
     for (s = PL_Cmd; *s;) {
@@ -1542,7 +1562,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
     *a = NULL;
     if (PL_Argv[0]) {
 	PERL_FPU_PRE_EXEC
-	PerlProc_execvp(PL_Argv[0],PL_Argv);
+	PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
 	PERL_FPU_POST_EXEC
 	if (errno == ENOEXEC) {		/* for system V NIH syndrome */
 	    do_execfree();
@@ -1567,6 +1587,8 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
     const char *s;
     SV ** const oldmark = mark;
 
+    PERL_ARGS_ASSERT_APPLY;
+
     /* Doing this ahead of the switch statement preserves the old behaviour,
        where attempting to use kill as a taint test test would fail on
        platforms where kill was not defined.  */
@@ -1869,6 +1891,9 @@ Perl_cando(pTHX_ Mode_t mode, bool effective, register const Stat_t *statbufp)
  */
 {
     dVAR;
+
+    PERL_ARGS_ASSERT_CANDO;
+
 #ifdef DOSISH
     /* [Comments and code from Len Reed]
      * MS-DOS "user" is similar to UNIX's "superuser," but can't write
@@ -1962,6 +1987,7 @@ Perl_do_ipcget(pTHX_ I32 optype, SV **mark, SV **sp)
     const I32 n = (optype == OP_MSGGET) ? 0 : SvIVx(*++mark);
     const I32 flags = SvIVx(*++mark);
 
+    PERL_ARGS_ASSERT_DO_IPCGET;
     PERL_UNUSED_ARG(sp);
 
     SETERRNO(0,0);
@@ -2002,6 +2028,7 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp)
     STRLEN infosize = 0;
     I32 getinfo = (cmd == IPC_STAT);
 
+    PERL_ARGS_ASSERT_DO_IPCCTL;
     PERL_UNUSED_ARG(sp);
 
     switch (optype)
@@ -2124,6 +2151,7 @@ Perl_do_msgsnd(pTHX_ SV **mark, SV **sp)
     const char * const mbuf = SvPV_const(mstr, len);
     const I32 msize = len - sizeof(long);
 
+    PERL_ARGS_ASSERT_DO_MSGSND;
     PERL_UNUSED_ARG(sp);
 
     if (msize < 0)
@@ -2131,6 +2159,8 @@ Perl_do_msgsnd(pTHX_ SV **mark, SV **sp)
     SETERRNO(0,0);
     return msgsnd(id, (struct msgbuf *)mbuf, msize, flags);
 #else
+    PERL_UNUSED_ARG(sp);
+    PERL_UNUSED_ARG(mark);
     Perl_croak(aTHX_ "msgsnd not implemented");
 #endif
 }
@@ -2145,6 +2175,8 @@ Perl_do_msgrcv(pTHX_ SV **mark, SV **sp)
     I32 msize, flags, ret;
     const I32 id = SvIVx(*++mark);
     SV * const mstr = *++mark;
+
+    PERL_ARGS_ASSERT_DO_MSGRCV;
     PERL_UNUSED_ARG(sp);
 
     /* suppress warning when reading into undef var --jhi */
@@ -2168,6 +2200,8 @@ Perl_do_msgrcv(pTHX_ SV **mark, SV **sp)
     }
     return ret;
 #else
+    PERL_UNUSED_ARG(sp);
+    PERL_UNUSED_ARG(mark);
     Perl_croak(aTHX_ "msgrcv not implemented");
 #endif
 }
@@ -2181,6 +2215,8 @@ Perl_do_semop(pTHX_ SV **mark, SV **sp)
     const I32 id = SvIVx(*++mark);
     SV * const opstr = *++mark;
     const char * const opbuf = SvPV_const(opstr, opsize);
+
+    PERL_ARGS_ASSERT_DO_SEMOP;
     PERL_UNUSED_ARG(sp);
 
     if (opsize < 3 * SHORTSIZE
@@ -2235,6 +2271,8 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
     SV * const mstr = *++mark;
     const I32 mpos = SvIVx(*++mark);
     const I32 msize = SvIVx(*++mark);
+
+    PERL_ARGS_ASSERT_DO_SHMIO;
     PERL_UNUSED_ARG(sp);
 
     SETERRNO(0,0);
@@ -2301,6 +2339,9 @@ Perl_start_glob (pTHX_ SV *tmpglob, IO *io)
     dVAR;
     SV * const tmpcmd = newSV(0);
     PerlIO *fp;
+
+    PERL_ARGS_ASSERT_START_GLOB;
+
     ENTER;
     SAVEFREESV(tmpcmd);
 #ifdef VMS /* expand the wildcards right here, rather than opening a pipe, */