perl-module/t/Pspp.t

   1 ## -*-perl-*-
   2
   3 ## PSPP - a program for statistical analysis.
   4 ## Copyright (C) 2019, 2020 Free Software Foundation, Inc.
   5 ##
   6 ## This program is free software: you can redistribute it and/or modify
   7 ## it under the terms of the GNU General Public License as published by
   8 ## the Free Software Foundation, either version 3 of the License, or
   9 ## (at your option) any later version.
  10 ##
  11 ## This program is distributed in the hope that it will be useful,
  12 ## but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ## GNU General Public License for more details.
  15 ##
  16 ## You should have received a copy of the GNU General Public License
  17 ## along with this program.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 # Before `make install' is performed this script should be runnable
  20 # with `make test' as long as libpspp-core-$VERSION.so is in
  21 # LD_LIBRARY_PATH.  After `make install' it should work as `perl
  22 # PSPP.t'
  23
  24 #########################
  25
  26 # change 'tests => 1' to 'tests => last_test_to_print';
  27
  28 use Test::More tests => 37;
  29 use Text::Diff;
  30 use File::Temp qw/ tempfile tempdir /;
  31 use Memory::Usage;
  32 BEGIN { use_ok('PSPP') };
  33
  34 #########################
  35
  36 sub compare
  37 {
  38     my $file = shift;
  39     my $pattern = shift;
  40     return ! diff ("$file", \$pattern);
  41 }
  42
  43 my $pspp_cmd = $ENV{PSPP_TEST_CMD};
  44
  45 if ( ! $pspp_cmd)
  46 {
  47     $pspp_cmd="pspp";
  48 }
  49
  50 sub run_pspp_syntax
  51 {
  52     my $tempdir = shift;
  53     my $syntax = shift;
  54
  55     my $syntaxfile = "$tempdir/foo.sps";
  56
  57     open (FH, ">$syntaxfile");
  58     print FH "$syntax";
  59     close (FH);
  60
  61     system ("cd $tempdir; $pspp_cmd -o pspp.csv $syntaxfile");
  62 }
  63
  64 sub run_pspp_syntax_cmp
  65 {
  66     my $tempdir = shift;
  67     my $syntax = shift;
  68
  69     my $result = shift;
  70
  71     run_pspp_syntax ($tempdir, $syntax);
  72
  73     my $diff =  diff ("$tempdir/pspp.csv", \$result);
  74
  75     if ( ! ($diff eq ""))
  76     {
  77         diag ("$diff");
  78     }
  79
  80     return ($diff eq "");
  81 }
  82
  83
  84 # Insert your test code below, the Test::More module is used here so read
  85 # its man page ( perldoc Test::More ) for help writing this test script.
  86
  87 {
  88   my $d = PSPP::Dict->new();
  89   ok (ref $d, "Dictionary Creation");
  90   ok ($d->get_var_cnt () == 0);
  91
  92   $d->set_label ("My Dictionary");
  93   $d->add_document ("These Documents");
  94
  95   # Tests for variable creation
  96
  97   my $var0 = PSPP::Var->new ($d, "le");
  98   ok (!ref $var0, "Trap illegal variable name");
  99   ok ($d->get_var_cnt () == 0);
 100
 101   $var0 = PSPP::Var->new ($d, "legal");
 102   ok (ref $var0, "Accept legal variable name");
 103   ok ($d->get_var_cnt () == 1);
 104
 105   my $var1 = PSPP::Var->new ($d, "legal");
 106   ok (!ref $var1, "Trap duplicate variable name");
 107   ok ($d->get_var_cnt () == 1);
 108
 109   $var1 = PSPP::Var->new ($d, "money",
 110                           (fmt=>PSPP::Fmt::DOLLAR,
 111                            width=>4, decimals=>2) );
 112   ok (ref $var1, "Accept valid format");
 113   ok ($d->get_var_cnt () == 2);
 114
 115   $d->set_weight ($var1);
 116
 117
 118   # Tests for system file creation
 119   # Make sure a system file can be created
 120   {
 121       my $tempdir = tempdir( CLEANUP => 1 );
 122       my $tempfile = "$tempdir/testfile.sav";
 123       my $syntaxfile = "$tempdir/syntax.sps";
 124       my $sysfile = PSPP::Sysfile->new ("$tempfile", $d);
 125       ok (ref $sysfile, "Create sysfile object");
 126
 127       $sysfile->close ();
 128       ok (-s "$tempfile", "Write system file");
 129   }
 130 }
 131
 132
 133 # Make sure we can write cases to a file
 134 {
 135   my $d = PSPP::Dict->new();
 136   PSPP::Var->new ($d, "id",
 137                          (
 138                           fmt=>PSPP::Fmt::F,
 139                           width=>2,
 140                           decimals=>0
 141                           )
 142                          );
 143
 144   PSPP::Var->new ($d, "name",
 145                          (
 146                           fmt=>PSPP::Fmt::A,
 147                           width=>20,
 148                           )
 149                          );
 150
 151   $d->add_document ("This should not appear");
 152   $d->clear_documents ();
 153   $d->add_document ("This is a document line");
 154
 155   $d->set_label ("This is the file label");
 156
 157   # Check that we can write system files
 158   {
 159       my $tempdir = tempdir( CLEANUP => 1 );
 160       my $tempfile = "$tempdir/testfile.sav";
 161       my $sysfile = PSPP::Sysfile->new ("$tempfile", $d);
 162
 163       my $res = $sysfile->append_case ( [34, "frederick"]);
 164       ok ($res, "Append Case");
 165
 166       $res = $sysfile->append_case ( [34, "frederick", "extra"]);
 167       ok (!$res, "Appending Case with too many variables");
 168
 169       $sysfile->close ();
 170       ok (-s  "$tempfile", "existance");
 171   }
 172
 173   # Check that sysfiles are closed properly
 174   {
 175       my $tempdir = tempdir( CLEANUP => 1 );
 176       my $tempfile = "$tempdir/testfile.sav";
 177       {
 178           my $sysfile = PSPP::Sysfile->new ("$tempfile", $d);
 179
 180           my $res = $sysfile->append_case ( [21, "wheelbarrow"]);
 181           ok ($res, "Append Case 2");
 182
 183           # Don't close.  We want to test that the destructor  does that
 184           # automatically
 185       }
 186       ok (-s "$tempfile", "existance2");
 187
 188     ok (run_pspp_syntax_cmp ($tempdir, <<SYNTAX, <<RESULT), "Check output");
 189
 190         GET FILE='$tempfile'.
 191         DISPLAY DICTIONARY.
 192         DISPLAY FILE LABEL.
 193         DISPLAY DOCUMENTS.
 194         LIST.
 195 SYNTAX
 196 Table: Variables
 197 Name,Position,Measurement Level,Role,Width,Alignment,Print Format,Write Format
 198 id,1,Scale,Input,8,Right,F2.0,F2.0
 199 name,2,Nominal,Input,20,Left,A20,A20
 200
 201 Table: File Label
 202 Label,This is the file label
 203
 204 Table: Documents
 205 This is a document line
 206
 207 Table: Data List
 208 id,name
 209 21,wheelbarrow
 210 RESULT
 211
 212
 213   }
 214
 215   # Now do some tests to make sure all the variable parameters
 216   # can be written properly.
 217
 218   {
 219       my $tempdir = tempdir( CLEANUP => 1 );
 220       my $tempfile = "$tempdir/testfile.sav";
 221       my $dict = PSPP::Dict->new();
 222       ok (ref $dict, "Dictionary Creation 2");
 223
 224       my $int = PSPP::Var->new ($dict, "integer",
 225                                 (width=>8, decimals=>0) );
 226
 227       $int->set_label ("My Integer");
 228
 229       $int->add_value_label (99, "Silly");
 230       $int->clear_value_labels ();
 231       $int->add_value_label (0, "Zero");
 232       $int->add_value_label (1, "Unity");
 233       $int->add_value_label (2, "Duality");
 234
 235       my $str = PSPP::Var->new ($dict, "string",
 236                                 (fmt=>PSPP::Fmt::A, width=>8) );
 237
 238
 239       $str->set_label ("My String");
 240       ok ($str->add_value_label ("xx", "foo"), "Value label for short string");
 241       diag ($PSPP::errstr);
 242       $str->add_value_label ("yy", "bar");
 243
 244       $str->set_missing_values ("this", "that");
 245
 246       my $longstr = PSPP::Var->new ($dict, "longstring",
 247                                 (fmt=>PSPP::Fmt::A, width=>9) );
 248
 249
 250       $longstr->set_label ("My Long String");
 251       my $re = $longstr->add_value_label ("xxx", "xfoo");
 252       ok ($re, "Value label for long string");
 253
 254       $int->set_missing_values (9, 99);
 255
 256       my $sysfile = PSPP::Sysfile->new ("$tempfile", $dict);
 257
 258
 259       $sysfile->close ();
 260
 261       ok (run_pspp_syntax_cmp ($tempdir, <<SYNTAX, <<RESULT), "Check output 2");
 262 GET FILE='$tempfile'.
 263 DISPLAY DICTIONARY.
 264 SYNTAX
 265 Table: Variables
 266 Name,Position,Label,Measurement Level,Role,Width,Alignment,Print Format,Write Format,Missing Values
 267 integer,1,My Integer,Scale,Input,8,Right,F8.0,F8.0,9; 99
 268 string,2,My String,Nominal,Input,8,Left,A8,A8,"""this    ""; ""that    """
 269 longstring,3,My Long String,Nominal,Input,9,Left,A9,A9,
 270
 271 Table: Value Labels
 272 Variable Value,,Label
 273 My Integer,0,Zero
 274 ,1,Unity
 275 ,2,Duality
 276 My String,xx,foo
 277 ,yy,bar
 278 My Long String,xxx,xfoo
 279 RESULT
 280
 281   }
 282
 283 }
 284
 285 sub generate_sav_file
 286 {
 287     my $filename = shift;
 288     my $tempdir = shift;
 289
 290     run_pspp_syntax_cmp ($tempdir, <<SYNTAX, <<RESULT);
 291 data list notable list /string (a8) longstring (a12) numeric (f10) date (date11) dollar (dollar8.2) datetime (datetime17)
 292 begin data.
 293 1111 One   1 1/1/1 1   1/1/1+01:01
 294 2222 Two   2 2/2/2 2   2/2/2+02:02
 295 3333 Three 3 3/3/3 3   3/3/3+03:03
 296 .    .     . .     .   .
 297 5555 Five  5 5/5/5 5   5/5/5+05:05
 298 end data.
 299
 300
 301 variable labels string 'A Short String Variable'
 302   /longstring 'A Long String Variable'
 303   /numeric 'A Numeric Variable'
 304   /date 'A Date Variable'
 305   /dollar 'A Dollar Variable'
 306   /datetime 'A Datetime Variable'.
 307
 308
 309 missing values numeric (9, 5, 999).
 310
 311 missing values string ("3333").
 312
 313 add value labels
 314   /string '1111' 'ones' '2222' 'twos' '3333' 'threes'
 315   /numeric 1 'Unity' 2 'Duality' 3 'Thripality'.
 316
 317 variable attribute
 318     variables = numeric
 319     attribute=colour[1]('blue') colour[2]('pink') colour[3]('violet')
 320     attribute=size('large') nationality('foreign').
 321
 322
 323 save outfile='$filename'.
 324 SYNTAX
 325
 326 RESULT
 327
 328 }
 329
 330
 331 # Test to make sure that the dictionary survives the sysfile.
 332 # Thanks to Rob Messer for reporting this problem
 333 {
 334     my $tempdir = tempdir( CLEANUP => 1 );
 335     my $tempfile = "$tempdir/testfile.sav";
 336     my $sysfile ;
 337
 338     {
 339         my $d = PSPP::Dict->new();
 340
 341         PSPP::Var->new ($d, "id",
 342                         (
 343                          fmt=>PSPP::Fmt::F,
 344                          width=>2,
 345                          decimals=>0
 346                          )
 347                         );
 348
 349         $sysfile = PSPP::Sysfile->new ("$tempfile", $d);
 350     }
 351
 352     my $res = $sysfile->append_case ([3]);
 353
 354     ok ($res, "Dictionary survives sysfile");
 355 }
 356
 357
 358 # Basic reader test
 359 {
 360  my $tempdir = tempdir( CLEANUP => 1 );
 361
 362  generate_sav_file ("$tempdir/in.sav", "$tempdir");
 363
 364  my $sf = PSPP::Reader->open ("$tempdir/in.sav");
 365
 366  my $dict = $sf->get_dict ();
 367
 368  open (MYFILE, ">$tempdir/out.txt");
 369  for ($v = 0 ; $v < $dict->get_var_cnt() ; $v++)
 370  {
 371     my $var = $dict->get_var ($v);
 372     my $name = $var->get_name ();
 373     my $label = $var->get_label ();
 374
 375     print MYFILE "Variable $v is \"$name\", label is \"$label\"\n";
 376
 377     my $vl = $var->get_value_labels ();
 378
 379     print MYFILE "Value Labels:\n";
 380     print MYFILE "$_ => $vl->{$_}\n" for (sort keys %$vl);
 381  }
 382
 383  while (my @c = $sf->get_next_case () )
 384  {
 385     for ($v = 0; $v < $dict->get_var_cnt(); $v++)
 386     {
 387         print MYFILE "val$v: \"$c[$v]\"\n";
 388     }
 389     print MYFILE "\n";
 390  }
 391
 392  close (MYFILE);
 393
 394 ok (compare ("$tempdir/out.txt", <<EOF), "Basic reader operation");
 395 Variable 0 is "string", label is "A Short String Variable"
 396 Value Labels:
 397 1111     => ones
 398 2222     => twos
 399 3333     => threes
 400 Variable 1 is "longstring", label is "A Long String Variable"
 401 Value Labels:
 402 Variable 2 is "numeric", label is "A Numeric Variable"
 403 Value Labels:
 404 1 => Unity
 405 2 => Duality
 406 3 => Thripality
 407 Variable 3 is "date", label is "A Date Variable"
 408 Value Labels:
 409 Variable 4 is "dollar", label is "A Dollar Variable"
 410 Value Labels:
 411 Variable 5 is "datetime", label is "A Datetime Variable"
 412 Value Labels:
 413 val0: "1111    "
 414 val1: "One         "
 415 val2: "1"
 416 val3: "13197686400"
 417 val4: "1"
 418 val5: "13197690060"
 419
 420 val0: "2222    "
 421 val1: "Two         "
 422 val2: "2"
 423 val3: "13231987200"
 424 val4: "2"
 425 val5: "13231994520"
 426
 427 val0: "3333    "
 428 val1: "Three       "
 429 val2: "3"
 430 val3: "13266028800"
 431 val4: "3"
 432 val5: "13266039780"
 433
 434 val0: ".       "
 435 val1: ".           "
 436 val2: ""
 437 val3: ""
 438 val4: ""
 439 val5: ""
 440
 441 val0: "5555    "
 442 val1: "Five        "
 443 val2: "5"
 444 val3: "13334630400"
 445 val4: "5"
 446 val5: "13334648700"
 447
 448 EOF
 449
 450 }
 451
 452
 453 # Check that we can stream one file into another
 454 {
 455  my $tempdir = tempdir( CLEANUP => 1 );
 456
 457  generate_sav_file ("$tempdir/in.sav", "$tempdir");
 458
 459  my $input = PSPP::Reader->open ("$tempdir/in.sav");
 460
 461  my $dict = $input->get_dict ();
 462
 463  my $output = PSPP::Sysfile->new ("$tempdir/out.sav", $dict);
 464
 465  while (my (@c) = $input->get_next_case () )
 466  {
 467    $output->append_case (\@c);
 468  }
 469
 470  $output->close ();
 471
 472
 473  #Check the two files are the same (except for metadata)
 474
 475  run_pspp_syntax ($tempdir, <<SYNTAX);
 476  get file='$tempdir/in.sav'.
 477  display dictionary.
 478  list.
 479
 480 SYNTAX
 481
 482  system ("cp $tempdir/pspp.csv $tempdir/in.txt");
 483
 484  run_pspp_syntax ($tempdir, <<SYNTAX);
 485  get file='$tempdir/out.sav'.
 486  display dictionary.
 487  list.
 488
 489 SYNTAX
 490
 491  ok (! diff ("$tempdir/pspp.csv", "$tempdir/in.txt"), "Streaming of files");
 492 }
 493
 494
 495
 496 # Check that the format_value function works properly
 497 {
 498  my $tempdir = tempdir( CLEANUP => 1 );
 499
 500  run_pspp_syntax ($tempdir, <<SYNTAX);
 501
 502 data list list /d (datetime17).
 503 begin data.
 504 11/9/2001+08:20
 505 end data.
 506
 507 save outfile='$tempdir/dd.sav'.
 508
 509 SYNTAX
 510
 511  my $sf = PSPP::Reader->open ("$tempdir/dd.sav");
 512
 513  my $dict = $sf->get_dict ();
 514
 515  my (@c) = $sf->get_next_case ();
 516
 517  my $var = $dict->get_var (0);
 518  my $val = $c[0];
 519  my $formatted = PSPP::format_value ($val, $var);
 520  my $str = gmtime ($val - PSPP::PERL_EPOCH);
 521  print "Formatted string is \"$formatted\"\n";
 522  ok ( $formatted eq "11-SEP-2001 08:20", "format_value function");
 523  ok ( $str eq "Tue Sep 11 08:20:00 2001", "Perl representation of time");
 524 }
 525
 526
 527 # Check that attempting to open a non-existent file results in an error
 528 {
 529   my $tempdir = tempdir( CLEANUP => 1 );
 530
 531   unlink ("$tempdir/no-such-file.sav");
 532
 533   my $sf = PSPP::Reader->open ("$tempdir/no-such-file.sav");
 534
 535   ok ( !ref $sf, "Returns undef on opening failure");
 536
 537   ok ("$PSPP::errstr" eq "An error occurred while opening `$tempdir/no-such-file.sav': No such file or directory.",
 538       "Error string on open failure");
 539 }
 540
 541
 542 # Missing value tests.
 543 {
 544  my $tempdir = tempdir( CLEANUP => 1 );
 545
 546  generate_sav_file ("$tempdir/in.sav", "$tempdir");
 547
 548  my $sf = PSPP::Reader->open ("$tempdir/in.sav");
 549
 550  my $dict = $sf->get_dict ();
 551
 552
 553  my (@c) = $sf->get_next_case ();
 554
 555  my $stringvar = $dict->get_var (0);
 556  my $numericvar = $dict->get_var (2);
 557  my $val = $c[0];
 558
 559  ok ( !PSPP::value_is_missing ($val, $stringvar), "Missing Value Negative String");
 560
 561  $val = $c[2];
 562
 563  ok ( !PSPP::value_is_missing ($val, $numericvar), "Missing Value Negative Num");
 564
 565  @c = $sf->get_next_case ();
 566  @c = $sf->get_next_case ();
 567
 568  $val = $c[0];
 569  ok ( PSPP::value_is_missing ($val, $stringvar), "Missing Value Positive");
 570
 571  @c = $sf->get_next_case ();
 572  $val = $c[2];
 573  ok ( PSPP::value_is_missing ($val, $numericvar), "Missing Value Positive SYS");
 574
 575  @c = $sf->get_next_case ();
 576  $val = $c[2];
 577  ok ( PSPP::value_is_missing ($val, $numericvar), "Missing Value Positive Num");
 578 }
 579
 580
 581 #Test reading of custom attributes
 582 {
 583     my $tempdir = tempdir( CLEANUP => 1 );
 584
 585     generate_sav_file ("$tempdir/in.sav", "$tempdir");
 586
 587     my $sf = PSPP::Reader->open ("$tempdir/in.sav");
 588
 589     my $dict = $sf->get_dict ();
 590
 591     my $var = $dict->get_var_by_name ("numeric");
 592
 593     my $attr = $var->get_attributes ();
 594
 595     open (MYFILE, ">$tempdir/out.txt");
 596
 597     foreach $k (sort (keys (%$attr)))
 598     {
 599         my $ll = $attr->{$k};
 600         print MYFILE "$k =>";
 601         print MYFILE map "$_\n", join ', ', @$ll;
 602     }
 603
 604     close (MYFILE);
 605
 606     ok (compare ("$tempdir/out.txt", <<'EOF'), "Custom Attributes");
 607 $@Role =>0
 608 colour =>blue, pink, violet
 609 nationality =>foreign
 610 size =>large
 611 EOF
 612 }
 613
 614
 615 # Test of the get_case_cnt function
 616 {
 617  my $tempdir = tempdir( CLEANUP => 1 );
 618
 619  generate_sav_file ("$tempdir/in.sav", "$tempdir");
 620
 621  my $sf = PSPP::Reader->open ("$tempdir/in.sav");
 622
 623  my $n = $sf->get_case_cnt ();
 624
 625  ok ($n == 5, "Case count");
 626 }