GNOME.org
 

[gimp-perl] Plugin exceptions now passed correctly. Bug #726439

commit 4d6119d984d9e9e77e16d940b615479c6348fe91
Author: Ed J <m8r-35s8eo mailinator com>
Date:   Sun Mar 16 02:54:56 2014 +0000

    Plugin exceptions now passed correctly. Bug #726439

 Gimp.pm        |    6 ++--
 Gimp/Lib.xs    |  100 ++++++++++++++++++++++++++++++++++----------------------
 Net/Net.pm     |   64 +++++++++++++++---------------------
 Perl-Server    |   27 +++++++--------
 t/perlplugin.t |   24 +++++++++++++
 5 files changed, 128 insertions(+), 93 deletions(-)
---
diff --git a/Gimp.pm b/Gimp.pm
index e00313f..25337cf 100644
--- a/Gimp.pm
+++ b/Gimp.pm
@@ -559,7 +559,7 @@ sub AUTOLOAD {
        shift unless ref $_[0];
        #goto &$ref; # does not work, PERLBUG! #FIXME
        my @r = eval { &$ref };
-       recroak $@ if $@; wantarray ? @r : $r[0];
+       die $@ if $@; wantarray ? @r : $r[0];
       };
       goto &$AUTOLOAD;
     } elsif (UNIVERSAL::can($interface_pkg,$sub)) {
@@ -568,7 +568,7 @@ sub AUTOLOAD {
        shift unless ref $_[0];
        #goto &$ref; # does not work, PERLBUG! #FIXME
        my @r = eval { &$ref };
-       recroak $@ if $@; wantarray ? @r : $r[0];
+       die $@ if $@; wantarray ? @r : $r[0];
       };
       goto &$AUTOLOAD;
     } elsif (gimp_procedural_db_proc_exists($sub)) {
@@ -577,7 +577,7 @@ sub AUTOLOAD {
        unshift @_, $sub;
        #goto &gimp_call_procedure; # does not work, PERLBUG! #FIXME
        my @r = eval { gimp_call_procedure (@_) };
-       recroak $@ if $@; wantarray ? @r : $r[0];
+       die $@ if $@; wantarray ? @r : $r[0];
       };
       goto &$AUTOLOAD;
     }
