[gimp-perl] Report exceptions in script context.

[Ed J <edj src gnome org>]

commit 53f1d2dc2f78cbd67e58747b5031c4f9031e3b5d
Author: Ed J <edj src gnome org>
Date:   Tue Apr 29 15:58:45 2014 +0100

    Report exceptions in script context.

 Gimp.pm        |   16 +++++++++-------
 Net/Net.pm     |    2 +-
 t/perlplugin.t |   14 +++++++++++---
 3 files changed, 21 insertions(+), 11 deletions(-)
---
diff --git a/Gimp.pm b/Gimp.pm
index 1ffe3b1..4ee4589 100644
--- a/Gimp.pm
+++ b/Gimp.pm
@@ -289,7 +289,12 @@ sub ignore_functions(@) {
    @ignore_function{ _}++;
 }
 
-sub recroak { $@ =~ /\n$/ ? die $@ : croak $@ }
+sub recroak {
+  my ($file, $e) = @_;
+  $file =~ s#\.[^\.]*$##; # cheat to allow Gimp[.pm] to match from Gimp/Net
+  die $e unless $e =~ s# at $file\S* line \d+\.\n\Z##;
+  croak $e;
+}
 sub AUTOLOAD {
   my ($class,$name) = $AUTOLOAD =~ /^(.*)::(.*?)$/;
   warn "$$-AUTOLOAD $AUTOLOAD(@_)" if $Gimp::verbose;
@@ -302,18 +307,16 @@ sub AUTOLOAD {
       my $ref = \&{"Gimp::Util::$sub"};
       *{$AUTOLOAD} = sub {
        shift unless ref $_[0];
-       #goto &$ref; # does not work, PERLBUG! #FIXME
        my @r = eval { &$ref };
-       recroak $@ if $@; wantarray ? @r : $r[0];
+       recroak __FILE__, $@ if $@; wantarray ? @r : $r[0];
       };
       goto &$AUTOLOAD;
     } elsif (UNIVERSAL::can($interface_pkg,$sub)) {
       my $ref = \&{"$interface_pkg\::$sub"};
       *{$AUTOLOAD} = sub {
        shift unless ref $_[0];
-       #goto &$ref; # does not work, PERLBUG! #FIXME
        my @r = eval { &$ref };
-       recroak $@ if $@; wantarray ? @r : $r[0];
+       recroak __FILE__, $@ if $@; wantarray ? @r : $r[0];
       };
       goto &$AUTOLOAD;
     } elsif (gimp_procedural_db_proc_exists($sub)) {
@@ -321,10 +324,9 @@ sub AUTOLOAD {
        warn "$$-gimp_call_procedure{0}(@_)" if $Gimp::verbose;
        shift unless ref $_[0];
        unshift @_, $sub;
-       #goto &gimp_call_procedure; # does not work, PERLBUG! #FIXME
        warn "$$-gimp_call_procedure{1}(@_)" if $Gimp::verbose;
        my @r = eval { gimp_call_procedure (@_) };
-       recroak $@ if $@; wantarray ? @r : $r[0];
+       recroak __FILE__, $@ if $@; wantarray ? @r : $r[0];
       };
       goto &$AUTOLOAD;
     }
diff --git a/Net/Net.pm b/Net/Net.pm
index 570ae8b..c0f44ee 100644
--- a/Net/Net.pm
+++ b/Net/Net.pm
@@ -101,7 +101,7 @@ sub gimp_call_procedure {
         print $trace_res $trace;
       }
    }
-   die $die_text if $die_text;
+   Gimp::recroak(__FILE__, $die_text) if $die_text;
    wantarray ? @response : $response[0];
 }
 
diff --git a/t/perlplugin.t b/t/perlplugin.t
index b587da1..3f86a97 100644
--- a/t/perlplugin.t
+++ b/t/perlplugin.t
@@ -1,12 +1,14 @@
 use strict;
 use Test::More;
 our ($dir, $DEBUG);
+my $tpf_name;
 BEGIN {
 #  $Gimp::verbose = 1;
   $DEBUG = 0;
   require 't/gimpsetup.pl';
   use Config;
-  write_plugin($DEBUG, "test_perl_filter", $Config{startperl}.
+  $tpf_name = "test_perl_filter";
+  write_plugin($DEBUG, $tpf_name, $Config{startperl}.
     "\nBEGIN { \$Gimp::verbose = ".int($Gimp::verbose||0).'; }'.<<'EOF');
 
 use strict;
@@ -29,7 +31,7 @@ sub boilerplate_params {
   "test_dies",
   boilerplate_params('exceptions', '<None>'),
   [ [ PF_STRING, "text", "Input text", 'default' ], ],
-  sub { die $_[0]."\n" }
+  sub { die $_[0] }
 );
 
 &register(
@@ -185,8 +187,14 @@ is_deeply(
   'return colour'
 );
 my $send_text = 'exception';
+eval { Gimp::Plugin->test_dies($send_text."\n"); };
+is($@, "$send_text\n", 'exception with newline correct');
 eval { Gimp::Plugin->test_dies($send_text); };
-is($@, "$send_text\n", 'exception returned correctly');
+like($@, qr/$send_text.*$tpf_name/, 'exception net w/o newline correct');
+eval { Gimp::Image->new; };
+my $dot_t_file = __FILE__;
+$dot_t_file =~ s#.*/##;
+like($@, qr/$dot_t_file/, 'exception from GIMP proc');
 eval { Gimp::Plugin->test_return_str_not_int; };
 like($@, qr/Expected a number/, 'exception handling on bad return value');
 eval { Gimp::Plugin->test_float_in('notfloat'); };