From: John Darrington <john@darrington.wattle.id.au>
Date: Sat, 14 Nov 2020 06:52:43 +0000 (+0100)
Subject: Fix leak in perl module
X-Git-Url: https://pintos-os.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=84e927df0b9a1686e9ea32f3327ea04312bbc348;p=pspp

Fix leak in perl module
---

diff --git a/perl-module/PSPP.xs b/perl-module/PSPP.xs
index 8800d0bdf4..923a472a84 100644
--- a/perl-module/PSPP.xs
+++ b/perl-module/PSPP.xs
@@ -1,5 +1,6 @@
 /* PSPP - computes sample statistics.
-   Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+   Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014,
+   2020 Free Software Foundation, Inc.
 
    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
@@ -686,7 +687,6 @@ CODE:
  const struct variable **vv;
  size_t nv;
  struct ccase *c;
- SV *sv;
 
  if ( av_len (av_case) >= dict_get_var_cnt (swi->dict->dict))
    XSRETURN_UNDEF;
@@ -696,37 +696,37 @@ CODE:
  dict_get_vars (swi->dict->dict, &vv, &nv,
                 1u << DC_ORDINARY | 1u << DC_SYSTEM);
 
- for (sv = av_shift (av_case); SvOK (sv);  sv = av_shift (av_case))
- {
+ for (SV *sv = av_shift (av_case); SvOK (sv);  sv = av_shift (av_case))
+  {
     const struct variable *v = vv[i++];
     const struct fmt_spec *ifmt = find_input_format (swi->dict, v);
 
     /* If an input format has been set, then use it.
-       Otherwise just convert the raw value.
-    */
-    if ( ifmt )
+       Otherwise just convert the raw value.    */
+    if (ifmt)
       {
-	struct substring ss = ss_cstr (SvPV_nolen (sv));
-	char *error;
-	bool ok;
-
-	error = data_in (ss, SvUTF8(sv) ? UTF8: "iso-8859-1", ifmt->type,
- 	       	         case_data_rw (c, v), var_get_width (v),
-			 dict_get_encoding (swi->dict->dict));
-        ok = error == NULL;
-        free (error);
-
-	if ( !ok )
-	  {
-	    RETVAL = 0;
-	    goto finish;
-	  }
+        struct substring ss = ss_cstr (SvPV_nolen (sv));
+        char *error = data_in (ss,
+                               SvUTF8(sv) ? UTF8: "iso-8859-1",
+                               ifmt->type,
+                               case_data_rw (c, v),
+                               var_get_width (v),
+                               dict_get_encoding (swi->dict->dict));
+        if (error)
+          {
+            free (error);
+            RETVAL = 0;
+            SvREFCNT_dec_NN (sv);
+            case_unref (c);
+            goto finish;
+          }
       }
     else
       {
-	scalar_to_value (case_data_rw (c, v), sv, v);
+        scalar_to_value (case_data_rw (c, v), sv, v);
       }
- }
+    SvREFCNT_dec_NN (sv);
+  }
 
  /* The remaining variables must be sysmis or blank string */
  while (i < dict_get_var_cnt (swi->dict->dict))
diff --git a/perl-module/t/Pspp.t b/perl-module/t/Pspp.t
index c31458dbe1..5d0789af9d 100644
--- a/perl-module/t/Pspp.t
+++ b/perl-module/t/Pspp.t
@@ -1,7 +1,7 @@
 ## -*-perl-*-
 
 ## PSPP - a program for statistical analysis.
-## Copyright (C) 2019 Free Software Foundation, Inc.
+## Copyright (C) 2019, 2020 Free Software Foundation, Inc.
 ##
 ## This program is free software: you can redistribute it and/or modify
 ## it under the terms of the GNU General Public License as published by
@@ -25,9 +25,10 @@
 
 # change 'tests => 1' to 'tests => last_test_to_print';
 
-use Test::More tests => 37;
+use Test::More tests => 38;
 use Text::Diff;
 use File::Temp qw/ tempfile tempdir /;
+use Memory::Usage;
 BEGIN { use_ok('PSPP') };
 
 #########################
@@ -623,3 +624,48 @@ EOF
 
  ok ($n == 5, "Case count");
 }
+
+
+# Check for a leak in append_case
+{
+    my $record_count = 10_000;
+    my $var_count = 10;
+
+    # Record amount of memory used by current process
+    my $mu = Memory::Usage->new();
+
+    my $dict = PSPP::Dict->new();
+    foreach my $i (1..$var_count)
+    {
+        my $var = PSPP::Var->new ($dict, "var$i", fmt => 12, width => 2);
+        $var->set_label ("var $i");
+    }
+
+    my $sysfile = PSPP::Sysfile->new ('testfile.sav', $dict, compress => 1);
+
+    $mu->record('');
+
+    foreach my $i (1..$record_count)
+    {
+        my @data = map { int(rand() * 100) } (1..$var_count);
+        $sysfile->append_case (\@data);
+    }
+
+    $mu->record('');
+
+    $sysfile->close;
+
+    my @memstate = @{$mu->state()};
+
+    my @array0 = @{$memstate[0]};
+    my @array1 = @{$memstate[1]};
+
+    # ignore the timestamps
+    $array0[0] = 0;
+    $array1[0] = 0;
+
+    my $result0 = join(",",@array0);
+    my $result1 = join(",",@array1);
+
+    ok (($result0 eq $result1), "Memory management of append_case");
+}
diff --git a/tests/perl-module.at b/tests/perl-module.at
index 18acf866d8..69e713c4aa 100644
--- a/tests/perl-module.at
+++ b/tests/perl-module.at
@@ -1,5 +1,5 @@
 dnl PSPP - a program for statistical analysis.
-dnl Copyright (C) 2017 Free Software Foundation, Inc.
+dnl Copyright (C) 2017, 2020 Free Software Foundation, Inc.
 dnl
 dnl This program is free software: you can redistribute it and/or modify
 dnl it under the terms of the GNU General Public License as published by
@@ -678,8 +678,10 @@ AT_KEYWORDS([slow])
 AT_SKIP_IF([test "$WITH_PERL_MODULE" = no])
 # Skip this test if Perl's Text::Diff module is not installed.
 AT_CHECK([perl -MText::Diff -e '' || exit 77])
+# Skip this test if Perl's Memory::Usage module is not installed.
+AT_CHECK([perl -MMemory::Usage -e '' || exit 77])
 AT_CHECK([run_perl_module $abs_top_builddir/perl-module/t/Pspp.t], [0],
-  [[1..37
+  [[1..38
 ok 1 - use PSPP;
 ok 2 - Dictionary Creation
 ok 3
@@ -718,5 +720,6 @@ ok 34 - Missing Value Positive SYS
 ok 35 - Missing Value Positive Num
 ok 36 - Custom Attributes
 ok 37 - Case count
+ok 38 - Memory management of append_case
 ]],[ignore])
 AT_CLEANUP