"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "t/TestLib.pm" between
Image-ExifTool-12.26.tar.gz and Image-ExifTool-12.27.tar.gz

About: ExifTool is a platform-independent Perl library plus a command-line application for reading, writing and editing meta information in a wide variety of files.

TestLib.pm  (Image-ExifTool-12.26):TestLib.pm  (Image-ExifTool-12.27)
skipping to change at line 17 skipping to change at line 17
# Feb. 26/04 - P. Harvey Name temporary file ".failed" and erase # Feb. 26/04 - P. Harvey Name temporary file ".failed" and erase
# it if the test passes # it if the test passes
# Feb. 27/04 - P. Harvey Change print format and allow ExifTool # Feb. 27/04 - P. Harvey Change print format and allow ExifTool
# object to be passed instead of tags hash ref. # object to be passed instead of tags hash ref.
# Oct. 30/04 - P. Harvey Split testCompare() into separate sub. # Oct. 30/04 - P. Harvey Split testCompare() into separate sub.
# May 18/05 - P. Harvey Tolerate round-off errors in floats. # May 18/05 - P. Harvey Tolerate round-off errors in floats.
# Feb. 02/08 - P. Harvey Allow different timezones in time values # Feb. 02/08 - P. Harvey Allow different timezones in time values
# Sep. 16/08 - P. Harvey Improve timezone testing # Sep. 16/08 - P. Harvey Improve timezone testing
# Jul. 14/10 - P. Harvey Added writeInfo() # Jul. 14/10 - P. Harvey Added writeInfo()
# Jan. 06/12 - P. Harvey Patched MirBSD leap second "feature" # Jan. 06/12 - P. Harvey Patched MirBSD leap second "feature"
# Jun. 08/21 - PH Patched float compare to fix quadmath test failu re
#------------------------------------------------------------------------------ #------------------------------------------------------------------------------
package t::TestLib; package t::TestLib;
use strict; use strict;
require 5.002; require 5.002;
require Exporter; require Exporter;
use Image::ExifTool qw(ImageInfo); use Image::ExifTool qw(ImageInfo);
use vars qw($VERSION @ISA @EXPORT); use vars qw($VERSION @ISA @EXPORT);
$VERSION = '1.22'; $VERSION = '1.23';
@ISA = qw(Exporter); @ISA = qw(Exporter);
@EXPORT = qw(check writeCheck writeInfo testCompare binaryCompare testVerbose); @EXPORT = qw(check writeCheck writeInfo testCompare binaryCompare testVerbose);
my $noTimeLocal; my $noTimeLocal;
sub nearEnough($$); sub nearEnough($$);
sub nearTime($$$$); sub nearTime($$$$);
sub formatValue($); sub formatValue($);
sub writeInfo($$;$$$); sub writeInfo($$;$$$);
skipping to change at line 81 skipping to change at line 82
my $success = 0; my $success = 0;
my $linenum; my $linenum;
my $oldSep = $/; my $oldSep = $/;
$/ = "\x0a"; # set input line separator $/ = "\x0a"; # set input line separator
if (open(FILE1, $stdfile)) { if (open(FILE1, $stdfile)) {
if (open(FILE2, $testfile)) { if (open(FILE2, $testfile)) {
$success = 1; $success = 1;
my ($line1, $line2); my ($line1, $line2);
my $linenum = 0; my $linenum = 0;
my $skip = 0;
for (;;) { for (;;) {
$line1 = <FILE1>; $line1 = <FILE1> unless $skip == 1;
last unless defined $line1; last unless defined $line1;
++$linenum; ++$linenum;
$line2 = <FILE2>; $line2 = <FILE2> unless $skip == 2;
$skip = 0;
if (defined $line2) { if (defined $line2) {
next if $line1 eq $line2; next if $line1 eq $line2;
next if nearEnough($line1, $line2); next if nearEnough($line1, $line2);
# ignore IPTCDigest warning if Digest::MD5 isn't available
if ($line1 =~ /Warning: IPTCDigest is not current/ and
not eval 'require Digest::MD5')
{
$skip = 2;
next;
} elsif ($line2 =~ /Warning: IPTCDigest is not current/ and
not eval 'require Digest::MD5')
{
$skip = 1;
next;
}
} }
$success = 0; $success = 0;
last; last;
} }
if ($success) { if ($success) {
# make sure there is nothing left in file2 # make sure there is nothing left in file2
$line2 = <FILE2>; $line2 = <FILE2>;
if ($line2) { if ($line2) {
++$linenum; ++$linenum;
$success = 0; $success = 0;
skipping to change at line 207 skipping to change at line 222
last unless $tok2 =~ s/\Q$a\E$//; last unless $tok2 =~ s/\Q$a\E$//;
} }
if ($tok1 =~ s/^(\d+:\d+:)//) { # remove leading HH:MM: if ($tok1 =~ s/^(\d+:\d+:)//) { # remove leading HH:MM:
my $a = $1; my $a = $1;
last unless $tok2 =~ s/^\Q$a//; last unless $tok2 =~ s/^\Q$a//;
} }
if ($tok1 =~ s/^'//) { # remove leading quote if ($tok1 =~ s/^'//) { # remove leading quote
last unless $tok2 =~ s/^'//; last unless $tok2 =~ s/^'//;
} }
last unless Image::ExifTool::IsFloat($tok1) and last unless Image::ExifTool::IsFloat($tok1) and
Image::ExifTool::IsFloat($tok2) and Image::ExifTool::IsFloat($tok2);
$tok1 =~ /\./ and $tok2 =~ /\./;
last if $tok1 == 0 or $tok2 == 0; last if $tok1 == 0 or $tok2 == 0;
# numbers are bad if not the same to 5 significant figures # numbers are bad if not the same to 5 significant figures
if (abs(($tok1-$tok2)/($tok1+$tok2)) > 1e-5) { if (abs(($tok1-$tok2)/($tok1+$tok2)) > 1e-5) {
# (but allow last digit to be different due to round-off errors) # (but allow last digit to be different due to round-off errors)
my ($int1, $int2); my ($int1, $int2);
($int1 = $tok1) =~ tr/0-9//dc; ($int1 = $tok1) =~ tr/0-9//dc;
($int2 = $tok2) =~ tr/0-9//dc; ($int2 = $tok2) =~ tr/0-9//dc;
my $dlen = length($int1) - length($int2); my $dlen = length($int1) - length($int2);
if ($dlen > 0) { if ($dlen > 0) {
$int2 .= '0' x $dlen; $int2 .= '0' x $dlen;
 End of changes. 7 change blocks. 
5 lines changed or deleted 19 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)