X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=934c7764751908b1b277c0e4627f88448e4c0f1a;hb=e5cf08def37eb3e6aae76e85f2a3156394cae970;hp=31c542e8da5999bc562633cc59d46a56ad148842;hpb=760ac839baf413929cd31cc32ffd6dba6b781a81;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/mg.c b/mg.c
index 31c542e..934c776 100644
--- a/mg.c
+++ b/mg.c
@@ -15,11 +15,16 @@
 #include "EXTERN.h"
 #include "perl.h"
 
-/* Omit -- it causes too much grief on mixed systems.
+/* XXX If this causes problems, set i_unistd=undef in the hint file.  */
 #ifdef I_UNISTD
 # include <unistd.h>
 #endif
-*/
+
+#ifdef HAS_GETGROUPS
+#  ifndef NGROUPS
+#    define NGROUPS 32
+#  endif
+#endif
 
 /*
  * Use the "DESTRUCTOR" scope cleanup to reinstate magic.
@@ -70,7 +75,7 @@ void* p;
 	    SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
     }
 
-    safefree((void *)mgs);
+    Safefree(mgs);
 }
 
 
@@ -338,7 +343,7 @@ MAGIC *mg;
 	sv_setsv(sv, bodytarget);
 	break;
     case '\004':		/* ^D */
-	sv_setiv(sv,(I32)(debug & 32767));
+	sv_setiv(sv, (IV)(debug & 32767));
 	break;
     case '\005':  /* ^E */
 #ifdef VMS
@@ -347,7 +352,7 @@ MAGIC *mg;
 #	    include <starlet.h>
 	    char msg[255];
 	    $DESCRIPTOR(msgdsc,msg);
-	    sv_setnv(sv,(double)vaxc$errno);
+	    sv_setnv(sv,(double) vaxc$errno);
 	    if (sys$getmsg(vaxc$errno,&msgdsc.dsc$w_length,&msgdsc,0,0) & 1)
 		sv_setpvn(sv,msgdsc.dsc$a_pointer,msgdsc.dsc$w_length);
 	    else
@@ -355,42 +360,42 @@ MAGIC *mg;
 	}
 #else
 #ifdef OS2
-	sv_setnv(sv,(double)Perl_rc);
+	sv_setnv(sv, (double)Perl_rc);
 	sv_setpv(sv, os2error(Perl_rc));
 #else
-	sv_setnv(sv,(double)errno);
+	sv_setnv(sv, (double)errno);
 	sv_setpv(sv, errno ? Strerror(errno) : "");
 #endif
 #endif
 	SvNOK_on(sv);	/* what a wonderful hack! */
 	break;
     case '\006':		/* ^F */
-	sv_setiv(sv,(I32)maxsysfd);
+	sv_setiv(sv, (IV)maxsysfd);
 	break;
     case '\010':		/* ^H */
-	sv_setiv(sv,(I32)hints);
+	sv_setiv(sv, (IV)hints);
 	break;
     case '\t':			/* ^I */
 	if (inplace)
 	    sv_setpv(sv, inplace);
 	else
-	    sv_setsv(sv,&sv_undef);
+	    sv_setsv(sv, &sv_undef);
 	break;
     case '\017':		/* ^O */
-	sv_setpv(sv,osname);
+	sv_setpv(sv, osname);
 	break;
     case '\020':		/* ^P */
-	sv_setiv(sv,(I32)perldb);
+	sv_setiv(sv, (IV)perldb);
 	break;
     case '\024':		/* ^T */
 #ifdef BIG_TIME
- 	sv_setnv(sv,basetime);
+ 	sv_setnv(sv, basetime);
 #else
-	sv_setiv(sv,(I32)basetime);
+	sv_setiv(sv, (IV)basetime);
 #endif
 	break;
     case '\027':		/* ^W */
-	sv_setiv(sv,(I32)dowarn);
+	sv_setiv(sv, (IV)dowarn);
 	break;
     case '1': case '2': case '3': case '4':
     case '5': case '6': case '7': case '8': case '9': case '&':
@@ -447,12 +452,12 @@ MAGIC *mg;
     case '.':
 #ifndef lint
 	if (GvIO(last_in_gv)) {
-	    sv_setiv(sv,(I32)IoLINES(GvIO(last_in_gv)));
+	    sv_setiv(sv, (IV)IoLINES(GvIO(last_in_gv)));
 	}
 #endif
 	break;
     case '?':
