X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=801f3f1ff1379e150adcb2edaec2ba5c45dd597e;hb=f4dd75d9918abbf789a5eca453b89168cad18ff0;hp=64c706ee366a23d6dca8ade0ac1c1dde376a0bef;hpb=24944567cd431bac90d270c4c84c69294f9784d9;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_ctl.c b/pp_ctl.c
index 64c706e..801f3f1 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -883,15 +883,18 @@ PP(pp_sort)
 
 	    CATCH_SET(TRUE);
 	    PUSHSTACKi(PERLSI_SORT);
-	    if (PL_sortstash != stash) {
-		PL_firstgv = gv_fetchpv("a", TRUE, SVt_PV);
-		PL_secondgv = gv_fetchpv("b", TRUE, SVt_PV);
-		PL_sortstash = stash;
+	    if (!hasargs && !is_xsub) {
+		if (PL_sortstash != stash || !PL_firstgv || !PL_secondgv) {
+		    SAVESPTR(PL_firstgv);
+		    SAVESPTR(PL_secondgv);
+		    PL_firstgv = gv_fetchpv("a", TRUE, SVt_PV);
+		    PL_secondgv = gv_fetchpv("b", TRUE, SVt_PV);
+		    PL_sortstash = stash;
+		}
+		SAVESPTR(GvSV(PL_firstgv));
+		SAVESPTR(GvSV(PL_secondgv));
 	    }
 
-	    SAVESPTR(GvSV(PL_firstgv));
-	    SAVESPTR(GvSV(PL_secondgv));
-
 	    PUSHBLOCK(cx, CXt_NULL, PL_stack_base);
 	    if (!(PL_op->op_flags & OPf_SPECIAL)) {
 		cx->cx_type = CXt_SUB;
@@ -1568,9 +1571,12 @@ PP(pp_caller)
     {
 	SV * mask ;
 	SV * old_warnings = cx->blk_oldcop->cop_warnings ;
-	if  (old_warnings == pWARN_NONE || old_warnings == pWARN_STD)
+
+	if  (old_warnings == pWARN_NONE || 
+		(old_warnings == pWARN_STD && (PL_dowarn & G_WARN_ON) == 0))
             mask = newSVpvn(WARN_NONEstring, WARNsize) ;
-        else if (old_warnings == pWARN_ALL)
+        else if (old_warnings == pWARN_ALL || 
+		  (old_warnings == pWARN_STD && PL_dowarn & G_WARN_ON))
             mask = newSVpvn(WARN_ALLstring, WARNsize) ;
         else
             mask = newSVsv(old_warnings);
@@ -2628,11 +2634,9 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp)
     /* switch to eval mode */
 
     if (PL_curcop == &PL_compiling) {
-	SAVECOPSTASH(&PL_compiling);
+	SAVECOPSTASH_FREE(&PL_compiling);
 	CopSTASH_set(&PL_compiling, PL_curstash);
     }
-    SAVECOPFILE(&PL_compiling);
-    SAVECOPLINE(&PL_compiling);
     if (PERLDB_NAMEEVAL && CopLINE(PL_curcop)) {
 	SV *sv = sv_newmortal();
 	Perl_sv_setpvf(aTHX_ sv, "_<(%.10seval %lu)[%s:%"IVdf"]",
@@ -2642,7 +2646,9 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp)
     }
     else
 	sprintf(tmpbuf, "_<(%.10s_eval %lu)", code, (unsigned long)++PL_evalseq);
+    SAVECOPFILE_FREE(&PL_compiling);
     CopFILE_set(&PL_compiling, tmpbuf+2);
+    SAVECOPLINE(&PL_compiling);
     CopLINE_set(&PL_compiling, 1);
     /* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
        deleting the eval's FILEGV from the stash before gv_check() runs
@@ -2990,8 +2996,19 @@ PP(pp_require)
     {
 	tryname = name;
 	tryrsfp = doopen_pmc(name,PERL_SCRIPT_MODE);
+#ifdef MACOS_TRADITIONAL
+	/* We consider paths of the form :a:b ambiguous and interpret them first
+	   as global then as local
+	*/
+    	if (!tryrsfp && name[0] == ':' && name[1] != ':' && strchr(name+2, ':'))
+	    goto trylocal;
+    }
+    else 
+trylocal: {
+#else
     }
     else {
+#endif
 	AV *ar = GvAVn(PL_incgv);
 	I32 i;
 #ifdef VMS
@@ -3109,6 +3126,10 @@ PP(pp_require)
 		}
 		else {
 		    char *dir = SvPVx(dirsv, n_a);
+#ifdef MACOS_TRADITIONAL
+		    /* We have ensured in incpush that library ends with ':' */
+		    Perl_sv_setpvf(aTHX_ namesv, "%s%s", dir, name+(name[0] == ':'));
+#else
 #ifdef VMS
 		    char *unixdir;
 		    if ((unixdir = tounixpath(dir, Nullch)) == Nullch)
@@ -3118,8 +3139,17 @@ PP(pp_require)
 #else
 		    Perl_sv_setpvf(aTHX_ namesv, "%s/%s", dir, name);
 #endif
+#endif
 		    TAINT_PROPER("require");
 		    tryname = SvPVX(namesv);
+#ifdef MACOS_TRADITIONAL
+		    {
+		    	/* Convert slashes in the name part, but not the directory part, to colons */
+		    	char * colon;
+		    	for (colon = tryname+strlen(dir); colon = strchr(colon, '/'); )
+			    *colon++ = ':';
+		    }
+#endif
 		    tryrsfp = doopen_pmc(tryname, PERL_SCRIPT_MODE);
 		    if (tryrsfp) {
 			if (tryname[0] == '.' && tryname[1] == '/')
@@ -3130,7 +3160,7 @@ PP(pp_require)
 	    }
 	}
     }
-    SAVECOPFILE(&PL_compiling);
+    SAVECOPFILE_FREE(&PL_compiling);
     CopFILE_set(&PL_compiling, tryrsfp ? tryname : name);
     SvREFCNT_dec(namesv);
     if (!tryrsfp) {
@@ -3240,7 +3270,6 @@ PP(pp_entereval)
  
     /* switch to eval mode */
 
-    SAVECOPFILE(&PL_compiling);
     if (PERLDB_NAMEEVAL && CopLINE(PL_curcop)) {
 	SV *sv = sv_newmortal();
 	Perl_sv_setpvf(aTHX_ sv, "_<(eval %lu)[%s:%"IVdf"]",
@@ -3250,7 +3279,9 @@ PP(pp_entereval)
     }
     else
 	sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq);
+    SAVECOPFILE_FREE(&PL_compiling);
     CopFILE_set(&PL_compiling, tmpbuf+2);
+    SAVECOPLINE(&PL_compiling);
     CopLINE_set(&PL_compiling, 1);
     /* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
        deleting the eval's FILEGV from the stash before gv_check() runs