X-Git-Url: https://pintos-os.org/cgi-bin/gitweb.cgi?a=blobdiff_plain;f=perl-module%2Ft%2FPspp.t;h=05ba24119a7cc382d97f68c8bfaaa5a3b3414926;hb=2aedb52a90e7dead9401bf7633b0481ad14325e0;hp=3388120acd0282f67e33d86523183b4cbb97d4e9;hpb=66b1b93cf6ca53c86199e88e5972f3017c56314c;p=pspp

diff --git a/perl-module/t/Pspp.t b/perl-module/t/Pspp.t
index 3388120acd..05ba24119a 100644
--- a/perl-module/t/Pspp.t
+++ b/perl-module/t/Pspp.t
@@ -1,32 +1,76 @@
-# -*-perl-*-
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl PSPP.t'
+## -*-perl-*-
+
+## PSPP - a program for statistical analysis.
+## 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
+## the Free Software Foundation, either version 3 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+# Before `make install' is performed this script should be runnable
+# with `make test' as long as libpspp-core-$VERSION.so is in
+# LD_LIBRARY_PATH.  After `make install' it should work as `perl
+# PSPP.t'
 
 #########################
 
 # change 'tests => 1' to 'tests => last_test_to_print';
 
-use Test::More tests => 19;
+use Test::More tests => 38;
 use Text::Diff;
 use File::Temp qw/ tempfile tempdir /;
+use Memory::Usage;
 BEGIN { use_ok('PSPP') };
 
 #########################
 
+sub compare
+{
+    my $file = shift;
+    my $pattern = shift;
+    return ! diff ("$file", \$pattern);
+}
+
+my $pspp_cmd = $ENV{PSPP_TEST_CMD};
+
+if ( ! $pspp_cmd)
+{
+    $pspp_cmd="pspp";
+}
+
 sub run_pspp_syntax
 {
     my $tempdir = shift;
     my $syntax = shift;
-    my $result = shift;
+
     my $syntaxfile = "$tempdir/foo.sps";
 
     open (FH, ">$syntaxfile");
     print FH "$syntax";
     close (FH);
 
-    system ("cd $tempdir; pspp -o raw-ascii $syntaxfile");
+    system ("cd $tempdir; $pspp_cmd -o pspp.csv $syntaxfile");
+}
+
+sub run_pspp_syntax_cmp
+{
+    my $tempdir = shift;
+    my $syntax = shift;
+
+    my $result = shift;
+
+    run_pspp_syntax ($tempdir, $syntax);
 
-    my $diff =  diff ("$tempdir/pspp.list", \$result);
+    my $diff =  diff ("$tempdir/pspp.csv", \$result);
 
     if ( ! ($diff eq ""))
     {
@@ -37,31 +81,36 @@ sub run_pspp_syntax
 }
 
 
-# Insert your test code below, the Test::More module is use()ed here so read
+# Insert your test code below, the Test::More module is used here so read
 # its man page ( perldoc Test::More ) for help writing this test script.
 
 {
   my $d = PSPP::Dict->new();
   ok (ref $d, "Dictionary Creation");
+  ok ($d->get_var_cnt () == 0);
 
   $d->set_label ("My Dictionary");
-  $d->set_documents ("These Documents");
+  $d->add_document ("These Documents");
 
   # Tests for variable creation
 
   my $var0 = PSPP::Var->new ($d, "le");
   ok (!ref $var0, "Trap illegal variable name");
+  ok ($d->get_var_cnt () == 0);
 
   $var0 = PSPP::Var->new ($d, "legal");
   ok (ref $var0, "Accept legal variable name");
+  ok ($d->get_var_cnt () == 1);
 
   my $var1 = PSPP::Var->new ($d, "legal");
   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);
 
   $d->set_weight ($var1);
 
@@ -86,20 +135,20 @@ sub run_pspp_syntax
   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,
 			  )
 			 );
 
-  $d->set_documents ("This should not appear");
+  $d->add_document ("This should not appear");
   $d->clear_documents ();
   $d->add_document ("This is a document line");
 
@@ -131,12 +180,12 @@ sub run_pspp_syntax
 	  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");
 
-    ok (run_pspp_syntax ($tempdir, <<SYNTAX, <<RESULT), "Check output");
+    ok (run_pspp_syntax_cmp ($tempdir, <<SYNTAX, <<RESULT), "Check output");
 
         GET FILE='$tempfile'.
 	DISPLAY DICTIONARY.
@@ -144,58 +193,46 @@ sub run_pspp_syntax
 	DISPLAY DOCUMENTS.
 	LIST.
 SYNTAX
