/usr/lib/x86_64-linux-gnu/perl5/5.24/Devel/Cover/Op.pm is in libdevel-cover-perl 1.23-2+b1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 | # Copyright 2001-2016, Paul Johnson (paul@pjcj.net)
# This software is free. It is licensed under the same terms as Perl itself.
# The latest version of this software should be available from my homepage:
# http://www.pjcj.net
package Devel::Cover::Op;
require 5.8.0; # My patches to B::Concise didn't get released till 5.8.0.
use strict;
use warnings;
our $VERSION = '1.23'; # VERSION
use Devel::Cover::Dumper;
use Devel::Cover qw( -ignore blib -ignore \\wB\\w );
use B::Concise qw( set_style add_callback );
my %style =
("terse" =>
["(?(#label =>\n)?)(*( )*)#class (#addr) #name <#cover> (?([#targ])?) "
. "#svclass~(?((#svaddr))?)~#svval~(?(label \"#coplabel\")?)\n",
"(*( )*)goto #class (#addr)\n",
"#class pp_#name"],
"concise" =>
["#hyphseq2 #addr10 #cover12 (*( (x( ;)x))*)<#classsym> "
. "#exname#arg(?([#targarglife])?)~#flags(?(/#private)?)(x(;~->#next)x)\n",
" (*( )*) goto #seq\n",
"(?(<#seq>)?)#exname#arg(?([#targarglife])?)"],
"debug" =>
["#class (#addr)\n\tcover\t\t#cover\n\top_next\t\t#nextaddr\n\top_sibling\t#sibaddr\n\t"
. "op_ppaddr\tPL_ppaddr[OP_#NAME]\n\top_type\t\t#typenum\n\top_seq\t\t"
. "#seqnum\n\top_flags\t#flagval\n\top_private\t#privval\n"
. "(?(\top_first\t#firstaddr\n)?)(?(\top_last\t\t#lastaddr\n)?)"
. "(?(\top_sv\t\t#svaddr\n)?)",
" GOTO #addr\n",
"#addr"],
);
my @Options;
sub import {
my $class = shift;
set_style(@{$style{concise}});
for (@_) {
/-(.*)/ && exists $style{$1}
? set_style(@{$style{$1}})
: push @Options, $_;
}
my $final = 1;
add_callback(sub {
my ($h, $op, $format, $level) = @_;
my $key = Devel::Cover::get_key($op);
# print Dumper Devel::Cover::coverage unless $d++;
if ($h->{seq}) {
my ($s, $b, $c) =
map Devel::Cover::coverage($final ? $final-- : 0)->{$_}{$key},
qw(statement branch condition);
local $" = ",";
no warnings "uninitialized";
$h->{cover} = $s ? "s[$s]" :
$b ? "b[@$b]" :
$c ? "c[@$c]" :
"";
} else {
$h->{cover} = "";
}
});
}
END { B::Concise::compile(@Options)->() }
1
__END__
=head1 NAME
Devel::Cover::Op - B::Concise with coverage data
=head1 VERSION
version 1.23
=head1 SYNOPSIS
perl -Mblib -MDevel::Cover::Op prog [options]
=head1 DESCRIPTION
This module works as if calling B::Concise but also outputs coverage
information. Its primary purpose is to aid in the development of Devel::Cover.
See comments in Cover.xs (especially set_conditional()) to aid in interpreting
the output.
=head1 SEE ALSO
Devel::Cover
=head1 BUGS
Huh?
=head1 LICENCE
Copyright 2001-2016, Paul Johnson (paul@pjcj.net)
This software is free. It is licensed under the same terms as Perl itself.
The latest version of this software should be available from my homepage:
http://www.pjcj.net
=cut
|