Change 18561 by jhi@kosh on 2003/01/22 17:43:45
Integrate from perlio:
[ 18560]
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.
Affected files ...
... //depot/perl/lib/open.t#22 integrate
... //depot/perl/perlio.c#200 integrate
Differences ...
==== //depot/perl/lib/open.t#22 (text) ====
Index: perl/lib/open.t
--- perl/lib/open.t#21~18232~ Mon Dec 2 11:59:07 2002
+++ perl/lib/open.t Wed Jan 22 09:43:45 2003
@@ -175,9 +175,9 @@
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");
}
==== //depot/perl/perlio.c#200 (text) ====
Index: perl/perlio.c
--- perl/perlio.c#199~18555~ Wed Jan 22 04:57:20 2003
+++ perl/perlio.c Wed Jan 22 09:43:45 2003
@@ -666,8 +666,13 @@
} 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 @@
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 @@
__FILE__);
#endif
newXS("PerlIO::Layer::find", XS_PerlIO__Layer__find, __FILE__);
+ newXS("PerlIO::Layer::NoWarnings", XS_PerlIO__Layer__NoWarnings, __FILE__);
}
PerlIO_funcs *
End of Patch.
