X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perlio.c;h=30e3e6ceac4ecc30a0308971adbc22470f4c695e;hb=461824dcfbc00b3c4e20590f06d6c9881e4a416b;hp=d2c96adf689c7ade7c04a6ef1491a6d1a6256823;hpb=37405f9009219de703848fda95b3f821e51fda4d;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perlio.c b/perlio.c
index d2c96ad..30e3e6c 100644
--- a/perlio.c
+++ b/perlio.c
@@ -1408,32 +1408,6 @@ Perl_PerlIO_fileno(pTHX_ PerlIO *f)
      Perl_PerlIO_or_Base(f, Fileno, fileno, -1, (aTHX_ f));
 }
 
-static const char *
-PerlIO_context_layers(pTHX_ const char *mode)
-{
-    dVAR;
-    const char *type = NULL;
-    /*
-     * Need to supply default layer info from open.pm
-     */
-    if (PL_curcop) {
-	SV * const layers = PL_curcop->cop_io;
-	if (layers) {
-	    STRLEN len;
-	    type = SvPV_const(layers, len);
-	    if (type && mode[0] != 'r') {
-		/*
-		 * Skip to write part, which is separated by a '\0'
-		 */
-		STRLEN read_len = strlen(type);
-		if (read_len < len) {
-		    type += read_len + 1;
-		}
-	    }
-	}
-    }
-    return type;
-}
 
 static PerlIO_funcs *
 PerlIO_layer_from_ref(pTHX_ SV *sv)
@@ -1457,8 +1431,9 @@ PerlIO_layer_from_ref(pTHX_ SV *sv)
 	return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Code"), 0);
     case SVt_PVGV:
 	return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Glob"), 0);
+    default:
+	return NULL;
     }
-    return NULL;
 }
 
 PerlIO_list_t *
@@ -1491,7 +1466,7 @@ PerlIO_resolve_layers(pTHX_ const char *layers,
 	}
     }
     if (!layers || !*layers)
-	layers = PerlIO_context_layers(aTHX_ mode);
+	layers = Perl_PerlIO_context_layers(aTHX_ mode);
     if (layers && *layers) {
 	PerlIO_list_t *av;
 	if (incdef) {
@@ -1528,7 +1503,7 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
     if (!f && narg == 1 && *args == &PL_sv_undef) {
 	if ((f = PerlIO_tmpfile())) {
 	    if (!layers || !*layers)
-		layers = PerlIO_context_layers(aTHX_ mode);
+		layers = Perl_PerlIO_context_layers(aTHX_ mode);
 	    if (layers && *layers)
 		PerlIO_apply_layers(aTHX_ f, mode, layers);
 	}
@@ -5052,6 +5027,36 @@ PerlIO_tmpfile(void)
  * Now some functions in terms of above which may be needed even if we are
  * not in true PerlIO mode
  */
+const char *
+Perl_PerlIO_context_layers(pTHX_ const char *mode)
+{
+    dVAR;
+    const char *type = NULL;
+    /*
+     * Need to supply default layer info from open.pm
+     */
+    if (PL_curcop && PL_curcop->cop_hints & HINT_LEXICAL_IO) {
+	SV * const layers
+	    = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash, 0,
+				       "open", 4, 0, 0);
+	assert(layers);
+	if (SvOK(layers)) {
+	    STRLEN len;
+	    type = SvPV_const(layers, len);
+	    if (type && mode && mode[0] != 'r') {
+		/*
+		 * Skip to write part, which is separated by a '\0'
+		 */
+		STRLEN read_len = strlen(type);
+		if (read_len < len) {
+		    type += read_len + 1;
+		}
+	    }
+	}
+    }
+    return type;
+}
+
 
 #ifndef HAS_FSETPOS
 #undef PerlIO_setpos
@@ -5142,10 +5147,12 @@ vfprintf(FILE *fd, char *pat, char *args)
 int
 PerlIO_vsprintf(char *s, int n, const char *fmt, va_list ap)
 {
+    dTHX; 
     const int val = my_vsnprintf(s, n > 0 ? n : 0, fmt, ap);
+    PERL_UNUSED_CONTEXT;
+
 #ifndef PERL_MY_VSNPRINTF_GUARDED
     if (val < 0 || (n > 0 ? val >= n : 0)) {
-	dTHX;
 	Perl_croak(aTHX_ "panic: my_vsnprintf overflow in PerlIO_vsprintf\n");
     }
 #endif