perl-module/t/Pspp.t

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