-1.1 DISPLAY.  
-+--------+-------------------------------------------+--------+
-|Variable|Description                                |Position|
-#========#===========================================#========#
-|id      |Format: F2.0                               |       1|
-|        |Measure: Scale                             |        |
-|        |Display Alignment: Right                   |        |
-|        |Display Width: 8                           |        |
-+--------+-------------------------------------------+--------+
-|name    |Format: A20                                |       2|
-|        |Measure: Nominal                           |        |
-|        |Display Alignment: Left                    |        |
-|        |Display Width: 20                          |        |
-+--------+-------------------------------------------+--------+
-
-File label:
-This is the file label
-
-Documents in the active file:
+Table: Variables
+Name,Position,Measurement Level,Role,Width,Alignment,Print Format,Write Format
+id,1,Scale,Input,8,Right,F2.0,F2.0
+name,2,Nominal,Input,20,Left,A20,A20
 
-This is a document line
+Table: File Label
+Label,This is the file label
 
-id                 name
--- --------------------
-21 wheelbarrow          
+Table: Documents
+This is a document line
 
+Table: Data List
+id,name
+21,wheelbarrow
 RESULT
 
 
   }
 
-  # 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) );
 
 
@@ -206,15 +243,13 @@ RESULT
 
       $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) );
 
 
       $longstr->set_label ("My Long String");
       my $re = $longstr->add_value_label ("xxx", "xfoo");
-      ok (($re == 0), "Long strings cant have labels");
-
-      ok ($PSPP::errstr eq "Cannot add label to a long string variable", "Error msg");
+      ok ($re, "Value label for long string");
 
       $int->set_missing_values (9, 99);
 
@@ -223,44 +258,414 @@ RESULT
 
       $sysfile->close ();
 
-      ok (run_pspp_syntax ($tempdir, <<SYNTAX, <<RESULT), "Check output 2");
+      ok (run_pspp_syntax_cmp ($tempdir, <<SYNTAX, <<RESULT), "Check output 2");
 GET FILE='$tempfile'.
 DISPLAY DICTIONARY.
 SYNTAX
-1.1 DISPLAY.  
-+----------+-----------------------------------------+--------+
-|Variable  |Description                              |Position|
-#==========#=========================================#========#
-|integer   |My Integer                               |       1|
-|          |Format: F8.0                             |        |
-|          |Measure: Scale                           |        |
-|          |Display Alignment: Right                 |        |
-|          |Display Width: 8                         |        |
-|          |Missing Values: 9; 99                    |        |
-|          +-----+-----------------------------------+        |
-|          |    0|Zero                               |        |
-|          |    1|Unity                              |        |
-|          |    2|Duality                            |        |
-+----------+-----+-----------------------------------+--------+
-|string    |My String                                |       2|
-|          |Format: A8                               |        |
-|          |Measure: Nominal                         |        |
-|          |Display Alignment: Left                  |        |
-|          |Display Width: 8                         |        |
-|          |Missing Values: "this    "; "that    "   |        |
-|          +-----+-----------------------------------+        |
-|          |   xx|foo                                |        |
-|          |   yy|bar                                |        |
-+----------+-----+-----------------------------------+--------+
-|longstring|My Long String                           |       3|
-|          |Format: A9                               |        |
-|          |Measure: Nominal                         |        |
-|          |Display Alignment: Left                  |        |
-|          |Display Width: 9                         |        |
-+----------+-----------------------------------------+--------+
-
+Table: Variables
+Name,Position,Label,Measurement Level,Role,Width,Alignment,Print Format,Write Format,Missing Values
+integer,1,My Integer,Scale,Input,8,Right,F8.0,F8.0,9; 99
+string,2,My String,Nominal,Input,8,Left,A8,A8,"""this    ""; ""that    """
+longstring,3,My Long String,Nominal,Input,9,Left,A9,A9,
+
+Table: Value Labels
+Variable Value,,Label
+My Integer,0,Zero
+,1,Unity
+,2,Duality
+My String,xx,foo
+,yy,bar
+My Long String,xxx,xfoo
 RESULT
 
   }
 
 }
