From: Nick Ing-Simmons <nik@tiuk.ti.com>
Date: Wed, 22 Jan 2003 17:19:41 +0000 (+0000)
Subject: Fixes for open.pm which attempts to load layers:
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c9bca74aca217023baf0f921dcffaaa072a83cf3;p=p5sagit%2Fp5-mst-13.2.git

Fixes for open.pm which attempts to load layers:
 1. C equivalent of local $SIG{__WARN__} = sub {}
    while loading layers to supress warnings lib/open.t does
    not want.
 2. The loading scheme does not recurse now so look for
    new symptom of bad layer which is that a good module
    fails to load (as we cannot open any files).

NOTE: In my opinion open.pm should probably die on bad layer
spec rather than just (maybe) warning and then allowing opens
to fail.

p4raw-id: //depot/perlio@18560
---

diff --git a/lib/open.t b/lib/open.t
index 3f0fdf2..68b3eca 100644
--- a/lib/open.t
+++ b/lib/open.t
@@ -175,9 +175,9 @@ SKIP: {
     skip("no perlio", 1) unless (find PerlIO::Layer 'perlio');
     use open IN => ':non-existent';
     eval {
-	require Anything;
+	require Symbol; # Anything that exists but we havn't loaded
     };
-    like($@, qr/Recursive call/i,
+    like($@, qr/Can't locate Symbol|Recursive call/i,
 	 "test for an endless loop in PerlIO_find_layer");
 }
 
diff --git a/perlio.c b/perlio.c
index d9cfc39..1067689 100644
--- a/perlio.c
+++ b/perlio.c
@@ -666,8 +666,13 @@ PerlIO_find_layer(pTHX_ const char *name, STRLEN len, int load)
 	} else {
 	    SV *pkgsv = newSVpvn("PerlIO", 6);
 	    SV *layer = newSVpvn(name, len);
-	    ENTER;
+	    CV *cv  = get_cv("PerlIO::Layer::NoWarnings", FALSE);
+    	    ENTER;
 	    SAVEINT(PL_in_load_module);
+	    if (cv) {
+	        SAVESPTR(PL_warnhook);
+		PL_warnhook = (SV *) cv;
+	    }
 	    PL_in_load_module++;
 	    /*
 	     * The two SVs are magically freed by load_module
@@ -770,6 +775,17 @@ PerlIO_tab_sv(pTHX_ PerlIO_funcs *tab)
     return sv;
 }
 
+XS(XS_PerlIO__Layer__NoWarnings)
+{
+    /* This is used as a %SIG{__WARN__} handler to supress warnings 
+       during loading of layers.
+     */
+    dXSARGS;
+    if (items)
+    	PerlIO_debug("warning:%s\n",SvPV_nolen(ST(0)));
+    XSRETURN(0);
+}
+
 XS(XS_PerlIO__Layer__find)
 {
     dXSARGS;
@@ -1012,6 +1028,7 @@ Perl_boot_core_PerlIO(pTHX)
 	  __FILE__);
 #endif
     newXS("PerlIO::Layer::find", XS_PerlIO__Layer__find, __FILE__);
+    newXS("PerlIO::Layer::NoWarnings", XS_PerlIO__Layer__NoWarnings, __FILE__);
 }
 
 PerlIO_funcs *