This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Deparse: Better constant-dumping heuristics
authorFather Chrysostomos <sprout@cpan.org>
Sun, 24 Sep 2017 21:14:00 +0000 (14:14 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 8 Oct 2017 20:06:05 +0000 (13:06 -0700)
Constants created via sub foo () { 1 } are stored in the stash as
simple scalar references, under the CV-in-stash optimisation.  That
optimisation currently only applies to the main package, but will
shortly be extended to other packages.  This means B::Deparse’s
heuristics for dumping the constants needs to be improved, to avoid
dumping B::Deparse’s own constants for every program.

The heuristic I am using (since CvFILE is not present on a scalar ref)
is to record whether other subroutines in the same package as the con-
stant are being dumped by virtue of having CvFILE pointing to a file
that is being dumped.  This assumption is that constants and subroutines
in the same package are likely to be in the same file.

lib/B/Deparse.pm
lib/B/Deparse.t

index fe4e249..dc1b9c1 100644 (file)
@@ -512,6 +512,10 @@ sub todo {
     } else {
        $seq = 0;
     }
+    my $stash = $cv->STASH;
+    if (class($stash) eq 'HV') {
+        $self->{packs}{$stash->NAME}++;
+    }
     push @{$self->{'subs_todo'}}, [$seq, $cv, $is_form, $name];
 }
 
@@ -809,6 +813,14 @@ sub print_protos {
     my $ar;
     my @ret;
     foreach $ar (@{$self->{'protos_todo'}}) {
+       if (ref $ar->[1]) {
+           # Only print a constant if it occurs in the same package as a
+           # dumped sub.  This is not perfect, but a heuristic that will
+           # hopefully work most of the time.  Ideally we would use
+           # CvFILE, but a constant stub has no CvFILE.
+           my $pack = ($ar->[0] =~ /(.*)::/)[0];
+           next if $pack and !$self->{packs}{$pack}
+       }
        my $body = defined $ar->[1]
                ? ref $ar->[1]
                    ? " () {\n    " . $self->const($ar->[1]->RV,0) . ";\n}"
@@ -850,6 +862,7 @@ sub new {
     $self->{'ex_const'} = "'???'";
     $self->{'expand'} = 0;
     $self->{'files'} = {};
+    $self->{'packs'} = {};
     $self->{'indent_size'} = 4;
     $self->{'linenums'} = 0;
     $self->{'parens'} = 0;
index 62570ed..c61cfa2 100644 (file)
@@ -13,7 +13,7 @@ BEGIN {
 use warnings;
 use strict;
 
-my $tests = 46; # not counting those in the __DATA__ section
+my $tests = 49; # not counting those in the __DATA__ section
 
 use B::Deparse;
 my $deparse = B::Deparse->new();
@@ -152,6 +152,21 @@ $a =~ s/-e syntax OK\n//g;
 is($a, "use constant ('PI', 4);\n",
    "Proxy Constant Subroutines must not show up as (incorrect) prototypes");
 
+$a = `$^X $path "-MO=Deparse" -e "sub foo(){1}" 2>&1`;
+$a =~ s/-e syntax OK\n//g;
+is($a, "sub foo () {\n    1;\n}\n",
+   "Main prog consisting of just a constant (via empty proto)");
+
+$a = readpipe qq|$^X $path "-MO=Deparse"|
+             .qq| -e "package F; sub f(){0} sub s{}"|
+             .qq| -e "#line 123 four-five-six"|
+             .qq| -e "package G; sub g(){0} sub s{}" 2>&1|;
+$a =~ s/-e syntax OK\n//g;
+like($a, qr/sub F::f \(\) \{\s*0;\s*}/,
+   "Constant is dumped in package in which other subs are dumped");
+unlike($a, qr/sub g/,
+   "Constant is not dumped in package in which other subs are not dumped");
+
 #Re: perlbug #35857, patch #24505
 #handle warnings::register-ed packages properly.
 package B::Deparse::Wrapper;