5338ed2b26
We set "use warnings" in most of our perl code to catch problems. But as the name implies, warnings just emit a message to stderr and don't otherwise affect the program. So our tests are quite likely to miss that warnings are being spewed, as most of them do not look at stderr. We could ask perl to make all warnings fatal, but this is likely annoying for non-developers, who would rather have a running program with a warning than something that refuses to work at all. So instead, let's teach the perl code to respect an environment variable (GIT_PERL_FATAL_WARNINGS) to increase the severity of the warnings. This can be set for day-to-day running if people want to be really pedantic, but the primary use is to trigger it within the test suite. We could also trigger that for every test run, but likewise even the tests failing may be annoying to distro builders, etc (just as -Werror would be for compiling C code). So we'll tie it to a special test-mode variable (GIT_TEST_PERL_FATAL_WARNINGS) that can be set in the environment or as a Makefile knob, and we'll automatically turn the knob when DEVELOPER=1 is set. That should give developers and CI the more careful view without disrupting normal users or packagers. Note that the mapping from the GIT_TEST_* form to the GIT_* form in test-lib.sh is necessary even if they had the same name: the perl scripts need it to be normalized to a perl truth value, and we also have to make sure it's exported (we might have gotten it from the environment, but we might also have gotten it from GIT-BUILD-OPTIONS directly). Signed-off-by: Jeff King <peff@peff.net> Signed-off-by: Junio C Hamano <gitster@pobox.com>
105 lines
3.4 KiB
Perl
105 lines
3.4 KiB
Perl
package Git::LoadCPAN;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings $ENV{GIT_PERL_FATAL_WARNINGS} ? qw(FATAL all) : ();
|
|
|
|
=head1 NAME
|
|
|
|
Git::LoadCPAN - Wrapper for loading modules from the CPAN (OS) or Git's own copy
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
The Perl code in Git depends on some modules from the CPAN, but we
|
|
don't want to make those a hard requirement for anyone building from
|
|
source.
|
|
|
|
Therefore the L<Git::LoadCPAN> namespace shipped with Git contains
|
|
wrapper modules like C<Git::LoadCPAN::Module::Name> that will first
|
|
attempt to load C<Module::Name> from the OS, and if that doesn't work
|
|
will fall back on C<FromCPAN::Module::Name> shipped with Git itself.
|
|
|
|
Usually distributors will not ship with Git's Git::FromCPAN tree at
|
|
all via the C<NO_PERL_CPAN_FALLBACKS> option, preferring to use their
|
|
own packaging of CPAN modules instead.
|
|
|
|
This module is only intended to be used for code shipping in the
|
|
C<git.git> repository. Use it for anything else at your peril!
|
|
|
|
=cut
|
|
|
|
# NO_PERL_CPAN_FALLBACKS_STR evades the sed search-replace from the
|
|
# Makefile, and allows for detecting whether the module is loaded from
|
|
# perl/Git as opposed to perl/build/Git, which is useful for one-off
|
|
# testing without having Error.pm et al installed.
|
|
use constant NO_PERL_CPAN_FALLBACKS_STR => '@@' . 'NO_PERL_CPAN_FALLBACKS' . '@@';
|
|
use constant NO_PERL_CPAN_FALLBACKS => (
|
|
q[@@NO_PERL_CPAN_FALLBACKS@@] ne ''
|
|
and
|
|
q[@@NO_PERL_CPAN_FALLBACKS@@] ne NO_PERL_CPAN_FALLBACKS_STR
|
|
);
|
|
|
|
sub import {
|
|
shift;
|
|
my $caller = caller;
|
|
my %args = @_;
|
|
my $module = exists $args{module} ? delete $args{module} : die "BUG: Expected 'module' parameter!";
|
|
my $import = exists $args{import} ? delete $args{import} : die "BUG: Expected 'import' parameter!";
|
|
die "BUG: Too many arguments!" if keys %args;
|
|
|
|
# Foo::Bar to Foo/Bar.pm
|
|
my $package_pm = $module;
|
|
$package_pm =~ s[::][/]g;
|
|
$package_pm .= '.pm';
|
|
|
|
eval {
|
|
require $package_pm;
|
|
1;
|
|
} or do {
|
|
my $error = $@ || "Zombie Error";
|
|
|
|
if (NO_PERL_CPAN_FALLBACKS) {
|
|
chomp(my $error = sprintf <<'THEY_PROMISED', $module);
|
|
BUG: The '%s' module is not here, but NO_PERL_CPAN_FALLBACKS was set!
|
|
|
|
Git needs this Perl module from the CPAN, and will by default ship
|
|
with a copy of it. This Git was built with NO_PERL_CPAN_FALLBACKS,
|
|
meaning that whoever built it promised to provide this module.
|
|
|
|
You're seeing this error because they broke that promise, and we can't
|
|
load our fallback version, since we were asked not to install it.
|
|
|
|
If you're seeing this error and didn't package Git yourself the
|
|
package you're using is broken, or your system is broken. This error
|
|
won't appear if Git is built without NO_PERL_CPAN_FALLBACKS (instead
|
|
we'll use our fallback version of the module).
|
|
THEY_PROMISED
|
|
die $error;
|
|
}
|
|
|
|
my $Git_LoadCPAN_pm_path = $INC{"Git/LoadCPAN.pm"} || die "BUG: Should have our own path from %INC!";
|
|
|
|
require File::Basename;
|
|
my $Git_LoadCPAN_pm_root = File::Basename::dirname($Git_LoadCPAN_pm_path) || die "BUG: Can't figure out lib/Git dirname from '$Git_LoadCPAN_pm_path'!";
|
|
|
|
require File::Spec;
|
|
my $Git_pm_FromCPAN_root = File::Spec->catdir($Git_LoadCPAN_pm_root, '..', 'FromCPAN');
|
|
die "BUG: '$Git_pm_FromCPAN_root' should be a directory!" unless -d $Git_pm_FromCPAN_root;
|
|
|
|
local @INC = ($Git_pm_FromCPAN_root, @INC);
|
|
require $package_pm;
|
|
};
|
|
|
|
if ($import) {
|
|
no strict 'refs';
|
|
*{"${caller}::import"} = sub {
|
|
shift;
|
|
use strict 'refs';
|
|
unshift @_, $module;
|
|
goto &{"${module}::import"};
|
|
};
|
|
use strict 'refs';
|
|
}
|
|
}
|
|
|
|
1;
|