+
+sub generate_sav_file
+{
+    my $filename = shift;
+    my $tempdir = shift;
+
+    run_pspp_syntax_cmp ($tempdir, <<SYNTAX, <<RESULT);
+data list notable list /string (a8) longstring (a12) numeric (f10) date (date11) dollar (dollar8.2) datetime (datetime17)
+begin data.
+1111 One   1 1/1/1 1   1/1/1+01:01
+2222 Two   2 2/2/2 2   2/2/2+02:02
+3333 Three 3 3/3/3 3   3/3/3+03:03
+.    .     . .     .   .
+5555 Five  5 5/5/5 5   5/5/5+05:05
+end data.
+
+
+variable labels string 'A Short String Variable'
+  /longstring 'A Long String Variable'
+  /numeric 'A Numeric Variable'
+  /date 'A Date Variable'
+  /dollar 'A Dollar Variable'
+  /datetime 'A Datetime Variable'.
+
+
+missing values numeric (9, 5, 999).
+
+missing values string ("3333").
+
+add value labels
+  /string '1111' 'ones' '2222' 'twos' '3333' 'threes'
+  /numeric 1 'Unity' 2 'Duality' 3 'Thripality'.
+
+variable attribute
+    variables = numeric
+    attribute=colour[1]('blue') colour[2]('pink') colour[3]('violet')
+    attribute=size('large') nationality('foreign').
+
+
+save outfile='$filename'.
+SYNTAX
+
+RESULT
+
+}
+
+
+# Test to make sure that the dictionary survives the sysfile.
+# Thanks to Rob Messer for reporting this problem
+{
+    my $tempdir = tempdir( CLEANUP => 1 );
+    my $tempfile = "$tempdir/testfile.sav";
+    my $sysfile ;
+
+    {
+	my $d = PSPP::Dict->new();
+
+	PSPP::Var->new ($d, "id",
+			(
+			 fmt=>PSPP::Fmt::F,
+			 width=>2,
+			 decimals=>0
+			 )
+			);
+
+	$sysfile = PSPP::Sysfile->new ("$tempfile", $d);
+    }
+
+    my $res = $sysfile->append_case ([3]);
+
+    ok ($res, "Dictionary survives sysfile");
+}
+
+
+# Basic reader test
+{
+ my $tempdir = tempdir( CLEANUP => 1 );
+
+ generate_sav_file ("$tempdir/in.sav", "$tempdir");
+
+ my $sf = PSPP::Reader->open ("$tempdir/in.sav");
+
+ my $dict = $sf->get_dict ();
+
+ open (MYFILE, ">$tempdir/out.txt");
+ for ($v = 0 ; $v < $dict->get_var_cnt() ; $v++)
+ {
+    my $var = $dict->get_var ($v);
+    my $name = $var->get_name ();
+    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";
+    print MYFILE "$_ => $vl->{$_}\n" for (sort keys %$vl);
+ }
+
+ while (my @c = $sf->get_next_case () )
+ {
+    for ($v = 0; $v < $dict->get_var_cnt(); $v++)
+    {
+	print MYFILE "val$v: \"$c[$v]\"\n";
+    }
+    print MYFILE "\n";
+ }
+
+ close (MYFILE);
+
+ok (compare ("$tempdir/out.txt", <<EOF), "Basic reader operation");
+Variable 0 is "string", label is "A Short String Variable"
+Value Labels:
+1111     => ones
+2222     => twos
+3333     => threes
+Variable 1 is "longstring", label is "A Long String Variable"
+Value Labels:
+Variable 2 is "numeric", label is "A Numeric Variable"
+Value Labels:
+1 => Unity
+2 => Duality
+3 => Thripality
+Variable 3 is "date", label is "A Date Variable"
+Value Labels:
+Variable 4 is "dollar", label is "A Dollar Variable"
+Value Labels:
+Variable 5 is "datetime", label is "A Datetime Variable"
+Value Labels:
+val0: "1111    "
+val1: "One         "
+val2: "1"
+val3: "13197686400"
+val4: "1"
+val5: "13197690060"
+
+val0: "2222    "
+val1: "Two         "
+val2: "2"
+val3: "13231987200"
+val4: "2"
+val5: "13231994520"
+
+val0: "3333    "
+val1: "Three       "
+val2: "3"
+val3: "13266028800"
+val4: "3"
+val5: "13266039780"
+
+val0: ".       "
+val1: ".           "
+val2: ""
+val3: ""
+val4: ""
+val5: ""
+
+val0: "5555    "
+val1: "Five        "
+val2: "5"
+val3: "13334630400"
+val4: "5"
+val5: "13334648700"
+
+EOF
+
+}
+
+
+# Check that we can stream one file into another
+{
+ my $tempdir = tempdir( CLEANUP => 1 );
+
+ generate_sav_file ("$tempdir/in.sav", "$tempdir");
+
+ my $input = PSPP::Reader->open ("$tempdir/in.sav");
+
+ my $dict = $input->get_dict ();
+
+ my $output = PSPP::Sysfile->new ("$tempdir/out.sav", $dict);
+
+ while (my (@c) = $input->get_next_case () )
+ {
+   $output->append_case (\@c);
+ }
+
+ $output->close ();
+
+
+ #Check the two files are the same (except for metadata)
+
+ run_pspp_syntax ($tempdir, <<SYNTAX);
+ get file='$tempdir/in.sav'.
+ display dictionary.
+ list.
+
+SYNTAX
+
+ system ("cp $tempdir/pspp.csv $tempdir/in.txt");
+
+ run_pspp_syntax ($tempdir, <<SYNTAX);
+ get file='$tempdir/out.sav'.
+ display dictionary.
+ list.
+
+SYNTAX
+
+ ok (! diff ("$tempdir/pspp.csv", "$tempdir/in.txt"), "Streaming of files");
+}
+
+
+
+# Check that the format_value function works properly
+{
+ my $tempdir = tempdir( CLEANUP => 1 );
+
+ run_pspp_syntax ($tempdir, <<SYNTAX);
+
+data list list /d (datetime17).
+begin data.
+11/9/2001+08:20
+end data.
+
+save outfile='$tempdir/dd.sav'.
+
+SYNTAX
+
+ my $sf = PSPP::Reader->open ("$tempdir/dd.sav");
+
+ my $dict = $sf->get_dict ();
+
+ my (@c) = $sf->get_next_case ();
+
+ my $var = $dict->get_var (0);
+ my $val = $c[0];
+ my $formatted = PSPP::format_value ($val, $var);
+ my $str = gmtime ($val - PSPP::PERL_EPOCH);
+ print "Formatted string is \"$formatted\"\n";
+ ok ( $formatted eq "11-SEP-2001 08:20", "format_value function");
+ ok ( $str eq "Tue Sep 11 08:20:00 2001", "Perl representation of time");
+}
+
+
+# Check that attempting to open a non-existent file results in an error
+{
+  my $tempdir = tempdir( CLEANUP => 1 );
+
+  unlink ("$tempdir/no-such-file.sav");
+
+  my $sf = PSPP::Reader->open ("$tempdir/no-such-file.sav");
+
+  ok ( !ref $sf, "Returns undef on opening failure");
+
+  ok ("$PSPP::errstr" eq "An error occurred while opening `$tempdir/no-such-file.sav': No such file or directory.",
+      "Error string on open failure");
+}
+
+
+# Missing value tests.
+{
+ my $tempdir = tempdir( CLEANUP => 1 );
+
+ generate_sav_file ("$tempdir/in.sav", "$tempdir");
+
+ my $sf = PSPP::Reader->open ("$tempdir/in.sav");
+
+ my $dict = $sf->get_dict ();
+
+
+ my (@c) = $sf->get_next_case ();
+
+ my $stringvar = $dict->get_var (0);
+ my $numericvar = $dict->get_var (2);
+ my $val = $c[0];
+
+ ok ( !PSPP::value_is_missing ($val, $stringvar), "Missing Value Negative String");
+
+ $val = $c[2];
+
+ ok ( !PSPP::value_is_missing ($val, $numericvar), "Missing Value Negative Num");
+
+ @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 ();
+ $val = $c[2];
+ ok ( PSPP::value_is_missing ($val, $numericvar), "Missing Value Positive SYS");
+
+ @c = $sf->get_next_case ();
+ $val = $c[2];
+ ok ( PSPP::value_is_missing ($val, $numericvar), "Missing Value Positive Num");
+}
+
+
+#Test reading of custom attributes
+{
+    my $tempdir = tempdir( CLEANUP => 1 );
+
+    generate_sav_file ("$tempdir/in.sav", "$tempdir");
+
+    my $sf = PSPP::Reader->open ("$tempdir/in.sav");
+
+    my $dict = $sf->get_dict ();
+
+    my $var = $dict->get_var_by_name ("numeric");
+
+    my $attr = $var->get_attributes ();
+
+    open (MYFILE, ">$tempdir/out.txt");
+
+    foreach $k (sort (keys (%$attr)))
+    {
+	my $ll = $attr->{$k};
+	print MYFILE "$k =>";
+	print MYFILE map "$_\n", join ', ', @$ll;
+    }
+
+    close (MYFILE);
+
+    ok (compare ("$tempdir/out.txt", <<'EOF'), "Custom Attributes");
+$@Role =>0
+colour =>blue, pink, violet
+nationality =>foreign
+size =>large
+EOF
+}
+
+
+# Test of the get_case_cnt function
+{
+ my $tempdir = tempdir( CLEANUP => 1 );
+
+ generate_sav_file ("$tempdir/in.sav", "$tempdir");
+
+ my $sf = PSPP::Reader->open ("$tempdir/in.sav");
+
+ my $n = $sf->get_case_cnt ();
+
+ 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");
+}