From: Florian Ragwitz Date: Thu, 13 Nov 2008 21:34:13 +0000 (+0100) Subject: Deparse inlined constants. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2990415a45;p=p5sagit%2Fp5-mst-13.2.git Deparse inlined constants. Message-Id: <1226608453-25937-2-git-send-email-rafl@debian.org> p4raw-id: //depot/perl@34844 --- diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm index 0401ea3..266473d 100644 --- a/ext/B/B/Deparse.pm +++ b/ext/B/B/Deparse.pm @@ -21,7 +21,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring PMf_KEEP PMf_GLOBAL PMf_CONTINUE PMf_EVAL PMf_ONCE PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED), ($] < 5.009 ? 'PMf_SKIPWHITE' : 'RXf_SKIPWHITE'); -$VERSION = 0.87; +$VERSION = 0.88; use strict; use vars qw/$AUTOLOAD/; use warnings (); @@ -563,6 +563,7 @@ sub new { $self->{'ambient_warnings'} = undef; # Assume no lexical warnings $self->{'ambient_hints'} = 0; $self->{'ambient_hinthash'} = undef; + $self->{'inlined_constants'} = $self->scan_for_constants; $self->init(); while (my $arg = shift @_) { @@ -599,6 +600,25 @@ sub new { } } +sub scan_for_constants { + my ($self) = @_; + my %ret; + + B::walksymtable(\%::, sub { + my ($gv) = @_; + + my $cv = $gv->CV; + return if !$cv || class($cv) ne 'CV'; + + my $const = $cv->const_sv; + return if !$const || class($const) eq 'SPECIAL'; + + $ret{ 0 + $const->object_2svref } = $gv->NAME; + }, sub { 1 }); + + return \%ret; +} + # Initialise the contextual information, either from # defaults provided with the ambient_pragmas method, # or from perl's own defaults otherwise. @@ -3628,6 +3648,8 @@ sub const { return ('undef', '1', $self->maybe_parens("!1", $cx, 21))[$$sv-1]; } elsif (class($sv) eq "NULL") { return 'undef'; + } elsif (my $const = $self->{'inlined_constants'}->{ 0 + $sv->object_2svref }) { + return $const; } # convert a version object into the "v1.2.3" string in its V magic if ($sv->FLAGS & SVs_RMG) { diff --git a/ext/B/t/deparse.t b/ext/B/t/deparse.t index c9232a2..50abd35 100644 --- a/ext/B/t/deparse.t +++ b/ext/B/t/deparse.t @@ -27,7 +27,7 @@ BEGIN { require feature; feature->import(':5.10'); } -use Test::More tests => 68; +use Test::More tests => 74; use B::Deparse; my $deparse = B::Deparse->new(); @@ -147,10 +147,18 @@ sub getcode { return $deparser->coderef2text(shift); } +package Moo; +use overload '0+' => sub { 42 }; + package main; use strict; use warnings; use constant GLIPP => 'glipp'; +use constant PI => 4; +use constant OVERLOADED_NUMIFICATION => bless({}, 'Moo'); +use Fcntl qw/O_NONBLOCK O_SYNC O_EXCL/; +BEGIN { delete $::Fcntl::{O_SYNC}; } +use POSIX qw/O_CREAT/; sub test { my $val = shift; my $res = B::Deparse::Wrapper::getcode($val); @@ -422,15 +430,15 @@ else { x(); } my($y, $t); /x${y}z$t/; #### -# SKIP ?$B::Deparse::VERSION <= 0.87 && "TODO new undocumented cpan-bug #33708" +# SKIP ?$B::Deparse::VERSION <= 0.88 && "TODO new undocumented cpan-bug #33708" # 55 (cpan-bug #33708) %{$_ || {}} #### -# SKIP ?$B::Deparse::VERSION <= 0.87 && "TODO hash constants not yet fixed" +# SKIP ?$B::Deparse::VERSION <= 0.88 && "TODO hash constants not yet fixed" # 56 (cpan-bug #33708) use constant H => { "#" => 1 }; H->{"#"} #### -# SKIP ?$B::Deparse::VERSION <= 0.87 && "TODO optimized away 0 not yet fixed" +# SKIP ?$B::Deparse::VERSION <= 0.88 && "TODO optimized away 0 not yet fixed" # 57 (cpan-bug #33708) foreach my $i (@_) { 0 } #### @@ -548,5 +556,25 @@ if (do { $a++; GLIPP }) { x() } >>>> x() if $a; if ($a == 1) { x(); } elsif ($b == 2) { z(); } -if (do { foo(); 'glipp' }) { x(); } -if (do { ++$a; 'glipp' }) { x(); } +if (do { foo(); GLIPP }) { x(); } +if (do { ++$a; GLIPP }) { x(); } +#### +# 62 tests for deparsing constants +warn PI; +#### +# 63 tests for deparsing imported constants +warn O_NONBLOCK; +#### +# 64 tests for deparsing re-exported constants +warn O_CREAT; +#### +# 65 tests for deparsing imported constants that got deleted from the original namespace +warn O_SYNC; +#### +# 66 tests for deparsing constants which got turned into full typeglobs +warn O_EXCL; +eval '@Fcntl::O_EXCL = qw/affe tiger/;'; +warn O_EXCL; +#### +# 67 tests for deparsing of blessed constant with overloaded numification +warn OVERLOADED_NUMIFICATION; diff --git a/pod/perltodo.pod b/pod/perltodo.pod index 77e2c8f..71aa49d 100644 --- a/pod/perltodo.pod +++ b/pod/perltodo.pod @@ -126,28 +126,6 @@ tests that are currently missing. A full test suite for the B module would be nice. -=head2 Deparse inlined constants - -Code such as this - - use constant PI => 4; - warn PI - -will currently deparse as - - use constant ('PI', 4); - warn 4; - -because the tokenizer inlines the value of the constant subroutine C. -This allows various compile time optimisations, such as constant folding -and dead code elimination. Where these haven't happened (such as the example -above) it ought be possible to make B::Deparse work out the name of the -original constant, because just enough information survives in the symbol -table to do this. Specifically, the same scalar is used for the constant in -the optree as is used for the constant subroutine, so by iterating over all -symbol tables and generating a mapping of SV address to constant name, it -would be possible to provide B::Deparse with this functionality. - =head2 A decent benchmark C seems impervious to any recent changes made to the perl core. It