sheet meta data: Move out of state data
[pspp] / 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,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,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,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 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 3333     => threes
395 1111     => ones
396 2222     => twos
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 3 => Thripality
403 2 => Duality
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 (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 colour =>blue, pink, violet
605 nationality =>foreign
606 size =>large
607 EOF
608 }
609
610
611 # Test of the get_case_cnt function
612 {
613  my $tempdir = tempdir( CLEANUP => 1 );
614
615  generate_sav_file ("$tempdir/in.sav", "$tempdir");
616
617  my $sf = PSPP::Reader->open ("$tempdir/in.sav");
618
619  my $n = $sf->get_case_cnt ();
620
621  ok ($n == 5, "Case count");
622 }