diff options
| author | Nick Ing-Simmons <nik@tiuk.ti.com> | 2003-01-22 17:19:41 +0000 |
|---|---|---|
| committer | Nick Ing-Simmons <nik@tiuk.ti.com> | 2003-01-22 17:19:41 +0000 |
| commit | c9bca74aca217023baf0f921dcffaaa072a83cf3 (patch) | |
| tree | 45e5091323624ef02bbf6c3c984dedbecaf560d2 | |
| parent | 9837d3731bea1e0d3aaed58a46127574f76ffe53 (diff) | |
| download | perl-c9bca74aca217023baf0f921dcffaaa072a83cf3.tar.gz | |
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
| -rw-r--r-- | lib/open.t | 4 | ||||
| -rw-r--r-- | perlio.c | 19 |
2 files changed, 20 insertions, 3 deletions
diff --git a/lib/open.t b/lib/open.t index 3f0fdf2827..68b3eca387 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"); } @@ -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 * |