In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/b2ffa09b496468f76f73ae06494c7187785f5e8c?hp=c7bd8b847014f9a4cd5fa4bcf968ab4a8e11d2fe>
- Log ----------------------------------------------------------------- commit b2ffa09b496468f76f73ae06494c7187785f5e8c Author: Father Chrysostomos <spr...@cpan.org> Date: Fri Nov 2 14:48:48 2012 -0700 Increase $Module::CoreList::VERSION to 2.76 M dist/Module-CoreList/lib/Module/CoreList.pm commit 10526356e664e201db9ef971ea753a75699ebe37 Author: Alexandr Ciornii <alexcho...@gmail.com> Date: Wed Oct 31 12:31:47 2012 +0200 print deprecation information in corelist M dist/Module-CoreList/Makefile.PL M dist/Module-CoreList/corelist M dist/Module-CoreList/lib/Module/CoreList.pm M dist/Module-CoreList/t/deprecated.t commit d861347ee4d008eefde849f3419e6016bb2c677f Author: Father Chrysostomos <spr...@cpan.org> Date: Fri Nov 2 12:36:23 2012 -0700 svleak.t: Suppress warning M t/op/svleak.t commit a577af66bcfd9e2196e6de9a29cda9fd20b50841 Author: Father Chrysostomos <spr...@cpan.org> Date: Fri Nov 2 12:35:25 2012 -0700 Stop string eval from leaking ops This was leaking: $ ./miniperl -Xe 'warn $$; while(1){eval "ok 8"};' 1915 at -e line 1. ^C This was not: $ ./miniperl -Xe 'warn $$; while(1){eval "sub {ok 8}"};' 1916 at -e line 1. ^C The sub is successfully taking care of its ops when it is freed. The eval is not. I made the mistake of having the CV relinquish ownership of the op slab after an eval syntax error. Thatâs precisely the situation in which the ops are likely to leak, and for which the slab allocator was designed. Duh. M pp_ctl.c M t/op/svleak.t ----------------------------------------------------------------------- Summary of changes: dist/Module-CoreList/Makefile.PL | 3 ++- dist/Module-CoreList/corelist | 8 +++++++- dist/Module-CoreList/lib/Module/CoreList.pm | 13 ++++++++++++- dist/Module-CoreList/t/deprecated.t | 12 ++++++++++-- pp_ctl.c | 1 - t/op/svleak.t | 7 +++++-- 6 files changed, 36 insertions(+), 8 deletions(-) diff --git a/dist/Module-CoreList/Makefile.PL b/dist/Module-CoreList/Makefile.PL index 3fd5f61..6235c47 100644 --- a/dist/Module-CoreList/Makefile.PL +++ b/dist/Module-CoreList/Makefile.PL @@ -9,7 +9,8 @@ WriteMakefile 'VERSION_FROM' => 'lib/Module/CoreList.pm', 'ABSTRACT_FROM' => 'lib/Module/CoreList.pod', 'PREREQ_PM' => { - 'Test::More' => '0', + 'Test::More' => '0', + 'List::Util' => 0, }, 'EXE_FILES' => [ _scripts() ], 'PL_FILES' => {}, diff --git a/dist/Module-CoreList/corelist b/dist/Module-CoreList/corelist index 9cd0e8f..8842e13 100644 --- a/dist/Module-CoreList/corelist +++ b/dist/Module-CoreList/corelist @@ -124,6 +124,7 @@ use Getopt::Long; use Pod::Usage; use strict; use warnings; +use List::Util qw/maxstr/; my %Opts; @@ -275,16 +276,21 @@ sub module_version { ? Module::CoreList->removed_from_by_date($mod) : Module::CoreList->removed_from($mod); + my $when = maxstr(values %Module::CoreList::released); + print "\n","Data for $when\n"; + if( defined $ret ) { + my $deprecated = Module::CoreList->deprecated_in($mod); $msg .= " was "; $msg .= "first " unless $ver; $msg .= "released with perl " . format_perl_version($ret); + $msg .= ( $rem ? ',' : ' and' ) . " deprecated in " . format_perl_version($deprecated) if $deprecated; $msg .= " and removed from " . format_perl_version($rem) if $rem; } else { $msg .= " was not in CORE (or so I think)"; } - print "\n",$msg,"\n"; + print $msg,"\n"; if(defined $ret and exists $Opts{a} and $Opts{a}){ display_a($mod); diff --git a/dist/Module-CoreList/lib/Module/CoreList.pm b/dist/Module-CoreList/lib/Module/CoreList.pm index d87f4b5..fa3326f 100644 --- a/dist/Module-CoreList/lib/Module/CoreList.pm +++ b/dist/Module-CoreList/lib/Module/CoreList.pm @@ -3,7 +3,7 @@ use strict; use vars qw/$VERSION %released %version %families %upstream %bug_tracker %deprecated/; use Module::CoreList::TieHashDelta; -$VERSION = '2.75'; +$VERSION = '2.76'; my $dumpinc = 0; sub import { @@ -78,6 +78,17 @@ sub is_deprecated { return $deprecated{$perl_version}{$module}; } +sub deprecated_in { + my $module = shift; + $module = shift if eval { $module->isa(__PACKAGE__) } + and scalar @_ and $_[0] =~ m#\A[a-zA-Z_][0-9a-zA-Z_]*(?:(::|')[0-9a-zA-Z_]+)*\z#; + return unless $module; + my @perls = grep { exists $deprecated{$_}{$module} } keys %deprecated; + return unless @perls; + require List::Util; + return List::Util::min(@perls); +} + sub removed_from { my @perls = &removed_raw; return shift @perls; diff --git a/dist/Module-CoreList/t/deprecated.t b/dist/Module-CoreList/t/deprecated.t index 00df561..020738f 100644 --- a/dist/Module-CoreList/t/deprecated.t +++ b/dist/Module-CoreList/t/deprecated.t @@ -1,6 +1,6 @@ #!perl -w use strict; -use Test::More tests => 7; +use Test::More tests => 9; require_ok('Module::CoreList'); @@ -11,7 +11,7 @@ ok(!exists $Module::CoreList::deprecated{5.011000}{'File::Spec'}, ); ok(! Module::CoreList::is_deprecated('File::Spec'), - "File::Spec not deprecated in 5.011000 (function)" + "File::Spec currently is not deprecated (function)" ); ok(exists $Module::CoreList::deprecated{5.011000}{'Switch'}, @@ -25,3 +25,11 @@ is(!! Module::CoreList::is_deprecated('Switch'), !! ($] >= 5.011 and $] < 5.0130 ok(! Module::CoreList::is_deprecated('Switch', 5.010000), "Switch not deprecated in 5.010000 (function w/ perl version)" ); + +is(Module::CoreList::deprecated_in('Switch'), 5.011000, + "Switch was deprecated in 5.011000 (deprecated_in)" +); + +ok(! Module::CoreList::deprecated_in('File::Spec'), + "File::Spec currently is not deprecated (deprecated_in)" +); diff --git a/pp_ctl.c b/pp_ctl.c index 869907d..27113c0 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -3462,7 +3462,6 @@ S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh) PL_op = saveop; if (yystatus != 3) { if (PL_eval_root) { - cv_forget_slab(evalcv); op_free(PL_eval_root); PL_eval_root = NULL; } diff --git a/t/op/svleak.t b/t/op/svleak.t index 3e70598..89c98a2 100644 --- a/t/op/svleak.t +++ b/t/op/svleak.t @@ -15,7 +15,7 @@ BEGIN { use Config; -plan tests => 45; +plan tests => 46; # run some code N times. If the number of SVs at the end of loop N is # greater than (N-1)*delta at the end of loop 1, we've got a leak @@ -173,7 +173,7 @@ SKIP: { } SKIP: { - skip "disabled under -Dmad (eval leaks)", 5 if $Config{mad}; + skip "disabled under -Dmad (eval leaks)", 6 if $Config{mad}; leak(2, 0, sub { eval '"${<<END}" ' }, 'unterminated here-doc in quotes in multiline eval'); leak(2, 0, sub { eval '"${<<END @@ -182,6 +182,8 @@ SKIP: { 'unterminated here-doc in file'); leak(2, 0, sub { eval 'tr/9-0//' }, 'tr/9-0//'); leak(2, 0, sub { eval 'tr/a-z-0//' }, 'tr/a-z-0//'); + leak(2, 0, sub { eval 'no warnings; nonexistent_function 33838' }, + 'bareword followed by number'); } # [perl #114764] Attributes leak scalars @@ -306,6 +308,7 @@ leak(2, 0, sub { { use warnings FATAL => 'all'; leak(2, 0, sub { + no warnings 'once'; eval { printf uNopened 42 }; }, 'printfing to bad handle under fatal warnings does not leak'); open my $fh, ">", \my $buf; -- Perl5 Master Repository