Change 34844 by [EMAIL PROTECTED] on 2008/11/16 18:00:42
Subject: [PATCH] Deparse inlined constants.
From: Florian Ragwitz <[EMAIL PROTECTED]>
Date: Thu, 13 Nov 2008 21:34:13 +0100
Message-Id: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/ext/B/B/Deparse.pm#197 edit
... //depot/perl/ext/B/t/deparse.t#42 edit
... //depot/perl/pod/perltodo.pod#243 edit
Differences ...
==== //depot/perl/ext/B/B/Deparse.pm#197 (text) ====
Index: perl/ext/B/B/Deparse.pm
--- perl/ext/B/B/Deparse.pm#196~34063~ 2008-06-16 07:13:58.000000000 -0700
+++ perl/ext/B/B/Deparse.pm 2008-11-16 10:00:42.000000000 -0800
@@ -21,7 +21,7 @@
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 @@
$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 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 @@
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) {
==== //depot/perl/ext/B/t/deparse.t#42 (text) ====
Index: perl/ext/B/t/deparse.t
--- perl/ext/B/t/deparse.t#41~34358~ 2008-09-13 01:44:30.000000000 -0700
+++ perl/ext/B/t/deparse.t 2008-11-16 10:00:42.000000000 -0800
@@ -27,7 +27,7 @@
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 @@
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 @@
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 @@
>>>>
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;
==== //depot/perl/pod/perltodo.pod#243 (text) ====
Index: perl/pod/perltodo.pod
--- perl/pod/perltodo.pod#242~34840~ 2008-11-16 09:07:24.000000000 -0800
+++ perl/pod/perltodo.pod 2008-11-16 10:00:42.000000000 -0800
@@ -126,28 +126,6 @@
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<PI>.
-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<perlbench> seems impervious to any recent changes made to the perl core. It
End of Patch.
