perl-module/t/Pspp.t

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