revert const deparsing in Deparse.pm

The code was added in 5.11.0 by
    2990415a4519bc3988d7224ae15100c3e9e901ee
    805b10112885d8868f21f8e860792d65e1e6c19d
but causes a big slowdown on most deparsing, due to the need
to walk the entire package tree looking for constant subs.

For more details, see
    [perl #73052] Storable considerably slower at storing coderefs

diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm
index 7c82c3a..6cdcd05 100644 (file)
--- a/dist/B-Deparse/Deparse.pm
+++ b/dist/B-Deparse/Deparse.pm
@@ -23,7 +23,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
         PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED),
         ($] < 5.009 ? 'PMf_SKIPWHITE' : 'RXf_SKIPWHITE'),
         ($] < 5.011 ? 'CVf_LOCKED' : ());
-$VERSION = 0.94;
+$VERSION = 0.95;
 use strict;
 use vars qw/$AUTOLOAD/;
 use warnings ();
@@ -610,25 +610,6 @@ 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.
@@ -3673,13 +3654,6 @@ sub const {
     if (class($sv) eq "NULL") {
        return 'undef';
     }
-    if ($cx) {
-       unless ($self->{'inlined_constants'}) {
-           $self->{'inlined_constants'} = $self->scan_for_constants;
-       }
-       my $const = $self->{'inlined_constants'}->{ 0 + $sv->object_2svref };
-        return $const if $const;
-    }
     # convert a version object into the "v1.2.3" string in its V magic
     if ($sv->FLAGS & SVs_RMG) {
        for (my $mg = $sv->MAGIC; $mg; $mg = $mg->MOREMAGIC) {

diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t
index 0404ab3..26ceb2d 100644 (file)
--- a/dist/B-Deparse/t/deparse.t
+++ b/dist/B-Deparse/t/deparse.t
@@ -548,19 +548,24 @@ if ($a == 1) { x(); } elsif ($b == 2) { z(); }
 if (do { foo(); GLIPP }) { x(); }
 if (do { ++$a; GLIPP }) { x(); }
 ####
+# TODO constant deparsing has been backed out for 5.12
 # 62 tests for deparsing constants
 warn PI;
 ####
+# TODO constant deparsing has been backed out for 5.12
 # 63 tests for deparsing imported constants
 warn O_TRUNC;
 ####
+# TODO constant deparsing has been backed out for 5.12
 # 64 tests for deparsing re-exported constants
 warn O_CREAT;
 ####
+# TODO constant deparsing has been backed out for 5.12
 # 65 tests for deparsing imported constants that got deleted from the original namespace
 warn O_APPEND;
 ####
-# TODO ? $Config::Config{useithreads} && "doesn't work with threads"
+# TODO constant deparsing has been backed out for 5.12
+# XXXTODO ? $Config::Config{useithreads} && "doesn't work with threads"
 # 66 tests for deparsing constants which got turned into full typeglobs
 # It might be fundamentally impossible to make this work on ithreads, in which
 # case the TODO should become a SKIP
@@ -568,6 +573,7 @@ warn O_EXCL;
 eval '@Fcntl::O_EXCL = qw/affe tiger/;';
 warn O_EXCL;
 ####
+# TODO constant deparsing has been backed out for 5.12
 # 67 tests for deparsing of blessed constant with overloaded numification
 warn OVERLOADED_NUMIFICATION;
 ####