placement-parser: Properly handle LONG_MAX != INT_MAX.
[pspp] / perl-module / t / Pspp.t
1 ## -*-perl-*-
2
3 ## PSPP - a program for statistical analysis.
4 ## Copyright (C) 2019 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,Label,Measurement Level,Role,Width,Alignment,Print Format,Write Format,Missing Values
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 }