[gimp-perl] Eliminate some memory leaking. Bug 525016



commit bdf6c8b1cb0297f9bb7129fe075f1134d485122e
Author: Ed J <m8r-35s8eo mailinator com>
Date:   Mon Mar 17 03:32:07 2014 +0000

    Eliminate some memory leaking. Bug 525016

 Changes        |    2 +-
 Gimp.pm        |    5 --
 Gimp/Lib.xs    |  134 ++++++++++++++++++++++++++++++++------------------------
 t/gimpsetup.pl |   44 +++++++++++++-----
 t/perlplugin.t |    3 +-
 5 files changed, 109 insertions(+), 79 deletions(-)
---
diff --git a/Changes b/Changes
index 7a1fade..49d9315 100644
--- a/Changes
+++ b/Changes
@@ -134,7 +134,7 @@ file to document revision changes (similar to a GNU-style NEWS file).
         - applied 5.004 compatibility patch by artie kmfms com 
         - applied glow_steel gradient patch by Michael Fowler
           <michael shoebox net>.
-        - removed gimp_proc_db_proc_info from xs code in favour
+        - removed gimp_procedural_db_proc_info from xs code in favour
           of the PDB call.
         - fix the parasite-editor as much as possible.
         - fixed bug reported by Andreas Jaekel (who chose not to accept
diff --git a/Gimp.pm b/Gimp.pm
index 25337cf..9af60bc 100644
--- a/Gimp.pm
+++ b/Gimp.pm
@@ -541,11 +541,6 @@ sub ignore_functions(@) {
    @ignore_function{ _}++;
 }
 
-sub recroak($) {
-  $_[0] =~ s/ at \S+ line \d+.*$//s;
-  croak $_[0];
-}
-
 sub AUTOLOAD {
   my ($class,$name) = $AUTOLOAD =~ /^(.*)::(.*?)$/;
   for(@{"$class\::PREFIXES"}) {
diff --git a/Gimp/Lib.xs b/Gimp/Lib.xs
index 2009a5d..629a7d3 100644
--- a/Gimp/Lib.xs
+++ b/Gimp/Lib.xs
@@ -927,8 +927,7 @@ push_gimp_sv (const GimpParam *arg, int array_as_ref)
 #define sv2gimp_extract_noref(fun,str) \
        fun(sv); \
        if (SvROK(sv)) \
-         sprintf (croak_str, __("Unable to convert a reference to type '%s'"), str); \
-       break;
+         sprintf (croak_str, __("Unable to convert a reference to type '%s'"), str);
 /*
  * convert a perl scalar into a GimpParam, return true if
  * the argument has been consumed.
@@ -938,14 +937,17 @@ convert_sv2gimp (char *croak_str, GimpParam *arg, SV *sv)
 {
   switch (arg->type)
     {
-      /* Note that the sv2gimp_extract_noref includes a break;, so no fall throughs occur */
       case GIMP_PDB_INT32:     check_int (croak_str, sv);
                                arg->data.d_int32 = SvIV(sv);
-                               arg->data.d_int32       = sv2gimp_extract_noref (SvIV, "INT32");
-      case GIMP_PDB_INT16:     arg->data.d_int16       = sv2gimp_extract_noref (SvIV, "INT16");
-      case GIMP_PDB_INT8:      arg->data.d_int8        = sv2gimp_extract_noref (SvIV, "INT8");
-      case GIMP_PDB_FLOAT:     arg->data.d_float       = sv2gimp_extract_noref (SvNV, "FLOAT");
-      case GIMP_PDB_STRING:    arg->data.d_string      = sv2gimp_extract_noref (SvPv, "STRING");
+                               arg->data.d_int32       = sv2gimp_extract_noref (SvIV, "INT32"); break;
+      case GIMP_PDB_INT16:     arg->data.d_int16       = sv2gimp_extract_noref (SvIV, "INT16"); break;
+      case GIMP_PDB_INT8:      arg->data.d_int8        = sv2gimp_extract_noref (SvIV, "INT8"); break;
+      case GIMP_PDB_FLOAT:     arg->data.d_float       = sv2gimp_extract_noref (SvNV, "FLOAT"); break;
+      case GIMP_PDB_STRING: {
+       char *p = sv2gimp_extract_noref (SvPv, "STRING");
+       arg->data.d_string = g_strdup (p);
+       break;
+      }
 
       case GIMP_PDB_ITEM:
       case GIMP_PDB_DISPLAY:
@@ -964,7 +966,7 @@ convert_sv2gimp (char *croak_str, GimpParam *arg, SV *sv)
             case GIMP_PDB_CHANNEL:     arg->data.d_channel     = unbless(sv, PKG_ITEM  , croak_str); break;
             case GIMP_PDB_DRAWABLE:    arg->data.d_drawable    = unbless(sv, PKG_ITEM  , croak_str); break;
             case GIMP_PDB_VECTORS:     arg->data.d_vectors     = unbless(sv, PKG_ITEM  , croak_str); break;
-            case GIMP_PDB_STATUS:      arg->data.d_status      = sv2gimp_extract_noref (SvIV, "STATUS");
+            case GIMP_PDB_STATUS:      arg->data.d_status      = sv2gimp_extract_noref (SvIV, "STATUS"); 
break;
             case GIMP_PDB_IMAGE:
               {
                 if (sv_derived_from (sv, PKG_ITEM))
@@ -1033,24 +1035,40 @@ convert_sv2gimp (char *croak_str, GimpParam *arg, SV *sv)
       case GIMP_PDB_INT16ARRAY:        av2gimp (arg, sv, d_int16array , gint16 , SvIV); break;
       case GIMP_PDB_INT8ARRAY: av2gimp (arg, sv, d_int8array  , guint8 , SvIV); break;
       case GIMP_PDB_FLOATARRAY:        av2gimp (arg, sv, d_floatarray , gdouble, SvNV); break;
-      case GIMP_PDB_STRINGARRAY:av2gimp (arg, sv, d_stringarray, gchar *, SvPv); break;
+      case GIMP_PDB_STRINGARRAY: {
+       if (SvROK (sv) && SvTYPE(SvRV(sv)) != SVt_PVAV) {
+         sprintf (croak_str, __("perl-arrayref required as d_stringarray for a gimp-array"));
+         arg->data.d_stringarray = 0;
+         break;
+       }
+       int i;
+       AV *av = (AV *)SvRV(sv);
+       int len = av_len (av) + 1;
+       arg[-1].data.d_int32 = len;
+       arg->data.d_stringarray = g_new (gchar *, len);
+       for (i = 0; i <= av_len (av); i++) {
+         char *p = SvPv (*av_fetch (av, i, 0));
+         arg->data.d_stringarray[i] = g_strdup (p);
+       }
+       break;
+      }
 
       case GIMP_PDB_COLORARRAY:
-       if (SvROK (sv) && SvTYPE(SvRV(sv)) == SVt_PVAV) {
-         int i;
-         AV *av = (AV *)SvRV(sv);
-         arg[-1].data.d_int32 = av_len (av) + 1;
-         arg->data.d_colorarray = g_new (GimpRGB, av_len (av) + 1);
-         for (i = 0; i <= av_len (av); i++)
-           canonicalize_colour (
-             croak_str,
-             *av_fetch (av, i, 0),
-             &arg->data.d_colorarray[i]
-           );
-       } else {
+       if (SvROK (sv) && SvTYPE(SvRV(sv)) != SVt_PVAV) {
          sprintf (croak_str, __("perl-arrayref required as datatype for a gimp-array"));
          arg->data.d_colorarray = 0;
+         break;
        }
+       int i;
+       AV *av = (AV *)SvRV(sv);
+       arg[-1].data.d_int32 = av_len (av) + 1;
+       arg->data.d_colorarray = g_new (GimpRGB, av_len (av) + 1);
+       for (i = 0; i <= av_len (av); i++)
+         canonicalize_colour (
+           croak_str,
+           *av_fetch (av, i, 0),
+           &arg->data.d_colorarray[i]
+         );
        break;
 
       default:
@@ -1116,7 +1134,7 @@ static void pii_run(const gchar *name,
                     gint *xnreturn_vals,
                     GimpParam **xreturn_vals)
 {
-  // static as need to leave allocated until finished with
+  // static as need to leave allocated until finished with; freed on next entry
   static GimpParam *return_vals;
   static int nreturn_vals;
 
@@ -1135,10 +1153,11 @@ static void pii_run(const gchar *name,
   GimpParamDef *params;
   GimpParamDef *return_defs;
 
-  /* the libgimp is soooooooo braindamaged. */
+  // freeing these if currently allocated - libgimp requirement
   if (return_vals) {
     destroy_params (return_vals, nreturn_vals);
-    return_vals = 0;
+    return_vals = NULL;
+    nreturn_vals = 0;
   }
 
   if (
@@ -1159,6 +1178,12 @@ static void pii_run(const gchar *name,
   g_free (proc_date);
   gimp_destroy_paramdefs (params, _nparams);
 
+  // from here stops meaning "number of values returned from proc call" and
+  // starts meaning "number of values to be returned up chain"
+  nreturn_vals++; // since we're inserting the STATUS "value" in 0-th place.
+
+  ENTER;
+  SAVETMPS;
   PUSHMARK(SP);
 
   EXTEND (SP, 3);
@@ -1187,71 +1212,64 @@ static void pii_run(const gchar *name,
 
   if (SvTRUE (ERRSV)) {
     if (strEQ ("IGNORE THIS MESSAGE\n", SvPV_nolen (ERRSV))) {
-      nreturn_vals = 0;
-      return_vals = g_new (GimpParam, 1);
+      nreturn_vals = 1;
+      return_vals = g_new (GimpParam, nreturn_vals);
       return_vals->type = GIMP_PDB_STATUS;
       return_vals->data.d_status = GIMP_PDB_SUCCESS;
-      *xnreturn_vals = nreturn_vals+1;
+      *xnreturn_vals = nreturn_vals;
       *xreturn_vals = return_vals;
     } else {
       err_msg = g_strdup (SvPV_nolen (ERRSV));
     }
   } else {
-    int i;
     char errmsg [MAX_STRING];
     errmsg [0] = 0;
 
-    return_vals = (GimpParam *) g_new0 (GimpParam, nreturn_vals+1);
-    return_vals->type = GIMP_PDB_STATUS;
-    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;
-      if (
-       (i >= nreturn_vals-1 || !is_array (return_defs[i+1].type)) &&
-       convert_sv2gimp (errmsg, &return_vals[i], TOPs)
-      ) {
-       --count;
-       (void) POPs;
-      }
-
+    return_vals = (GimpParam *) g_new0 (GimpParam, nreturn_vals);
+    return_vals[0].type = GIMP_PDB_STATUS;
+    return_vals[0].data.d_status = GIMP_PDB_SUCCESS;
+    *xnreturn_vals = nreturn_vals;
+    *xreturn_vals = return_vals;
+
+    for (i = nreturn_vals - 1; i > 0; i--) {
+      return_vals[i].type = return_defs[i - 1].type;
+      if (i < nreturn_vals - 1 && is_array(return_defs[i].type))
+       // if one above is an array, this will be count, already set
+       // by convert_sv2gimp (and no perl-stack var supplied) so skip
+       continue;
+      convert_sv2gimp (errmsg, return_vals + i, POPs);
+      --count;
       if (errmsg [0]) {
        err_msg = g_strdup (errmsg);
-       break;
+       goto error;
       }
     }
 
-    /* shouldn't be fatal
-    if (count && !err_msg)
-      err_msg = g_strdup_printf (__("plug-in returned %d more values than expected"), count);
-    */
+    while (count) { count--; (void) POPs; }
   }
 
-  gimp_destroy_paramdefs (return_defs, nreturn_vals);
+  gimp_destroy_paramdefs (return_defs, nreturn_vals - 1);
 
   PUTBACK;
+  FREETMPS;
+  LEAVE;
 
   if (!err_msg)
     return;
 
   error:
   gimp_die_msg (err_msg);
-  // not g_free(err_msg) as gets used for return_vals[1]
 
   if (return_vals)
-    destroy_params (*xreturn_vals, nreturn_vals+1);
+    destroy_params (return_vals, nreturn_vals);
 
-  nreturn_vals = 1;
-  return_vals = g_new (GimpParam, 2);
+  nreturn_vals = 2;
+  return_vals = g_new (GimpParam, nreturn_vals);
   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;
+  *xnreturn_vals = nreturn_vals;
   *xreturn_vals = return_vals;
 }
 
diff --git a/t/gimpsetup.pl b/t/gimpsetup.pl
index f529b4b..01ff49f 100644
--- a/t/gimpsetup.pl
+++ b/t/gimpsetup.pl
@@ -20,21 +20,10 @@ 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 $perlserver = "$dir/Perl-Server";
 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);
-}
+write_plugin($DEBUG, $perlserver, $s);
 die "symlink script-fu: $!"
   unless symlink("$plugins/script-fu", "$dir/script-fu");
 die "symlink sharpen: $!" unless symlink("$plugins/sharpen", "$dir/sharpen");
@@ -47,4 +36,33 @@ $ENV{GIMP2_DIRECTORY} = $dir;
 
 ok(1, 'gimp set up');
 
+sub make_executable {
+  my $file = shift;
+  my $newfile = "$file.pl";
+  die "rename $file $newfile: $!\n" unless rename $file, $newfile;
+  die "chmod $newfile: $!\n" unless chmod 0700, $newfile;
+}
+
+sub write_plugin {
+  my ($debug, $file, $text) = @_;
+  # trying to be windows- and unix-compat in how to make things executable
+  # $file needs to have no extension on it
+  my $wrapper = "$file-wrap";
+  die "write $file: $!" unless io($file)->print($text);
+  if ($DEBUG) {
+    die "write $wrapper: $!" unless io($wrapper)->print(<<EOF);
+$Config{startperl}
+\$ENV{MALLOC_CHECK_} = '3';
+\$ENV{G_SLICE} = 'always-malloc';
+my \ args = (qw(valgrind --read-var-info=yes perl), '$file', \ ARGV);
+open STDOUT, '>', "valgrind-out.\$\$";
+open STDERR, '>&', \*STDOUT;
+die "failed to exec \ args: \$!\\n" unless exec \ args;
+EOF
+    make_executable($wrapper);
+  } else {
+    make_executable($file);
+  }
+}
+
 1;
diff --git a/t/perlplugin.t b/t/perlplugin.t
index d11c6ac..15639da 100644
--- a/t/perlplugin.t
+++ b/t/perlplugin.t
@@ -9,7 +9,7 @@ our $DEBUG = 0;
 require 't/gimpsetup.pl';
 
 my $plugin = "$dir/test_perl_filter";
-die "write $plugin: $!" unless io($plugin)->print($Config{startperl}.<<'EOF');
+write_plugin($DEBUG, $plugin, $Config{startperl}.<<'EOF');
 
 use strict;
 use Gimp qw(:auto __ N_);
@@ -76,7 +76,6 @@ sub boilerplate_params {
 
 exit main;
 EOF
-die "chmod $plugin: $!" unless chmod 0700, $plugin;
 
 #Gimp::set_trace(TRACE_ALL);
 Gimp::init("spawn/");


[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]