libdevel-cover-perl 1.08-1ubuntu2 / usr / lib / perl5 / Devel / Cover / Op.pm

This file is indexed.

/usr/lib/perl5/Devel/Cover/Op.pm is in libdevel-cover-perl 1.08-1ubuntu2.

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
119
120
121
122
123
124
125
126
127
# Copyright 2001-2013, 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.08'; # 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.08

=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-2013, 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

APT Browse - Built by Thomas Orozco.