DATA MATRIX: Avoid crash on invalid input
[pspp] / tests / perl-module.at
1 AT_BANNER([Perl module tests])
2
3 dnl This command can be used to run with the PSPP Perl module after it has been
4 dnl built (with "make") but before it has been installed.  The -I options are
5 dnl equivalent to "use ExtUtils::testlib;" inside the Perl program, but it does
6 dnl not need to be run with the perl-module build directory as the current
7 dnl working directory.
8 dnl
9 dnl XXX "libtool --mode=execute" is probably better than setting
10 dnl LD_LIBRARY_PATH.
11 m4_define([RUN_PERL_MODULE],
12   [LD_LIBRARY_PATH=$abs_top_builddir/src/.libs \
13    DYLD_LIBRARY_PATH=$abs_top_builddir/src/.libs \
14    $PERL -I$abs_top_builddir/perl-module/blib/arch \
15          -I$abs_top_builddir/perl-module/blib/lib])
16
17 AT_SETUP([Perl create system file])
18 AT_SKIP_IF([test "$WITH_PERL_MODULE" = no])
19 AT_DATA([test.pl],
20   [use warnings;
21    use strict;
22    use PSPP;
23
24    my $d = PSPP::Dict->new();
25    die "dictionary creation" if !ref $d;
26    die if $d->get_var_cnt () != 0;
27
28    $d->set_label ("My Dictionary");
29    $d->set_documents ("These Documents");
30
31    # Tests for variable creation
32
33    my $var0 = PSPP::Var->new ($d, "le");
34    die "trap illegal variable name" if ref $var0;
35    die if $d->get_var_cnt () != 0;
36
37    $var0 = PSPP::Var->new ($d, "legal");
38    die "accept legal variable name" if !ref $var0;
39    die if $d->get_var_cnt () != 1;
40
41    my $var1 = PSPP::Var->new ($d, "money", 
42                               (fmt=>PSPP::Fmt::DOLLAR,
43                                width=>4, decimals=>2) );
44    die "cappet valid format" if !ref $var1;
45    die if $d->get_var_cnt () != 2;
46
47    $d->set_weight ($var1);
48
49    my $sysfile = PSPP::Sysfile->new ('testfile.sav', $d);
50    die "create sysfile object" if !ref $sysfile;
51
52    $sysfile->close ();
53 ])
54 AT_CHECK([RUN_PERL_MODULE test.pl])
55 AT_DATA([dump-dict.sps],
56   [GET FILE='testfile.sav'.
57 DISPLAY FILE LABEL.
58 DISPLAY DOCUMENTS.
59 DISPLAY DICTIONARY.
60 SHOW WEIGHT.
61 ])
62 AT_CHECK([pspp -O format=csv dump-dict.sps], [0],
63   [File label: My Dictionary
64
65 Documents in the active dataset:
66
67 These Documents
68
69 Variable,Description,Position
70 legal,Format: F9.2,1
71 money,Format: DOLLAR6.2,2
72
73 dump-dict.sps:5: note: SHOW: WEIGHT is money.
74 ])
75 AT_CLEANUP
76
77 AT_SETUP([Perl writing cases to system files])
78 AT_SKIP_IF([test "$WITH_PERL_MODULE" = no])
79 AT_DATA([test.pl],
80   [[use warnings;
81     use strict;
82     use PSPP;
83
84     my $d = PSPP::Dict->new();
85     PSPP::Var->new ($d, "id",
86                     (
87                      fmt=>PSPP::Fmt::F, 
88                      width=>2, 
89                      decimals=>0
90                      )
91                     );
92
93     PSPP::Var->new ($d, "name",
94                            (
95                             fmt=>PSPP::Fmt::A, 
96                             width=>20, 
97                             )
98                            );
99
100     $d->set_documents ("This should not appear");
101     $d->clear_documents ();
102     $d->add_document ("This is a document line");
103
104     $d->set_label ("This is the file label");
105
106     # Check that we can write cases to system files.
107     my $sysfile = PSPP::Sysfile->new ("testfile.sav", $d);
108     my $res = $sysfile->append_case ( [34, "frederick"]);
109     die "append case" if !$res;
110
111     $res = $sysfile->append_case ( [34, "frederick", "extra"]);
112     die "append case with too many variables" if $res;
113     $sysfile->close ();
114
115     # Check that sysfiles are closed properly automaticallly in the destructor.
116     my $sysfile2 = PSPP::Sysfile->new ("testfile2.sav", $d);
117     $res = $sysfile2->append_case ( [21, "wheelbarrow"]);
118     die "append case 2" if !$res;
119
120     $res = $sysfile->append_case ( [34, "frederick", "extra"]);
121     die "append case with too many variables" if $res;
122
123     # Don't close.  We want to test that the destructor does that.
124 ]])
125 AT_CHECK([RUN_PERL_MODULE test.pl])
126 AT_DATA([dump-dicts.sps],
127   [GET FILE='testfile.sav'.
128 DISPLAY DICTIONARY.
129 DISPLAY FILE LABEL.
130 DISPLAY DOCUMENTS.
131 LIST.
132
133 GET FILE='testfile2.sav'.
134 DISPLAY DICTIONARY.
135 DISPLAY FILE LABEL.
136 DISPLAY DOCUMENTS.
137 LIST.
138 ])
139 AT_CHECK([pspp -O format=csv dump-dicts.sps], [0],
140   [Variable,Description,Position
141 id,Format: F2.0,1
142 name,Format: A20,2
143
144 File label: This is the file label
145
146 Documents in the active dataset:
147
148 This is a document line
149
150 Table: Data List
151 id,name
152 34,frederick           @&t@
153
154 Variable,Description,Position
155 id,Format: F2.0,1
156 name,Format: A20,2
157
158 File label: This is the file label
159
160 Documents in the active dataset:
161
162 This is a document line
163
164 Table: Data List
165 id,name
166 21,wheelbarrow         @&t@
167 ])
168 AT_CLEANUP
169
170 AT_SETUP([Perl write variable parameters])
171 AT_SKIP_IF([test "$WITH_PERL_MODULE" = no])
172 AT_DATA([test.pl],
173   [[use warnings;
174     use strict;
175     use PSPP;
176
177     my $dict = PSPP::Dict->new();
178     die "dictionary creation" if !ref $dict;
179
180     my $int = PSPP::Var->new ($dict, "integer", 
181                               (width=>8, decimals=>0) );
182
183     $int->set_label ("My Integer");
184
185     $int->add_value_label (99, "Silly");
186     $int->clear_value_labels ();
187     $int->add_value_label (0, "Zero");
188     $int->add_value_label (1, "Unity");
189     $int->add_value_label (2, "Duality");
190
191     my $str = PSPP::Var->new ($dict, "string", 
192                               (fmt=>PSPP::Fmt::A, width=>8) );
193
194
195     $str->set_label ("My String");
196     $str->add_value_label ("xx", "foo");
197     $str->add_value_label ("yy", "bar");
198
199     $str->set_missing_values ("this", "that");
200
201     my $longstr = PSPP::Var->new ($dict, "longstring", 
202                               (fmt=>PSPP::Fmt::A, width=>9) );
203
204
205     $longstr->set_label ("My Long String");
206     my $re = $longstr->add_value_label ("xxx", "xfoo");
207
208     $int->set_missing_values (9, 99);
209
210     my $sysfile = PSPP::Sysfile->new ("testfile.sav", $dict);
211
212
213     $sysfile->close ();
214 ]])
215 AT_CHECK([RUN_PERL_MODULE test.pl])
216 AT_DATA([dump-dict.sps],
217   [GET FILE='testfile.sav'.
218 DISPLAY DICTIONARY.
219 ])
220 AT_CHECK([pspp -O format=csv dump-dict.sps], [0],
221   [Variable,Description,Position
222 integer,"Label: My Integer
223 Format: F8.0
224 Missing Values: 9; 99
225
226 Value,Label
227 0,Zero
228 1,Unity
229 2,Duality",1
230 string,"Label: My String
231 Format: A8
232 Missing Values: ""this    ""; ""that    ""
233
234 Value,Label
235 xx      ,foo
236 yy      ,bar",2
237 longstring,"Label: My Long String
238 Format: A9
239
240 Value,Label
241 xxx      ,xfoo",3
242 ])
243 AT_CLEANUP
244
245 AT_SETUP([Perl dictionary survives system file])
246 AT_SKIP_IF([test "$WITH_PERL_MODULE" = no])
247 AT_DATA([test.pl],
248   [[use warnings;
249 use strict;
250 use PSPP;
251
252 my $sysfile ;
253
254     {
255         my $d = PSPP::Dict->new();
256
257         PSPP::Var->new ($d, "id",
258                         (
259                          fmt=>PSPP::Fmt::F, 
260                          width=>2, 
261                          decimals=>0
262                          )
263                         );
264
265         $sysfile = PSPP::Sysfile->new ("testfile.sav", $d);
266     }
267
268     my $res = $sysfile->append_case ([3]);
269     print "Dictionary survives sysfile\n" if $res;
270 ]])
271 AT_CHECK([RUN_PERL_MODULE test.pl], [0],
272   [Dictionary survives sysfile
273 ])
274 AT_CLEANUP
275
276 m4_define([PERL_GENERATE_SYSFILE],
277   [AT_DATA([sample.sps],
278     [[data list notable list /string (a8) longstring (a12) numeric (f10) date (date11) dollar (dollar8.2) datetime (datetime17)
279 begin data.
280 1111 One   1 1/1/1 1   1/1/1+01:01
281 2222 Two   2 2/2/2 2   2/2/2+02:02
282 3333 Three 3 3/3/3 3   3/3/3+03:03
283 .    .     . .     .   .
284 5555 Five  5 5/5/5 5   5/5/5+05:05
285 end data.
286
287
288 variable labels string 'A Short String Variable'
289   /longstring 'A Long String Variable'
290   /numeric 'A Numeric Variable'
291   /date 'A Date Variable'
292   /dollar 'A Dollar Variable'
293   /datetime 'A Datetime Variable'.
294
295
296 missing values numeric (9, 5, 999).
297
298 missing values string ("3333").
299
300 add value labels
301   /string '1111' 'ones' '2222' 'twos' '3333' 'threes'
302   /numeric 1 'Unity' 2 'Duality' 3 'Thripality'.
303
304 variable attribute
305     variables = numeric
306     attribute=colour[1]('blue') colour[2]('pink') colour[3]('violet')
307     attribute=size('large') nationality('foreign').
308
309
310 save outfile='sample.sav'.
311 ]])
312    AT_CHECK([pspp -O format=csv sample.sps])])
313
314 AT_SETUP([Perl read system file])
315 AT_SKIP_IF([test "$WITH_PERL_MODULE" = no])
316 PERL_GENERATE_SYSFILE
317 AT_DATA([test.pl],
318   [[use warnings;
319     use strict;
320     use PSPP;
321
322     my $sf = PSPP::Reader->open ("sample.sav");
323
324     my $dict = $sf->get_dict ();
325
326     for (my $v = 0 ; $v < $dict->get_var_cnt() ; $v++)
327     {
328        my $var = $dict->get_var ($v);
329        my $name = $var->get_name ();
330        my $label = $var->get_label ();
331
332        print "Variable $v is \"$name\", label is \"$label\"\n";
333
334        my $vl = $var->get_value_labels ();
335
336        print "Value Labels:\n";
337        print "$_ => $vl->{$_}\n" for sort (keys %$vl);
338     }
339
340     while (my @c = $sf->get_next_case () )
341     {
342        for (my $v = 0; $v < $dict->get_var_cnt(); $v++)
343        {
344            print "val$v: \"$c[$v]\"\n";
345        }
346        print "\n";
347     }
348 ]])
349 AT_CHECK([RUN_PERL_MODULE test.pl], [0],
350   [Variable 0 is "string", label is "A Short String Variable"
351 Value Labels:
352 1111     => ones
353 2222     => twos
354 3333     => threes
355 Variable 1 is "longstring", label is "A Long String Variable"
356 Value Labels:
357 Variable 2 is "numeric", label is "A Numeric Variable"
358 Value Labels:
359 1 => Unity
360 2 => Duality
361 3 => Thripality
362 Variable 3 is "date", label is "A Date Variable"
363 Value Labels:
364 Variable 4 is "dollar", label is "A Dollar Variable"
365 Value Labels:
366 Variable 5 is "datetime", label is "A Datetime Variable"
367 Value Labels:
368 val0: "1111    "
369 val1: "One         "
370 val2: "1"
371 val3: "13197686400"
372 val4: "1"
373 val5: "13197690060"
374
375 val0: "2222    "
376 val1: "Two         "
377 val2: "2"
378 val3: "13231987200"
379 val4: "2"
380 val5: "13231994520"
381
382 val0: "3333    "
383 val1: "Three       "
384 val2: "3"
385 val3: "13266028800"
386 val4: "3"
387 val5: "13266039780"
388
389 val0: ".       "
390 val1: ".           "
391 val2: ""
392 val3: ""
393 val4: ""
394 val5: ""
395
396 val0: "5555    "
397 val1: "Five        "
398 val2: "5"
399 val3: "13334630400"
400 val4: "5"
401 val5: "13334648700"
402
403 ])
404 AT_CLEANUP
405
406 AT_SETUP([Perl copying system files])
407 AT_SKIP_IF([test "$WITH_PERL_MODULE" = no])
408 PERL_GENERATE_SYSFILE
409 AT_DATA([test.pl],
410   [[use warnings;
411     use strict;
412     use PSPP;
413
414     my $input = PSPP::Reader->open ("sample.sav");
415
416     my $dict = $input->get_dict ();
417
418     my $output = PSPP::Sysfile->new ("copy.sav", $dict);
419
420     while (my (@c) = $input->get_next_case () )
421     {
422       $output->append_case (\@c);
423     }
424
425     $output->close ();
426 ]])
427 AT_CHECK([RUN_PERL_MODULE test.pl])
428 AT_DATA([dump-dicts.sps],
429   [GET FILE='sample.sav'.
430 DISPLAY DICTIONARY.
431 LIST.
432
433 GET FILE='copy.sav'.
434 DISPLAY DICTIONARY.
435 LIST.
436 ])
437 AT_CHECK([pspp -O format=csv dump-dicts.sps], [0],
438   [[Variable,Description,Position
439 string,"Label: A Short String Variable
440 Format: A8
441 Missing Values: ""3333    ""
442
443 Value,Label
444 1111    ,ones
445 2222    ,twos
446 3333    ,threes",1
447 longstring,"Label: A Long String Variable
448 Format: A12",2
449 numeric,"Label: A Numeric Variable
450 Format: F10.0
451 Missing Values: 9; 5; 999
452
453 Value,Label
454 1,Unity
455 2,Duality
456 3,Thripality
457
458 Attribute,Value
459 colour[1],blue
460 colour[2],pink
461 colour[3],violet
462 nationality,foreign
463 size,large",3
464 date,"Label: A Date Variable
465 Format: DATE11",4
466 dollar,"Label: A Dollar Variable
467 Format: DOLLAR11.2",5
468 datetime,"Label: A Datetime Variable
469 Format: DATETIME17.0",6
470
471 Table: Data List
472 string,longstring,numeric,date,dollar,datetime
473 1111    ,One         ,1,01-JAN-2001,$1.00,01-JAN-2001 01:01
474 2222    ,Two         ,2,02-FEB-2002,$2.00,02-FEB-2002 02:02
475 3333    ,Three       ,3,03-MAR-2003,$3.00,03-MAR-2003 03:03
476 .       ,.           ,.,.,.  ,.
477 5555    ,Five        ,5,05-MAY-2005,$5.00,05-MAY-2005 05:05
478
479 Variable,Description,Position
480 string,"Label: A Short String Variable
481 Format: A8
482 Missing Values: ""3333    ""
483
484 Value,Label
485 1111    ,ones
486 2222    ,twos
487 3333    ,threes",1
488 longstring,"Label: A Long String Variable
489 Format: A12",2
490 numeric,"Label: A Numeric Variable
491 Format: F10.0
492 Missing Values: 9; 5; 999
493
494 Value,Label
495 1,Unity
496 2,Duality
497 3,Thripality
498
499 Attribute,Value
500 colour[1],blue
501 colour[2],pink
502 colour[3],violet
503 nationality,foreign
504 size,large",3
505 date,"Label: A Date Variable
506 Format: DATE11",4
507 dollar,"Label: A Dollar Variable
508 Format: DOLLAR11.2",5
509 datetime,"Label: A Datetime Variable
510 Format: DATETIME17.0",6
511
512 Table: Data List
513 string,longstring,numeric,date,dollar,datetime
514 1111    ,One         ,1,01-JAN-2001,$1.00,01-JAN-2001 01:01
515 2222    ,Two         ,2,02-FEB-2002,$2.00,02-FEB-2002 02:02
516 3333    ,Three       ,3,03-MAR-2003,$3.00,03-MAR-2003 03:03
517 .       ,.           ,.,.,.  ,.
518 5555    ,Five        ,5,05-MAY-2005,$5.00,05-MAY-2005 05:05
519 ]])
520 AT_CLEANUP
521
522 AT_SETUP([Perl value formatting])
523 AT_SKIP_IF([test "$WITH_PERL_MODULE" = no])
524 AT_DATA([dd.sps],
525   [DATA LIST LIST /d (DATETIME17).
526 BEGIN DATA.
527 11/9/2001+08:20
528 END DATA.
529
530 SAVE OUTFILE='dd.sav'.
531 ])
532 AT_CHECK([pspp -O format=csv dd.sps], [0],
533   [Table: Reading free-form data from INLINE.
534 Variable,Format
535 d,DATETIME17.0
536 ])
537 AT_DATA([test.pl],
538   [[use warnings;
539     use strict;
540     use PSPP;
541
542     my $sf = PSPP::Reader->open ("dd.sav");
543
544     my $dict = $sf->get_dict ();
545
546     my (@c) = $sf->get_next_case ();
547
548     my $var = $dict->get_var (0);
549     my $val = $c[0];
550     my $formatted = PSPP::format_value ($val, $var);
551     my $str = gmtime ($val - PSPP::PERL_EPOCH);
552     print "Formatted string is \"$formatted\"\n";
553     print "Perl representation is \"$str\"\n";
554 ]])
555 AT_CHECK([RUN_PERL_MODULE test.pl], [0],
556   [[Formatted string is "11-SEP-2001 08:20"
557 Perl representation is "Tue Sep 11 08:20:00 2001"
558 ]])
559 AT_CLEANUP
560
561 AT_SETUP([Perl opening nonexistent file])
562 AT_SKIP_IF([test "$WITH_PERL_MODULE" = no])
563 AT_DATA([test.pl],
564   [[use warnings;
565     use strict;
566     use PSPP;
567
568     my $sf = PSPP::Reader->open ("no-such-file.sav");
569
570     die "Returns undef on opening failure" if ref $sf;
571     print $PSPP::errstr, "\n";
572 ]])
573 AT_CHECK([RUN_PERL_MODULE test.pl], [0],
574   [[An error occurred while opening `no-such-file.sav': No such file or directory.
575 ]],
576   [[Name "PSPP::errstr" used only once: possible typo at test.pl line 8.
577 ]])
578 AT_CLEANUP
579
580 AT_SETUP([Perl missing values])
581 AT_SKIP_IF([test "$WITH_PERL_MODULE" = no])
582 PERL_GENERATE_SYSFILE
583 AT_DATA([test.pl],
584   [[use warnings;
585     use strict;
586     use PSPP;
587
588     my $sf = PSPP::Reader->open ("sample.sav");
589
590     my $dict = $sf->get_dict ();
591
592     my (@c) = $sf->get_next_case ();
593
594     my $stringvar = $dict->get_var (0);
595     my $numericvar = $dict->get_var (2);
596     my $val = $c[0];
597
598     die "Missing Value Negative String"
599         if PSPP::value_is_missing ($val, $stringvar);
600
601     $val = $c[2];
602
603     die "Missing Value Negative Num"
604         if PSPP::value_is_missing ($val, $numericvar);
605
606     @c = $sf->get_next_case (); 
607     @c = $sf->get_next_case (); 
608
609     $val = $c[0];
610     die "Missing Value Positive"
611         if !PSPP::value_is_missing ($val, $stringvar);
612
613     @c = $sf->get_next_case (); 
614     $val = $c[2];
615     die "Missing Value Positive SYS"
616         if !PSPP::value_is_missing ($val, $numericvar);
617
618     @c = $sf->get_next_case (); 
619     $val = $c[2];
620     die "Missing Value Positive Num"
621         if !PSPP::value_is_missing ($val, $numericvar);
622 ]])
623 AT_CHECK([RUN_PERL_MODULE test.pl])
624 AT_CLEANUP
625
626 AT_SETUP([Perl custom attributes])
627 AT_SKIP_IF([test "$WITH_PERL_MODULE" = no])
628 PERL_GENERATE_SYSFILE
629 AT_DATA([test.pl],
630   [[use warnings;
631     use strict;
632     use PSPP;
633
634     my $sf = PSPP::Reader->open ("sample.sav");
635
636     my $dict = $sf->get_dict ();
637
638     my $var = $dict->get_var_by_name ("numeric");
639
640     my $attr = $var->get_attributes ();
641
642     foreach my $k (sort (keys (%$attr)))
643     {
644         my $ll = $attr->{$k};
645         print "$k =>";
646         print map "$_\n", join ', ', @$ll;
647     }
648 ]])
649 AT_CHECK([RUN_PERL_MODULE test.pl], [0],
650   [[$@Role =>0
651 colour =>blue, pink, violet
652 nationality =>foreign
653 size =>large
654 ]])
655 AT_CLEANUP
656
657 AT_SETUP([Perl Pspp.t])
658 AT_SKIP_IF([test "$WITH_PERL_MODULE" = no])
659 # Skip this test if Perl's Text::Diff module is not installed.
660 AT_CHECK([perl -MText::Diff -e '' || exit 77])
661 AT_CHECK([RUN_PERL_MODULE $abs_top_builddir/perl-module/t/Pspp.t], [0],
662   [[1..37
663 ok 1 - use PSPP;
664 ok 2 - Dictionary Creation
665 ok 3
666 ok 4 - Trap illegal variable name
667 ok 5
668 ok 6 - Accept legal variable name
669 ok 7
670 ok 8 - Trap duplicate variable name
671 ok 9
672 ok 10 - Accept valid format
673 ok 11
674 ok 12 - Create sysfile object
675 ok 13 - Write system file
676 ok 14 - Append Case
677 ok 15 - Appending Case with too many variables
678 ok 16 - existance
679 ok 17 - Append Case 2
680 ok 18 - existance2
681 ok 19 - Check output
682 ok 20 - Dictionary Creation 2
683 ok 21 - Value label for short string
684 ok 22 - Value label for long string
685 ok 23 - Check output 2
686 ok 24 - Dictionary survives sysfile
687 ok 25 - Basic reader operation
688 ok 26 - Streaming of files
689 Formatted string is "11-SEP-2001 08:20"
690 ok 27 - format_value function
691 ok 28 - Perl representation of time
692 ok 29 - Returns undef on opening failure
693 ok 30 - Error string on open failure
694 ok 31 - Missing Value Negative String
695 ok 32 - Missing Value Negative Num
696 ok 33 - Missing Value Positive
697 ok 34 - Missing Value Positive SYS
698 ok 35 - Missing Value Positive Num
699 ok 36 - Custom Attributes
700 ok 37 - Case count
701 ]],[ignore])
702 AT_CLEANUP