4 use File
::Basename
qw(fileparse);
10 @GnumericTest::ISA
= qw
(Exporter
);
11 @GnumericTest::EXPORT
= qw(test_sheet_calc test_valgrind
12 test_importer test_exporter test_roundtrip
13 test_csv_format_guessing
14 test_ssindex sstest test_command message subtest
16 setup_python_environment
17 $ssconvert $sstest $ssdiff $ssgrep $gnumeric
19 $subtests $samples corpus $PERL $PYTHON);
20 @GnumericTest::EXPORT_OK = qw(junkfile);
22 use vars
qw($topsrc $top_builddir $samples $default_subtests $default_corpus $PERL $PYTHON $verbose);
23 use vars qw($ssconvert $ssindex $sstest $ssdiff $ssgrep $gnumeric);
24 use vars qw($normalize_gnumeric);
28 $PERL = $Config{'perlpath'};
29 $PERL .= $Config{'_exe'} if $^O ne 'VMS' && $PERL !~ m/$Config{'_exe'}$/i;
32 # Running as "perl -e '...'", so no idea about where we are
36 $topsrc =~ s|/[^/]+$|/..|;
37 $topsrc =~ s|/test/\.\.$||;
41 $samples = "$topsrc/samples"; $samples =~ s{^\./+}{};
42 $ssconvert = "$top_builddir/src/ssconvert";
43 $ssindex = "$top_builddir/src/ssindex";
44 $sstest = "$top_builddir/src/sstest";
45 $ssdiff = "$top_builddir/src/ssdiff";
46 $ssgrep = "$top_builddir/src/ssgrep";
47 $gnumeric = "$top_builddir/src/gnumeric";
48 $normalize_gnumeric = "$PERL $topsrc/test/normalize-gnumeric";
50 $default_subtests = '*';
52 $default_corpus = 'full';
53 my $user_corpus = undef;
55 # -----------------------------------------------------------------------------
71 if (@tempfiles && $fn eq $tempfiles[-1]) {
72 scalar (pop @tempfiles);
76 # -----------------------------------------------------------------------------
79 my ($program,$code) = @_;
82 die "failed to run $program: $!\n";
83 } elsif ($code >> 8) {
85 die "$program died due to signal $sig\n";
87 die "$program exited with exit code $code\n";
95 open (FIL, $fn) or die "Cannot open $fn: $!\n";
104 my ($fn,$contents) = @_;
107 open (FIL, ">$fn.tmp") or die "Cannot create $fn.tmp: $!\n";
110 rename "$fn.tmp", $fn;
114 my ($fn,$contents) = @_;
117 die "Cannot stat $fn: $!\n" unless @stat > 2;
119 &write_file ($fn,$contents);
121 chmod $stat[2], $fn or
122 die "Cannot chmod $fn: $!\n";
125 # Print a string with each line prefixed by "| ".
128 return if $txt eq '';
130 $txt = "$txt\n" unless substr($txt, -1) eq "\n";
135 my ($p, $nofail) = @_;
140 my $PATH = exists $ENV{'PATH'} ? $ENV{'PATH'} : '';
141 foreach my $dir (split (':', $PATH)) {
142 $dir = '.' if $dir eq '';
143 my $tentative = "$dir/$p";
144 return $tentative if -x $tentative;
148 return undef if $nofail;
150 &report_skip ("$p is missing");
153 # -----------------------------------------------------------------------------
157 print "-" x 79, "\n";
160 foreach (split (/\n/, $message)) {
165 # -----------------------------------------------------------------------------
171 foreach my $t (split (',', $subtests || $default_subtests)) {
172 if ($t eq '*' || $t eq $q) {
175 } elsif ($t eq '-*' || $t eq "-$q") {
183 # -----------------------------------------------------------------------------
186 ("$samples/regress.gnumeric",
187 "$samples/excel/address.xls",
188 "$samples/excel/bitwise.xls",
189 "$samples/excel/datefuns.xls",
190 "$samples/excel/dbfuns.xls",
191 "$samples/excel/engfuns.xls",
192 "$samples/excel/finfuns.xls",
193 "$samples/excel/functions.xls",
194 "$samples/excel/infofuns.xls",
195 "$samples/excel/logfuns.xls",
196 "$samples/excel/lookfuns2.xls",
197 "$samples/excel/lookfuns.xls",
198 "$samples/excel/mathfuns.xls",
199 "$samples/excel/objs.xls",
200 "$samples/excel/operator.xls",
201 "$samples/excel/sort.xls",
202 "$samples/excel/statfuns.xls",
203 "$samples/excel/textfuns.xls",
204 "$samples/excel/yalta2008.xls",
205 "$samples/excel12/cellstyle.xlsx",
206 "$samples/excel12/database.xlsx",
207 "$samples/excel12/ifs-funcs.xlsx",
208 "$samples/excel12/countif.xlsx",
209 "$samples/crlibm.gnumeric",
210 "$samples/amath.gnumeric",
211 "$samples/gamma.gnumeric",
212 "$samples/linest.xls",
213 "$samples/vba-725220.xls",
214 "$samples/sumif.xls",
215 "$samples/array-intersection.xls",
216 "$samples/arrays.xls",
217 "$samples/docs-samples.gnumeric",
218 "$samples/ftest.xls",
219 "$samples/ttest.xls",
220 "$samples/chitest.xls",
221 "$samples/vdb.gnumeric",
222 "$samples/numbermatch.gnumeric",
223 "$samples/numtheory.gnumeric",
224 "$samples/solver/afiro.mps",
225 "$samples/solver/blend.mps",
226 "$samples/auto-filter-tests.gnumeric",
227 "$samples/cell-comment-tests.gnumeric",
228 "$samples/colrow-tests.gnumeric",
229 "$samples/cond-format-tests.gnumeric",
230 "$samples/format-tests.gnumeric",
231 "$samples/formula-tests.gnumeric",
232 "$samples/graph-tests.gnumeric",
233 "$samples/hlink-tests.gnumeric",
234 "$samples/merge-tests.gnumeric",
235 "$samples/names-tests.gnumeric",
236 "$samples/number-tests.gnumeric",
237 "$samples/object-tests.gnumeric",
238 "$samples/page-setup-tests.gnumeric",
239 "$samples/rich-text-tests.gnumeric",
240 "$samples/sheet-formatting-tests.gnumeric",
241 "$samples/sheet-names-tests.gnumeric",
242 "$samples/sheet-tab-tests.gnumeric",
243 "$samples/solver-tests.gnumeric",
244 "$samples/split-panes-tests.gnumeric",
245 "$samples/string-tests.gnumeric",
246 "$samples/merge-tests.gnumeric",
247 "$samples/selection-tests.gnumeric",
248 "$samples/style-tests.gnumeric",
249 "$samples/validation-tests.gnumeric",
253 ("$samples/excel/chart-tests-excel.xls", # Too big
260 my $corpus = ($c || $user_corpus || $default_corpus);
261 if ($corpus eq 'full') {
263 } elsif ($corpus eq 'dist') {
265 } elsif ($corpus =~ /^random:(\d+)$/) {
267 my @corpus = grep { -r $_; } @full_corpus;
268 while ($n < @corpus) {
269 my $i = int (rand() * @corpus);
270 splice @corpus, $i, 1;
273 } elsif ($corpus =~ m{^/(.*)/$}) {
275 my @corpus = grep { /$rx/ } @full_corpus;
278 die "Invalid corpus specification\n";
282 # -----------------------------------------------------------------------------
285 my ($cmd,$test) = @_;
287 print STDERR "# $cmd\n" if $verbose;
288 my $output = `$cmd 2>&1`;
290 &dump_indented ($output);
291 die "Failed command: $cmd\n" if $err;
294 if (&$test ($output)) {
295 print STDERR "Pass\n";
301 # -----------------------------------------------------------------------------
305 my $expected = shift @_;
307 my $cmd = "earg ($sstest, $test);
308 my $actual = `$cmd 2>&1`;
310 die "Failed command: $cmd\n" if $err;
315 $ok = &$expected ($_);
317 foreach (split ("\n", $actual)) {
322 my @actual = split ("\n", $actual);
324 while (@actual > 0 && $actual[-1] eq '') {
325 my $dummy = pop @actual;
328 my @expected = split ("\n", $expected);
330 while (@expected > 0 && $expected[-1] eq '') {
331 my $dummy = pop @expected;
335 while ($i < @actual && $i < @expected) {
336 last if $actual[$i] ne $expected[$i];
339 if ($i < @actual || $i < @expected) {
341 print STDERR "Differences between actual and expected on line ", ($i + 1), ":\n";
342 print STDERR "Actual : ", ($i < @actual ? $actual[$i] : "-"), "\n";
343 print STDERR "Expected: ", ($i < @expected ? $expected[$i] : "-"), "\n";
350 print STDERR "Pass\n";
356 # -----------------------------------------------------------------------------
358 sub test_sheet_calc {
360 my $pargs = (ref $_[0]) ? shift @_ : [];
361 my ($range,$expected) = @_;
363 &report_skip ("file $file does not exist") unless -r $file;
365 my $tmp = fileparse ($file);
366 $tmp =~ s/\.[a-zA-Z0-9]+$/.csv/;
369 my $cmd = "$ssconvert " . "earg (@$pargs, '--recalc', "--export-range=$range", $file, $tmp);
370 print STDERR "# $cmd\n" if $verbose;
371 my $code = system ("$cmd 2>&1 | sed -e 's/^/| /' ");
372 &system_failure ($ssconvert, $code) if $code;
374 my $actual = &read_file ($tmp);
379 $ok = &$expected ($_);
381 $ok = ($actual eq $expected);
387 print STDERR "Pass\n";
390 &dump_indented ($actual);
395 # -----------------------------------------------------------------------------
397 my $import_db = 'import-db';
400 # check: check that conversion produces right file
401 # create-db: save the current corresponding .gnumeric
402 # diff: diff conversion against saved .gnumeric
403 # update-SHA-1: update $0 to show current SHA-1 [validate first!]
406 my ($file,$sha1,$mode) = @_;
408 my $tmp = fileparse ($file);
409 ($tmp =~ s/\.[a-zA-Z0-9]+$/.gnumeric/ ) or ($tmp .= '.gnumeric');
410 if ($mode eq 'create-db') {
411 -d $import_db or mkdir ($import_db, 0777) or
412 die "Cannot create $import_db: $!\n";
413 $tmp = "$import_db/$tmp";
418 &report_skip ("file $file does not exist") unless -r $file;
420 my $code = system ("$ssconvert '$file' '$tmp' 2>&1 | sed -e 's/^/| /'");
421 &system_failure ($ssconvert, $code) if $code;
423 my $htxt = `zcat -f '$tmp' | $normalize_gnumeric | sha1sum`;
424 my $newsha1 = lc substr ($htxt, 0, 40);
425 die "SHA-1 failure\n" unless $newsha1 =~ /^[0-9a-f]{40}$/;
427 if ($mode eq 'check') {
428 if ($sha1 ne $newsha1) {
429 die "New SHA-1 is $newsha1; expected was $sha1\n";
431 print STDERR "Pass\n";
432 } elsif ($mode eq 'create-db') {
433 if ($sha1 ne $newsha1) {
434 warn ("New SHA-1 is $newsha1; expected was $sha1\n");
438 } elsif ($mode eq 'diff') {
439 my $saved = "$import_db/$tmp";
440 die "$saved not found\n" unless -r $saved;
442 my $tmp1 = "$tmp-old";
444 my $code1 = system ("zcat -f '$saved' >'$tmp1'");
445 &system_failure ('zcat', $code1) if $code1;
447 my $tmp2 = "$tmp-new";
449 my $code2 = system ("zcat -f '$tmp' >'$tmp2'");
450 &system_failure ('zcat', $code2) if $code2;
452 my $code3 = system ('diff', @ARGV, $tmp1, $tmp2);
456 } elsif ($mode =~ /^update-(sha|SHA)-?1/) {
457 if ($sha1 ne $newsha1) {
458 my $script = &read_file ($0);
459 my $count = ($script =~ s/\b$sha1\b/$newsha1/g);
460 die "SHA-1 found in script $count times\n" unless $count == 1;
461 &update_file ($0, $script);
465 die "Invalid mode \"$mode\"\n";
471 # -----------------------------------------------------------------------------
474 my ($file,$ext) = @_;
476 &report_skip ("file $file does not exist") unless -r $file;
478 my $tmp = fileparse ($file);
479 $tmp =~ s/\.([a-zA-Z0-9]+)$//;
480 $ext = $1 unless defined $ext;
481 $ext or die "Must have extension for export test.";
485 my $tmp1 = "$tmp.gnumeric";
486 &junkfile ($tmp1) unless $keep;
488 my $cmd = "earg ($ssconvert, $file, $tmp1);
489 print STDERR "# $cmd\n" if $verbose;
490 my $code = system ("$cmd 2>&1 | sed -e 's/^/| /'");
491 &system_failure ($ssconvert, $code) if $code;
494 my $tmp2 = "$tmp-new.$ext";
495 &junkfile ($tmp2) unless $keep;
497 my $cmd = "earg ($ssconvert, $file, $tmp2);
498 print STDERR "# $cmd\n" if $verbose;
499 my $code = system ("$cmd 2>&1 | sed -e 's/^/| /'");
500 &system_failure ($ssconvert, $code) if $code;
503 my $tmp3 = "$tmp-new.gnumeric";
504 &junkfile ($tmp3) unless $keep;
506 my $cmd = "earg ($ssconvert, $tmp2, $tmp3);
507 print STDERR "# $cmd\n" if $verbose;
508 my $code = system ("$cmd 2>&1 | sed -e 's/^/| /'");
509 &system_failure ($ssconvert, $code) if $code;
512 my $tmp4 = "$tmp.xml";
513 &junkfile ($tmp4) unless $keep;
514 $code = system ("earg ("zcat", "-f", $tmp1) . "| $normalize_gnumeric >" . "earg ($tmp4));
515 &system_failure ('zcat', $code) if $code;
517 my $tmp5 = "$tmp-new.xml";
518 &junkfile ($tmp5) unless $keep;
519 $code = system ("earg ("zcat" , "-f", $tmp3) . " | $normalize_gnumeric >" . "earg ($tmp5));
520 &system_failure ('zcat', $code) if $code;
522 $code = system ('diff', '-u', $tmp4, $tmp5);
523 &system_failure ('diff', $code) if $code;
525 print STDERR "Pass\n";
528 # -----------------------------------------------------------------------------
530 sub test_csv_format_guessing {
532 my $data = $args{'data'};
536 my $datafn = "test-data.csv";
537 &junkfile ($datafn) unless $keep;
538 &write_file ($datafn, $data);
540 my $outfn = "test-data.gnumeric";
541 &junkfile ($outfn) unless $keep;
543 local $ENV{'GNM_DEBUG'} = 'stf';
544 my $cmd = "earg ($ssconvert, $datafn, $outfn);
545 print STDERR "# $cmd\n" if $verbose;
546 my $out = `$cmd 2>&1`;
548 if ($out !~ m/^\s*fmt\.0\s*=\s*(\S+)\s*$/m) {
549 die "Failed to guess any format\n";
556 $ok = &{$args{'format'}} ($_);
559 if ($verbose || !$ok) {
560 print STDERR "Data:\n";
561 foreach (split ("\n", $data)) {
562 print STDERR "| $_\n";
564 print STDERR "Result:\n";
565 foreach (split ("\n", $out)) {
566 print STDERR "| $_\n";
570 die "Guessed wrong format: $guessed\n" unless $ok;
572 if (exists $args{'decimal'}) {
573 if ($out !~ m/^\s*fmt\.0\.dec\s*=\s*(\S+)\s*$/m) {
574 die "Failed to guess any decimal separator\n";
577 my $ok = ($1 eq $args{'decimal'});
579 die "Guessed wrong decimal separator: $guessed\n" unless $ok;
582 if (exists $args{'thousand'}) {
583 if ($out !~ m/^\s*fmt\.0\.thou\s*=\s*(\S+)\s*$/m) {
584 die "Failed to guess any thousands separator\n";
587 my $ok = ($1 eq $args{'thousand'});
589 die "Guessed wrong thousands separator: $guessed\n" unless $ok;
592 &removejunk ($outfn) unless $keep;
593 &removejunk ($datafn) unless $keep;
596 # -----------------------------------------------------------------------------
598 # The BIFF formats leave us with a msole:codepage property
599 my $drop_codepage_filter =
600 "$PERL -p -e '\$_ = \"\" if m{<meta:user-defined meta:name=.msole:codepage.}'";
602 my $drop_generator_filter =
603 "$PERL -p -e '\$_ = \"\" if m{<meta:generator>}'";
605 # BIFF7 doesn't store cell comment author
606 my $no_author_filter = "$PERL -p -e 's{ Author=\"[^\"]*\"}{};'";
608 # BIFF7 cannot store rich text comments
609 my $no_rich_comment_filter = "$PERL -p -e 'if (/gnm:CellComment/) { s{ TextFormat=\"[^\"]*\"}{}; }'";
611 # Excel cannot have superscript and subscript at the same time
612 my $supersub_filter = "$PERL -p -e 's{\\[superscript=1:(\\d+):(\\d+)\\]\\[subscript=1:(\\d+):\\2\\]}{[superscript=1:\$1:\$3][subscript=1:\$3:\$2]};'";
614 my $noframe_filter = "$PERL -p -e '\$_ = \"\" if m{<gnm:SheetWidgetFrame .*/>}'";
616 my $noasindex_filter = "$PERL -p -e 'if (/gnm:SheetWidget(List|Combo)/) { s{( OutputAsIndex=)\"\\d+\"}{\$1\"0\"}; }'";
618 sub normalize_filter {
620 return 'cat' unless defined $f;
622 $f =~ s/\bstd:drop_codepage\b/$drop_codepage_filter/;
623 $f =~ s/\bstd:drop_generator\b/$drop_generator_filter/;
624 $f =~ s/\bstd:no_author\b/$no_author_filter/;
625 $f =~ s/\bstd:no_rich_comment\b/$no_rich_comment_filter/;
626 $f =~ s/\bstd:supersub\b/$supersub_filter/;
627 $f =~ s/\bstd:noframewidget\b/$noframe_filter/;
628 $f =~ s/\bstd:nocomboasindex\b/$noasindex_filter/;
633 # -----------------------------------------------------------------------------
636 my ($file,%named_args) = @_;
638 &report_skip ("file $file does not exist") unless -r $file;
640 my $format = $named_args{'format'};
641 my $newext = $named_args{'ext'};
642 my $resize = $named_args{'resize'};
643 my $ignore_failure = $named_args{'ignore_failure'};
645 my $filter0 = &normalize_filter ($named_args{'filter0'});
646 my $filter1 = &normalize_filter ($named_args{'filter1'} ||
647 $named_args{'filter'});
648 my $filter2 = &normalize_filter ($named_args{'filter2'} ||
649 $named_args{'filter'});
651 my $tmp = fileparse ($file);
652 $tmp =~ s/\.([a-zA-Z0-9]+)$// or die "Must have extension for roundtrip test.";
657 my $file_resized = $file;
659 $file_resized =~ s{^.*/}{};
660 $file_resized =~ s/(\.gnumeric)$/-resize$1/;
661 unlink $file_resized;
662 my $cmd = "earg ($ssconvert, "--resize", $resize, $file, $file_resized);
663 print STDERR "# $cmd\n" if $verbose;
664 $code = system ("$cmd 2>&1 | sed -e 's/^/| /'");
665 &system_failure ($ssconvert, $code) if $code;
666 die "Failed to produce $file_resized\n" unless -r $file_resized;
667 &junkfile ($file_resized) unless $keep;
670 my $file_filtered = $file_resized;
672 $file_filtered =~ s{^.*/}{};
673 $file_filtered =~ s/(\.gnumeric)$/-filter$1/;
674 unlink $file_filtered;
675 my $cmd = "zcat " . "earg ($file_resized) . " | $filter0 >" . "earg ($file_filtered);
676 print STDERR "# $cmd\n" if $verbose;
677 $code = system ("($cmd) 2>&1 | sed -e 's/^/| /'");
678 &system_failure ($ssconvert, $code) if $code;
679 die "Failed to produce $file_filtered\n" unless -r $file_filtered;
680 &junkfile ($file_filtered) unless $keep;
683 my $tmp1 = "$tmp.$newext";
685 &junkfile ($tmp1) unless $keep;
687 my $cmd = "earg ($ssconvert, "-T", $format, $file_filtered, $tmp1);
688 print "# $cmd\n" if $verbose;
689 my $code = system ("$cmd 2>&1 | sed -e 's/^/| /'");
690 &system_failure ($ssconvert, $code) if $code;
691 die "Failed to produce $tmp1\n" unless -r $tmp1;
694 my $tmp2 = "$tmp-new.$ext";
696 &junkfile ($tmp2) unless $keep;
698 my $cmd = "earg ($ssconvert, $tmp1, $tmp2);
699 print "# $cmd\n" if $verbose;
700 my $code = system ("$cmd 2>&1 | sed -e 's/^/| /'");
701 &system_failure ($ssconvert, $code) if $code;
702 die "Failed to produce $tmp2\n" unless -r $tmp2;
705 my $tmp_xml = "$tmp.xml";
707 &junkfile ($tmp_xml) unless $keep;
708 $code = system ("zcat -f '$file_filtered' | $normalize_gnumeric | $filter1 >'$tmp_xml'");
709 &system_failure ('zcat', $code) if $code;
711 my $tmp2_xml = "$tmp-new.xml";
713 &junkfile ($tmp2_xml) unless $keep;
714 # print STDERR "zcat -f '$tmp2' | $normalize_gnumeric | $filter2 >'$tmp2_xml'\n";
715 $code = system ("zcat -f '$tmp2' | $normalize_gnumeric | $filter2 >'$tmp2_xml'");
716 &system_failure ('zcat', $code) if $code;
718 $code = system ('diff', '-u', $tmp_xml, $tmp2_xml);
719 &system_failure ('diff', $code) if $code && !$ignore_failure;
721 print STDERR "Pass\n";
724 # -----------------------------------------------------------------------------
727 my ($cmd,$uselibtool,$qreturn) = @_;
730 $ENV{'G_DEBUG'} .= ':gc-friendly:resident-modules';
731 $ENV{'G_SLICE'} = 'always-malloc';
732 delete $ENV{'VALGRIND_OPTS'};
734 my $outfile = 'valgrind.log';
736 die "Cannot remove $outfile.\n" if -f $outfile;
737 &junkfile ($outfile);
739 my $valhelp = `valgrind --help 2>&1`;
740 &report_skip ("Valgrind is not available") unless defined $valhelp;
741 die "Problem running valgrind.\n" unless $valhelp =~ /log-file/;
743 my $valvers = `valgrind --version`;
744 die "Problem running valgrind.\n"
745 unless $valvers =~ /^valgrind-(\d+)\.(\d+)\.(\d+)/;
746 $valvers = $1 * 10000 + $2 * 100 + $3;
747 &report_skip ("Valgrind is too old") unless $valvers >= 30500;
749 $cmd = "--gen-suppressions=all $cmd";
752 my $suppfile = "$topsrc/test/common.supp";
753 &report_skip ("file $suppfile does not exist") unless -r $suppfile;
754 $cmd = "--suppressions=$suppfile $cmd" if -r $suppfile;
759 $suppfile =~ s/\.pl$/.supp/;
760 $cmd = "--suppressions=$suppfile $cmd" if -r $suppfile;
763 # $cmd = "--show-reachable=yes $cmd";
764 $cmd = "--show-below-main=yes $cmd";
765 $cmd = "--leak-check=full $cmd";
766 $cmd = "--num-callers=20 $cmd";
767 $cmd = "--track-fds=yes $cmd";
768 if ($valhelp =~ /--log-file-exactly=/) {
769 $cmd = "--log-file-exactly=$outfile $cmd";
771 $cmd = "--log-file=$outfile $cmd";
773 $cmd = "valgrind $cmd";
774 $cmd = "../libtool --mode=execute $cmd" if $uselibtool;
776 my $code = system ($cmd);
777 &system_failure ('valgrind', $code) if $code;
779 my $txt = &read_file ($outfile);
780 &removejunk ($outfile);
781 my $errors = ($txt =~ /ERROR\s+SUMMARY:\s*(\d+)\s+errors?/i)
785 # &dump_indented ($txt);
786 print STDERR "Pass\n" unless $qreturn;
790 &dump_indented ($txt);
791 die "Fail\n" unless $qreturn;
795 # -----------------------------------------------------------------------------
798 my ($file,$test) = @_;
800 &report_skip ("file $file does not exist") unless -r $file;
802 my $xmlfile = fileparse ($file);
803 $xmlfile =~ s/\.[a-zA-Z0-9]+$/.xml/;
805 die "Cannot remove $xmlfile.\n" if -f $xmlfile;
806 &junkfile ($xmlfile);
809 my $cmd = "earg ($ssindex, "--index", $file);
810 my $output = `$cmd 2>&1 >'$xmlfile'`;
812 &dump_indented ($output);
813 die "Failed command: $cmd\n" if $err;
816 my $parser = new XML::Parser ('Style' => 'Tree');
817 my $tree = $parser->parsefile ($xmlfile);
818 &removejunk ($xmlfile);
822 die "$0: Invalid parse tree from ssindex.\n"
823 unless (ref ($tree) eq 'ARRAY' && $tree->[0] eq "gnumeric");
824 my @children = @{$tree->[1]};
825 my $attrs = shift @children;
828 my $tag = shift @children;
829 my $content = shift @children;
833 goto FAIL unless $content =~ /^\s*$/;
834 } elsif ($tag eq 'data') {
835 my @dchildren = @$content;
836 my $dattrs = shift @dchildren;
837 die "$0: Unexpected attributes in data tag\n" if keys %$dattrs;
838 die "$0: Unexpected data tag content.\n" if @dchildren != 2;
839 die "$0: Unexpected data tag content.\n" if $dchildren[0] ne '0';
840 my $data = $dchildren[1];
843 die "$0: Unexpected tag \"$tag\".\n";
849 print STDERR "Pass\n";
856 # -----------------------------------------------------------------------------
859 my ($file,$tool,$tool_args,$range,$test) = @_;
861 &report_skip ("file $file does not exist") unless -r $file;
864 push @args, "--export-range=$range" if defined $range;
865 push @args, "--tool-test=$tool";
866 for (my $i = 0; $i + 1 < @$tool_args; $i += 2) {
867 my $k = $tool_args->[$i];
868 my $v = $tool_args->[$i + 1];
869 push @args, "--tool-test=$k:$v";
872 my $tmp = "tool.csv";
875 my $cmd = "earg ($ssconvert, @args, $file, $tmp);
876 print STDERR "# $cmd\n" if $GnumericTest::verbose;
877 my $code = system ($cmd);
878 &system_failure ($ssconvert, $code) if $code;
879 my $actual = &read_file ($tmp);
883 if (&$test ($actual)) {
884 print STDERR "Pass\n";
886 &GnumericTest::dump_indented ($actual);
891 # -----------------------------------------------------------------------------
893 sub has_linear_solver {
894 return (defined (&find_program ('lp_solve', 1)) ||
895 defined (&find_program ('glpsol', 1)));
898 # -----------------------------------------------------------------------------
900 sub setup_python_environment {
901 $PYTHON = `grep '^#define PYTHON_INTERPRETER ' $top_builddir/gnumeric-config.h 2>&1`;
903 $PYTHON =~ s/^[^"]*"(.*)"\s*$/$1/;
904 &report_skip ("Missing python interpreter") unless -x $PYTHON;
906 # Make sure we load introspection preferentially from build directory
907 my $v = 'GI_TYPELIB_PATH';
908 my $dir = "$top_builddir/src";
909 $ENV{$v} = ($ENV{$v} || '') eq '' ? $dir : $dir . ':' . $ENV{$v};
911 # Ditto for shared libraries
912 $v = 'LD_LIBRARY_PATH';
913 $dir = "$top_builddir/src/.libs";
914 $ENV{$v} = ($ENV{$v} || '') eq '' ? $dir : $dir . ':' . $ENV{$v};
916 $ENV{'PYTHONPATH'} = "$topsrc/introspection";
919 $ENV{'PYTHONDONTWRITEBYTECODE'} = 1;
922 # -----------------------------------------------------------------------------
925 return join (' ', map { "earg1 ($_) } @_);
931 return "''" if $arg eq '';
934 if ($arg =~ m!^([-=/._a-zA-Z0-9:]+)!) {
936 $arg = substr ($arg, length $1);
938 $res .= "\\" . substr ($arg, 0, 1);
939 $arg = substr ($arg, 1);
945 # -----------------------------------------------------------------------------
950 print "SKIP -- $txt\n";
951 # 77 is magic for automake
955 # -----------------------------------------------------------------------------
956 # Setup a consistent environment
958 &report_skip ("all tests skipped") if exists $ENV{'GNUMERIC_SKIP_TESTS'};
960 delete $ENV{'G_SLICE'};
961 $ENV{'G_DEBUG'} = 'fatal_criticals';
964 delete $ENV{'LANGUAGE'};
965 foreach (keys %ENV) { delete $ENV{$_} if /^LC_/; }
966 $ENV{'LC_ALL'} = 'C';
968 # libgsf listens for this
969 delete $ENV{'WINDOWS_LANGUAGE'};
974 if (@ARGV && $ARGV[0] eq '--verbose') {
978 } elsif (@ARGV > 1 && $ARGV[0] eq '--subtests') {
980 $subtests = shift @ARGV;
981 } elsif (@ARGV > 1 && $ARGV[0] eq '--corpus') {
983 $user_corpus = shift @ARGV;