-	sv_setiv(sv,(I32)statusvalue);
+	sv_setiv(sv, (IV)statusvalue);
 	break;
     case '^':
 	s = IoTOP_NAME(GvIOp(defoutgv));
@@ -471,13 +476,13 @@ MAGIC *mg;
 	break;
 #ifndef lint
     case '=':
-	sv_setiv(sv,(I32)IoPAGE_LEN(GvIOp(defoutgv)));
+	sv_setiv(sv, (IV)IoPAGE_LEN(GvIOp(defoutgv)));
 	break;
     case '-':
-	sv_setiv(sv,(I32)IoLINES_LEFT(GvIOp(defoutgv)));
+	sv_setiv(sv, (IV)IoLINES_LEFT(GvIOp(defoutgv)));
 	break;
     case '%':
-	sv_setiv(sv,(I32)IoPAGE(GvIOp(defoutgv)));
+	sv_setiv(sv, (IV)IoPAGE(GvIOp(defoutgv)));
 	break;
 #endif
     case ':':
@@ -485,10 +490,10 @@ MAGIC *mg;
     case '/':
 	break;
     case '[':
-	sv_setiv(sv,(I32)curcop->cop_arybase);
+	sv_setiv(sv, (IV)curcop->cop_arybase);
 	break;
     case '|':
-	sv_setiv(sv, (IoFLAGS(GvIOp(defoutgv)) & IOf_FLUSH) != 0 );
+	sv_setiv(sv, (IV)(IoFLAGS(GvIOp(defoutgv)) & IOf_FLUSH) != 0 );
 	break;
     case ',':
 	sv_setpvn(sv,ofs,ofslen);
@@ -501,12 +506,12 @@ MAGIC *mg;
 	break;
     case '!':
 #ifdef VMS