diff --git a/Gimp/Lib.xs b/Gimp/Lib.xs
index 8a378af..2009a5d 100644
--- a/Gimp/Lib.xs
+++ b/Gimp/Lib.xs
@@ -1116,6 +1116,7 @@ static void pii_run(const gchar *name,
                     gint *xnreturn_vals,
                     GimpParam **xreturn_vals)
 {
+  // static as need to leave allocated until finished with
   static GimpParam *return_vals;
   static int nreturn_vals;
 
@@ -1134,11 +1135,11 @@ static void pii_run(const gchar *name,
   GimpParamDef *params;
   GimpParamDef *return_defs;
 
-   /* the libgimp is soooooooo braindamaged. */
-   if (return_vals) {
-     destroy_params (return_vals, nreturn_vals);
-     return_vals = 0;
-   }
+  /* the libgimp is soooooooo braindamaged. */
+  if (return_vals) {
+    destroy_params (return_vals, nreturn_vals);
+    return_vals = 0;
+  }
 
   if (
     gimp_procedural_db_proc_info (
@@ -1192,8 +1193,9 @@ static void pii_run(const gchar *name,
       return_vals->data.d_status = GIMP_PDB_SUCCESS;
       *xnreturn_vals = nreturn_vals+1;
       *xreturn_vals = return_vals;
-    } else
+    } else {
       err_msg = g_strdup (SvPV_nolen (ERRSV));
+    }
   } else {
     int i;
     char errmsg [MAX_STRING];
@@ -1204,6 +1206,8 @@ static void pii_run(const gchar *name,
     return_vals->data.d_status = GIMP_PDB_SUCCESS;
     *xnreturn_vals = nreturn_vals+1;
     *xreturn_vals = return_vals++;
+    // this probably shouldn't be ++ except for the convenience below -
+    //   gets destroy_params() top of function
 
     for (i = nreturn_vals; i-- && count; ) {
       return_vals[i].type = return_defs[i].type;
@@ -1236,15 +1240,17 @@ static void pii_run(const gchar *name,
 
   error:
   gimp_die_msg (err_msg);
-  g_free (err_msg);
+  // not g_free(err_msg) as gets used for return_vals[1]
 
   if (return_vals)
     destroy_params (*xreturn_vals, nreturn_vals+1);
 
-  nreturn_vals = 0;
-  return_vals = g_new (GimpParam, 1);
-  return_vals->type = GIMP_PDB_STATUS;
-  return_vals->data.d_status = GIMP_PDB_EXECUTION_ERROR;
+  nreturn_vals = 1;
+  return_vals = g_new (GimpParam, 2);
+  return_vals[0].type = GIMP_PDB_STATUS;
+  return_vals[0].data.d_status = GIMP_PDB_EXECUTION_ERROR;
+  return_vals[1].type = GIMP_PDB_STRING;
+  return_vals[1].data.d_string = err_msg;
   *xnreturn_vals = nreturn_vals+1;
   *xreturn_vals = return_vals;
 }
@@ -1524,40 +1530,57 @@ PPCODE:
 
     if (nparams)
       destroy_params (args, nparams);
-  } else {
-    values = gimp_run_procedure2 (proc_name, &nvalues, nparams, args);
+    goto error;
+  }
 
-    if (nparams)
-      destroy_params (args, nparams);
+  values = gimp_run_procedure2 (proc_name, &nvalues, nparams, args);
+
+  if (nparams)
+    destroy_params (args, nparams);
 
+  if (values && values[0].type != GIMP_PDB_STATUS) {
+    sprintf (croak_str, __("gimp didn't return an execution status, fatal error"));
+    goto error;
+  }
+  if (
+    values[0].data.d_status == GIMP_PDB_EXECUTION_ERROR ||
+    values[0].data.d_status == GIMP_PDB_CALLING_ERROR
+  ) {
+    if (nvalues > 1 && values[1].type == GIMP_PDB_STRING) {
+      // values[1] ought to be the error string
+      sprintf (croak_str, "%s", values[1].data.d_string);
+    } else
+      // just try gimp_get_pdb_error()
+      sprintf (croak_str, "%s: %s", proc_name, gimp_get_pdb_error ());
     if (trace & TRACE_CALL) {
-      dump_params (nvalues-1, values+1, return_vals);
-      trace_printf ("\n");
+      trace_printf ("(");
+      if ((trace & TRACE_DESC) == TRACE_DESC)
+       trace_printf ("\n\t");
+      trace_printf (__("EXCEPTION: \"%s\""), croak_str);
+      if ((trace & TRACE_DESC) == TRACE_DESC)
+       trace_printf ("\n\t");
+      trace_printf (")\n");
     }
+    goto error;
+  }
+  if (values[0].data.d_status != GIMP_PDB_SUCCESS) {
+    sprintf (croak_str, __("unsupported status code: %d, fatal error\n"), values[0].data.d_status);
+    goto error;
+  }
 
-    if (values && values[0].type == GIMP_PDB_STATUS) {
-      if (
-       values[0].data.d_status == GIMP_PDB_EXECUTION_ERROR ||
-       values[0].data.d_status == GIMP_PDB_CALLING_ERROR
-      )
-       sprintf (croak_str, __("%s: %s"), proc_name, gimp_get_pdb_error ());
-      else if (values[0].data.d_status == GIMP_PDB_SUCCESS) {
-       EXTEND(SP, perl_paramdef_count (return_vals, nvalues-1));
-       PUTBACK;
-       for (i = 0; i < nvalues-1; i++) {
-         if (i < nvalues-2 && is_array (values[i+2].type))
-           i++;
-
-         push_gimp_sv (values+i+1, nvalues > 2+1);
-       }
-
-       SPAGAIN;
-      } else
-       sprintf (croak_str, __("unsupported status code: %d, fatal error\n"), values[0].data.d_status);
-    } else
-      sprintf (croak_str, __("gimp didn't return an execution status, fatal error"));
+  if (trace & TRACE_CALL) {
+    dump_params (nvalues-1, values+1, return_vals);
+    trace_printf ("\n");
+  }
 
+  EXTEND(SP, perl_paramdef_count (return_vals, nvalues-1));
+  PUTBACK;
+  for (i = 0; i < nvalues-1; i++) {
+    if (i < nvalues-2 && is_array (values[i+2].type))
+      i++;
+    push_gimp_sv (values+i+1, nvalues > 2+1);
   }
+  SPAGAIN;
 
   error:
 
@@ -1567,7 +1590,6 @@ PPCODE:
   gimp_destroy_paramdefs (params, nparams);
   gimp_destroy_paramdefs (return_vals, nreturn_vals);
 
-
   if (croak_str[0])
     croak (croak_str);
 }
diff --git a/Net/Net.pm b/Net/Net.pm
index 1abbec0..b19f429 100644
--- a/Net/Net.pm
+++ b/Net/Net.pm
@@ -77,44 +77,34 @@ sub command {
    print $server_fh pack("N",length($req)).$req;
 }
 
-my($len,@args,$trace,$req); # small speedup, these are really local to gimp_call_procedure
-
 sub gimp_call_procedure {
-   if ($trace_level) {
-      $req="TRCE".args2net(0,$trace_level,@_);
-      print $server_fh pack("N",length($req)).$req;
-      do {
-         read($server_fh,$len,4) == 4 or die "protocol error (3)";
-         $len=unpack("N",$len);
-         read($server_fh,$req,abs($len)) == $len or die "protocol error (4)";
-         if ($len<0) {
-            ($req,@args)=net2args(0,$req);
-            print "ignoring callback $req\n";
-            redo;
-         }
-         ($trace,$req,@args)=net2args(0,$req);
-         if (ref $trace_res eq "SCALAR") {
-            $$trace_res = $trace;
-         } else {
-            print $trace_res $trace;
-         }
-      } while 0;
-   } else {
-      $req="EXEC".args2net(0,@_);
-      print $server_fh pack("N",length($req)).$req;
-      do {
-         read($server_fh,$len,4) == 4 or die "protocol error (5)";
-         $len=unpack("N",$len);
-         read($server_fh,$req,abs($len)) == $len or die "protocol error (6)";
-         if ($len<0) {
-            ($req,@args)=net2args(0,$req);
-            print "ignoring callback $req\n";
-            redo;
-         }
-         ($req,@args)=net2args(0,$req);
-      } while 0;
-   }
-   croak $req if $req;
+   my (@args,$trace,$req);
+   $req = ($trace_level ? "TRCE" : "EXEC") . args2net(
+     0, ($trace_level ? $trace_level : ()), @_
+   );
+   print $server_fh pack("N",length($req)).$req;
+   do {
+      my $len;
+      read($server_fh,$len,4) == 4 or die "protocol error (3)";
+      $len=unpack("N",$len);
+      read($server_fh,$req,abs($len)) == $len or die "protocol error (4)";
+      if ($len<0) {
+        ($req,@args)=net2args(0,$req);
+        print "ignoring callback $req\n";
+        redo;
+      }
+      @args = net2args(0,$req);
+      $trace = shift @args if $trace_level;
+      $req = shift @args;
+      if ($trace_level) {
+        if (ref $trace_res eq "SCALAR") {
+           $$trace_res = $trace;
+        } else {
+           print $trace_res $trace;
+        }
+      }
+   } while 0;
+   die $req if $req;
    wantarray ? @args : $args[0];
 }
 
diff --git a/Perl-Server b/Perl-Server
index 4589c1a..43baeb4 100755
--- a/Perl-Server
+++ b/Perl-Server
@@ -68,11 +68,12 @@ sub reply {
 
 sub handle_request($) {
    my($fh)= _;
-   my($length,$req,$data,@args,$trace_level);
+   my ($req,$data);
    
    eval {
       local $SIG{ALRM}=sub { die "1\n" };
       #alarm(6) unless $ps_flags & &Gimp::_PS_FLAG_BATCH;
+      my $length;
       read($fh,$length,4) == 4 or die "2\n";
       $length=unpack("N",$length);
       $length>0 && $length<$max_pkt or die "3\n";
@@ -85,27 +86,25 @@ sub handle_request($) {
    return 0 if $@;
    
    if(!$auth or $authorized[fileno($fh)]) {
-      if($req eq "EXEC") {
+      if ($req eq "TRCE" or $req eq "EXEC") {
          no strict 'refs';
-         ($req,@args)=Gimp::Net::net2args(1,$data);
-         @args=eval { Gimp->$req(@args) };
-         $data=Gimp::Net::args2net(1,$@,@args);
+         my @args = Gimp::Net::net2args(1, $data);
+         my $trace_level = shift @args if $req eq "TRCE";
+        my $function = shift @args;
+         Gimp::set_trace($trace_level) if $req eq "TRCE";
+         $trace_res = "" if $req eq "TRCE";
+         @args = eval { Gimp->$function(@args) };
+        unshift @args, $@;
+        unshift @args, $trace_res if $req eq "TRCE";
+         $data = Gimp::Net::args2net(1,@args);
          print $fh pack("N",length($data)).$data;
+         Gimp::set_trace(0) if $req eq "TRCE";
       } elsif ($req eq "TEST") {
          no strict 'refs';
          print $fh (defined(*{"Gimp::Lib::$data"}{CODE}) || Gimp::gimp_procedural_db_proc_exists($data)) ? 
"1" : "0";
       } elsif ($req eq "DTRY") {
          Gimp::Net::destroy_objects Gimp::Net::net2args 0,$data;
          print $fh pack("N",0); # fix to work around using non-sysread/write functions
-      } elsif($req eq "TRCE") {
-         no strict 'refs';
-         ($trace_level,$req,@args)=Gimp::Net::net2args 1,$data;
-         Gimp::set_trace($trace_level);
-         $trace_res="";
-         @args=eval { Gimp->$req(@args) };
-         $data=Gimp::Net::args2net(1,$trace_res,$@,@args);
-         print $fh pack("N",length($data)).$data;
-         Gimp::set_trace(0);
       } elsif ($req eq "QUIT") {
          slog __"received QUIT request";
          $server_quit = 1;
diff --git a/t/perlplugin.t b/t/perlplugin.t
index 185c0c3..74fbaac 100644
--- a/t/perlplugin.t
+++ b/t/perlplugin.t
@@ -14,6 +14,11 @@ die "write $plugin: $!" unless io($plugin)->print($Config{startperl}.<<'EOF');
 use Gimp qw(:auto __ N_);
 use Gimp::Fu;
 
+sub test_dies {
+  my ($text) = @_;
+  die $text."\n";
+}
+
 sub test_return_text {
   my ($text) = @_;
   return $text;
@@ -35,6 +40,20 @@ sub test_perl_filter {
   return $image;
 }
 
+register       "test_dies",
+               "exercise gimp-perl filter testing exceptions",
+               "exercise gimp-perl filter testing exceptions",
+               "boilerplate id",
+               "boilerplate id",
+               "20140310",
+               N_"<None>",
+               "*",
+       [
+         [PF_STRING, "text", "Input text", 'default' ],
+       ],
+       [],
+       \&test_dies;
+
 register       "test_return_text",
                "exercise gimp-perl filter returning text",
                "exercise gimp-perl filter returning text",
@@ -99,6 +118,11 @@ is('value', $tl->get_name, 'layer name');
 is(Gimp::Plugin->test_return_text('text'), 'text', 'call return text');
 is(Gimp::Plugin->test_return_text(undef), 'default', 'test default on plugin');
 ok((my $c = Gimp::Plugin->test_return_colour([6, 6, 6])), 'return colour');
+my $send_text = 'exception';
+eval { Gimp::Plugin->test_dies($send_text); };
+my $at = $@;
+chomp $at;
+is($at, $send_text, 'check exception returned correctly');
 
 ok(!$i->delete, 'remove image');
[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]