File: Util.pm

package info (click to toggle)
libtest-deep-unorderedpairs-perl 0.006-3
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 288 kB
  • sloc: perl: 351; makefile: 2
file content (38 lines) | stat: -rw-r--r-- 871 bytes parent folder | download | duplicates (2)
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
use strict;
use warnings;

use Test::Deep qw(cmp_details deep_diag);

sub test_plugin
{
    # got and exp to use in test;
    # expecting an ok?
    # expected diag, if not ok
    my ($data_got, $data_exp, $exp_ok, $exp_diag) = @_;
    return sub {
        my ($ok, $stack) = cmp_details($data_got, $data_exp);

        ok( !($ok xor $exp_ok), 'test ' . ($exp_ok ? 'passed' : 'failed'));
        return if not Test::Builder->new->is_passing;

        if (not $ok)
        {
            my $diag = deep_diag($stack);
            if (__is_regexp($exp_diag))
            {
                like($diag, $exp_diag, 'failure diagnostics');
            }
            else
            {
                is($diag, $exp_diag, 'failure diagnostics');
            }
        }
    };
}

sub __is_regexp
{
    re->can('is_regexp') ? re::is_regexp(shift) : ref(shift) eq 'Regexp';
}

1;