# common code for code test in t/*
#
# Copyright 2010-2024 Free Software Foundation, Inc.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License,
# or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see .
#
# Original author: Patrice Dumas
package Texinfo::Tests;
use 5.006;
use strict;
use File::Compare qw(compare); # standard since 5.004
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(
compare_dirs_files
unlink_dir_files
prepare_format_directories
);
# not that subdirectories are not compared, so subdirectories generated
# by INFO_JS_DIR, if different, will not trigger an error in test, but
# will lead to different directories and files in diffs.
sub compare_dirs_files($$;$)
{
my $dir1 = shift;
my $dir2 = shift;
my $ignore_files = shift;
my %dir1_files;
my %dir2_files;
my @errors;
my %ignored_files_hash;
foreach my $ignored_file (@$ignore_files) {
$ignored_files_hash{$ignored_file} = 1;
}
if (opendir(DIR1, $dir1)) {
my @files = readdir (DIR1);
foreach my $file (@files) {
next if (! -r "$dir1/$file" or ! -f "$dir1/$file"
or $ignored_files_hash{$file});
$dir1_files{$file} = 1;
}
closedir (DIR1);
} else {
push @errors, "readdir $dir1: $!";
}
if (opendir(DIR2, $dir2)) {
my @files = readdir (DIR2);
foreach my $file (@files) {
next if (! -r "$dir2/$file" or ! -f "$dir2/$file"
or $ignored_files_hash{$file});
$dir2_files{$file} = 1;
}
closedir (DIR2);
} else {
push @errors, "readdir $dir2: $!";
}
if (scalar(@errors)) {
return \@errors;
}
foreach my $file (sort(keys(%dir1_files))) {
if ($dir2_files{$file}) {
my $status = compare("$dir1/$file", "$dir2/$file");
if ($status) {
push @errors, "$dir1/$file and $dir2/$file differ: $status";
}
delete $dir2_files{$file};
} else {
push @errors, "No $file in $dir2";
}
}
foreach my $file (sort(keys(%dir2_files))) {
push @errors, "No $file in $dir1"
}
if (scalar(@errors)) {
return \@errors;
} else {
return undef;
}
}
#my $errors = compare_dirs_files('a', 'b',['nnn']);
#if ($errors) {
# foreach my $error (@$errors) {
# warn $error."\n";
# }
#}
sub unlink_dir_files($;$)
{
my $dir = shift;
my $ignore_files = shift;
my %ignored_files_hash;
foreach my $ignored_file (@$ignore_files) {
$ignored_files_hash{$ignored_file} = 1;
}
if (opendir(DIR, $dir)) {
my @files = readdir (DIR);
foreach my $file (@files) {
next if (! -f "$dir/$file"
or $ignored_files_hash{$file});
unlink "$dir/$file" or warn "Could not unlink $dir/$file: $!\n";
}
closedir (DIR);
} else {
warn "readdir $dir: $!";
}
}
my $default_result_base = 't/results/';
sub create_group_directory($;$)
{
my $test_group = shift;
my $result_base = shift;
$result_base = $default_result_base if (!defined($result_base));
foreach my $dir ('t', $result_base,
File::Spec->catdir($result_base, $test_group)) {
my $error;
# to avoid a race conditon, first create the dir then test that it
# exists
mkdir $dir or $error = $!;
if (! -d $dir) {
die "mkdir $dir: $error\n";
}
}
}
sub prepare_format_directories($$$$;$)
{
my $srcdir = shift;
my $test_group = shift;
my $test_name = shift;
my $format_type = shift;
my $result_base = shift;
$result_base = $default_result_base if (!defined($result_base));
my $base = File::Spec->catdir($result_base, $test_group, $test_name);
my $test_out_dir = File::Spec->catdir($base, 'out_'.$format_type);
my $reference_dir = File::Spec->catdir($srcdir, $base, 'res_'.$format_type);
mkdir ($base)
if (! -d $base);
if (! -d $test_out_dir) {
mkdir ($test_out_dir);
} else {
# remove any files from previous runs
unlink glob ("$test_out_dir/*");
}
return ($test_out_dir, $reference_dir);
}
1;