Build results of 9162301 (on undefined)

Changes

@@ -3,15 +3,15 @@ Release history for Devel-Isa-Explainer
 0.002002 2016-05-19T14:12:35Z 4b32b3c
  [Dependencies::Stats]
  - Dependencies changed since 0.002001, see misc/*.deps* for details
- - runtime: +1
-
-[Internals]
- - Sub properties now communicated directly to highlighters
+ - runtime: +2
 
 0.002001 2016-05-19T14:07:12Z c167598
  [Documentation]
  - Reference updated screenshots.
 
+ [Internals]
+ - use namespace::clean in a few more places.
+
 0.002000 2016-05-19T12:30:00Z 6c368ff
  - isa-splain now accepts -M parameter to explicitly specify modules to load. This is helpful in handling cases where
    one module inlines others, ( B -> B::CV ) or a module can't be loaded on its own ( Class::MOP::Class )

MANIFEST

@@ -35,6 +35,8 @@ t/cli/basic.t
 t/cli/dash-m.t
 t/internals/01-discover_xsub.t
 t/internals/02-isacache-hide.t
+t/internals/03-discover-constant.t
+t/internals/04-blessed_subs.t
 t/internals/max-width.t
 weaver.ini
 xt/author/critic.t

META.json

@@ -105,6 +105,7 @@
             "MRO::Compat" : "0",
             "Module::Load" : "0",
             "Package::Stash" : "0",
+            "Scalar::Util" : "0",
             "Term::ANSIColor" : "3.00",
             "constant" : "1.03",
             "namespace::clean" : "0",

META.yml

@@ -32,6 +32,7 @@ requires:
   MRO::Compat: '0'
   Module::Load: '0'
   Package::Stash: '0'
+  Scalar::Util: '0'
   Term::ANSIColor: '3.00'
   constant: '1.03'
   namespace::clean: '0'

Makefile.PL

@@ -26,6 +26,7 @@ my %WriteMakefileArgs = (
     "MRO::Compat" => 0,
     "Module::Load" => 0,
     "Package::Stash" => 0,
+    "Scalar::Util" => 0,
     "Term::ANSIColor" => "3.00",
     "constant" => "1.03",
     "namespace::clean" => 0,
@@ -54,6 +55,7 @@ my %FallbackPrereqs = (
   "MRO::Compat" => 0,
   "Module::Load" => 0,
   "Package::Stash" => 0,
+  "Scalar::Util" => 0,
   "Term::ANSIColor" => "3.00",
   "Test::Builder" => 0,
   "Test::More" => "0.89",

lib/Devel/Isa/Explainer.pm

@@ -16,6 +16,9 @@ use Carp           ('croak');
 use Package::Stash ();
 use MRO::Compat    ();
 use B              ('svref_2object');
+use Scalar::Util   ('reftype');
+
+use constant _HAS_CONST => B::CV->can('CONST');
 
 # Perl critic is broken. This is not a void context.
 ## no critic (BuiltinFunctions::ProhibitVoidMap)
@@ -37,12 +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 $SHADOW_SUFFIX   = q{(^)};
-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';
 
 
 
@@ -79,8 +86,16 @@ 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 .= $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} );
+  return $SUFFIX_START . $suffix_flags . $SUFFIX_STOP if length $suffix_flags;
+
   return q[];
 }
 
@@ -117,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;
 }
@@ -257,9 +281,12 @@ sub _extract_mro {
     for my $isa ( @{ $seen_subs->{$sub} } ) {
 
       # mark all subs both shadowing and shadowed until proven otherwise
-      $class_data->{$isa}->{$sub} = { shadowed => 1, shadowing => 1, xsub => 0 };
-      $class_data->{$isa}->{$sub}->{xsub} = 1 if $isa->can($sub) and svref_2object( $isa->can($sub) )->XSUB;
-
+      $class_data->{$isa}->{$sub} = { shadowed => 1, shadowing => 1, xsub => 0, constant => 0 };
+      my $coderef = $isa->can($sub);
+      next unless 'CODE' eq reftype $coderef;
+      my $cv = svref_2object($coderef);
+      $class_data->{$isa}->{$sub}->{constant} = 1, next if _HAS_CONST ? $cv->CONST : ref $cv->XSUBANY;
+      $class_data->{$isa}->{$sub}->{xsub} = 1 if $cv->XSUB;
     }
 
     # mark top-most sub unshadowed

maint/perlcritic.rc.gen.pl

@@ -30,6 +30,7 @@
 $bundle->remove_policy('TestingAndDebugging::ProhibitNoStrict');
 $bundle->remove_policy('Subroutines::ProhibitCallsToUndeclaredSubs');
 $bundle->remove_policy('Subroutines::RequireArgUnpacking');
+$bundle->remove_policy('ValuesAndExpressions::ProhibitCommaSeparatedStatements');
 #$bundle->remove_policy('CodeLayout::RequireUseUTF8');
 #$bundle->remove_policy('ErrorHandling::RequireCarping');
 $bundle->remove_policy('NamingConventions::Capitalization');

misc/Changes.deps

@@ -3,6 +3,7 @@ This file contains changes in REQUIRED dependencies for standard CPAN phases (co
 0.002002
  [Added / runtime requires]
  - B
+ - Scalar::Util
 
 0.002001 2016-05-19T14:07:12Z
 

misc/Changes.deps.all

@@ -3,6 +3,7 @@ This file contains ALL changes in dependencies in both REQUIRED / OPTIONAL depen
 0.002002
  [Added / runtime requires]
  - B
+ - Scalar::Util
 
 0.002001 2016-05-19T14:07:12Z
 

misc/built_with.json

@@ -65,6 +65,7 @@
       "Module::Load" : "0.32",
       "Package::Stash" : "0.37",
       "Pod::Coverage::TrustPod" : "0.100003",
+      "Scalar::Util" : "1.45",
       "Software::License::Perl_5" : "0.103012",
       "Term::ANSIColor" : "4.03",
       "Test::Builder" : "1.001014",

perlcritic.rc

@@ -369,7 +369,7 @@ base_max = 130
 
 [ValuesAndExpressions::ProhibitBarewordDoubleColon]
 
-[ValuesAndExpressions::ProhibitCommaSeparatedStatements]
+[-ValuesAndExpressions::ProhibitCommaSeparatedStatements]
 
 [ValuesAndExpressions::ProhibitComplexVersion]
 

t/00-report-prereqs.dd

@@ -90,6 +90,7 @@ do { my $x = {
                                       'MRO::Compat' => '0',
                                       'Module::Load' => '0',
                                       'Package::Stash' => '0',
+                                      'Scalar::Util' => '0',
                                       'Term::ANSIColor' => '3.00',
                                       'constant' => '1.03',
                                       'namespace::clean' => '0',

t/02-shadowing.t

@@ -68,17 +68,17 @@ is( scalar keys %{ $mro->[2]->{subs} }, 3, "base class has 3 subs" );
 
 is_deeply(
   $mro->[0]->{subs}->{three_layer_shadow},
-  { shadowing => 1, shadowed => 0, xsub => 0 },
+  { shadowing => 1, shadowed => 0, xsub => 0, constant => 0 },
   "three layer shadow top layer shadowing but not shadowed"
 );
 is_deeply(
   $mro->[1]->{subs}->{three_layer_shadow},
-  { shadowing => 1, shadowed => 1, xsub => 0 },
+  { shadowing => 1, shadowed => 1, xsub => 0, constant => 0 },
   "three layer shadow middle layer shadowing and shadowed"
 );
 is_deeply(
   $mro->[2]->{subs}->{three_layer_shadow},
-  { shadowing => 0, shadowed => 1, xsub => 0 },
+  { shadowing => 0, shadowed => 1, xsub => 0, constant => 0 },
   "three layer shadow bottom layer shadowed but not shadowing"
 );
 

t/internals/03-discover-constant.t

@@ -0,0 +1,34 @@
+use strict;
+use warnings;
+
+use Test::More;
+{
+  package My::Test;
+  sub constant_sub() { 'Hello' }
+}
+use Devel::Isa::Explainer ();
+
+*extract_mro = \&Devel::Isa::Explainer::_extract_mro;
+{
+  my $mro  = extract_mro("My::Test");
+  my $fail = 0;
+  for my $class ( @{$mro} ) {
+    next unless $class->{class} eq 'My::Test';
+    $fail = 1 unless ok( exists $class->{subs}->{'constant_sub'},  "constant_sub discovered in class" );
+    $fail = 1 unless ok( $class->{subs}->{'constant_sub'}->{constant}, "constant_sub is a constant sub" );
+  }
+  diag explain $mro if $fail;
+
+}
+{
+  my $mro  = extract_mro("Devel::Isa::Explainer");
+  my $fail = 0;
+  for my $class ( @{$mro} ) {
+    next unless $class->{class} eq 'Devel::Isa::Explainer';
+    $fail = 1 unless ok( exists $class->{subs}->{'explain_isa'},   "explain_isa discovered in class" );
+    $fail = 1 unless ok( !$class->{subs}->{'explain_isa'}->{constant}, "explain_isa is NOT a constant sub" );
+  }
+  diag explain $mro if $fail;
+}
+
+done_testing;

t/internals/04-blessed_subs.t

@@ -0,0 +1,32 @@
+use strict;
+use warnings;
+
+use Test::More;
+use B qw();
+{
+  package My::Test;
+  sub constant_sub() { 'Hello' }
+  BEGIN {
+    bless \&My::Test::constant_sub, 'My::Test';
+    *My::Test::xsub = \&B::svref_2object;
+    bless \&My::Test::xsub, 'B';
+  };
+}
+
+use Devel::Isa::Explainer ();
+
+*extract_mro = \&Devel::Isa::Explainer::_extract_mro;
+{
+  my $mro  = extract_mro("My::Test");
+  my $fail = 0;
+  for my $class ( @{$mro} ) {
+    next unless $class->{class} eq 'My::Test';
+    $fail = 1 unless ok( exists $class->{subs}->{'constant_sub'},  "constant_sub discovered in class" );
+    $fail = 1 unless ok( $class->{subs}->{'constant_sub'}->{constant}, "constant_sub is a constant sub" );
+    $fail = 1 unless ok( exists $class->{subs}->{'xsub'},  "xsub discovered in class" );
+    $fail = 1 unless ok( $class->{subs}->{'xsub'}->{xsub}, "xsub is an XSUB" );
+  }
+  diag explain $mro if $fail;
+
+}
+done_testing;

xt/author/eol.t

@@ -20,6 +20,8 @@ my @files = (
     't/cli/dash-m.t',
     't/internals/01-discover_xsub.t',
     't/internals/02-isacache-hide.t',
+    't/internals/03-discover-constant.t',
+    't/internals/04-blessed_subs.t',
     't/internals/max-width.t'
 );