时间戳

首页 > 解决方案 > 为什么 Perl 的 Devel::Cover 认为有些分支和条件没有被覆盖？

perl - 为什么 Perl 的 Devel::Cover 认为有些分支和条件没有被覆盖？

问题描述

我有这个函数，它接受一个数组，计算每个项目出现的频率，并返回一个唯一项目数组，首先按计数排序，然后按字母顺序排序，然后按字母顺序不区分大小写，这样运行之间的顺序就不会改变。

use strict;
use warnings;

sub sorted {
    my @elements = @_;

    my %counts;
    foreach my $e (@elements) {
        $counts{$e}++;
    }

    my @sorted = sort { 
        $counts{$b} <=> $counts{$a} or $a cmp $b or lc $a cmp lc $b
    } keys %counts;

    return @sorted;
}

1;

我有这个测试用例，一切正常：

use strict;
use warnings;
use Test::More;
use module;

is_deeply(['A', 'a', 'c', 'b'], [sorted('a', 'b', 'c', 'a', 'c', 'A', 'A')]);
done_testing();

我运行它并Devel::Cover用来收集测试覆盖率数字。我期望 100% 的覆盖率，但分支和条件覆盖率很短：

HARNESS_PERL_SWITCHES=-MDevel::Cover prove -I. test.t && cover
test.t .. ok   
All tests successful.
Files=1, Tests=1,  1 wallclock secs ( 0.03 usr  0.00 sys +  0.22 cusr  0.02 csys =  0.27 CPU)
Result: PASS
Reading database from ./cover_db


--------- ------ ------ ------ ------ ------ ------ ------
File        stmt   bran   cond    sub    pod   time  total
--------- ------ ------ ------ ------ ------ ------ ------
module.pm  100.0   50.0   66.6  100.0    n/a    0.2   90.4
test.t     100.0    n/a    n/a  100.0    n/a   99.8  100.0
Total      100.0   50.0   66.6  100.0    n/a  100.0   94.8
--------- ------ ------ ------ ------ ------ ------ ------

检查HTML报告，它显示一些分支和条件没有被覆盖：

分支覆盖

条件覆盖

我不明白为什么Devel::Cover认为某些分支和条件没有被涵盖。

它抱怨没有涵盖 TF 的分支，这将是<=>永远不真实的部分？我有两次'a'和'c'，所以<=>当它比较'a'计数（2）和'b'计数（1）时，它应该返回零（F）和非零（T）。

对于条件覆盖，报告说，检查的两个部分都是错误的情况不包括在内。再说一次，我认为我应该把它包括在内，因为我有相同的数量和相同的名字。

我需要添加什么测试用例才能获得 100% 的分支和条件覆盖率？

或者，如果sort这样的函数对 来说很棘手Devel::Cover，我怎么能告诉它忽略这些？我将代码更改为

    my @sorted = sort {
        # uncoverable branch left
        # uncoverable condition true
        $counts{$b} <=> $counts{$a} or $a cmp $b or lc $a cmp lc $b
    } keys %counts;

但这确实得到了相同的结果。

标签： perltestingcode-coveragedevel-cover

解决方案

覆盖率的问题在于，它所比较的​​两个项目的计数永远不会相同（<=>条件是0），并且它们是相同的（第一个cmp条件是0）。

为此，我们需要将一个元素与其自身进行比较，但是排序例程使用来自频率计数的键，而不是使用数组元素——所以任何一个元素都没有两个！所以一个元素永远不会与它自己进行比较，前两个条件永远不会同时失败。

一种解决方案：按实际元素排序，然后选择唯一的元素。

至于分支故障，我现在还不能完全确定，但一个实用（有效）的解决方案是取消这些测试。总共†</sup>

package TestMod;

use strict;
use warnings;    
use List::Util qw(uniq);

sub sorted {
    my @elements = @_;

    my %counts;
    foreach my $e (@elements) {
        $counts{$e}++;
    }

    my @sorted = sort { 
        my $cmp;

        if ( my $nc = $counts{$b} <=> $counts{$a} ) {
            $cmp = $nc
        }
        elsif ( my $ac = $a cmp $b ) {
            $cmp = $ac
        }
        else { $cmp = lc $a cmp lc $b }

        $cmp;
    } @elements;

    return uniq @sorted;
}

1;

现在我明白了

main_TestMod.pl .. ok   
All tests successful.
Files=1, Tests=1,  0 wallclock secs ( 0.02 usr  0.01 sys +  0.29 cusr  0.02 csys =  0.34 CPU)
Result: PASS
Reading database from .../test_coverage/cover_db


--------------- ------ ------ ------ ------ ------ ------ ------
File              stmt   bran   cond    sub    pod   time  total
--------------- ------ ------ ------ ------ ------ ------ ------
TestMod.pm       100.0  100.0    n/a  100.0    0.0    2.5   97.3
main_TestMod.pl  100.0    n/a    n/a  100.0    n/a   97.4  100.0
Total            100.0  100.0    n/a  100.0    0.0  100.0   98.3
--------------- ------ ------ ------ ------ ------ ------ ------


HTML output written to .../test_coverage/cover_db/coverage.html
done.

（我系统上的实际路径被抑制）

注意——现在根本没有条件。FWIW：当我留下一个大的、典型的sort-ish 多重or条件（同时对元素进行排序，而不是频率哈希键）时，该条件确实有 100% 的覆盖率。但是分支失败了。

†</sup> 在这种直接连续测试且没有其他处理的情况下，我们也可以在每个分支中返回（其中的块sort是匿名 sub 并且可以return）

package TestMod;

use strict;
use warnings;    
use List::Util qw(uniq);

sub sorted {
    my @elements = @_;

    my %counts;
    foreach my $e (@elements) {
        $counts{$e}++;
    }

    my @sorted = sort { 
        if ( my $nc = $counts{$b} <=> $counts{$a} ) {
            return $nc
        }
        elsif ( my $ac = $a cmp $b ) {
            return $ac
        }
        else { 
            return lc $a cmp lc $b 
        }
    } @elements;

    return uniq @sorted;
}

1;

推荐阅读