From ee207f7d32799e467842a1d53ad7381feb5d3864 Mon Sep 17 00:00:00 2001 From: Kent Fredric Date: Mon, 27 Jun 2016 22:25:00 +1200 Subject: [PATCH 1/7] Remove redundant comment that leaked in. This was a residual effect of the rebasing proces. --- lib/Devel/Isa/Explainer/_MRO.pm | 2 -- 1 file changed, 2 deletions(-) diff --git a/lib/Devel/Isa/Explainer/_MRO.pm b/lib/Devel/Isa/Explainer/_MRO.pm index 7675fb5..3c8454e 100644 --- a/lib/Devel/Isa/Explainer/_MRO.pm +++ b/lib/Devel/Isa/Explainer/_MRO.pm @@ -21,8 +21,6 @@ BEGIN { *_mro_is_universal = \&mro::is_universal; } -# yes, this is evil - our @EXPORT_OK = qw( is_mro_proxy get_linear_isa From 384e966dc92bc44e830871c8ef970bf772512aa9 Mon Sep 17 00:00:00 2001 From: Kent Fredric Date: Mon, 27 Jun 2016 22:36:27 +1200 Subject: [PATCH 2/7] Exempt CLONE and CLONE_SKIP from from shadowing logic. Closes #5 --- Changes | 1 + lib/Devel/Isa/Explainer/_MRO.pm | 21 +++++++++++++++++++-- 2 files changed, 20 insertions(+), 2 deletions(-) diff --git a/Changes b/Changes index 8fdebeb..af3d91d 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,7 @@ Release history for Devel-Isa-Explainer {{$NEXT}} + - CLONE/CLONE_SKIP now exempt from shadowing logic. ( Closes #5 ) 0.002900 2016-06-26T19:35:43Z 7405ed0 - UNIVERSAL now automatically shown in inheritance. ( Closes #11 ) diff --git a/lib/Devel/Isa/Explainer/_MRO.pm b/lib/Devel/Isa/Explainer/_MRO.pm index 3c8454e..3f930c0 100644 --- a/lib/Devel/Isa/Explainer/_MRO.pm +++ b/lib/Devel/Isa/Explainer/_MRO.pm @@ -33,6 +33,18 @@ our @EXPORT_OK = qw( get_flattened_class ); +our %SHADOW_EXEMPT = ( + map { $_ => 1 } ( + + # http://perldoc.perl.org/perlmod.html#Making-your-module-threadsafe + # CLONE is called at all levels, shadowed or not + 'CLONE', + + # CLONE_SKIP is also called on all levels, shadowed or not. + ( $] >= 5.008007 ? 'CLONE_SKIP' : () ), + ) +); + BEGIN { # MRO Proxies removed since 5.009_005 *MRO_PROXIES = ( $] <= 5.009005 ) ? sub() { 1 } : sub() { 0 }; @@ -217,8 +229,13 @@ sub get_linear_class_shadows { $methods->{$subname} = $node->{$subname}; next; } - $node->{$subname} = { shadowing => 1, shadowed => 0, ref => $subs->{$subname} }; - $methods->{$subname}->{shadowed} = 1; # mark previous version shadowed + if ( exists $SHADOW_EXEMPT{$subname} ) { + $node->{$subname} = { shadowing => 0, shadowed => 0, ref => $subs->{$subname} }; + } + else { + $node->{$subname} = { shadowing => 1, shadowed => 0, ref => $subs->{$subname} }; + $methods->{$subname}->{shadowed} = 1; # mark previous version shadowed + } $methods->{$subname} = $node->{$subname}; # update current } unshift @isa_out, { class => $package, subs => $node }; From 8bf676c3e682750a9731024161e3e52d37fc60d4 Mon Sep 17 00:00:00 2001 From: Kent Fredric Date: Thu, 21 Apr 2016 00:21:55 +1200 Subject: [PATCH 3/7] Add glue to handle pretty-printing XSUB data, but undecided symbol/highlighting mechanisms --- lib/Devel/Isa/Explainer.pm | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/lib/Devel/Isa/Explainer.pm b/lib/Devel/Isa/Explainer.pm index 00db090..854c7d5 100644 --- a/lib/Devel/Isa/Explainer.pm +++ b/lib/Devel/Isa/Explainer.pm @@ -43,7 +43,10 @@ our @SHADOWED_PUBLIC = qw( red ); our $MAX_WIDTH = 80; our $SHOW_SHADOWED = 1; our $INDENT = q[ ] x 4; -our $SHADOW_SUFFIX = q{(^)}; +our $SUFFIX_START = q{(}; +our $SUFFIX_STOP = q{)}; +our $SHADOW_SUFFIX = q{^}; +our $XSUB_SUFFIX = q{}; # TBD our $SHADOWED_SUFFIX = q{}; # TBD our $CLUSTERING = 'type_clustered'; @@ -82,8 +85,15 @@ sub _hl_TYPE_UTIL { } sub _hl_suffix { - return colored( $_[0], $SHADOW_SUFFIX ) if $_[1]->{shadowing}; - return colored( $_[0], $SHADOWED_SUFFIX ) if $_[1]->{shadowed}; + my ($suffix_flags) = q[]; + $suffix_flags .= $SHADOW_SUFFIX if $_[1]->{shadowing}; + $suffix_flags .= $SHADOWED_SUFFIX if $_[1]->{shadowed}; + $suffix_flags .= $XSUB_SUFFIX if $_[1]->{xsub}; + + return colored( $_[0], $SUFFIX_START . $suffix_flags . $SUFFIX_STOP ) + if length $suffix_flags and ( $_[1]->{shadowing} or $_[1]->{shadowed} ); + return $SUFFIX_START . $suffix_flags . $SUFFIX_STOP if length $suffix_flags; + return q[]; } From 5f3691eac7465d3c0e1f0ec63de11ae9c956874e Mon Sep 17 00:00:00 2001 From: Kent Fredric Date: Thu, 21 Apr 2016 00:41:56 +1200 Subject: [PATCH 4/7] Add underlying glue for constant highlighting --- lib/Devel/Isa/Explainer.pm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lib/Devel/Isa/Explainer.pm b/lib/Devel/Isa/Explainer.pm index 854c7d5..2f47de5 100644 --- a/lib/Devel/Isa/Explainer.pm +++ b/lib/Devel/Isa/Explainer.pm @@ -46,6 +46,7 @@ our $INDENT = q[ ] x 4; our $SUFFIX_START = q{(}; our $SUFFIX_STOP = q{)}; our $SHADOW_SUFFIX = q{^}; +our $CONSTANT_SUFFIX = q{}; # TBD our $XSUB_SUFFIX = q{}; # TBD our $SHADOWED_SUFFIX = q{}; # TBD our $CLUSTERING = 'type_clustered'; @@ -89,6 +90,7 @@ sub _hl_suffix { $suffix_flags .= $SHADOW_SUFFIX if $_[1]->{shadowing}; $suffix_flags .= $SHADOWED_SUFFIX if $_[1]->{shadowed}; $suffix_flags .= $XSUB_SUFFIX if $_[1]->{xsub}; + $suffix_flags .= $CONSTANT_SUFFIX if $_[1]->{constant}; return colored( $_[0], $SUFFIX_START . $suffix_flags . $SUFFIX_STOP ) if length $suffix_flags and ( $_[1]->{shadowing} or $_[1]->{shadowed} ); From 632b56a7ff38258e1f7a913f672ede4ef0ae3d8a Mon Sep 17 00:00:00 2001 From: Kent Fredric Date: Thu, 21 Apr 2016 00:42:58 +1200 Subject: [PATCH 5/7] Rename SHADOW_SUFFIX to SHADOWING_SUFFIX for consistency --- lib/Devel/Isa/Explainer.pm | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/lib/Devel/Isa/Explainer.pm b/lib/Devel/Isa/Explainer.pm index 2f47de5..e8f13de 100644 --- a/lib/Devel/Isa/Explainer.pm +++ b/lib/Devel/Isa/Explainer.pm @@ -40,16 +40,16 @@ our @PUBLIC = qw( bold bright_green ); our @SHADOWED_PRIVATE = qw( magenta ); our @SHADOWED_PUBLIC = qw( red ); -our $MAX_WIDTH = 80; -our $SHOW_SHADOWED = 1; -our $INDENT = q[ ] x 4; -our $SUFFIX_START = q{(}; -our $SUFFIX_STOP = q{)}; -our $SHADOW_SUFFIX = q{^}; -our $CONSTANT_SUFFIX = q{}; # TBD -our $XSUB_SUFFIX = q{}; # TBD -our $SHADOWED_SUFFIX = q{}; # TBD -our $CLUSTERING = 'type_clustered'; +our $MAX_WIDTH = 80; +our $SHOW_SHADOWED = 1; +our $INDENT = q[ ] x 4; +our $SUFFIX_START = q{(}; +our $SUFFIX_STOP = q{)}; +our $SHADOWING_SUFFIX = q{^}; +our $CONSTANT_SUFFIX = q{}; # TBD +our $XSUB_SUFFIX = q{}; # TBD +our $SHADOWED_SUFFIX = q{}; # TBD +our $CLUSTERING = 'type_clustered'; =func C @@ -87,10 +87,10 @@ sub _hl_TYPE_UTIL { sub _hl_suffix { my ($suffix_flags) = q[]; - $suffix_flags .= $SHADOW_SUFFIX if $_[1]->{shadowing}; - $suffix_flags .= $SHADOWED_SUFFIX if $_[1]->{shadowed}; - $suffix_flags .= $XSUB_SUFFIX if $_[1]->{xsub}; - $suffix_flags .= $CONSTANT_SUFFIX if $_[1]->{constant}; + $suffix_flags .= $SHADOWING_SUFFIX if $_[1]->{shadowing}; + $suffix_flags .= $SHADOWED_SUFFIX if $_[1]->{shadowed}; + $suffix_flags .= $XSUB_SUFFIX if $_[1]->{xsub}; + $suffix_flags .= $CONSTANT_SUFFIX if $_[1]->{constant}; return colored( $_[0], $SUFFIX_START . $suffix_flags . $SUFFIX_STOP ) if length $suffix_flags and ( $_[1]->{shadowing} or $_[1]->{shadowed} ); From c0903ea1eec148e7cdb4e8d92b8065e8fc3f81e0 Mon Sep 17 00:00:00 2001 From: Kent Fredric Date: Thu, 21 Apr 2016 01:15:15 +1200 Subject: [PATCH 6/7] Add a suffix table for suffixes that are defined --- lib/Devel/Isa/Explainer.pm | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/lib/Devel/Isa/Explainer.pm b/lib/Devel/Isa/Explainer.pm index e8f13de..5e9b4f7 100644 --- a/lib/Devel/Isa/Explainer.pm +++ b/lib/Devel/Isa/Explainer.pm @@ -132,6 +132,15 @@ sub _pp_key { push @tokens, 'Private/Boring Sub another and shadowed itself: ' . _hl_PRIVATE( 'shadowing_shadowed_example', { shadowed => 1, shadowing => 1 } ); } + my @suffixes; + if ($SHOW_SHADOWED) { + push @suffixes, 'shadowing=' . _hl_suffix( ['reset'], { shadowing => 1 } ) if length $SHADOWING_SUFFIX; + push @suffixes, 'shadowed=' . _hl_suffix( ['reset'], { shadowed => 1 } ) if length $SHADOWED_SUFFIX; + } + push @suffixes, 'xsub=' . _hl_suffix( ['reset'], { xsub => 1 } ) if length $XSUB_SUFFIX; + push @suffixes, 'constant=' . _hl_suffix( ['reset'], { constant => 1 } ) if length $CONSTANT_SUFFIX; + + push @tokens, 'Suffixes: ' . join q[, ], @suffixes if @suffixes; push @tokens, 'No Subs: ()'; return sprintf "Key:\n$INDENT%s\n\n", join qq[\n$INDENT], @tokens; } From 8c410a3aa1b398135ec2a40e397b4c29d3170a96 Mon Sep 17 00:00:00 2001 From: Kent Fredric Date: Thu, 19 May 2016 22:30:10 +1200 Subject: [PATCH 7/7] Handle indicating shadow mode differently --- lib/Devel/Isa/Explainer.pm | 37 ++++++++++++++++++++++--------------- 1 file changed, 22 insertions(+), 15 deletions(-) diff --git a/lib/Devel/Isa/Explainer.pm b/lib/Devel/Isa/Explainer.pm index 5e9b4f7..097d3e8 100644 --- a/lib/Devel/Isa/Explainer.pm +++ b/lib/Devel/Isa/Explainer.pm @@ -40,16 +40,17 @@ our @PUBLIC = qw( bold bright_green ); our @SHADOWED_PRIVATE = qw( magenta ); our @SHADOWED_PUBLIC = qw( red ); -our $MAX_WIDTH = 80; -our $SHOW_SHADOWED = 1; -our $INDENT = q[ ] x 4; -our $SUFFIX_START = q{(}; -our $SUFFIX_STOP = q{)}; -our $SHADOWING_SUFFIX = q{^}; -our $CONSTANT_SUFFIX = q{}; # TBD -our $XSUB_SUFFIX = q{}; # TBD -our $SHADOWED_SUFFIX = q{}; # TBD -our $CLUSTERING = 'type_clustered'; +our $MAX_WIDTH = 80; +our $SHOW_SHADOWED = 1; +our $INDENT = q[ ] x 4; +our $SUFFIX_START = q{(}; +our $SUFFIX_STOP = q{)}; +our $SHADOWING_SUFFIX = q{^}; +our $CONSTANT_SUFFIX = q{}; # TBD +our $XSUB_SUFFIX = q{}; # TBD +our $SHADOWED_SUFFIX = q{}; # TBD +our $SHADOWED_BOTTOM_SUFFIX = q{}; # TBD +our $CLUSTERING = 'type_clustered'; =func C @@ -87,10 +88,15 @@ sub _hl_TYPE_UTIL { sub _hl_suffix { my ($suffix_flags) = q[]; - $suffix_flags .= $SHADOWING_SUFFIX if $_[1]->{shadowing}; - $suffix_flags .= $SHADOWED_SUFFIX if $_[1]->{shadowed}; - $suffix_flags .= $XSUB_SUFFIX if $_[1]->{xsub}; - $suffix_flags .= $CONSTANT_SUFFIX if $_[1]->{constant}; + if ( $_[1]->{shadowed} and not $_[1]->{shadowing} ) { + $suffix_flags .= $SHADOWED_BOTTOM_SUFFIX; + } + else { + $suffix_flags .= $SHADOWING_SUFFIX if $_[1]->{shadowing}; + $suffix_flags .= $SHADOWED_SUFFIX if $_[1]->{shadowed}; + } + $suffix_flags .= $XSUB_SUFFIX if $_[1]->{xsub}; + $suffix_flags .= $CONSTANT_SUFFIX if $_[1]->{constant}; return colored( $_[0], $SUFFIX_START . $suffix_flags . $SUFFIX_STOP ) if length $suffix_flags and ( $_[1]->{shadowing} or $_[1]->{shadowed} ); @@ -135,7 +141,8 @@ sub _pp_key { my @suffixes; if ($SHOW_SHADOWED) { push @suffixes, 'shadowing=' . _hl_suffix( ['reset'], { shadowing => 1 } ) if length $SHADOWING_SUFFIX; - push @suffixes, 'shadowed=' . _hl_suffix( ['reset'], { shadowed => 1 } ) if length $SHADOWED_SUFFIX; + push @suffixes, 'shadowed=' . _hl_suffix( ['reset'], { shadowing => 1, shadowed => 1 } ) if length $SHADOWED_SUFFIX; + push @suffixes, 'last_shadowed=' . _hl_suffix( ['reset'], { shadowed => 1 } ) if length $SHADOWED_BOTTOM_SUFFIX; } push @suffixes, 'xsub=' . _hl_suffix( ['reset'], { xsub => 1 } ) if length $XSUB_SUFFIX; push @suffixes, 'constant=' . _hl_suffix( ['reset'], { constant => 1 } ) if length $CONSTANT_SUFFIX;