view release on metacpan or  search on metacpan

t/JPEG_0_records.t  view on Meta::CPAN

use Test::More tests => 152;
BEGIN { require 't/test_setup.pl'; }

my ($record, $data, $result, $mykey, $key, $type,
    $count, $dataref, @v, @w, $problem);
my $trim = sub { join '\n', map { s/^.*\"(.*)\".*$/$1/; $_ }
		 grep { /0:/ } split '\n', $_[0] };
my @messages = ( "1st value", "2nd value" , "3rd value", "4th value" );
my @notnums  = (qr/NAN/i, qr/^[^-]*INF/i, qr/-.*INF/i); # case insensitive!
my @notnames = ('NaN', '+Inf', '-Inf');
# this stuff is needed for testing floating point numbers
sub vsum      { my $s = 0; $s += $_ for @_; $s }
sub pack_ieee { my $v = pack $_[0], $_[1]; $_[2] ? \(scalar reverse $v) : \$v};
sub test_ieee { my $e = shift; my $i = ref $_[0] ? undef : shift;
		abs(($_[0]->get_value($i)-$_[1])/$_[1]) < 2**(-$e) ? 1:undef };
sub pack_float { pack_ieee('f', @_) };
sub test_float { test_ieee( 23, @_) };
sub pack_double{ pack_ieee('d', @_) };
sub test_double{ test_ieee( 52, @_) };
# this is for trapping an error:
sub trap_error { local $SIG{'__DIE__'} = sub { $problem = shift; };
		 $problem = undef; eval $_[0]; }

#=======================================
diag "Testing [Image::MetaData::JPEG::Record]";
#=======================================

BEGIN { use_ok ($::tabname, qw(:RecordTypes :Endianness)) or exit; }
BEGIN { use_ok ($::recname) or exit; } # this must be loaded second!

#########################
my $native = $NATIVE_ENDIANNESS;
my $not_native = ($native eq $BIG_ENDIAN ? $LITTLE_ENDIAN : $BIG_ENDIAN);
isnt( $native, undef, "Endianness detected: $native" );

#########################
$data  = "an average string"; 
$mykey = 'Test';
$record = newrecord($mykey, $ASCII, \$data, length $data);
ok( $record, "ASCII ctor" );

#########################
isa_ok( $record, $::recname );

#########################
ok(newrecord(0x3456, $ASCII, \$data, length $data), "with numeric tag" );

#########################
$record = newrecord($mykey, $ASCII, \$data, length $data);
$result = $record->get_value();
is( $data, $result, "rereading ASCII data" );

#########################
$result = scalar $record->get();
is( $data, $result, "... test of get" );

#########################
($key, $type, $count, $dataref) = $record->get();
is_deeply( [$mykey, $type, $dataref], [$key, $ASCII, \$data],
	   "... test of get (list)" );

#########################
$record = newrecord($mykey, $UNDEF, \$data, length $data);
$result = $record->get_value();
is( $data, $result, "rereading UNDEF variables" );

#########################
$data = \ $mykey;
$record = newrecord($mykey, $REFERENCE, \$data);
$result = $record->get_value();