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 sub run_pspp_syntax
  24 {
  25     my $tempdir = shift;
  26     my $syntax = shift;
  27
  28     my $syntaxfile = "$tempdir/foo.sps";
  29
  30     open (FH, ">$syntaxfile");
  31     print FH "$syntax";
  32     close (FH);
  33
  34     system ("cd $tempdir; pspp -o raw-ascii $syntaxfile");
  35 }
  36
  37 sub run_pspp_syntax_cmp
  38 {
  39     my $tempdir = shift;
  40     my $syntax = shift;
  41
  42     my $result = shift;
  43
  44     run_pspp_syntax ($tempdir, $syntax);
  45
  46     my $diff =  diff ("$tempdir/pspp.list", \$result);
  47
  48     if ( ! ($diff eq ""))
  49     {
  50         diag ("$diff");
  51     }
  52
  53     return ($diff eq "");
  54 }
  55
  56
  57 # Insert your test code below, the Test::More module is used here so read
  58 # its man page ( perldoc Test::More ) for help writing this test script.
  59
  60 {
  61   my $d = PSPP::Dict->new();
  62   ok (ref $d, "Dictionary Creation");
  63
  64   $d->set_label ("My Dictionary");
  65   $d->set_documents ("These Documents");
  66
  67   # Tests for variable creation
  68
  69   my $var0 = PSPP::Var->new ($d, "le");
  70   ok (!ref $var0, "Trap illegal variable name");
  71
  72   $var0 = PSPP::Var->new ($d, "legal");
  73   ok (ref $var0, "Accept legal variable name");
  74
  75   my $var1 = PSPP::Var->new ($d, "legal");
  76   ok (!ref $var1, "Trap duplicate variable name");
  77
  78   $var1 = PSPP::Var->new ($d, "money",
  79                           (fmt=>PSPP::Fmt::DOLLAR,
  80                            width=>4, decimals=>2) );
  81   ok (ref $var1, "Accept valid format");
  82
  83   $d->set_weight ($var1);
  84
  85
  86   # Tests for system file creation
  87   # Make sure a system file can be created
  88   {
  89       my $tempdir = tempdir( CLEANUP => 1 );
  90       my $tempfile = "$tempdir/testfile.sav";
  91       my $syntaxfile = "$tempdir/syntax.sps";
  92       my $sysfile = PSPP::Sysfile->new ("$tempfile", $d);
  93       ok (ref $sysfile, "Create sysfile object");
  94
  95       $sysfile->close ();
  96       ok (-s "$tempfile", "Write system file");
  97   }
  98 }
  99
 100
 101 # Make sure we can write cases to a file
 102 {
 103   my $d = PSPP::Dict->new();
 104   PSPP::Var->new ($d, "id",
 105                          (
 106                           fmt=>PSPP::Fmt::F,
 107                           width=>2,
 108                           decimals=>0
 109                           )
 110                          );
 111
 112   PSPP::Var->new ($d, "name",
 113                          (
 114                           fmt=>PSPP::Fmt::A,
 115                           width=>20,
 116                           )
 117                          );
 118
 119   $d->set_documents ("This should not appear");
 120   $d->clear_documents ();
 121   $d->add_document ("This is a document line");
 122
 123   $d->set_label ("This is the file label");
 124
 125   # Check that we can write system files
 126   {
 127       my $tempdir = tempdir( CLEANUP => 1 );
 128       my $tempfile = "$tempdir/testfile.sav";
 129       my $sysfile = PSPP::Sysfile->new ("$tempfile", $d);
 130
 131       my $res = $sysfile->append_case ( [34, "frederick"]);
 132       ok ($res, "Append Case");
 133
 134       $res = $sysfile->append_case ( [34, "frederick", "extra"]);
 135       ok (!$res, "Appending Case with too many variables");
 136
 137       $sysfile->close ();
 138       ok (-s  "$tempfile", "existance");
 139   }
 140
 141   # Check that sysfiles are closed properly
 142   {
 143       my $tempdir = tempdir( CLEANUP => 1 );
 144       my $tempfile = "$tempdir/testfile.sav";
 145       {
 146           my $sysfile = PSPP::Sysfile->new ("$tempfile", $d);
 147
 148           my $res = $sysfile->append_case ( [21, "wheelbarrow"]);
 149           ok ($res, "Append Case 2");
 150
 151           # Don't close.  We want to test that the destructor  does that
 152           # automatically
 153       }
 154       ok (-s "$tempfile", "existance2");
 155
 156     ok (run_pspp_syntax_cmp ($tempdir, <<SYNTAX, <<RESULT), "Check output");
 157
 158         GET FILE='$tempfile'.
 159         DISPLAY DICTIONARY.
 160         DISPLAY FILE LABEL.
 161         DISPLAY DOCUMENTS.
 162         LIST.
 163 SYNTAX
 164 1.1 DISPLAY.
 165 +--------+-------------------------------------------+--------+
 166 |Variable|Description                                |Position|
 167 #========#===========================================#========#
 168 |id      |Format: F2.0                               |       1|
 169 |        |Measure: Scale                             |        |
 170 |        |Display Alignment: Right                   |        |
 171 |        |Display Width: 8                           |        |
 172 +--------+-------------------------------------------+--------+
 173 |name    |Format: A20                                |       2|
 174 |        |Measure: Nominal                           |        |
 175 |        |Display Alignment: Left                    |        |
 176 |        |Display Width: 20                          |        |
 177 +--------+-------------------------------------------+--------+
 178
 179 File label:
 180 This is the file label
 181
 182 Documents in the active file:
 183
 184 This is a document line
 185
 186 id                 name
 187 -- --------------------
 188 21 wheelbarrow
 189
 190 RESULT
 191
 192
 193   }
 194
 195   # Now do some tests to make sure all the variable parameters
 196   # can be written properly.
 197
 198   {
 199       my $tempdir = tempdir( CLEANUP => 1 );
 200       my $tempfile = "$tempdir/testfile.sav";
 201       my $dict = PSPP::Dict->new();
 202       ok (ref $dict, "Dictionary Creation 2");
 203
 204       my $int = PSPP::Var->new ($dict, "integer",
 205                                 (width=>8, decimals=>0) );
 206
 207       $int->set_label ("My Integer");
 208
 209       $int->add_value_label (99, "Silly");
 210       $int->clear_value_labels ();
 211       $int->add_value_label (0, "Zero");
 212       $int->add_value_label (1, "Unity");
 213       $int->add_value_label (2, "Duality");
 214
 215       my $str = PSPP::Var->new ($dict, "string",
 216                                 (fmt=>PSPP::Fmt::A, width=>8) );
 217
 218
 219       $str->set_label ("My String");
 220       ok ($str->add_value_label ("xx", "foo"), "Value label for short string");
 221       diag ($PSPP::errstr);
 222       $str->add_value_label ("yy", "bar");
 223
 224       $str->set_missing_values ("this", "that");
 225
 226       my $longstr = PSPP::Var->new ($dict, "longstring",
 227                                 (fmt=>PSPP::Fmt::A, width=>9) );
 228
 229
 230       $longstr->set_label ("My Long String");
 231       my $re = $longstr->add_value_label ("xxx", "xfoo");
 232       ok (($re == 0), "Long strings cant have labels");
 233
 234       ok ($PSPP::errstr eq "Cannot add label to a long string variable", "Error msg");
 235
 236       $int->set_missing_values (9, 99);
 237
 238       my $sysfile = PSPP::Sysfile->new ("$tempfile", $dict);
 239
 240
 241       $sysfile->close ();
 242
 243       ok (run_pspp_syntax_cmp ($tempdir, <<SYNTAX, <<RESULT), "Check output 2");
 244 GET FILE='$tempfile'.
 245 DISPLAY DICTIONARY.
 246 SYNTAX
 247 1.1 DISPLAY.
 248 +----------+-----------------------------------------+--------+
 249 |Variable  |Description                              |Position|
 250 #==========#=========================================#========#
 251 |integer   |My Integer                               |       1|
 252 |          |Format: F8.0                             |        |
 253 |          |Measure: Scale                           |        |
 254 |          |Display Alignment: Right                 |        |
 255 |          |Display Width: 8                         |        |
 256 |          |Missing Values: 9; 99                    |        |
 257 |          +-----+-----------------------------------+        |
 258 |          |    0|Zero                               |        |
 259 |          |    1|Unity                              |        |
 260 |          |    2|Duality                            |        |
 261 +----------+-----+-----------------------------------+--------+
 262 |string    |My String                                |       2|
 263 |          |Format: A8                               |        |
 264 |          |Measure: Nominal                         |        |
 265 |          |Display Alignment: Left                  |        |
 266 |          |Display Width: 8                         |        |
 267 |          |Missing Values: "this    "; "that    "   |        |
 268 |          +-----+-----------------------------------+        |
 269 |          |   xx|foo                                |        |
 270 |          |   yy|bar                                |        |
 271 +----------+-----+-----------------------------------+--------+
 272 |longstring|My Long String                           |       3|
 273 |          |Format: A9                               |        |
 274 |          |Measure: Nominal                         |        |
 275 |          |Display Alignment: Left                  |        |
 276 |          |Display Width: 9                         |        |
 277 +----------+-----------------------------------------+--------+
 278
 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 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 3333     => threes
 398 1111     => ones
 399 2222     => twos
 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 3 => Thripality
 406 2 => Duality
 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.list $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.list", "$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 "Error opening \"$tempdir/no-such-file.sav\" for reading as a system file: 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 (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 colour =>blue, pink, violet
 608 nationality =>foreign
 609 size =>large
 610 EOF
 611
 612 }