From: Peter Rabbitson Date: Thu, 22 Dec 2011 11:15:20 +0000 (+0100) Subject: The real fix for RT#73402 (abaondon tie %^H entirely), FC++ X-Git-Tag: 0.22~6 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b2e54862c91ba576736e1889a84733d11cb1b675;p=p5sagit%2Fnamespace-clean.git The real fix for RT#73402 (abaondon tie %^H entirely), FC++ --- diff --git a/Changes b/Changes index ebe2fb6..6c43eed 100644 --- a/Changes +++ b/Changes @@ -1,4 +1,6 @@ - - Compile away the debugger fixup on perls >= 5.15.5 + - Replace the %^H tie approach with fieldhashes, fixes all known + corner cases and caveats on supported perls >= 5.8.1 (FC) + - Compile away the debugger fixup on perls >= 5.15.5 (FC) [0.21_01] - More robust handling of the tied %^H in pure perl mode (RT#73402) diff --git a/lib/namespace/clean.pm b/lib/namespace/clean.pm index 6e081ec..c1450b4 100644 --- a/lib/namespace/clean.pm +++ b/lib/namespace/clean.pm @@ -1,5 +1,4 @@ package namespace::clean; -# ABSTRACT: Keep imports and functions out of your namespace use warnings; use strict; @@ -11,11 +10,8 @@ our $VERSION = '0.21_01'; $STORAGE_VAR = '__NAMESPACE_CLEAN_STORAGE'; +# FIXME - all of this buggery will migrate to B::H::EOS soon BEGIN { - - use warnings; - use strict; - # when changing also change in Makefile.PL my $b_h_eos_req = '0.07'; @@ -26,71 +22,13 @@ BEGIN { } ) { B::Hooks::EndOfScope->import('on_scope_end'); } - else { - eval <<'PP' or die $@; - - use Tie::Hash (); - - { - package namespace::clean::_TieHintHash; - - use warnings; - use strict; - - use base 'Tie::ExtraHash'; - } - - { - package namespace::clean::_ScopeGuard; - - use warnings; - use strict; - - sub arm { bless [ $_[1] ] } - - sub DESTROY { $_[0]->[0]->() } - } - - - sub on_scope_end (&) { - $^H |= 0x020000; - - if( my $stack = tied( %^H ) ) { - if ( (my $c = ref $stack) ne 'namespace::clean::_TieHintHash') { - die <arm(shift); - } - else { - my %old_contents = %^H; - %^H = (); - tie( %^H, 'namespace::clean::_TieHintHash', namespace::clean::_ScopeGuard->arm(shift) ); - $^H{$_} = $old_contents{$_} for keys %old_contents; - } + elsif ($] < 5.009_003_9) { + require namespace::clean::_PP_OSE_5_8; + *on_scope_end = \&namespace::clean::_PP_OSE_5_8::on_scope_end; } - - 1; - -PP - + else { + require namespace::clean::_PP_OSE; + *on_scope_end = \&namespace::clean::_PP_OSE::on_scope_end; } } @@ -484,17 +422,6 @@ will be stable in future releases. Just for completeness sake, if you want to remove the symbol completely, use C instead. -=head1 CAVEATS - -This module is fully functional in a pure-perl environment, where -L (with the XS dependency L), may -not be available. However in this case this module falls back to a -L of L<%^H|perlvar/%^H> which may or may not interfere -with some crack you may be doing independently of namespace::clean. - -If you want to ensure that your codebase is protected from this unlikely -clash, you need to explicitly depend on L. - =head1 SEE ALSO L @@ -523,11 +450,15 @@ Jesse Luehrs Peter Rabbitson +=item * + +Father Chrysostomos + =back =head1 COPYRIGHT AND LICENSE -This software is copyright (c) 2011 by Robert 'phaylon' Sedlacek. +This software is copyright (c) 2011 by L This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. diff --git a/lib/namespace/clean/_PP_OSE.pm b/lib/namespace/clean/_PP_OSE.pm new file mode 100644 index 0000000..26fc091 --- /dev/null +++ b/lib/namespace/clean/_PP_OSE.pm @@ -0,0 +1,42 @@ +package # hide from the pauses + namespace::clean::_PP_OSE; + +use warnings; +use strict; + +use namespace::clean::_PP_SG; +use Tie::Hash; +use Hash::Util::FieldHash 'fieldhash'; + +# Hash::Util::FieldHash is not deleting elements in void context. When +# you call delete() in non-void context, a mortal scalar is returned. A +# mortal scalar is one whose reference count decreases at the end of the +# current statement. During scope exit, ‘statement’ is not clearly +# defined, so more scope unwinding could happen before the mortal gets +# freed. +# By tying it and overriding DELETE, we can force the deletion into +# void context. + +fieldhash my %hh; + +{ + package namespace::clean::_TieHintHashFieldHash; + use base 'Tie::StdHash'; + sub DELETE { + shift->SUPER::DELETE(@_); + 1; # put the preceding statement in void context + } +} + + +sub on_scope_end (&) { + $^H |= 0x020000; + + tie(%hh, 'namespace::clean::_TieHintHashFieldHash') + unless tied %hh; + + push @{$hh{\%^H} ||= []}, + namespace::clean::_PP_SG->arm(shift); +} + +1; diff --git a/lib/namespace/clean/_PP_OSE_5_8.pm b/lib/namespace/clean/_PP_OSE_5_8.pm new file mode 100644 index 0000000..15cc00b --- /dev/null +++ b/lib/namespace/clean/_PP_OSE_5_8.pm @@ -0,0 +1,18 @@ +package # hide from the pauses + namespace::clean::_PP_OSE_5_8; + +use warnings; +use strict; + +use namespace::clean::_PP_SG; + +# This is the original implementation, which sadly is broken +# on perl 5.10+ withing string evals +sub on_scope_end (&) { + $^H |= 0x020000; + + push @{$^H{'__namespace::clean__guardstack__'} ||= [] }, + namespace::clean::_PP_SG->arm(shift); +} + +1; diff --git a/lib/namespace/clean/_PP_SG.pm b/lib/namespace/clean/_PP_SG.pm new file mode 100644 index 0000000..768ce41 --- /dev/null +++ b/lib/namespace/clean/_PP_SG.pm @@ -0,0 +1,10 @@ +package # hide from the pauses + namespace::clean::_PP_SG; + +use warnings; +use strict; + +sub arm { bless [ $_[1] ] } +sub DESTROY { $_[0]->[0]->() } + +1; diff --git a/t/09-fiddle-hinthash.t b/t/09-fiddle-hinthash.t index adc1923..bf7b075 100644 --- a/t/09-fiddle-hinthash.t +++ b/t/09-fiddle-hinthash.t @@ -24,10 +24,15 @@ use Test::More 0.88; use namespace::clean; BEGIN { - Test::More::is( $^H{'foo'}, 'bar', 'hinthash intact' ); + Test::More::is( $^H{'foo'}, 'bar', 'compiletime hinthash intact after n::c' ); } { + BEGIN { + Test::More::is( + $^H{'foo'}, 'bar', 'compile-time hinthash intact in inner scope' + ); + } 1; }