为什么 Perl 的 Devel::Cover 认为某些分支和条件没有涵盖？

Question

我有这个函数，它接受一个数组，计算每个项目出现的频率，returns 一个独特项目的数组，首先按计数排序，然后按字母顺序排序，然后按字母顺序不区分大小写，所以该顺序在运行秒之间不会改变。

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 认为某些分支和条件没有涵盖。

它抱怨 T F 的分支没有被覆盖，这将是 <=> 部分永远不正确？我有两次 'a' 和 'c'，因此 <=> 在比较 [=47= 时应该 return 零（F）和非零（T） ] 计数 (2) 到 'b' 计数 (1).

对于条件覆盖，报告说不包括检查的两个部分都为假的情况。同样，我认为我应该涵盖这一点，因为我的人数和名字都相同。

我需要添加什么测试用例才能获得 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;

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

Answer 1

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

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

一个解决方案：按实际元素排序，然后 select 个唯一元素。

至于分支失败，我现在不能完全确定，但一个实用的（可行的）解决方案是停止这些测试。一共^†

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 multi-or-ed 条件（同时对元素进行排序，而不是频率哈希键）时，该条件确实具有 100% 的覆盖率。但是分支失败了。

^† 在这种直接连续测试且没有其他处理的情况下，我们也可以在每个分支中 return （sort 中的块是匿名的子和一罐 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;

为什么 Perl 的 Devel::Cover 认为某些分支和条件没有涵盖？

Why does Perl's Devel::Cover think some branches and conditions are not covered?

testing

perl

code-coverage

devel-cover