-	sv_setnv(sv,(double)((errno == EVMSERR) ? vaxc$errno : errno));
+	sv_setnv(sv, (double)((errno == EVMSERR) ? vaxc$errno : errno));
 	sv_setpv(sv, errno ? Strerror(errno) : "");
 #else
 	{
 	int saveerrno = errno;
-	sv_setnv(sv,(double)errno);
+	sv_setnv(sv, (double)errno);
 #ifdef OS2
 	if (errno == errno_isOS2) sv_setpv(sv, os2error(Perl_rc));
 	else
@@ -518,35 +523,35 @@ MAGIC *mg;
 	SvNOK_on(sv);	/* what a wonderful hack! */
 	break;
     case '<':
-	sv_setiv(sv,(I32)uid);
+	sv_setiv(sv, (IV)uid);
 	break;
     case '>':
-	sv_setiv(sv,(I32)euid);
+	sv_setiv(sv, (IV)euid);
 	break;
     case '(':
+	sv_setiv(sv, (IV)gid);
 	s = buf;
 	(void)sprintf(s,"%d",(int)gid);
 	goto add_groups;
     case ')':
+	sv_setiv(sv, (IV)egid);
 	s = buf;
 	(void)sprintf(s,"%d",(int)egid);
       add_groups:
 	while (*s) s++;
 #ifdef HAS_GETGROUPS
-#ifndef NGROUPS
-#define NGROUPS 32
-#endif
 	{
 	    Groups_t gary[NGROUPS];
 
 	    i = getgroups(NGROUPS,gary);
 	    while (--i >= 0) {
-		(void)sprintf(s," %ld", (long)gary[i]);
+		(void)sprintf(s," %d", (int)gary[i]);
 		while (*s) s++;
 	    }
 	}
 #endif
 	sv_setpv(sv,buf);
+	SvNOK_on(sv);	/* what a wonderful hack! */
 	break;
     case '*':
 	break;
@@ -578,15 +583,19 @@ MAGIC* mg;
     STRLEN len;
     I32 i;
     s = SvPV(sv,len);
-    ptr = (mg->mg_len == HEf_SVKEY) ? SvPV((SV*)mg->mg_ptr, na) : mg->mg_ptr;
+    ptr = MgPV(mg);
     my_setenv(ptr, s);
 #ifdef DYNAMIC_ENV_FETCH
      /* We just undefd an environment var.  Is a replacement */
      /* waiting in the wings? */
     if (!len) {
 	HE *envhe;
-	if (envhe = hv_fetch_ent(GvHVn(envgv),HeSVKEY((HE*)(mg->mg_ptr)),FALSE,0))
+	SV *keysv;
+	if (mg->mg_len == HEf_SVKEY) keysv = (SV *)mg->mg_ptr;
+	else keysv = newSVpv(mg->mg_ptr,mg->mg_len);
+	if (envhe = hv_fetch_ent(GvHVn(envgv),keysv,FALSE,0))
 	    s = SvPV(HeVAL(envhe),len);
+	if (mg->mg_len != HEf_SVKEY) SvREFCNT_dec(keysv);
     }
 #endif
 			    /* And you'll never guess what the dog had */
@@ -612,8 +621,7 @@ magic_clearenv(sv,mg)
 SV* sv;
 MAGIC* mg;
 {
-    my_setenv(((mg->mg_len == HEf_SVKEY) ?
-	       SvPV((SV*)mg->mg_ptr, na) : mg->mg_ptr),Nullch);
+    my_setenv(MgPV(mg),Nullch);
     return 0;
 }
 
@@ -664,7 +672,7 @@ MAGIC* mg;
 {
     I32 i;
     /* Are we fetching a signal entry? */
-    i = whichsig(mg->mg_ptr);
+    i = whichsig(MgPV(mg));
     if (i) {
     	if(psig_ptr[i])
     	    sv_setsv(sv,psig_ptr[i]);
@@ -694,7 +702,7 @@ MAGIC* mg;
 {
     I32 i;
     /* Are we clearing a signal entry? */
-    i = whichsig(mg->mg_ptr);
+    i = whichsig(MgPV(mg));
     if (i) {
     	if(psig_ptr[i]) {
     	    SvREFCNT_dec(psig_ptr[i]);
@@ -717,7 +725,7 @@ MAGIC* mg;
     I32 i;
     SV** svp;
 
-    s = (mg->mg_len == HEf_SVKEY) ? SvPV((SV*)mg->mg_ptr, na) : mg->mg_ptr;
+    s = MgPV(mg);
     if (*s == '_') {
 	if (strEQ(s,"__DIE__"))
 	    svp = &diehook;
@@ -745,7 +753,7 @@ MAGIC* mg;
 	psig_ptr[i] = SvREFCNT_inc(sv);
 	if(psig_name[i])
 	    SvREFCNT_dec(psig_name[i]);
-	psig_name[i] = newSVpv(mg->mg_ptr,strlen(mg->mg_ptr));
+	psig_name[i] = newSVpv(s,strlen(s));
 	SvTEMP_off(sv); /* Make sure it doesn't go away on us */
 	SvREADONLY_on(psig_name[i]);
     }
@@ -807,6 +815,18 @@ MAGIC* mg;
 }
 #endif /* OVERLOAD */
 
+int
+magic_setnkeys(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    if (LvTARG(sv)) {
+	hv_ksplit((HV*)LvTARG(sv), SvIV(sv));
+	LvTARG(sv) = Nullsv;	/* Don't allow a ref to reassign this. */
+    }
+    return 0;
+}
+
 static int
 magic_methpack(sv,mg,meth)
 SV* sv;
@@ -944,7 +964,8 @@ MAGIC* mg;
 
     gv = DBline;
     i = SvTRUE(sv);
-    svp = av_fetch(GvAV(gv),atoi(mg->mg_ptr), FALSE);
+    svp = av_fetch(GvAV(gv),
+		     atoi(MgPV(mg)), FALSE);
     if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp)))
 	o->op_private = i;
     else
@@ -1031,7 +1052,13 @@ magic_getglob(sv,mg)
 SV* sv;
 MAGIC* mg;
 {
-    gv_efullname(sv,((GV*)sv));/* a gv value, be nice */
+    if (SvFAKE(sv)) {			/* FAKE globs can get coerced */
+	SvFAKE_off(sv);
+	gv_efullname3(sv,((GV*)sv), "*");
+	SvFAKE_on(sv);
+    }
+    else
+	gv_efullname3(sv,((GV*)sv), "*");	/* a gv value, be nice */
     return 0;
 }