## -*-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
# 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') };
#########################
ok (!ref $var1, "Trap duplicate variable name");
ok ($d->get_var_cnt () == 1);
- $var1 = PSPP::Var->new ($d, "money",
- (fmt=>PSPP::Fmt::DOLLAR,
+ $var1 = PSPP::Var->new ($d, "money",
+ (fmt=>PSPP::Fmt::DOLLAR,
width=>4, decimals=>2) );
ok (ref $var1, "Accept valid format");
ok ($d->get_var_cnt () == 2);
my $d = PSPP::Dict->new();
PSPP::Var->new ($d, "id",
(
- fmt=>PSPP::Fmt::F,
- width=>2,
+ fmt=>PSPP::Fmt::F,
+ width=>2,
decimals=>0
)
);
PSPP::Var->new ($d, "name",
(
- fmt=>PSPP::Fmt::A,
- width=>20,
+ fmt=>PSPP::Fmt::A,
+ width=>20,
)
);
my $res = $sysfile->append_case ( [21, "wheelbarrow"]);
ok ($res, "Append Case 2");
- # Don't close. We want to test that the destructor does that
- # automatically
+ # Don't close. We want to test that the destructor does that
+ # automatically
}
ok (-s "$tempfile", "existance2");
}
- # Now do some tests to make sure all the variable parameters
+ # Now do some tests to make sure all the variable parameters
# can be written properly.
{
my $tempdir = tempdir( CLEANUP => 1 );
- my $tempfile = "$tempdir/testfile.sav";
+ my $tempfile = "$tempdir/testfile.sav";
my $dict = PSPP::Dict->new();
ok (ref $dict, "Dictionary Creation 2");
- my $int = PSPP::Var->new ($dict, "integer",
+ my $int = PSPP::Var->new ($dict, "integer",
(width=>8, decimals=>0) );
$int->set_label ("My Integer");
-
+
$int->add_value_label (99, "Silly");
$int->clear_value_labels ();
$int->add_value_label (0, "Zero");
$int->add_value_label (1, "Unity");
$int->add_value_label (2, "Duality");
- my $str = PSPP::Var->new ($dict, "string",
+ my $str = PSPP::Var->new ($dict, "string",
(fmt=>PSPP::Fmt::A, width=>8) );
$str->set_missing_values ("this", "that");
- my $longstr = PSPP::Var->new ($dict, "longstring",
+ my $longstr = PSPP::Var->new ($dict, "longstring",
(fmt=>PSPP::Fmt::A, width=>9) );
}
-sub generate_sav_file
+sub generate_sav_file
{
my $filename = shift;
my $tempdir = shift;
PSPP::Var->new ($d, "id",
(
- fmt=>PSPP::Fmt::F,
- width=>2,
+ fmt=>PSPP::Fmt::F,
+ width=>2,
decimals=>0
)
);
my $label = $var->get_label ();
print MYFILE "Variable $v is \"$name\", label is \"$label\"\n";
-
+
my $vl = $var->get_value_labels ();
print MYFILE "Value Labels:\n";
list.
SYNTAX
-
+
ok (! diff ("$tempdir/pspp.csv", "$tempdir/in.txt"), "Streaming of files");
}
}
-# Missing value tests.
+# Missing value tests.
{
my $tempdir = tempdir( CLEANUP => 1 );
ok ( !PSPP::value_is_missing ($val, $numericvar), "Missing Value Negative Num");
- @c = $sf->get_next_case ();
- @c = $sf->get_next_case ();
+ @c = $sf->get_next_case ();
+ @c = $sf->get_next_case ();
$val = $c[0];
ok ( PSPP::value_is_missing ($val, $stringvar), "Missing Value Positive");
- @c = $sf->get_next_case ();
+ @c = $sf->get_next_case ();
$val = $c[2];
ok ( PSPP::value_is_missing ($val, $numericvar), "Missing Value Positive SYS");
- @c = $sf->get_next_case ();
+ @c = $sf->get_next_case ();
$val = $c[2];
ok ( PSPP::value_is_missing ($val, $numericvar), "Missing Value Positive Num");
}
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");
+}