view release on metacpan or  search on metacpan

t/IPNGDT.pm  view on Meta::CPAN

# The functions in this module are helpers for testing
# Image::PNG::Data. The name IPNGDT is just "Image PNG Data Testing
# module". This module should not be indexed by CPAN. See
# Makefile.PL.tmpl under "no_index/file".

package IPNGDT;
use warnings;
use strict;
use utf8;
require Exporter;
our @ISA = qw(Exporter);
# We just export everything by default, because this is not a user module.
our @EXPORT = (qw/
    chunk_ok
    fake_wpng
    rmfile
    round_trip
    skip_itxt
    skip_old
/);
use Test::More;
use Image::PNG::Const ':all';
use Image::PNG::Libpng ':all';
use Image::PNG::Data ':all';

push @EXPORT, (@Test::More::EXPORT, @Image::PNG::Const::EXPORT_OK, @Image::PNG::Libpng::EXPORT_OK, @Image::PNG::Data::EXPORT_OK);

my $builder = Test::More->builder;
binmode $builder->output,         ":encoding(utf8)";
binmode $builder->failure_output, ":encoding(utf8)";
binmode $builder->todo_output,    ":encoding(utf8)";
binmode STDOUT, ":encoding(utf8)";
binmode STDERR, ":encoding(utf8)";

sub import
{
    strict->import ();
    utf8->import ();
    warnings->import ();

    Test::More->import ();
    Image::PNG::Const->import (':all');
    Image::PNG::Libpng->import (':all');
    Image::PNG::Data->import (':all');

    IPNGDT->export_to_level (1);
}

# Skip testing if the libpng doesn't seem to support itxt.

sub skip_itxt
{
    if (! libpng_supports ('iTXt') ||
	! libpng_supports ('zTXt') ||
	! libpng_supports ('tEXt') ||
	! libpng_supports ('TEXT')) {
	plan skip_all => 'your libpng does not support iTXt/zTXt/tEXt',
	return 1;
    }
    return 0;
}

# The most recent faulty response is for libpng version 1.6.12.
# http://www.cpantesters.org/cpan/report/f7295c1a-6bf5-1014-a07d-70c0b928df0

# Skip testing of set-text.t and compress-level.t for versions older
# than these, due to bugs or incompatibilities. Ideally the libpng
# PNG_*_SUPPORTED variables would be used here, but those are not very
# reliable.

my $oldmajor = 0; # Reject 0.*
my $oldminor = 5; # Reject 1.[0-5]
my $oldpatch = 12; # Reject 1.6.[0-12]

sub skip_old
{
    my $libpngver = get_libpng_ver ();
    if ($libpngver !~ /^([0-9]+)\.([0-9]+)\.([0-9]+)/) {
	plan skip_all => "Incomprehensible libpng version $libpngver";
	return 1;
    }
    my ($major, $minor, $patch) = ($1, $2, $3);
    if ($major > 1 || $minor > 6) {
	# Get out of here, since the test for $minor or $patch will be
	# tripped by 1.7.1 or 2.1.3 or something.
	return 0;
    }
    if ($major <= $oldmajor) {
	plan skip_all =>
	"Skipping: libpng major version $libpngver <= $oldmajor";
	return 1;
    }
    if ($minor <= $oldminor) {
	plan skip_all =>
	"Skipping: libpng minor version $libpngver <= $oldminor";
	return 1;
    }