X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fglobs.t;h=11c044155569483cc73a53f213a9842a61d21881;hb=a8fa215c7b5b72b98f8e6029907087b0ff176594;hp=0fecd46b3c47a7d2f09636885b625b4dcc42bb3c;hpb=81f1c0187fa7bb773d2f2c2e30bc57de03bad30a;p=p5sagit%2FDevel-Size.git diff --git a/t/globs.t b/t/globs.t index 0fecd46..11c0441 100644 --- a/t/globs.t +++ b/t/globs.t @@ -60,17 +60,49 @@ $SIG{__WARN__} = sub { my $copy = *PFLAP; my $copy_gv_size = total_size($copy); # GV copies point back to the real GV through GvEGV. They share the same GP - # and GvFILE - is($copy_gv_size, $real_gv_size + $incremental_gv_size - $gp_size, - 'GV copies point back to the real GV'); + # and GvFILE. In 5.10 and later GvNAME is also shared. + my $shared_gvname = 0; + if ($] >= 5.010) { + # Calculate the size of the shared HEK: + my %h = (PFLAP => 0); + my $shared = (keys %h)[0]; + $shared_gvname = total_size($shared); + undef $shared; + $shared_gvname-= total_size($shared); + } + is($copy_gv_size, $real_gv_size + $incremental_gv_size - $gp_size + - $shared_gvname, 'GV copies point back to the real GV'); } -sub gv_grew { - my ($sub, $glob, $code, $type) = @_; +# As of blead commit b50b20584a1bbc1a, Implement new 'use 5.xxx' plan, +# use strict; will write to %^H. In turn, this causes the eval $code below +# to have compile with a pp_hintseval with a private copy of %^H in the +# optree. In turn, this private value is copied on op execution and put on +# the stack. The act of copying requires a hash iterator, and the *first* +# time the op is encountered its private HV doesn't have space for one, so +# it's expanded to hold one. Which happens after $cv_was_size is assigned to. +# Which matters, because it means that the total size of anything that can +# reach \&gv_grew will include this extra size. In this case, this means that +# if the code for generate_glob() is within gv_grew() [as it used to be], +# then the generated subroutine's CvOUTSIDE points to an anon sub whose +# CvOUTSIDE points to gv_grew(). Which means that the generated subroutine +# gets "bigger" simply as a side effect of the eval executing. + +# The solution is to put the eval that creates the subroutine into a different +# scope, so that its outside pointer chain doesn't include gv_grew(). Hence +# it's now broken out into generate_glob(): + +sub generate_glob { + my ($sub, $glob) = @_; # unthreaded, this gives us a way of getting to sv_size() from one of the # other *_size() functions, with a GV that has nothing allocated from its # GP: eval "sub $sub { *$glob }; 1" or die $@; +} + +sub gv_grew { + my ($sub, $glob, $code, $type) = @_; + generate_glob($sub, $glob); # Assigning to IoFMT_GV() also provides this, threaded and unthreaded: $~ = $glob; @@ -99,11 +131,11 @@ sub gv_grew { cmp_ok($new_thing_size, '>', 0, "For $type, new item has a size"); is($cv_now_size, $cv_was_size, - "Under multiplicity, the optree doesn't directly close onto a GV, so CVs won't change size") - if $Config{usemultiplicity}; + "Under ithreads, the optree doesn't directly close onto a GV, so CVs won't change size") + if $Config{useithreads}; if ($] < 5.010 && $type eq 'SCALAR') { is($cv_now_size, $cv_was_size, "CV doesn't grow as GV has SCALAR") - unless $Config{usemultiplicity}; + unless $Config{useithreads}; is($io_now_size, $io_was_size, "IO doesn't grow as GV has SCALAR"); is($gv_now_size, $gv_was_size, 'GV size unchanged as GV has SCALAR'); is($gv_now_total_size, $gv_was_total_size, @@ -112,7 +144,7 @@ sub gv_grew { # CV like things (effectively) close back over their typeglob, so its # hard to just get the size of the CV. cmp_ok($cv_now_size, '>', $cv_was_size, "CV grew for $type") - unless $Config{usemultiplicity}; + unless $Config{useithreads}; cmp_ok($io_now_size, '>', $io_was_size, "IO grew for $type"); # Assigning CVs and FORMATs to typeglobs causes the typeglob to get # weak reference magic @@ -122,7 +154,7 @@ sub gv_grew { } else { is($cv_now_size, $cv_was_size + $new_thing_size, "CV grew by expected amount for $type") - unless $Config{usemultiplicity}; + unless $Config{useithreads}; is($io_now_size, $io_was_size + $new_thing_size, "IO total_size grew by expected amount for $type"); is($gv_now_size, $gv_was_size + $new_thing_size, @@ -135,7 +167,8 @@ sub gv_grew { gv_grew('glipp', 'zok', 'no strict "vars"; $zok = undef; 1', 'SCALAR'); gv_grew('bang', 'boff', 'no strict "vars"; @boff = (); 1', 'ARRAY'); gv_grew('clange', 'sock', 'no strict "vars"; %sock = (); 1', 'HASH'); -{ +SKIP: { + skip("Can't create FORMAT references prior to 5.8.0", 7) if $] < 5.008; local $Devel::Size::warn = 0; gv_grew('biff', 'zapeth', "format zapeth =\n.\n1", 'FORMAT'); }