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 => 31;
  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 save outfile='$filename'.
 318 SYNTAX
 319
 320 RESULT
 321
 322 }
 323
 324
 325 # Test to make sure that the dictionary survives the sysfile.
 326 # Thanks to Rob Messer for reporting this problem
 327 {
 328     my $tempdir = tempdir( CLEANUP => 1 );
 329     my $tempfile = "$tempdir/testfile.sav";
 330     my $sysfile ;
 331
 332     {
 333         my $d = PSPP::Dict->new();
 334
 335         PSPP::Var->new ($d, "id",
 336                         (
 337                          fmt=>PSPP::Fmt::F,
 338                          width=>2,
 339                          decimals=>0
 340                          )
 341                         );
 342
 343         $sysfile = PSPP::Sysfile->new ("$tempfile", $d);
 344     }
 345
 346     my $res = $sysfile->append_case ([3]);
 347
 348     ok ($res, "Dictionary survives sysfile");
 349 }
 350
 351
 352 # Basic reader test
 353 {
 354  my $tempdir = tempdir( CLEANUP => 1 );
 355
 356  generate_sav_file ("$tempdir/in.sav", "$tempdir");
 357
 358  my $sf = PSPP::Reader->open ("$tempdir/in.sav");
 359
 360  my $dict = $sf->get_dict ();
 361
 362  open (MYFILE, ">$tempdir/out.txt");
 363  for ($v = 0 ; $v < $dict->get_var_cnt() ; $v++)
 364  {
 365     my $var = $dict->get_var ($v);
 366     my $name = $var->get_name ();
 367     my $label = $var->get_label ();
 368
 369     print MYFILE "Variable $v is \"$name\", label is \"$label\"\n";
 370
 371     my $vl = $var->get_value_labels ();
 372
 373     print MYFILE "Value Labels:\n";
 374     print MYFILE "$_ => $vl->{$_}\n" for keys %$vl;
 375  }
 376
 377  while (my $c = $sf->get_next_case () )
 378  {
 379     for ($v = 0; $v < $dict->get_var_cnt(); $v++)
 380     {
 381         print MYFILE "val$v: \"@$c[$v]\"\n";
 382     }
 383     print MYFILE "\n";
 384  }
 385
 386  close (MYFILE);
 387
 388 ok (compare ("$tempdir/out.txt", <<EOF), "Basic reader operation");
 389 Variable 0 is "string", label is "A Short String Variable"
 390 Value Labels:
 391 3333     => threes
 392 1111     => ones
 393 2222     => twos
 394 Variable 1 is "longstring", label is "A Long String Variable"
 395 Value Labels:
 396 Variable 2 is "numeric", label is "A Numeric Variable"
 397 Value Labels:
 398 1 => Unity
 399 3 => Thripality
 400 2 => Duality
 401 Variable 3 is "date", label is "A Date Variable"
 402 Value Labels:
 403 Variable 4 is "dollar", label is "A Dollar Variable"
 404 Value Labels:
 405 Variable 5 is "datetime", label is "A Datetime Variable"
 406 Value Labels:
 407 val0: "1111    "
 408 val1: "One         "
 409 val2: "1"
 410 val3: "13197686400"
 411 val4: "1"
 412 val5: "13197690060"
 413
 414 val0: "2222    "
 415 val1: "Two         "
 416 val2: "2"
 417 val3: "13231987200"
 418 val4: "2"
 419 val5: "13231994520"
 420
 421 val0: "3333    "
 422 val1: "Three       "
 423 val2: "3"
 424 val3: "13266028800"
 425 val4: "3"
 426 val5: "13266039780"
 427
 428 val0: ".       "
 429 val1: ".           "
 430 val2: ""
 431 val3: ""
 432 val4: ""
 433 val5: ""
 434
 435 val0: "5555    "
 436 val1: "Five        "
 437 val2: "5"
 438 val3: "13334630400"
 439 val4: "5"
 440 val5: "13334648700"
 441
 442 EOF
 443
 444 }
 445
 446
 447 # Check that we can stream one file into another
 448 {
 449  my $tempdir = tempdir( CLEANUP => 1 );
 450
 451  generate_sav_file ("$tempdir/in.sav", "$tempdir");
 452
 453  my $input = PSPP::Reader->open ("$tempdir/in.sav");
 454
 455  my $dict = $input->get_dict ();
 456
 457  my $output = PSPP::Sysfile->new ("$tempdir/out.sav", $dict);
 458
 459  while (my $c = $input->get_next_case () )
 460  {
 461    $output->append_case ($c);
 462  }
 463
 464  $output->close ();
 465
 466
 467  #Check the two files are the same (except for metadata)
 468
 469  run_pspp_syntax ($tempdir, <<SYNTAX);
 470  get file='$tempdir/in.sav'.
 471  display dictionary.
 472  list.
 473
 474 SYNTAX
 475
 476  system ("cp $tempdir/pspp.list $tempdir/in.txt");
 477
 478  run_pspp_syntax ($tempdir, <<SYNTAX);
 479  get file='$tempdir/out.sav'.
 480  display dictionary.
 481  list.
 482
 483 SYNTAX
 484
 485  ok (! diff ("$tempdir/pspp.list", "$tempdir/in.txt"), "Streaming of files");
 486 }
 487
 488
 489
 490 # Check that the format_value function works properly
 491 {
 492  my $tempdir = tempdir( CLEANUP => 1 );
 493
 494  run_pspp_syntax ($tempdir, <<SYNTAX);
 495
 496 data list list /d (datetime17).
 497 begin data.
 498 11/9/2001+08:20
 499 end data.
 500
 501 save outfile='$tempdir/dd.sav'.
 502
 503 SYNTAX
 504
 505  my $sf = PSPP::Reader->open ("$tempdir/dd.sav");
 506
 507  my $dict = $sf->get_dict ();
 508
 509  my $c = $sf->get_next_case ();
 510
 511  my $var = $dict->get_var (0);
 512  my $val = @$c[0];
 513  my $formatted = PSPP::format_value ($val, $var);
 514  my $str = gmtime ($val - PSPP::PERL_EPOCH);
 515  print "Formatted string is \"$formatted\"\n";
 516  ok ( $formatted eq "11-SEP-2001 08:20", "format_value function");
 517  ok ( $str eq "Tue Sep 11 08:20:00 2001", "Perl representation of time");
 518 }
 519
 520
 521 # Check that attempting to open a non-existent file results in an error
 522 {
 523   my $tempdir = tempdir( CLEANUP => 1 );
 524
 525   unlink ("$tempdir/no-such-file.sav");
 526
 527   my $sf = PSPP::Reader->open ("$tempdir/no-such-file.sav");
 528
 529   ok ( !ref $sf, "Returns undef on opening failure");
 530
 531   ok ("$PSPP::errstr" eq "Error opening \"$tempdir/no-such-file.sav\" for reading as a system file: No such file or directory.",
 532       "Error string on open failure");
 533 }
 534
 535
 536 # Missing value tests.
 537 {
 538  my $tempdir = tempdir( CLEANUP => 1 );
 539
 540  generate_sav_file ("$tempdir/in.sav", "$tempdir");
 541
 542  my $sf = PSPP::Reader->open ("$tempdir/in.sav");
 543
 544  my $dict = $sf->get_dict ();
 545
 546
 547  my $c = $sf->get_next_case ();
 548
 549  my $stringvar = $dict->get_var (0);
 550  my $numericvar = $dict->get_var (2);
 551  my $val = @$c[0];
 552
 553  ok ( !PSPP::value_is_missing ($val, $stringvar), "Missing Value Negative String");
 554
 555  $val = @$c[2];
 556
 557  ok ( !PSPP::value_is_missing ($val, $numericvar), "Missing Value Negative Num");
 558
 559  $c = $sf->get_next_case ();
 560  $c = $sf->get_next_case ();
 561
 562  $val = @$c[0];
 563  ok ( PSPP::value_is_missing ($val, $stringvar), "Missing Value Positive");
 564
 565  $c = $sf->get_next_case ();
 566  $val = @$c[2];
 567  ok ( PSPP::value_is_missing ($val, $numericvar), "Missing Value Positive SYS");
 568
 569  $c = $sf->get_next_case ();
 570  $val = @$c[2];
 571  ok ( PSPP::value_is_missing ($val, $numericvar), "Missing Value Positive Num");
 572 }