IO::GD tests replace tapprox with is_pdl - #34

PDLPorters · Oct 30, 2024 · 55ced64 · 55ced64
1 parent 2e0655f
commit 55ced64
Show file tree

Hide file tree

Showing 2 changed files with 12 additions and 43 deletions.
diff --git a/IO/GD/t/gd_oo_tests.t b/IO/GD/t/gd_oo_tests.t
@@ -6,17 +6,10 @@ use strict;
 use warnings;
 use PDL;
 use Test::More;
+use Test::PDL;
 use File::Temp qw(tempdir);
 use PDL::IO::GD;
 
-sub tapprox {
-    my $x = shift;
-    my $y = shift;
-    my $d = abs($x - $y);
-    #ok( all($d < 1.0e-5) );
-    return all($d < 1.0e-5);
-}
-
 my $tempdir = tempdir( CLEANUP => 1 );
 my $lutfile = "$tempdir/default.rcols";
 my $testfile_lut = "$tempdir/test.png";
@@ -26,7 +19,6 @@ my $testfile_true = "$tempdir/test3.png";
 # Write out the lutfile below, so we don't have to include it in the distro:
 write_lut($lutfile);
 
-#diag "Test writing byte (8bit) PNG image...\n";
 my $pdl = sequence(byte, 30, 30);
 
 my $lut = load_lut( $lutfile );
@@ -39,21 +31,13 @@ write_true_png(sequence(100, 100, 3), $testfile_true);
 eval {PDL::IO::GD->new( { filename => "$tempdir/notthere.png" } )};
 like $@, qr/Error/, 'exception not segfault on non-existent file';
 my $gd = PDL::IO::GD->new( { filename => $testfile_lut } );
-#diag "Object created!\n";
 ok( defined( $gd ), 'Object created' );
 
-my $x = $gd->gdImageSX();
-ok( $x, 'query X dim' );
-my $y = $gd->gdImageSY();
-ok( $y, 'query Y dim' );
-
-my $pdl2 = $gd->to_pdl;
-ok( tapprox( $pdl, $pdl2 ), 'image matches original pdl' );
+is $gd->gdImageSX, 30, 'query X dim';
+is $gd->gdImageSY, 30, 'query Y dim';
 
-my $pdl3 = $gd->to_rpic->slice(',-1:0');
-ok( tapprox( $pdl3, $pdl ), 'rpic image matches original pdl' )
-  or diag 'orig(0:3,0:3)=', $pdl->slice('0:3,0:3'),
-    'new(0:3,0:3)=', $pdl3->slice('0:3,0:3');
+is_pdl $gd->to_pdl, $pdl->long, 'image matches original pdl';
+is_pdl $gd->to_rpic->slice(',-1:0'), $pdl->long, 'rpic image matches original pdl';
 
 undef $gd;
 

diff --git a/IO/GD/t/gd_tests.t b/IO/GD/t/gd_tests.t
@@ -6,17 +6,10 @@ use strict;
 use warnings;
 use PDL;
 use Test::More;
+use Test::PDL;
 use File::Temp qw(tempdir);
 use PDL::IO::GD;
 
-sub tapprox {
-    my $x = shift;
-    my $y = shift;
-    my $d = abs($x - $y);
-    #ok( all($d < 1.0e-5) );
-    return all($d < 1.0e-5);
-}
-
 # Test Files:
 my $tempdir = tempdir( CLEANUP=>1 );
 
@@ -34,24 +27,16 @@ ok( ($lut->dim(0) == 3 && $lut->dim(1) == 256) );
 
 eval {write_png( sequence(16,16), sequence(255)->dummy(0,3), $testfile1 )};
 like $@, qr/exceeded LUT size/, 'too-short LUT throws exception';
-
 my $pdl = sequence(byte, 30, 30);
 write_png( $pdl, $lut, $testfile1 );
-
-my $tc_pdl = sequence(byte, 100, 100, 3);
-write_true_png( $tc_pdl, $testfile2 );
-
-my $image = read_png($testfile1);
-ok( tapprox( $pdl, $image ) );
-$image = null;
-
-$image = read_true_png( $testfile2 );
-ok( tapprox( $image, $tc_pdl ) );
+is_pdl read_png($testfile1), $pdl->long;
 eval {read_true_png($testfile1)};
 like $@, qr/Tried to read a non-truecolour/, 'right error instead of segfault';
+is_pdl read_png_lut( $testfile1 ), $lut;
 
-my $lut2 = read_png_lut( $testfile1 );
-ok( tapprox( $lut, $lut2 ) );
+my $tc_pdl = sequence(byte, 100, 100, 3);
+write_true_png( $tc_pdl, $testfile2 );
+is_pdl read_true_png( $testfile2 ), $tc_pdl;
 
 $pdl = sequence(byte, 30, 30);
 write_png_ex($pdl, $lut, $testfile3, 0);
@@ -64,7 +49,7 @@ write_true_png_ex($pdl, $testfile3, 9);
 write_true_png_best($pdl, $testfile3 );
 
 recompress_png_best( $testfile3 );
-ok( tapprox( read_png( $testfile4 ), read_png( $testfile3 ) ) );
+is_pdl read_png( $testfile4 ), read_png( $testfile3 );
 
 done_testing;