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