X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=4da7453c3c2015ad69ee019315429292e13d9e95;hb=1e73acc8af3eecb1b36ee831483e1e9a7b3d1662;hp=916d1cf7ed096edf9518c02e197d1b67fa95143e;hpb=46da273f387b179a7655892d9988a75dc6e89057;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/mg.c b/mg.c
index 916d1cf..4da7453 100644
--- a/mg.c
+++ b/mg.c
@@ -379,7 +379,7 @@ Perl_mg_copy(pTHX_ SV *sv, SV *nsv, const char *key, I32 klen)
 	}
 	else {
 	    const char type = mg->mg_type;
-	    if (isUPPER(type)) {
+	    if (isUPPER(type) && type != PERL_MAGIC_uvar) {
 		sv_magic(nsv,
 		     (type == PERL_MAGIC_tied)
 			? SvTIED_obj(sv, mg)
@@ -758,10 +758,13 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	    SvTAINTED_off(sv);
 	}
 	else if (strEQ(remaining, "PEN")) {
-	    if (!PL_compiling.cop_io)
+	    if (!(CopHINTS_get(&PL_compiling) & HINT_LEXICAL_IO))
 		sv_setsv(sv, &PL_sv_undef);
             else {
-	        sv_setsv(sv, PL_compiling.cop_io);
+	        sv_setsv(sv,
+			 Perl_refcounted_he_fetch(aTHX_
+						  PL_compiling.cop_hints_hash,
+						  0, "open", 4, 0, 0));
 	    }
 	}
 	break;
@@ -1094,16 +1097,25 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
 #endif /* VMS */
 	if (s && klen == 4 && strEQ(ptr,"PATH")) {
 	    const char * const strend = s + len;
+#ifdef VMS  /* Hmm.  How do we get $Config{path_sep} from C? */
+	    const char path_sep = '|';
+#else
+	    const char path_sep = ':';
+#endif
 
 	    while (s < strend) {
 		char tmpbuf[256];
 		Stat_t st;
 		I32 i;
 		s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf,
-			     s, strend, ':', &i);
+			     s, strend, path_sep, &i);
 		s++;
 		if (i >= (I32)sizeof tmpbuf   /* too long -- assume the worst */
-		      || *tmpbuf != '/'
+#ifdef VMS
+		      || !strchr(tmpbuf, ':') /* no colon thus no device name -- assume relative path */
+#else
+		      || *tmpbuf != '/'       /* no starting slash -- assume relative path */
+#endif
 		      || (PerlLIO_stat(tmpbuf, &st) == 0 && (st.st_mode & 2)) ) {
 		    MgTAINTEDDIR_on(mg);
 		    return 0;
@@ -1659,7 +1671,7 @@ Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key)
 }
 
 int
-Perl_magic_existspack(pTHX_ SV *sv, MAGIC *mg)
+Perl_magic_existspack(pTHX_ SV *sv, const MAGIC *mg)
 {
     return magic_methpack(sv,mg,"EXISTS");
 }
@@ -1668,7 +1680,7 @@ SV *
 Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
 {
     dVAR; dSP;
-    SV *retval = &PL_sv_undef;
+    SV *retval;
     SV * const tied = SvTIED_obj((SV*)hv, mg);
     HV * const pkg = SvSTASH((SV*)SvRV(tied));
    
@@ -1694,6 +1706,8 @@ Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
 
     if (call_method("SCALAR", G_SCALAR))
         retval = *PL_stack_sp--; 
+    else
+	retval = &PL_sv_undef;
     POPSTACK;
     LEAVE;
     return retval;
@@ -1901,7 +1915,7 @@ Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
     STRLEN len;
-    const char *tmps = SvPV_const(sv, len);
+    const char * const tmps = SvPV_const(sv, len);
     SV * const lsv = LvTARG(sv);
     I32 lvoff = LvTARGOFF(sv);
     I32 lvlen = LvTARGLEN(sv);
@@ -1915,11 +1929,12 @@ Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
 	SvUTF8_on(lsv);
     }
     else if (lsv && SvUTF8(lsv)) {
+	const char *utf8;
 	sv_pos_u2b(lsv, &lvoff, &lvlen);
 	LvTARGLEN(sv) = len;
-	tmps = (char*)bytes_to_utf8((U8*)tmps, &len);
-	sv_insert(lsv, lvoff, lvlen, tmps, len);
-	Safefree(tmps);
+	utf8 = (char*)bytes_to_utf8((U8*)tmps, &len);
+	sv_insert(lsv, lvoff, lvlen, utf8, len);
+	Safefree(utf8);
     }
     else {
 	sv_insert(lsv, lvoff, lvlen, tmps, len);
@@ -2227,10 +2242,11 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	    }
 	}
 	else if (strEQ(mg->mg_ptr, "\017PEN")) {
-	    if (!PL_compiling.cop_io)
-		PL_compiling.cop_io = newSVsv(sv);
-	    else
-		sv_setsv(PL_compiling.cop_io,sv);
+	    PL_compiling.cop_hints |= HINT_LEXICAL_IO;
+	    PL_hints |= HINT_LOCALIZE_HH | HINT_LEXICAL_IO;
+	    PL_compiling.cop_hints_hash
+		= Perl_refcounted_he_new(aTHX_ PL_compiling.cop_hints_hash,
+					 sv_2mortal(newSVpvs("open")), sv);
 	}
 	break;
     case '\020':	/* ^P */
@@ -2852,8 +2868,9 @@ S_unwind_handler_stack(pTHX_ const void *p)
 =for apidoc magic_sethint
 
 Triggered by a store to %^H, records the key/value pair to
-C<PL_compiling.cop_hints>.  It is assumed that hints aren't storing anything
-that would need a deep copy.  Maybe we should warn if we find a reference.
+C<PL_compiling.cop_hints_hash>.  It is assumed that hints aren't storing
+anything that would need a deep copy.  Maybe we should warn if we find a
+reference.
 
 =cut
 */
@@ -2872,16 +2889,17 @@ Perl_magic_sethint(pTHX_ SV *sv, MAGIC *mg)
        Doing this here saves a lot of doing it manually in perl code (and
        forgetting to do it, and consequent subtle errors.  */
     PL_hints |= HINT_LOCALIZE_HH;
-    PL_compiling.cop_hints
-	= Perl_refcounted_he_new(aTHX_ PL_compiling.cop_hints,
-				 (SV *)mg->mg_ptr, newSVsv(sv));
+    PL_compiling.cop_hints_hash
+	= Perl_refcounted_he_new(aTHX_ PL_compiling.cop_hints_hash,
+				 (SV *)mg->mg_ptr, sv);
     return 0;
 }
 
 /*
 =for apidoc magic_sethint
 
-Triggered by a delete from %^H, records the key to C<PL_compiling.cop_hints>.
+Triggered by a delete from %^H, records the key to
+C<PL_compiling.cop_hints_hash>.
 
 =cut
 */
@@ -2894,8 +2912,8 @@ Perl_magic_clearhint(pTHX_ SV *sv, MAGIC *mg)
     PERL_UNUSED_ARG(sv);
 
     PL_hints |= HINT_LOCALIZE_HH;
-    PL_compiling.cop_hints
-	= Perl_refcounted_he_new(aTHX_ PL_compiling.cop_hints,
+    PL_compiling.cop_hints_hash
+	= Perl_refcounted_he_new(aTHX_ PL_compiling.cop_hints_hash,
 				 (SV *)mg->mg_ptr, &PL_sv_placeholder);
     return 0;
 }