view release on metacpan or  search on metacpan

t/Magick.t  view on Meta::CPAN

#!/usr/bin/perl -w

# Copyright 2010, 2011, 2012, 2017, 2021 Kevin Ryde

# This file is part of Image-Base-Magick.
#
# Image-Base-Magick is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Image-Base-Magick is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Image-Base-Magick.  If not, see <http://www.gnu.org/licenses/>.

use 5.004;
use strict;
use Test;

my $test_count = (tests => 2518)[1];
plan tests => $test_count;

use lib 't';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings() }

# uncomment this to run the ### lines
# use Smart::Comments;


# only test on 6.6 up since 6.5.5 seen doing dodgy stuff on a 3x3 ellipse,
# coming out with an excess to the right like
#     _____www____________
#     _____wwwww__________
#     _____www____________
#

my $have_image_magick = eval { require Image::Magick; 1 };
if ($have_image_magick) {
  # something in Image::Magick circa 6.97 broke its Image::Magick->VERSION,
  # so watch out for undef
  my $im_version = Image::Magick->VERSION;
  MyTestHelpers::diag ("Image::Magick VERSION ".(defined $im_version ? $im_version : "[undef]"));
  if (! defined $im_version) {
    $im_version = eval { Image::Magick::Q16->VERSION };
    if (defined $im_version) {
      MyTestHelpers::diag ("Image::Magick::Q16 VERSION $im_version");
    }
  }

  # Demand 6.6 or higher for bug fixes.  But not Image::Magick->VERSION(6.6)
  # since that provokes badness when non-numeric $VERSION='6.6.0'.
  if (defined $im_version && $im_version =~ /([0-9]*(\.[0-9]*)?)/) {
    my $im_two_version = $1;
    if ($im_two_version < 6.6) {
      MyTestHelpers::diag ("Image::Magick 6.6 not available -- im_version $im_version im_two_version $im_two_version");
      $have_image_magick = 0;
    }
  }
}
if (! $have_image_magick) {
  foreach (1 .. $test_count) {
    skip ('no Image::Magick 6.6', 1, 1);
  }
  exit 0;
}

require Image::Base::Magick;


#------------------------------------------------------------------------------
# VERSION

my $want_version = 7;
ok ($Image::Base::Magick::VERSION,
    $want_version,
    'VERSION variable');
ok (Image::Base::Magick->VERSION,
    $want_version, 'VERSION class method');

ok (eval { Image::Base::Magick->VERSION($want_version); 1 },
    1,
    "VERSION class check $want_version");
my $check_version = $want_version + 1000;
ok (! eval { Image::Base::Magick->VERSION($check_version); 1 },
    1,
    "VERSION class check $check_version");


my $temp_filename = 'tempfile.png';
MyTestHelpers::diag ("Tempfile ",$temp_filename);
unlink $temp_filename;
ok (! -e $temp_filename, 1, "removed any existing $temp_filename");
END {
  if (defined $temp_filename) {
    MyTestHelpers::diag ("Remove tempfile ",$temp_filename);
    unlink $temp_filename
      or MyTestHelpers::diag ("No remove $temp_filename: ",$!);
  }
}

#-----------------------------------------------------------------------------
# save() -zlib_compression

{
  my $image = Image::Base::Magick->new (-width => 300,
                                        -height => 300,
                                        -file_format => 'png',
                                        -zlib_compression => 0);
  $image->rectangle(0,0, 299,299, '#000000', 1); # black fill
  $image->rectangle(0,0, 299,299, '#FFFFFF');    # white border
  $image->save ($temp_filename);
  my $uncomp_size = -s $temp_filename;

  $image->set (-zlib_compression => 9);
  $image->save;
  my $comp_size = -s $temp_filename;

  ### $uncomp_size
  ### $comp_size
  if ($comp_size >= $uncomp_size) {
    MyTestHelpers::diag ("oops, uncomp_size $uncomp_size  comp_size $comp_size");
  }