From 54766b122d9abd7580e0e1223be2ed3861e9035a Mon Sep 17 00:00:00 2001 From: Ed J Date: Wed, 10 Jan 2024 20:45:35 +0000 Subject: [PATCH] incorporate Ufunc tests into t/ufunc.t not just complain --- MANIFEST | 1 - t/lib/My/Test/Primitive.pm | 4 -- t/primitive/Ufunc.t | 82 -------------------------------------- t/ufunc.t | 80 +++++++++++++++++++++++++++++++++---- 4 files changed, 72 insertions(+), 95 deletions(-) delete mode 100644 t/primitive/Ufunc.t diff --git a/MANIFEST b/MANIFEST index 4bf12b507..08711bb74 100644 --- a/MANIFEST +++ b/MANIFEST @@ -729,7 +729,6 @@ t/primitive/random.t t/primitive/selector.t t/primitive/setops.t t/primitive/stats.t -t/primitive/Ufunc.t t/primitive/vector.t t/primitive/vsearch.t t/pthread.t diff --git a/t/lib/My/Test/Primitive.pm b/t/lib/My/Test/Primitive.pm index 62143dac5..a3b07df65 100644 --- a/t/lib/My/Test/Primitive.pm +++ b/t/lib/My/Test/Primitive.pm @@ -1,11 +1,7 @@ use strict; use warnings; -use Test2::V0 '!float'; use PDL::LiteF; -use Exporter 'import'; -our @EXPORT = qw( tapprox ); - sub tapprox { my ( $x, $y ) = @_; $_ = pdl($_) for $x, $y; diff --git a/t/primitive/Ufunc.t b/t/primitive/Ufunc.t deleted file mode 100644 index d95c1b186..000000000 --- a/t/primitive/Ufunc.t +++ /dev/null @@ -1,82 +0,0 @@ -use strict; -use warnings; -use Test2::V0 '!float'; - -use PDL::LiteF; -use PDL::Types; -use Test::Lib; -use My::Test::Primitive; - -diag "These tests should be in Ufunc, not Primitive"; - -# provide independent copies of test data. -sub X { PDL->pdl( [ [ 5, 4, 3 ], [ 2, 3, 1.5 ] ] ) } - -ok( tapprox( X->average(), PDL->pdl( [ 4, 2.16666 ] ) ), "average" ); -ok( tapprox( X->sumover(), PDL->pdl( [ 12, 6.5 ] ) ), "sumover" ); -ok( tapprox( X->prodover(), PDL->pdl( [ 60, 9 ] ) ), "prodover" ); - - -# provide independent copies of test data. -sub IM { - PDL->new( - [ - [ 1, 2, 3, 3, 5 ], - [ 2, 3, 4, 5, 6 ], - [ 13, 13, 13, 13, 13 ], - [ 1, 3, 1, 3, 1 ], - [ 10, 10, 2, 2, 2, ] - ] - ); -} - -subtest 'minmax' => sub { - my @minMax = IM->minmax; - ok( $minMax[0] == 1, "minmax min" ); - ok( $minMax[1] == 13, "minmax max" ); -}; - -subtest dsumover => sub { - my $x = ones( byte, 3000 ); - my $y; - dsumover( $x, ( $y = null ) ); - is( $y->get_datatype, $PDL_D, "get_datatype" ); - is( $y->at, 3000, "at" ); -}; - -subtest 'minimum_n_ind' => sub { - - subtest 'usage' => sub { - my $p = pdl [ 1, 2, 3, 4, 7, 9, 1, 1, 6, 2, 5 ]; - my $q = zeroes 5; - minimum_n_ind $p, $q; - ok( tapprox( $q, pdl( 0, 6, 7, 1, 9 ) ), "usage 1" ); - $q = minimum_n_ind( $p, 5 ); - ok( tapprox( $q, pdl( 0, 6, 7, 1, 9 ) ), "usage 2" ); - minimum_n_ind( $p, $q = null, 5 ); - ok( tapprox( $q, pdl( 0, 6, 7, 1, 9 ) ), "usage 3" ); - }; - - subtest 'BAD' => sub { - my $p = pdl '[1 BAD 3 4 7 9 1 1 6 2 5]'; - my $q = zeroes 5; - minimum_n_ind $p, $q; - is $q. '', '[0 6 7 9 2]', "BAD"; - }; - - subtest 'insufficient good' => sub { - my $p = pdl '[1 BAD 3 4 BAD BAD]'; - my $q = zeroes 5; - minimum_n_ind $p, $q; - is $q. '', '[0 2 3 BAD BAD]', "insufficient good"; - }; - - subtest 'bad & good' => sub { - my $p = pdl '[1 BAD 3 4 BAD BAD 3 1 5 8 9]'; - my $q = zeroes 5; - minimum_n_ind $p, $q; - is $q. '', '[0 7 2 6 3]', "some bad, sufficient good"; - } -}; - -done_testing; diff --git a/t/ufunc.t b/t/ufunc.t index 9c9853954..eae42ee69 100644 --- a/t/ufunc.t +++ b/t/ufunc.t @@ -2,14 +2,9 @@ use strict; use warnings; use Test::More; use PDL::LiteF; - -sub tapprox ($$) { - my ( $x, $y ) = @_; - my $d = abs( $x - $y ); - my $check = ($d <= 0.0001); - diag "diff = [$d]\n" unless my $res = all $check; - return $res; -} +use PDL::Types; +use Test::Lib; +use My::Test::Primitive; my $p = pdl([]); $p->setdims([1,0]); $p->qsortvec; # shouldn't segfault! my $p2d = pdl([[1,2],[3,4],[1,3],[1,2],[3,3]]); @@ -201,4 +196,73 @@ is( pdl([-6,~0,-4])->setvaltobad(~0)->bandover(), -8, "bandover with BAD values" is ushort(65535)->max, 65535, 'max(highest ushort value) should not be BAD'; +# provide indepdent copies of test data. +sub X { PDL->pdl( [ [ 5, 4, 3 ], [ 2, 3, 1.5 ] ] ) } + +ok( tapprox( X->average(), PDL->pdl( [ 4, 2.16666 ] ) ), "average" ); +ok( tapprox( X->sumover(), PDL->pdl( [ 12, 6.5 ] ) ), "sumover" ); +ok( tapprox( X->prodover(), PDL->pdl( [ 60, 9 ] ) ), "prodover" ); + +# provide indepdent copies of test data. +sub IM { + PDL->new( + [ + [ 1, 2, 3, 3, 5 ], + [ 2, 3, 4, 5, 6 ], + [ 13, 13, 13, 13, 13 ], + [ 1, 3, 1, 3, 1 ], + [ 10, 10, 2, 2, 2, ] + ] + ); +} + +subtest 'minmax' => sub { + my @minMax = IM->minmax; + ok( $minMax[0] == 1, "minmax min" ); + ok( $minMax[1] == 13, "minmax max" ); +}; + +subtest dsumover => sub { + my $x = ones( byte, 3000 ); + my $y; + dsumover( $x, ( $y = null ) ); + is( $y->get_datatype, $PDL_D, "get_datatype" ); + is( $y->at, 3000, "at" ); +}; + +subtest 'minimum_n_ind' => sub { + + subtest 'usage' => sub { + my $p = pdl [ 1, 2, 3, 4, 7, 9, 1, 1, 6, 2, 5 ]; + my $q = zeroes 5; + minimum_n_ind $p, $q; + ok( tapprox( $q, pdl( 0, 6, 7, 1, 9 ) ), "usage 1" ); + $q = minimum_n_ind( $p, 5 ); + ok( tapprox( $q, pdl( 0, 6, 7, 1, 9 ) ), "usage 2" ); + minimum_n_ind( $p, $q = null, 5 ); + ok( tapprox( $q, pdl( 0, 6, 7, 1, 9 ) ), "usage 3" ); + }; + + subtest 'BAD' => sub { + my $p = pdl '[1 BAD 3 4 7 9 1 1 6 2 5]'; + my $q = zeroes 5; + minimum_n_ind $p, $q; + is $q. '', '[0 6 7 9 2]', "BAD"; + }; + + subtest 'insufficient good' => sub { + my $p = pdl '[1 BAD 3 4 BAD BAD]'; + my $q = zeroes 5; + minimum_n_ind $p, $q; + is $q. '', '[0 2 3 BAD BAD]', "insufficient good"; + }; + + subtest 'bad & good' => sub { + my $p = pdl '[1 BAD 3 4 BAD BAD 3 1 5 8 9]'; + my $q = zeroes 5; + minimum_n_ind $p, $q; + is $q. '', '[0 7 2 6 3]', "some bad, sufficient good"; + } +}; + done_testing;