r66982 - in /branches/upstream/libtest-image-gd-perl: ./ current/ current/lib/ current/lib/Test/ current/lib/Test/Image/ current/t/
periapt-guest at users.alioth.debian.org
periapt-guest at users.alioth.debian.org
Wed Jan 5 02:09:53 UTC 2011
Author: periapt-guest
Date: Wed Jan 5 02:09:27 2011
New Revision: 66982
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=66982
Log:
[svn-inject] Installing original source of libtest-image-gd-perl (0.03)
Added:
branches/upstream/libtest-image-gd-perl/
branches/upstream/libtest-image-gd-perl/current/
branches/upstream/libtest-image-gd-perl/current/Changes
branches/upstream/libtest-image-gd-perl/current/MANIFEST
branches/upstream/libtest-image-gd-perl/current/Makefile.PL
branches/upstream/libtest-image-gd-perl/current/README
branches/upstream/libtest-image-gd-perl/current/lib/
branches/upstream/libtest-image-gd-perl/current/lib/Test/
branches/upstream/libtest-image-gd-perl/current/lib/Test/Image/
branches/upstream/libtest-image-gd-perl/current/lib/Test/Image/GD.pm
branches/upstream/libtest-image-gd-perl/current/t/
branches/upstream/libtest-image-gd-perl/current/t/10_Test_Image_GD_test.t
branches/upstream/libtest-image-gd-perl/current/t/20_cmp_image.t
branches/upstream/libtest-image-gd-perl/current/t/30_size_ok.t
branches/upstream/libtest-image-gd-perl/current/t/40_height_ok.t
branches/upstream/libtest-image-gd-perl/current/t/50_width_ok.t
branches/upstream/libtest-image-gd-perl/current/t/pod.t
branches/upstream/libtest-image-gd-perl/current/t/pod_coverage.t
Added: branches/upstream/libtest-image-gd-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-image-gd-perl/current/Changes?rev=66982&op=file
==============================================================================
--- branches/upstream/libtest-image-gd-perl/current/Changes (added)
+++ branches/upstream/libtest-image-gd-perl/current/Changes Wed Jan 5 02:09:27 2011
@@ -1,0 +1,18 @@
+Revision history for Perl extension Test-Image-GD.
+
+0.03 Fri, Dec 9, 2005
+ - added size_ok() function
+ - added tests for this
+ - added height_ok() function
+ - added tests for this
+ - added width_ok() function
+ - added tests for this
+
+0.02 Wed, Dec 7, 2005
+ - removed GIF files from distro and now the test
+ file itself generates them, this is (IMO) a more
+ realistic use case.
+
+0.01 Sat Dec 3 23:06:56 2005
+ - module created
+
Added: branches/upstream/libtest-image-gd-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-image-gd-perl/current/MANIFEST?rev=66982&op=file
==============================================================================
--- branches/upstream/libtest-image-gd-perl/current/MANIFEST (added)
+++ branches/upstream/libtest-image-gd-perl/current/MANIFEST Wed Jan 5 02:09:27 2011
@@ -1,0 +1,12 @@
+Changes
+Makefile.PL
+MANIFEST
+README
+lib/Test/Image/GD.pm
+t/10_Test_Image_GD_test.t
+t/20_cmp_image.t
+t/30_size_ok.t
+t/40_height_ok.t
+t/50_width_ok.t
+t/pod.t
+t/pod_coverage.t
Added: branches/upstream/libtest-image-gd-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-image-gd-perl/current/Makefile.PL?rev=66982&op=file
==============================================================================
--- branches/upstream/libtest-image-gd-perl/current/Makefile.PL (added)
+++ branches/upstream/libtest-image-gd-perl/current/Makefile.PL Wed Jan 5 02:09:27 2011
@@ -1,0 +1,15 @@
+use ExtUtils::MakeMaker;
+WriteMakefile(
+ NAME => 'Test::Image::GD',
+ VERSION_FROM => 'lib/Test/Image/GD.pm',
+ PREREQ_PM => {
+ # for the module itself
+ 'Test::Builder' => 0,
+ 'GD' => 0,
+ 'Scalar::Util' => 0,
+ # for testing the module
+ 'Test::Builder::Tester' => 0,
+ 'Test::More' => 0.47,
+ 'File::Spec' => 0,
+ }
+);
Added: branches/upstream/libtest-image-gd-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-image-gd-perl/current/README?rev=66982&op=file
==============================================================================
--- branches/upstream/libtest-image-gd-perl/current/README (added)
+++ branches/upstream/libtest-image-gd-perl/current/README Wed Jan 5 02:09:27 2011
@@ -1,0 +1,29 @@
+Test::Image::GD version 0.03
+===========================
+
+See the individual module documentation for more information
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+ None
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2005 Infinity Interactive, Inc.
+
+http://www.iinteractive.com
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
Added: branches/upstream/libtest-image-gd-perl/current/lib/Test/Image/GD.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-image-gd-perl/current/lib/Test/Image/GD.pm?rev=66982&op=file
==============================================================================
--- branches/upstream/libtest-image-gd-perl/current/lib/Test/Image/GD.pm (added)
+++ branches/upstream/libtest-image-gd-perl/current/lib/Test/Image/GD.pm Wed Jan 5 02:09:27 2011
@@ -1,0 +1,216 @@
+
+package Test::Image::GD;
+
+use strict;
+use warnings;
+
+use Test::Builder ();
+use Scalar::Util 'blessed';
+use GD ':cmp';
+
+require Exporter;
+
+our $VERSION = '0.03';
+our @ISA = ('Exporter');
+our @EXPORT = qw(
+ cmp_image
+ size_ok
+ height_ok
+ width_ok
+ );
+
+my $Test = Test::Builder->new;
+
+sub cmp_image ($$;$) {
+ my ($got, $expected, $message) = @_;
+ _coerce_image($got);
+ _coerce_image($expected);
+
+ if ($got->compare($expected) & GD_CMP_IMAGE) {
+ $Test->ok(0, $message);
+ }
+ else {
+ $Test->ok(1, $message);
+ }
+}
+
+sub size_ok ($$;$) {
+ my ($got, $expected, $message) = @_;
+ _coerce_image($got);
+ (ref($expected) && ref($expected) eq 'ARRAY')
+ || die "expected must be an ARRAY ref";
+
+ if ($got->width == $expected->[0] &&
+ $got->height == $expected->[1] ){
+ $Test->ok(1, $message);
+ }
+ else {
+ $Test->diag("... (image => (width, height))\n" .
+ " w: (" . $got->width . " => " . $expected->[0] . ")\n" .
+ " h: (" . $got->height . " => " . $expected->[1] . ")");
+ $Test->ok(0, $message);
+ }
+}
+
+sub height_ok ($$;$) {
+ my ($got, $expected, $message) = @_;
+ _coerce_image($got);
+
+ if ($got->height == $expected){
+ $Test->ok(1, $message);
+ }
+ else {
+ $Test->diag("... (image => (height))\n" .
+ " h: (" . $got->height . " => " . $expected . ")");
+ $Test->ok(0, $message);
+ }
+}
+
+sub width_ok ($$;$) {
+ my ($got, $expected, $message) = @_;
+ _coerce_image($got);
+
+ if ($got->width == $expected){
+ $Test->ok(1, $message);
+ }
+ else {
+ $Test->diag("... (image => (width))\n" .
+ " w: (" . $got->width . " => " . $expected . ")");
+ $Test->ok(0, $message);
+ }
+}
+
+## Utility Methods
+
+sub _coerce_image {
+ unless (blessed($_[0]) && $_[0]->isa('GD::Image')) {
+ $_[0] = GD::Image->new($_[0])
+ || die "Could not create GD::Image instance with : " . $_[0];
+ }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Image::GD - A module for testing images using GD
+
+=head1 SYNOPSIS
+
+ use Test::More plan => 1;
+ use Test::Image::GD;
+
+ cmp_image('test.gif', 'control.gif', '... these images should match');
+
+ # or
+
+ my $test = GD::Image->new('test.gif');
+ my $control = GD::Image->new('control.gif');
+ cmp_image($test, $control, '... these images should match');
+
+ # some other test functions ...
+
+ size_ok('camel.gif', [ 100, 350 ], '... the image is 100 x 350");
+
+ height_ok('test.gif', 200, '... the image has a height of 200');
+ width_ok('test.gif', 200, '... the image has a width of 200');
+
+=head1 DESCRIPTION
+
+This module is meant to be used for testing custom graphics, it attempts
+to "visually" compare the images, this means it ignores invisible differences
+like color palettes and metadata. It also provides some extra functions to
+check the size of the image.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item B<cmp_image ($got, $expected, $message)>
+
+This function will tell you whether the two images will look different,
+ignoring differences in the order of colors in the color palette and
+other invisible changes.
+
+Both C<$got> and C<$expected> can be either instances of C<GD::Image> or
+either a file handle or a file path (both are valid parameters to the
+C<GD::Image> constructor).
+
+=item B<size_ok ($got, [ $width, $height ], ?$message)>
+
+This function will check if an image is a certain size.
+
+As with the C<cmp_image> function, the C<$got> parameter can be either an
+instance of C<GD::Image> or a file handle or a file path (all are valid
+parameters to the C<GD::Image> constructor).
+
+=item B<height_ok ($got, $height, ?$message)>
+
+This function will check if an image is a certain height.
+
+As with the C<cmp_image> function, the C<$got> parameter can be either an
+instance of C<GD::Image> or a file handle or a file path (all are valid
+parameters to the C<GD::Image> constructor).
+
+=item B<width_ok ($got, $width, ?$message)>
+
+This function will check if an image is a certain width.
+
+As with the C<cmp_image> function, the C<$got> parameter can be either an
+instance of C<GD::Image> or a file handle or a file path (all are valid
+parameters to the C<GD::Image> constructor).
+
+=back
+
+=head1 TO DO
+
+=over 4
+
+=item Add more functions
+
+This module currently serves a very basic need of mine, however, I am sure as
+I start writing more tests against images I will find a need for other testing
+functions. Any suggestions are welcome.
+
+=back
+
+=head1 BUGS
+
+None that I am aware of. Of course, if you find a bug, let me know, and I
+will be sure to fix it.
+
+=head1 CODE COVERAGE
+
+I use B<Devel::Cover> to test the code coverage of my tests, below is the
+B<Devel::Cover> report on this module test suite.
+
+ ---------------------------- ------ ------ ------ ------ ------ ------ ------
+ File stmt bran cond sub pod time total
+ ---------------------------- ------ ------ ------ ------ ------ ------ ------
+ Test/Image/GD.pm 100.0 91.7 63.6 100.0 100.0 100.0 93.7
+ ---------------------------- ------ ------ ------ ------ ------ ------ ------
+ Total 100.0 91.7 63.6 100.0 100.0 100.0 93.7
+ ---------------------------- ------ ------ ------ ------ ------ ------ ------
+
+=head1 SEE ALSO
+
+The C<compare> function of C<GD::Image> class, that is how this C<cmp_image> is
+implemented.
+
+=head1 AUTHOR
+
+Stevan Little, E<lt>stevan at iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2005 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
Added: branches/upstream/libtest-image-gd-perl/current/t/10_Test_Image_GD_test.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-image-gd-perl/current/t/10_Test_Image_GD_test.t?rev=66982&op=file
==============================================================================
--- branches/upstream/libtest-image-gd-perl/current/t/10_Test_Image_GD_test.t (added)
+++ branches/upstream/libtest-image-gd-perl/current/t/10_Test_Image_GD_test.t Wed Jan 5 02:09:27 2011
@@ -1,0 +1,11 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok('Test::Image::GD');
+}
+
Added: branches/upstream/libtest-image-gd-perl/current/t/20_cmp_image.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-image-gd-perl/current/t/20_cmp_image.t?rev=66982&op=file
==============================================================================
--- branches/upstream/libtest-image-gd-perl/current/t/20_cmp_image.t (added)
+++ branches/upstream/libtest-image-gd-perl/current/t/20_cmp_image.t Wed Jan 5 02:09:27 2011
@@ -1,0 +1,72 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::Builder::Tester tests => 2;
+use Test::More;
+use File::Spec::Functions;
+
+BEGIN {
+ use_ok('Test::Image::GD');
+}
+
+my $path_to_cpan_gif = catdir('t', 'cpan.gif');
+my $path_to_cpan2_gif = catdir('t', 'cpan2.gif');
+my $path_to_perl_gif = catdir('t', 'download_perl.gif');
+
+{
+ my $cpan = GD::Image->new(200, 100);
+ $cpan->colorAllocate(255, 255, 255);
+ $cpan->string(GD::gdSmallFont(), (10 * $_), (10 * $_), "CPAN Rules", $cpan->colorAllocate(0, 0, 0))
+ foreach 1 .. 5;
+ open GIF1, ">", $path_to_cpan_gif || die "Could not create test GIF file";
+ print GIF1 $cpan->gif;
+ close GIF1;
+}
+{
+ my $cpan2 = GD::Image->new(200, 100);
+ $cpan2->colorAllocate(255, 255, 255);
+ $cpan2->string(GD::gdSmallFont(), (10 * $_), (10 * $_), "CPAN Rules", $cpan2->colorAllocate(0, 0, 0))
+ foreach 1 .. 5;
+ open GIF2, ">", $path_to_cpan2_gif || die "Could not create test GIF file";
+ print GIF2 $cpan2->gif;
+ close GIF2;
+}
+{
+ my $perl = GD::Image->new(200, 100);
+ $perl->colorAllocate(255, 255, 255);
+ $perl->string(GD::gdSmallFont(), (10 * $_), (10 * $_), "Perl Rules", $perl->colorAllocate(0, 0, 0))
+ foreach 1 .. 5;
+ open GIF3, ">", $path_to_perl_gif || die "Could not create test GIF file";
+ print GIF3 $perl->gif;
+ close GIF3;
+}
+
+test_out("ok 1 - ... these are the exact same images");
+test_out("ok 2 - ... these are the same images visually");
+test_out("not ok 3 - ... these are not the same images");
+test_err("# Failed test (t/20_cmp_image.t at line 58)");
+test_out("ok 4 - ... these are the exact same images");
+test_out("ok 5 - ... these are the same images visually");
+test_out("not ok 6 - ... these are not the same images");
+test_err("# Failed test (t/20_cmp_image.t at line 66)");
+
+cmp_image($path_to_cpan_gif, $path_to_cpan_gif, '... these are the exact same images');
+cmp_image($path_to_cpan_gif, $path_to_cpan2_gif, '... these are the same images visually');
+
+cmp_image($path_to_cpan_gif, $path_to_perl_gif, '... these are not the same images');
+
+my $cpan = GD::Image->new($path_to_cpan_gif);
+my $cpan2 = GD::Image->new($path_to_cpan2_gif);
+my $perl = GD::Image->new($path_to_perl_gif);
+
+cmp_image($cpan, $cpan2, '... these are the exact same images');
+cmp_image($cpan, $cpan2, '... these are the same images visually');
+cmp_image($cpan, $perl, '... these are not the same images');
+
+test_test("cmp_image works");
+
+unlink $path_to_cpan_gif;
+unlink $path_to_cpan2_gif;
+unlink $path_to_perl_gif;
Added: branches/upstream/libtest-image-gd-perl/current/t/30_size_ok.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-image-gd-perl/current/t/30_size_ok.t?rev=66982&op=file
==============================================================================
--- branches/upstream/libtest-image-gd-perl/current/t/30_size_ok.t (added)
+++ branches/upstream/libtest-image-gd-perl/current/t/30_size_ok.t Wed Jan 5 02:09:27 2011
@@ -1,0 +1,54 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::Builder::Tester tests => 2;
+use Test::More;
+use File::Spec::Functions;
+
+BEGIN {
+ use_ok('Test::Image::GD');
+}
+
+my $image_path = catdir('t', 'temp.gif');
+
+{
+ my $img = GD::Image->new(400, 400);
+ open GIF, ">", $image_path || die "Could not create test GIF file";
+ print GIF $img->gif;
+ close GIF;
+}
+
+test_out("ok 1 - ... image is (200 x 100)");
+test_out("not ok 2 - ... image is not (100 x 200)");
+test_err("# ... (image => (width, height))");
+test_err("# w: (100 => 100)");
+test_err("# h: (100 => 200)");
+test_err("# Failed test (t/30_size_ok.t at line 43)");
+test_out("ok 3 - ... image is (400 x 400)");
+test_out("not ok 4 - ... image is not (100 x 200)");
+test_err("# ... (image => (width, height))");
+test_err("# w: (400 => 100)");
+test_err("# h: (400 => 200)");
+test_err("# Failed test (t/30_size_ok.t at line 48)");
+
+{
+ my $img = GD::Image->new(200, 100);
+ size_ok($img, [ 200, 100 ], '... image is (200 x 100)');
+}
+
+{
+ my $img = GD::Image->new(100, 100);
+ size_ok($img, [ 100, 200 ], '... image is not (100 x 200)');
+}
+
+{
+ size_ok($image_path, [ 400, 400 ], '... image is (400 x 400)');
+ size_ok($image_path, [ 100, 200 ], '... image is not (100 x 200)');
+}
+
+
+test_test("size_ok works");
+
+unlink $image_path;
Added: branches/upstream/libtest-image-gd-perl/current/t/40_height_ok.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-image-gd-perl/current/t/40_height_ok.t?rev=66982&op=file
==============================================================================
--- branches/upstream/libtest-image-gd-perl/current/t/40_height_ok.t (added)
+++ branches/upstream/libtest-image-gd-perl/current/t/40_height_ok.t Wed Jan 5 02:09:27 2011
@@ -1,0 +1,52 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::Builder::Tester tests => 2;
+use Test::More;
+use File::Spec::Functions;
+
+BEGIN {
+ use_ok('Test::Image::GD');
+}
+
+my $image_path = catdir('t', 'temp.gif');
+
+{
+ my $img = GD::Image->new(400, 400);
+ open GIF, ">", $image_path || die "Could not create test GIF file";
+ print GIF $img->gif;
+ close GIF;
+}
+
+test_out("ok 1 - ... image is 200");
+test_out("not ok 2 - ... image is not 100");
+test_err("# ... (image => (height))");
+test_err("# h: (10 => 100)");
+test_err("# Failed test (t/40_height_ok.t at line 41)");
+test_out("ok 3 - ... image is 400");
+test_out("not ok 4 - ... image is not 200");
+test_err("# ... (image => (height))");
+test_err("# h: (400 => 200)");
+test_err("# Failed test (t/40_height_ok.t at line 46)");
+
+{
+ my $img = GD::Image->new(100, 200);
+ height_ok($img, 200, '... image is 200');
+}
+
+{
+ my $img = GD::Image->new(10, 10);
+ height_ok($img, 100, '... image is not 100');
+}
+
+{
+ height_ok($image_path, 400, '... image is 400');
+ height_ok($image_path, 200, '... image is not 200');
+}
+
+
+test_test("height_ok works");
+
+unlink $image_path;
Added: branches/upstream/libtest-image-gd-perl/current/t/50_width_ok.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-image-gd-perl/current/t/50_width_ok.t?rev=66982&op=file
==============================================================================
--- branches/upstream/libtest-image-gd-perl/current/t/50_width_ok.t (added)
+++ branches/upstream/libtest-image-gd-perl/current/t/50_width_ok.t Wed Jan 5 02:09:27 2011
@@ -1,0 +1,52 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::Builder::Tester tests => 2;
+use Test::More;
+use File::Spec::Functions;
+
+BEGIN {
+ use_ok('Test::Image::GD');
+}
+
+my $image_path = catdir('t', 'temp.gif');
+
+{
+ my $img = GD::Image->new(400, 400);
+ open GIF, ">", $image_path || die "Could not create test GIF file";
+ print GIF $img->gif;
+ close GIF;
+}
+
+test_out("ok 1 - ... image is 200");
+test_out("not ok 2 - ... image is not 100");
+test_err("# ... (image => (width))");
+test_err("# w: (10 => 100)");
+test_err("# Failed test (t/50_width_ok.t at line 41)");
+test_out("ok 3 - ... image is 400");
+test_out("not ok 4 - ... image is not 200");
+test_err("# ... (image => (width))");
+test_err("# w: (400 => 200)");
+test_err("# Failed test (t/50_width_ok.t at line 46)");
+
+{
+ my $img = GD::Image->new(200, 100);
+ width_ok($img, 200, '... image is 200');
+}
+
+{
+ my $img = GD::Image->new(10, 10);
+ width_ok($img, 100, '... image is not 100');
+}
+
+{
+ width_ok($image_path, 400, '... image is 400');
+ width_ok($image_path, 200, '... image is not 200');
+}
+
+
+test_test("width_ok works");
+
+unlink $image_path;
Added: branches/upstream/libtest-image-gd-perl/current/t/pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-image-gd-perl/current/t/pod.t?rev=66982&op=file
==============================================================================
--- branches/upstream/libtest-image-gd-perl/current/t/pod.t (added)
+++ branches/upstream/libtest-image-gd-perl/current/t/pod.t Wed Jan 5 02:09:27 2011
@@ -1,0 +1,11 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+
+all_pod_files_ok();
Added: branches/upstream/libtest-image-gd-perl/current/t/pod_coverage.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-image-gd-perl/current/t/pod_coverage.t?rev=66982&op=file
==============================================================================
--- branches/upstream/libtest-image-gd-perl/current/t/pod_coverage.t (added)
+++ branches/upstream/libtest-image-gd-perl/current/t/pod_coverage.t Wed Jan 5 02:09:27 2011
@@ -1,0 +1,11 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+
+all_pod_coverage_ok();
More information about the Pkg-perl-cvs-commits
mailing list