Re^2: Testing: shades of grey

I think you should read this sub thread (again): Re: Testing: shades of grey

You can

bundle test routines into abstract functions
fine tune output and behavior with Test::Builder
analyse the output with TAP::Parser

Regarding the weights, I'd start with reasonable defaults unless specified. For instance if you have an order of preferable results, degrade the weight appropriately if better options are missed.

And I'd group different features in different TODO classes. Like that you can have multi-dimensional quality metrics and are free to combine them into one dimension again.

All this gives you plenty of possibilities of easy adjustments at a later stage.

Cheers Rolf
_{(addicted to the Perl Programming Language :)

see Wikisyntax for the Monastery}

Comment on Re^2: Testing: shades of grey

Replies are listed 'Best First'.
Re^3: Testing: shades of grey by LanX (Saint) on Dec 26, 2024 at 02:08 UTC
Maybe this minimal demo gets you started? It's implementing a basic test function "rank" which tests `eq` and does a linear quality ranking from 1 to 0 against the provided list. The output includes a field `"quality:"` You are free to extend this in multiple ways, like providing the internal test function, e.g `rank( 'is', ,...)` adjusting the ranking curve checking if $TODO is set taking advantage of the todo_output handle to collect metrics separately As already said I'd use TAP::Parser to find the quality fields. use strict; use warnings; use Test::More; TODO: { local $TODO = "STRINGIFICATION"; rank( 'a-b' => ['a+(-b)', 'a+-b', 'a-b'], "to pass" ); rank( 'a--b' => ['a+(-b)', 'a+-b', 'a-b'], "to fail" ); } sub rank { my ($got, $a_exps, $name) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; my @exps = @$a_exps; my $pos = 0; my %rank = map { $_ => 1- ($pos++ / @exps) } @exps; my $quality = $rank{$got}; if($quality){ pass($name); diag( sprintf "%12s: %.2f", "quality", $quality ); } else { fail($name); diag( sprintf "%12s: %s", "got","'$got'" ); diag( sprintf "%12s: %s", "expected", join ", ", map {"'$_'"} +@exps ); diag( sprintf "%12s: %.2f", "quality", 0 ); } } done_testing; exit; __END__ [download] `ok 1 - to pass # TODO STRINGIFICATION # quality: 0.33 not ok 2 - to fail # TODO STRINGIFICATION # Failed (TODO) test 'to fail' # at /home/lanx/perl/pm/test_rank.pl line 10. # got: 'a--b' # expected: 'a+(-b)', 'a+-b', 'a-b' # quality: 0.00 1..2` [download] Cheers Rolf _{(addicted to the Perl Programming Language :) see Wikisyntax for the Monastery}	[reply] [d/l] [select]

Replies are listed 'Best First'.

Re^3: Testing: shades of grey
by LanX (Saint) on Dec 26, 2024 at 02:08 UTC

It's implementing a basic test function "rank" which tests eq and does a linear quality ranking from 1 to 0 against the provided list.

The output includes a field "quality:"

You are free to extend this in multiple ways, like

providing the internal test function, e.g rank( 'is', ,...)
adjusting the ranking curve
checking if $TODO is set
taking advantage of the todo_output handle to collect metrics separately

TAP::Parser

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

TODO: {
    local $TODO = "STRINGIFICATION";

    rank( 'a-b'  => ['a+(-b)', 'a+-b', 'a-b'], "to pass" );
    rank( 'a--b' => ['a+(-b)', 'a+-b', 'a-b'], "to fail" );
}



sub rank {
    my ($got, $a_exps, $name) = @_;

    local $Test::Builder::Level = $Test::Builder::Level + 1;

    my @exps = @$a_exps;
    my $pos  = 0;
    my %rank = map { $_ => 1- ($pos++ / @exps) } @exps;

    my $quality = $rank{$got};
    if($quality){
        pass($name);
        diag( sprintf "%12s: %.2f", "quality", $quality );
    } else {
        fail($name);
        diag( sprintf "%12s: %s", "got","'$got'" );
        diag( sprintf "%12s: %s", "expected", join ", ", map {"'$_'"} 
+@exps );
        diag( sprintf "%12s: %.2f", "quality", 0 );
    }

}
done_testing;
exit;
__END__
[download]

ok 1 - to pass # TODO STRINGIFICATION # quality: 0.33 not ok 2 - to fail # TODO STRINGIFICATION # Failed (TODO) test 'to fail' # at /home/lanx/perl/pm/test_rank.pl line 10. # got: 'a--b' # expected: 'a+(-b)', 'a+-b', 'a-b' # quality: 0.00 1..2
[download]

Cheers Rolf
_{(addicted to the Perl Programming Language :)

see Wikisyntax for the Monastery}

[reply]
[d/l]
[select]