This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Concise: improve hints decoding
authorDavid Mitchell <davem@iabyn.com>
Fri, 19 Aug 2016 10:30:47 +0000 (11:30 +0100)
committerDavid Mitchell <davem@iabyn.com>
Fri, 19 Aug 2016 10:30:47 +0000 (11:30 +0100)
Include the missing HINT_UNI_8_BIT (as 'us'), decode the feature bundle
bits (as fea=7) and display any unrecognised bits in hex rather than
decimal.

This changes a nextstate following 'use feature "signatures"' from, to

    2     <;> nextstate(...) v:%,{,469762048 ->3
    2     <;> nextstate(...) v:%,{,fea=7 ->3

ext/B/B/Concise.pm
ext/B/t/concise.t

index 4688a8c..34efc2c 100644 (file)
@@ -14,7 +14,7 @@ use warnings; # uses #3 and #4, since warnings uses Carp
 
 use Exporter (); # use #5
 
-our $VERSION   = "0.997";
+our $VERSION   = "0.998";
 our @ISA       = qw(Exporter);
 our @EXPORT_OK = qw( set_style set_style_standard add_callback
                     concise_subref concise_cv concise_main
@@ -604,22 +604,34 @@ our %hints; # used to display each COP's op_hints values
 @hints{0x1000,0x2000,0x4000,0x8000,0x10000} = ('I', 'F', 'B', 'S', 'R');
 # taint and eval
 @hints{0x100000,0x200000} = ('T', 'E');
-# filetest access, UTF-0x8
-@hints{0x400000,0x800000} = ('X', 'U');
+# filetest access, use utf8, unicode_strings feature
+@hints{0x400000,0x800000,0x800} = ('X', 'U', 'us');
 
-sub _flags {
-    my($hash, $x) = @_;
+# pick up the feature hints constants.
+# Note that we're relying on non-API parts of feature.pm,
+# but its less naughty than just blindly copying those constants into
+# this src file.
+#
+require feature;
+
+sub hints_flags {
+    my($x) = @_;
     my @s;
-    for my $flag (sort {$b <=> $a} keys %$hash) {
-       if ($hash->{$flag} and $x & $flag and $x >= $flag) {
+    for my $flag (sort {$b <=> $a} keys %hints) {
+       if ($hints{$flag} and $x & $flag and $x >= $flag) {
            $x -= $flag;
-           push @s, $hash->{$flag};
+           push @s, $hints{$flag};
        }
     }
-    push @s, $x if $x;
+    if ($x & $feature::hint_mask) {
+        push @s, "fea=" . (($x & $feature::hint_mask) >> $feature::hint_shift);
+        $x &= ~$feature::hint_mask;
+    }
+    push @s, sprintf "0x%x", $x if $x;
     return join(",", @s);
 }
 
+
 # return a string like 'LVINTRO,1' for the op $name with op_private
 # value $x
 
@@ -677,11 +689,6 @@ sub private_flags {
     return join ",", @flags;
 }
 
-sub hints_flags {
-    my($x) = @_;
-    _flags(\%hints, $x);
-}
-
 sub concise_sv {
     my($sv, $hr, $preferpv) = @_;
     $hr->{svclass} = class($sv);
@@ -1597,6 +1604,9 @@ string if this is not a COP. Here are the symbols used:
     X filetest access
     U utf-8
 
+    us      use feature 'unicode_strings'
+    fea=NNN feature bundle number
+
 =item B<#hintsval>
 
 The numeric value of the COP's hint flags, or an empty string if this is not
index bb1056f..fe955d1 100644 (file)
@@ -10,7 +10,7 @@ BEGIN {
     require 'test.pl';         # we use runperl from 'test.pl', so can't use Test::More
 }
 
-plan tests => 163;
+plan tests => 167;
 
 require_ok("B::Concise");
 
@@ -502,4 +502,22 @@ $end =~ s/<NEXT>/$next/;
 
 like $out, qr/$end/, 'OP_AND->op_other points correctly';
 
+# test nextstate hints display
+
+{
+
+    $out = runperl(
+        switches => ["-MO=Concise"],
+        prog => q{my $x; use strict; use warnings; $x++; use feature q(:5.11); $x++},
+        stderr => 1,
+    );
+
+    my @hints = $out =~ /nextstate\([^)]+\) (.*) ->/g;
+
+    is(scalar(@hints), 3, "3 hints");
+    is($hints[0], 'v:{',                           "hints[0]");
+    is($hints[1], 'v:*,&,{,x*,x&,x$,$',            "hints[1]");
+    is($hints[2], 'v:%,us,*,&,{,x*,x&,x$,$,fea=7', "hints[2]");
+}
+
 __END__