X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_sys.c;h=833e5656aff6a5b2b99196681ecfa7f33c0ded08;hb=bc3f1c14f93bf857a045b618293617218d759095;hp=d73772b9898a2aaa91ad56040c1bfe3460295cf3;hpb=f9c764c5b8dcfa74adde8337ee9a5db227b55f56;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_sys.c b/pp_sys.c
index d73772b..833e565 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -762,8 +762,12 @@ PP(pp_binmode)
 
     PUTBACK;
     {
-	const int mode = mode_from_discipline(discp);
-	const char *const d = (discp ? SvPV_nolen_const(discp) : NULL);
+	STRLEN len = 0;
+	const char *d = NULL;
+	int mode;
+	if (discp)
+	    d = SvPV_const(discp, len);
+	mode = mode_from_discipline(d, len);
 	if (PerlIO_binmode(aTHX_ fp, IoTYPE(io), mode, d)) {
 	    if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {
 		if (!PerlIO_binmode(aTHX_ IoOFP(io), IoTYPE(io), mode, d)) {
@@ -821,7 +825,7 @@ PP(pp_tie)
 	    break;
     }
     items = SP - MARK++;
-    if (sv_isobject(*MARK)) {
+    if (sv_isobject(*MARK)) { /* Calls GET magic. */
 	ENTER;
 	PUSHSTACKi(PERLSI_MAGIC);
 	PUSHMARK(SP);
@@ -835,10 +839,12 @@ PP(pp_tie)
 	/* Not clear why we don't call call_method here too.
 	 * perhaps to get different error message ?
 	 */
-	stash = gv_stashsv(*MARK, 0);
+	STRLEN len;
+	const char *name = SvPV_nomg_const(*MARK, len);
+	stash = gv_stashpvn(name, len, 0);
 	if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
 	    DIE(aTHX_ "Can't locate object method \"%s\" via package \"%"SVf"\"",
-		 methname, SVfARG(*MARK));
+		 methname, SVfARG(SvOK(*MARK) ? *MARK : &PL_sv_no));
 	}
 	ENTER;
 	PUSHSTACKi(PERLSI_MAGIC);
@@ -942,7 +948,7 @@ PP(pp_dbmopen)
 	PUTBACK;
 	require_pv("AnyDBM_File.pm");
 	SPAGAIN;
-	if (!(gv = gv_fetchmethod(stash, "TIEHASH")))
+	if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH")))
 	    DIE(aTHX_ "No dbm on this machine");
     }
 
@@ -1240,6 +1246,8 @@ S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
     register PERL_CONTEXT *cx;
     const I32 gimme = GIMME_V;
 
+    PERL_ARGS_ASSERT_DOFORM;
+
     ENTER;
     SAVETMPS;
 
@@ -3597,6 +3605,8 @@ S_dooneliner(pTHX_ const char *cmd, const char *filename)
     int anum = 1;
     Size_t size = strlen(cmd) + (strlen(filename) * 2) + 10;
 
+    PERL_ARGS_ASSERT_DOONELINER;
+
     Newx(cmdline, size, char);
     my_strlcpy(cmdline, cmd, size);
     my_strlcat(cmdline, " ", size);
@@ -4161,14 +4171,14 @@ PP(pp_system)
     result = 0;
     if (PL_op->op_flags & OPf_STACKED) {
 	SV * const really = *++MARK;
-#  if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__)
+#  if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__) || defined(__VMS)
 	value = (I32)do_aspawn(really, MARK, SP);
 #  else
 	value = (I32)do_aspawn(really, (void **)MARK, (void **)SP);
 #  endif
     }
     else if (SP - MARK != 1) {
-#  if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__)
+#  if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__) || defined(__VMS)
 	value = (I32)do_aspawn(NULL, MARK, SP);
 #  else
 	value = (I32)do_aspawn(NULL, (void **)MARK, (void **)SP);
@@ -4604,6 +4614,8 @@ S_space_join_names_mortal(pTHX_ char *const *array)
 {
     SV *target;
 
+    PERL_ARGS_ASSERT_SPACE_JOIN_NAMES_MORTAL;
+
     if (array && *array) {
 	target = newSVpvs_flags("", SVs_TEMP);
 	while (1) {
@@ -4933,7 +4945,7 @@ PP(pp_snetent)
 {
 #ifdef HAS_SETNETENT
     dVAR; dSP;
-    PerlSock_setnetent(TOPi);
+    (void)PerlSock_setnetent(TOPi);
     RETSETYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "setnetent");
@@ -4944,7 +4956,7 @@ PP(pp_sprotoent)
 {
 #ifdef HAS_SETPROTOENT
     dVAR; dSP;
-    PerlSock_setprotoent(TOPi);
+    (void)PerlSock_setprotoent(TOPi);
     RETSETYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "setprotoent");
@@ -4955,7 +4967,7 @@ PP(pp_sservent)
 {
 #ifdef HAS_SETSERVENT
     dVAR; dSP;
-    PerlSock_setservent(TOPi);
+    (void)PerlSock_setservent(TOPi);
     RETSETYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "setservent");