| Subject: | [PATCH] Compatibility with constants and with CV-in-stash optimisation |
Since perl 5.10, ‘use constant’ has cheated and put scalar references in the stash, not full typeglobs (at least when it can get away with it).
Perl 5.28 will introduce (or extend) a new optimisation, detailed below.
The attached patch makes Devel::TraceMethods work with both.
From the perldelta for 5.27.6:
=head2 Subroutines no longer need typeglobs
Perl 5.22.0 introduced an optimization allowing subroutines to be stored in
packages as simple sub refs, not requiring a full typeglob (thus
potentially saving large amounts of memeory). However, the optimization
was flawed: it only applied to the main package.
This optimization has now been extended to all packages. This may break
compatibility with introspection code that looks inside stashes and expects
everything in them to be a typeglob.
When this optimization happens, the typeglob still notionally exists, so
accessing it will cause the stash entry to be upgraded to a typeglob. The
optimization does not apply to XSUBs or exported subroutines, and calling a
method will undo it, since method calls cache things in typeglobs.
[perl #129916] [perl #132252]
| Subject: | open_KuP8QcRv.txt |
diff -rup Devel-TraceMethods-1.00-0/lib/Devel/TraceMethods.pm Devel-TraceMethods-1.00-1/lib/Devel/TraceMethods.pm
--- Devel-TraceMethods-1.00-0/lib/Devel/TraceMethods.pm 2005-07-09 14:34:36.000000000 -0700
+++ Devel-TraceMethods-1.00-1/lib/Devel/TraceMethods.pm 2017-11-18 10:48:47.000000000 -0800
@@ -32,7 +32,13 @@ sub _wrap_symbol
for my $symbol ( keys %$src )
{
# get all code references, make sure they're valid
- my $sub = *{ $src->{$symbol} }{CODE};
+ my $globref = \$src->{$symbol};
+ if (ref $globref ne 'GLOB') {
+ # something weird; vivify a normal glob
+ no strict 'refs';
+ $globref = \*{ $traced . "::" . $symbol};
+ }
+ my $sub = *$globref{CODE};
next unless defined $sub and defined &$sub;
# save all other slots of the typeglob
Only in Devel-TraceMethods-1.00-1/: pm_to_blib
diff -rup Devel-TraceMethods-1.00-0/t/base.t Devel-TraceMethods-1.00-1/t/base.t
--- Devel-TraceMethods-1.00-0/t/base.t 2005-07-09 14:34:36.000000000 -0700
+++ Devel-TraceMethods-1.00-1/t/base.t 2017-11-18 10:48:58.000000000 -0800
@@ -9,7 +9,7 @@ BEGIN
use strict;
use warnings;
-use Test::More tests => 6;
+use Test::More tests => 9;
my $module = 'Devel::TraceMethods';
use_ok( $module );
@@ -64,3 +64,19 @@ Devel::TraceMethods->import( 'TraceMe2'
$result = '';
$t2->bar();
is( $result, 'Called TraceMe2::bar', '... unless tracking that class too' );
+
+{
+ package TraceMe3;
+ use constant foo => 42;
+ sub bar () { 32 }
+ sub baz () { 43 } () = \&baz;
+}
+Devel::TraceMethods->import( 'TraceMe3' );
+$result = '';
+TraceMe3->foo;
+is $result, 'Called TraceMe3::foo', 'traced "use constant" constant';
+TraceMe3->bar;
+is $result, 'Called TraceMe3::bar', 'traced ()-proto constant';
+TraceMe3->baz;
+is $result, 'Called TraceMe3::baz',
+ 'traced ()-proto constant that has been referenced';