t/450-api/110-inlinectx.t

   1 #!perl -w
   2 #
   3 # this tests both the Inline interface and the API with IMAGER_NO_CONTEXT
   4 use strict;
   5 use Test::More;
   6 use Imager::Test qw(is_color3 is_color4);
   7 eval "require Inline::C;";
   8 plan skip_all => "Inline required for testing API" if $@;
   9
  10 eval "require Parse::RecDescent;";
  11 plan skip_all => "Could not load Parse::RecDescent" if $@;
  12
  13 use Cwd 'getcwd';
  14 plan skip_all => "Inline won't work in directories with spaces"
  15   if getcwd() =~ / /;
  16
  17 plan skip_all => "perl 5.005_04, 5.005_05 too buggy"
  18   if $] =~ /^5\.005_0[45]$/;
  19
  20 -d "testout" or mkdir "testout";
  21
  22 plan tests => 5;
  23 require Inline;
  24 Inline->import(C => Config => AUTO_INCLUDE => "#define IMAGER_NO_CONTEXT\n");
  25 Inline->import(with => 'Imager');
  26 Inline->import("FORCE"); # force rebuild
  27 #Inline->import(C => Config => OPTIMIZE => "-g");
  28
  29 Inline->bind(C => <<'EOS');
  30 #include <math.h>
  31
  32 Imager make_10x10() {
  33   dIMCTX;
  34   i_img *im = i_img_8_new(10, 10, 3);
  35   i_color c;
  36   c.channel[0] = c.channel[1] = c.channel[2] = 255;
  37   i_box_filled(im, 0, 0, im->xsize-1, im->ysize-1, &c);
  38
  39   return im;
  40 }
  41
  42 void error_dIMCTX() {
  43   dIMCTX;
  44   im_clear_error(aIMCTX);
  45   im_push_error(aIMCTX, 0, "test1");
  46   im_push_errorf(aIMCTX, 0, "test%d", 2);
  47
  48   im_log((aIMCTX, 0, "test logging\n"));
  49 }
  50
  51 void error_dIMCTXim(Imager im) {
  52   dIMCTXim(im);
  53   im_clear_error(aIMCTX);
  54   im_push_error(aIMCTX, 0, "test1");
  55 }
  56
  57 int context_refs() {
  58   dIMCTX;
  59
  60   im_context_refinc(aIMCTX, "context_refs");
  61   im_context_refdec(aIMCTX, "context_refs");
  62
  63   return 1;
  64 }
  65
  66 EOS
  67
  68 Imager->open_log(log => "testout/t84inlinectx.log");
  69
  70 my $im2 = make_10x10();
  71 ok($im2, "make an image");
  72 is_color3($im2->getpixel(x => 0, y => 0), 255, 255, 255,
  73           "check the colors");
  74 error_dIMCTX();
  75 is(_get_error(), "test2: test1", "check dIMCTX");
  76
  77 my $im = Imager->new(xsize => 1, ysize => 1);
  78 error_dIMCTXim($im);
  79 is(_get_error(), "test1", "check dIMCTXim");
  80
  81 ok(context_refs(), "check refcount functions");
  82
  83 Imager->close_log();
  84
  85 unless ($ENV{IMAGER_KEEP_FILES}) {
  86   unlink "testout/t84inlinectx.log";
  87 }
  88
  89 sub _get_error {
  90   my @errors = Imager::i_errors();
  91   return join(": ", map $_->[0], @errors);
  92 }