[gimp-perl] Test perl plugin functionality. Bug #726085

[Kevin Cozens <kcozens src gnome org>]

commit 2f458246df2993aa5d7217d1a690ab794f013c38
Author: Ed J <m8r-35s8eo mailinator com>
Date:   Tue Mar 11 04:27:19 2014 +0000

    Test perl plugin functionality. Bug #726085

 t/gimpsetup.pl |   50 ++++++++++++++++++++++++++++++++++++++++++++++++++
 t/perlplugin.t |   54 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 t/run.t        |   30 ++++++------------------------
 3 files changed, 110 insertions(+), 24 deletions(-)
---
diff --git a/t/gimpsetup.pl b/t/gimpsetup.pl
new file mode 100644
index 0000000..f529b4b
--- /dev/null
+++ b/t/gimpsetup.pl
@@ -0,0 +1,50 @@
+# only one "test" result - 'gimp set up' at bottom
+# relies on caller having first done:
+#    use Test::*; # to make available ok()
+#    use Gimp qw(:auto);
+#    our $dir;
+# if encounters problems, does a die()
+
+use strict;
+use Config;
+use File::Temp;
+use IO::All;
+
+our $DEBUG = 0 unless defined $DEBUG;
+
+our %cfg;
+require './config.pl';
+
+my $plugins = $cfg{gimpplugindir} . '/plug-ins';
+die "plugins dir: $!" unless -d $plugins;
+die "script-fu not executable: $!" unless-x "$plugins/script-fu";
+
+our $dir = File::Temp->newdir($DEBUG ? (CLEANUP => 0) : ());;#
+my $perlserver = "$dir/Perl-Server.pl";
+my $s = io("Perl-Server")->all or die "unable to read the Perl-Server: $!";
+$s =~ s/^(#!).*?(\n)/$Config{startperl}$2/;
+die "write Perl-Server: $!" unless io($perlserver)->print($s);
+if ($DEBUG) {
+  die "chmod Perl-Server: $!" unless chmod(0600, $perlserver);
+  my $wrapper = "$dir/perlserver-wrapper";
+  die "write $wrapper: $!" unless io($wrapper)->print(<<EOF);
+#!/bin/sh
+MALLOC_CHECK_=3 G_SLICE=always-malloc valgrind --read-var-info=yes perl $perlserver "\$\@" >../tf 2>&1
+EOF
+  die "chmod $wrapper: $!" unless chmod 0700, $wrapper;
+} else {
+  die "chmod Perl-Server: $!" unless chmod(0700, $perlserver);
+}
+die "symlink script-fu: $!"
+  unless symlink("$plugins/script-fu", "$dir/script-fu");
+die "symlink sharpen: $!" unless symlink("$plugins/sharpen", "$dir/sharpen");
+die "output gimprc: $!"
+  unless io("$dir/gimprc")->print("(plug-in-path \"$dir\")\n");
+map { die "mkdir $dir/$_: $!" unless mkdir "$dir/$_"; }
+  qw(palettes gradients patterns brushes dynamics);
+
+$ENV{GIMP2_DIRECTORY} = $dir;
+
+ok(1, 'gimp set up');
+
+1;
diff --git a/t/perlplugin.t b/t/perlplugin.t
new file mode 100644
index 0000000..c34ffb5
--- /dev/null
+++ b/t/perlplugin.t
@@ -0,0 +1,54 @@
+use strict;
+use Test::More tests => 7;
+#BEGIN { $Gimp::verbose = 1; }
+use Gimp qw(:auto);
+use Config;
+
+our $dir;
+our $DEBUG = 0;
+require 't/gimpsetup.pl';
+
+my $plugin = "$dir/test_perl_filter";
+die "write $plugin: $!" unless io($plugin)->print($Config{startperl}.<<'EOF');
+
+use Gimp qw(:auto __ N_);
+use Gimp::Fu;
+
+sub test_perl_filter {
+  my ($i, $drawable, $text) = @_;
+  my $tl = $i->text_layer_new("hi", "Arial", 8, 3);
+  $i->insert_layer($tl, 0, 0);
+  $tl->set_name('text layer');
+  return $image;
+}
+
+register       "test_perl_filter",
+               "exercise gimp-perl for a filter",
+               "exercise gimp-perl for a filter",
+               "boilerplate id",
+               "boilerplate id",
+               "20140310",
+               N_"<Image>/Filters",
+               "*",
+       [
+         [PF_STRING, "text", "Text to put in layer", "hello"],
+       ],
+       \&test_perl_filter;
+
+exit main;
+EOF
+die "chmod $plugin: $!" unless chmod 0700, $plugin;
+
+Gimp::init("spawn/");
+
+ok((my $i = Gimp::Image->new(10,10,RGB)), 'new image');
+ok(
+  (my $l0 = $i->layer_new(10,10,RGBA_IMAGE,"new layer",100,VALUE_MODE)),
+  'make layer',
+);
+ok(!$i->insert_layer($l0,0,0), 'insert layer');
+ok(!$i->test_perl_filter(undef, 'text value'), 'call filter'); # 1st param drawable
+my ($tl) = $i->get_layers;
+is('text layer', $tl->get_name, 'layer name');
+
+ok(!$i->delete, 'remove image');
diff --git a/t/run.t b/t/run.t
index 4fa8446..da1b29a 100644
--- a/t/run.t
+++ b/t/run.t
@@ -1,28 +1,10 @@
-use Config;
 use strict;
-use File::Temp;
-use Test::More tests => 23;
-use IO::All;
+use Test::More tests => 15;
+use Gimp qw(:auto);
 
-BEGIN { use_ok('Gimp', qw(:auto)); }
-our %cfg;
-require_ok './config.pl';
-
-my $plugins = $cfg{gimpplugindir} . '/plug-ins';
-ok(-d $plugins, 'plugins dir exists');
-ok(-x "$plugins/script-fu", 'script-fu executable');
-
-my $dir = File::Temp->newdir;
-my $perlserver = "$dir/Perl-Server.pl";
-my $s = io("Perl-Server")->all or die "unable to read the Perl-Server";
-$s =~ s/^(#!).*?(\n)/$Config{startperl}$2/;
-ok(io($perlserver)->print($s), 'wrote Perl-Server');
-ok(chmod(0700, $perlserver), 'chmod Perl-Server');
-ok(symlink("$plugins/script-fu", "$dir/script-fu"), 'symlink script-fu');
-ok(symlink("$plugins/sharpen", "$dir/sharpen"), 'symlink sharpen');
-ok(io("$dir/gimprc")->print("(plug-in-path \"$dir\")\n"), 'output gimprc');
-
-$ENV{GIMP2_DIRECTORY} = $dir;
+our $dir;
+our $DEBUG = 0;
+require 't/gimpsetup.pl';
 
 Gimp::init("spawn/");
 
@@ -31,7 +13,7 @@ ok(
   (my $l = $i->layer_new(10,10,RGBA_IMAGE,"new layer",100,VALUE_MODE)),
   'Different OO syntax for creating a layer',
 );
-ok(!Gimp->image_add_layer($l,0), 'Yet another OO syntax');
+ok(!Gimp->image_insert_layer($l,0,0), 'Yet another OO syntax');
 is("new layer", $l->get_name, 'layer name');
 ok(
   !$l->paintbrush(50,[1,1,2,2,5,3,7,4,2,8],PAINT_CONSTANT,0),