pintos-os.org Git - pspp/blob - perl-module/t/Pspp.t

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