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

Question

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

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'，所以 <=>当比较“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;

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

Answer 1

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

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

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

至于分支故障，我现在不能完全确定，但一个实用(有效)的解决方案是停止这些测试。总而言之^†

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

---

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