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