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

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