[gimp-perl] Eliminate some memory leaking. Bug 525016
- From: Kevin Cozens <kcozens src gnome org>
- To: commits-list gnome org
- Cc:
- Subject: [gimp-perl] Eliminate some memory leaking. Bug 525016
- Date: Wed, 26 Mar 2014 19:49:31 +0000 (UTC)
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]