X-Git-Url: https://pintos-os.org/cgi-bin/gitweb.cgi?a=blobdiff_plain;f=perl-module%2Ft%2FPspp.t;h=04b76a57313666ff4119803ffd47ed12f45cc6ae;hb=9a331fe64eb814ae5c1322e21717a04fb254bf65;hp=ed824d12cc476fdda08dcaad3aae5473fdabff2a;hpb=7da2b01528493bd9f84a706e71fafb9ae8797ab7;p=pspp

diff --git a/perl-module/t/Pspp.t b/perl-module/t/Pspp.t
index ed824d12cc..04b76a5731 100644
--- a/perl-module/t/Pspp.t
+++ b/perl-module/t/Pspp.t
@@ -6,7 +6,7 @@
 
 # change 'tests => 1' to 'tests => last_test_to_print';
 
-use Test::More tests => 30;
+use Test::More tests => 37;
 use Text::Diff;
 use File::Temp qw/ tempfile tempdir /;
 BEGIN { use_ok('PSPP') };
@@ -20,6 +20,13 @@ sub compare
     return ! diff ("$file", \$pattern);
 }
 
+my $pspp_cmd = $ENV{PSPP_TEST_CMD};
+
+if ( ! $pspp_cmd)
+{
+    $pspp_cmd="pspp";
+}
+
 sub run_pspp_syntax
 {
     my $tempdir = shift;
@@ -31,7 +38,7 @@ sub run_pspp_syntax
     print FH "$syntax";
     close (FH);
 
-    system ("cd $tempdir; pspp -o raw-ascii $syntaxfile");
+    system ("cd $tempdir; $pspp_cmd -o raw-ascii $syntaxfile");
 }
 
 sub run_pspp_syntax_cmp
@@ -60,6 +67,7 @@ sub run_pspp_syntax_cmp
 {
   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");
@@ -68,17 +76,21 @@ sub run_pspp_syntax_cmp
 
   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, 
 			   width=>4, decimals=>2) );
   ok (ref $var1, "Accept valid format");
+  ok ($d->get_var_cnt () == 2);
 
   $d->set_weight ($var1);
 
@@ -314,6 +326,12 @@ 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
 
@@ -322,6 +340,33 @@ 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 );
@@ -347,11 +392,11 @@ RESULT
     print MYFILE "$_ => $vl->{$_}\n" for keys %$vl;
  }
 
- while (my $c = $sf->get_next_case () )
+ 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 "val$v: \"$c[$v]\"\n";
     }
     print MYFILE "\n";
  }
@@ -429,9 +474,9 @@ EOF
 
  my $output = PSPP::Sysfile->new ("$tempdir/out.sav", $dict);
 
- while (my $c = $input->get_next_case () )
+ while (my (@c) = $input->get_next_case () )
  {
-   $output->append_case ($c);
+   $output->append_case (\@c);
  }
 
  $output->close ();
@@ -479,10 +524,10 @@ SYNTAX
 
  my $dict = $sf->get_dict ();
 
- my $c = $sf->get_next_case ();
+ my (@c) = $sf->get_next_case ();
 
  my $var = $dict->get_var (0);
- my $val = @$c[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";
@@ -517,29 +562,63 @@ SYNTAX
  my $dict = $sf->get_dict ();
 
 
- my $c = $sf->get_next_case ();
+ my (@c) = $sf->get_next_case ();
 
  my $stringvar = $dict->get_var (0);
  my $numericvar = $dict->get_var (2);
- my $val = @$c[0];
+ my $val = $c[0];
 
  ok ( !PSPP::value_is_missing ($val, $stringvar), "Missing Value Negative String");
 
- $val = @$c[2];
+ $val = $c[2];
 
  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];
+ $val = $c[0];
  ok ( PSPP::value_is_missing ($val, $stringvar), "Missing Value Positive");
 
- $c = $sf->get_next_case (); 
- $val = @$c[2];
+ @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];
+ @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 (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");
+colour =>blue, pink, violet
+nationality =>foreign
+size =>large
+EOF
+
+}