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