...
 
Commits (59)
{ use 5.006; }
use warnings;
use strict;
use Module::Build;
my $require_xs = "$]" < 5.007002 || ("$]" >= 5.009004 && "$]" < 5.010001);
Module::Build->subclass(code => q{
unless(__PACKAGE__->can("cbuilder")) {
*cbuilder = sub { $_[0]->_cbuilder or die "no C support" };
}
unless(__PACKAGE__->can("have_c_compiler")) {
*have_c_compiler = sub {
my $cb = eval { $_[0]->cbuilder };
return $cb && $cb->have_compiler;
};
}
if($Module::Build::VERSION < 0.33) {
# Older versions of Module::Build have a bug where if the
# cbuilder object is used at Build.PL time (which it will
# be for this distribution due to the logic in
# ->find_xs_files) then that object can be dumped to the
# build_params file, and then at Build time it will
# attempt to use the dumped blessed object without loading
# the ExtUtils::CBuilder class that is needed to make it
# work.
*write_config = sub {
delete $_[0]->{properties}->{_cbuilder};
return $_[0]->SUPER::write_config;
};
}
sub find_xs_files {
my($self) = @_;
return {} unless $self->have_c_compiler;
# On MSWin32, the XS version of the workaround can't work
# properly, because it doesn't have access to the core
# symbols to let SAVEHINTS() work.
return {} if "$]" < 5.012 && $^O eq "MSWin32";
return $self->SUPER::find_xs_files;
}
sub compile_c {
my($self, $file, %args) = @_;
if("$]" < 5.012) {
# need PERL_CORE for working SAVEHINTS()
$args{defines} = { %{$args{defines} || {}},
PERL_CORE => 1,
};
}
return $self->SUPER::compile_c($file, %args);
}
})->new(
module_name => "Lexical::SealRequireHints",
license => "perl",
configure_requires => {
"Module::Build" => 0,
"perl" => "5.006",
"strict" => 0,
"warnings" => 0,
($require_xs ? (
"ExtUtils::CBuilder" => "0.15",
) : ()),
},
configure_recommends => {
($require_xs ? () : (
"ExtUtils::CBuilder" => "0.15",
)),
},
build_requires => {
"Module::Build" => 0,
"Test::More" => "0.41",
"perl" => "5.006",
"strict" => 0,
"warnings" => 0,
($require_xs ? (
"ExtUtils::CBuilder" => "0.15",
) : ()),
},
build_recommends => {
($require_xs ? () : (
"ExtUtils::CBuilder" => "0.15",
)),
},
requires => {
"perl" => "5.006",
($require_xs ? (
"XSLoader" => 0,
) : ()),
},
recommends => {
($require_xs ? () : (
"XSLoader" => 0,
)),
},
conflicts => {
"B::Hooks::OP::Check" => "< 0.19",
},
needs_compiler => 0,
dynamic_config => 1,
meta_add => { distribution_type => "module" },
sign => 1,
)->create_build_script;
1;
version 0.011; 2017-07-15
* update test suite to not rely on . in @INC, which is no longer
necessarily there from Perl 5.25.7
* no longer include a Makefile.PL in the distribution
* update op-munging code to the PERL_OP_PARENT-compatible style
(though none of it is actually used on Perls new enough to support
PERL_OP_PARENT)
* rename internal gen_*_op() functions into a better style
* consistently use THX_ prefix on internal function names
version 0.010; 2016-03-18
* skip test with lexical $_ on Perl 5.23.4+ where that feature has
been removed
version 0.009; 2015-03-20
* in test of require for version checking, work around [perl #124135]
which was introduced in Perl 5.21.4
version 0.008; 2015-03-20
* bugfix: don't localise hints around a version-number require, so that
"use v5.10.0" can have its intentional effect of setting feature flags
* bugfix: in pure Perl implementation, use a ($) prototype on
CORE::GLOBAL::require, so that the argument expression will be in
the correct context
* better error message for refusing to use pure Perl implementation
on Perl 5.9.4 to 5.10.0
* document that the pure Perl implementation breaks the use of the
implicit $_ parameter with require
* in swash test, don't fail if utf8.pm was loaded unexpectedly early,
as has been seen to happen on some systems
* test idempotence
* fix test for thread safety, which risked false negatives
* when preemptively loading Carp and Carp::Heavy, avoid the Perl core
bug regarding the context applied to file scope of required modules,
in case of future versions of those modules becoming vulnerable and
running on an old Perl
* declare correct version for Test::More dependency
* typo fix in documentation
* typo fix in a comment
version 0.007; 2012-02-11
* be thread-safe, by mutex control on op check hooking
* in pure Perl implementation, avoid putting extra eval stack frames
around the require, to avoid unnecessary complication of exception
handling; this can't be done on Perls 5.9.4 to 5.10.0, so don't
allow use of the pure Perl implementation on those Perls
* revise documentation to suggest loading this module earlier
* document the relevant changes to the Perl core in more detail
* on Perl versions where the pure Perl implementation can't work,
dynamically declare requirement for XS infrastructure in Build.PL
* refine threshold for ability to correctly override require from
5.8.0 to 5.7.2
* revise minimum required Perl version down from 5.6.1 to 5.6.0
* test that modules see the correct context at file scope
* test that module return values are handled correctly
* test that the module doesn't generate warnings
* in pure Perl implementation, fix handling of the variable that
previously needed to be "our"
* rearrange and better comment the treatment of lexical warnings in
the Perl code
version 0.006; 2011-11-20
* bugfix: avoid loading warnings.pm and leaving its delayed requires
of Carp.pm susceptible to hint leakage, which was causing trouble
on some Perls
* skip swash test on Perl 5.6, where swash loading appears to be broken
by loading Test::More or anything else useful
* remove bogus tests that cause false failures on Perl 5.15.5
* in Build.PL, declare incompatibility with pre-0.19
B::Hooks::OP::Check, which doesn't play nicely around op check hooking
* comment why a variable surprisingly needs to be "our"
* convert .cvsignore to .gitignore
version 0.005; 2011-07-25
* bugfix: work around core bug [perl #73174] affecting Unicode swash
loading, and apply entire workaround arrangement to 5.11.{0..5}
where [perl #73174] exists but [perl #68590] does not
* correct dynamic_config setting to 0
* include META.json in distribution
* add MYMETA.json to .cvsignore
version 0.004; 2010-11-21
* bugfix: don't attempt to use XS version of the workaround on Win32,
where it can't work properly due to linker restriction on access to
core symbols
* only define PERL_CORE for compilation on Perl versions where the
bug workaround (and thus interference with core-private stuff)
is actually necessary
* in XS, use PERL_NO_GET_CONTEXT for efficiency
* in XS, declare "PROTOTYPES: DISABLE" to prevent automatic generation
of unintended prototypes
* in XS, provide a reserve definition of croak, so that the Perl_croak
circumlocution is avoided even with PERL_CORE defined
* in XS, give symbolic names to the Perl version thresholds
* jump through hoops to avoid compiler warnings
* use full stricture in test suite
* also test POD coverage of pure Perl implementation
* in t/setup_pp.pl, avoid a warning that occurs if XSLoader::load()
is given no arguments, which is now a valid usage
* in Build.PL, explicitly set needs_compiler to avoid bogus
auto-dependency on ExtUtils::CBuilder
* in Build.PL, complete declaration of configure-time requirements
version 0.003; 2010-04-10
* bugfix: in pure-Perl implementation, make sure ambient package (from
which require is invoked) is passed on correctly to the code in the
required file, on those Perls where it is so inherited
* in XS, use macros to avoid explicit passing of aTHX, in the manner
of the core
* in XS, avoid using "class" as a variable name, for compatibility
with C++ compilers
* make all numeric comparisons against $] stringify it first, to avoid
architecture-dependent problems with floating point rounding giving
it an unexpected numeric value
* in Build.PL, explicitly declare configure-time requirements
* add MYMETA.yml to .cvsignore
version 0.002; 2009-10-21
* generate a more normal-looking op tree, that doesn't crash B::Deparse
* don't apply the workaround on Perl 5.11.0 or later, where the bug
has been fixed
* in t/seal.t, test that cop_hints_hash is properly handled
* check for required Perl version at runtime
version 0.001; 2009-09-26
* bugfix: die cleanly if the pure-Perl implementation is needed but
won't work (which occurs on pre-5.8 perls)
* bugfix: avoid undesired warning from pure-Perl implementation if
require has already been overridden via CORE::GLOBAL::require
* in tests, set HINT_LOCALIZE_HH where appropriate, to avoid false
test failures on pre-5.10 perls
* test that the module plays nicely with code that overrides require
via CORE::GLOBAL::require
version 0.000; 2009-09-22
* initial released version
.gitignore
Build.PL
Changes
MANIFEST
META.json
META.yml
README
lib/Lexical/SealRequireHints.pm
lib/Lexical/SealRequireHints.xs
t/before_warnings.t
t/before_warnings_pp.t
t/context.t
t/context_pp.t
t/defsv.t
t/eval.t
t/eval_pp.t
t/idempotent.t
t/idempotent_pp.t
t/lib/t/context_0.pm
t/lib/t/context_1.pm
t/lib/t/context_2.pm
t/lib/t/eval_0.pm
t/lib/t/package_0.pm
t/lib/t/seal_0.pm
t/lib/t/seal_1.pm
t/lib/t/seal_2.pm
t/lib/t/seal_3.pm
t/lib/t/seal_4.pm
t/override.t
t/override_pp.t
t/package.t
t/package_pp.t
t/pod_cvg.t
t/pod_cvg_pp.t
t/pod_syn.t
t/seal.t
t/seal_pp.t
t/setup_pp.pl
t/swash.t
t/swash_pp.t
t/threads.t
t/threads_pp.t
t/version_check.t
t/version_check_pp.t
t/version_feature.t
t/version_feature_pp.t
SIGNATURE Added here by Module::Build
{
"abstract" : "prevent leakage of lexical hints",
"author" : [
"Andrew Main (Zefram) <zefram@fysh.org>"
],
"dynamic_config" : 1,
"generated_by" : "Module::Build version 0.4222",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "Lexical-SealRequireHints",
"prereqs" : {
"build" : {
"requires" : {
"Module::Build" : "0",
"Test::More" : "0.41",
"perl" : "5.006",
"strict" : "0",
"warnings" : "0"
}
},
"configure" : {
"requires" : {
"Module::Build" : "0",
"perl" : "5.006",
"strict" : "0",
"warnings" : "0"
}
},
"runtime" : {
"conflicts" : {
"B::Hooks::OP::Check" : "< 0.19"
},
"recommends" : {
"XSLoader" : "0"
},
"requires" : {
"perl" : "5.006"
}
}
},
"provides" : {
"Lexical::SealRequireHints" : {
"file" : "lib/Lexical/SealRequireHints.pm",
"version" : "0.011"
}
},
"release_status" : "stable",
"resources" : {
"license" : [
"http://dev.perl.org/licenses/"
]
},
"version" : "0.011",
"x_serialization_backend" : "JSON::PP version 2.93"
}
---
abstract: 'prevent leakage of lexical hints'
author:
- 'Andrew Main (Zefram) <zefram@fysh.org>'
build_requires:
Module::Build: '0'
Test::More: '0.41'
perl: '5.006'
strict: '0'
warnings: '0'
configure_requires:
Module::Build: '0'
perl: '5.006'
strict: '0'
warnings: '0'
conflicts:
B::Hooks::OP::Check: '< 0.19'
dynamic_config: 1
generated_by: 'Module::Build version 0.4222, CPAN::Meta::Converter version 2.150010'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: Lexical-SealRequireHints
provides:
Lexical::SealRequireHints:
file: lib/Lexical/SealRequireHints.pm
version: '0.011'
recommends:
XSLoader: '0'
requires:
perl: '5.006'
resources:
license: http://dev.perl.org/licenses/
version: '0.011'
x_serialization_backend: 'CPAN::Meta::YAML version 0.012'
NAME
Lexical::SealRequireHints - prevent leakage of lexical hints
DESCRIPTION
This module works around two historical bugs in Perl's handling of the
"%^H" (lexical hints) variable. One bug causes lexical state in one file
to leak into another that is "require"d/"use"d from it. This bug, [perl
#68590], was present from Perl 5.6 up to Perl 5.10, fixed in Perl 5.11.0.
The second bug causes lexical state (normally a blank "%^H" once the first
bug is fixed) to leak outwards from "utf8.pm", if it is automatically
loaded during Unicode regular expression matching, into whatever source
is compiling at the time of the regexp match. This bug, [perl #73174],
was present from Perl 5.8.7 up to Perl 5.11.5, fixed in Perl 5.12.0.
Both of these bugs seriously damage the usability of any module relying
on "%^H" for lexical scoping, on the affected Perl versions. It is in
practice essential to work around these bugs when using such modules.
On versions of Perl that require such a workaround, this module globally
changes the behaviour of "require", including "use" and the implicit
"require" performed in Unicode regular expression matching, so that it
no longer exhibits these bugs.
The workaround supplied by this module takes effect the first time its
"import" method is called. Typically this will be done by means of a
"use" statement. This should be done as early as possible, because
it only affects "require"/"use" statements that are compiled after
the workaround goes into effect. For "use" statements, and "require"
statements that are executed immediately and only once, it suffices to
invoke the workaround when loading the first module that will set up
vulnerable lexical state. Delayed-action "require" statements, however,
are more troublesome, and can require the workaround to be loaded
much earlier. Ultimately, an affected Perl program may need to load
the workaround as very nearly its first action. Invoking this module
multiple times, from multiple modules, is not a problem: the workaround
is only applied once, and applies to everything subsequently compiled.
This module is implemented in XS, with a pure Perl backup version for
systems that can't handle XS modules. The XS version has a better chance
of playing nicely with other modules that modify "require" handling.
The pure Perl version can't work at all on some Perl versions; users of
those versions must use the XS.
INSTALLATION
perl Build.PL
./Build
./Build test
./Build install
AUTHOR
Andrew Main (Zefram) <zefram@fysh.org>
COPYRIGHT
Copyright (C) 2009, 2010, 2011, 2012, 2015, 2016, 2017
Andrew Main (Zefram) <zefram@fysh.org>
LICENSE
This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
This file contains message digests of all files listed in MANIFEST,
signed via the Module::Signature module, version 0.73.
To verify the content in this distribution, first make sure you have
Module::Signature installed, then type:
% cpansign -v
It will check each file's integrity, as well as the signature's
validity. If "==> Signature verified OK! <==" is not displayed,
the distribution may already have been compromised, and you should
not run its Makefile.PL or Build.PL.
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
SHA1 6950821fe34951e6170552099d0de2ee22e43714 .gitignore
SHA1 0616efb9fea4b42ef61504539491dea58c0786b1 Build.PL
SHA1 6350fe8377653135b4815b6e0e1ef388dd3aea1d Changes
SHA1 f6bab67957ec6cb5a1dbfb303390229f981b96db MANIFEST
SHA1 efc5631378f819a1dfbd4074fb6d38f492970198 META.json
SHA1 c9698f97e2d78e3a15f79570c61fab4a499e1314 META.yml
SHA1 3f668a964c81d5ce977c778255b5eed9fea1c6b2 README
SHA1 4327c0f4dd68ec8bd91d35eaabadb92723346921 lib/Lexical/SealRequireHints.pm
SHA1 ee3c56448c1878c343d62da40f2021e9d69528a2 lib/Lexical/SealRequireHints.xs
SHA1 85aaf18e006530f42082c756aa1040649c8b09a0 t/before_warnings.t
SHA1 ba8ac9a2c5eae1646fe0a32884f8bce8164981d4 t/before_warnings_pp.t
SHA1 f0e8de16764c8ed0cb2de866e62e04d3b6710681 t/context.t
SHA1 ae68c412d70f10ac1c8dfd0e78a1fcb03c64a4cd t/context_pp.t
SHA1 5439e1dcab04c71c710ee9d6566f0a8794f054a1 t/defsv.t
SHA1 ba454428e28bf1e2c52ab85f99262eafec90264a t/eval.t
SHA1 0dc83a10b6e41c384c6d14d70d941f0f9852ea3e t/eval_pp.t
SHA1 6b56f4e9647471655eeff10a08293bef3ffd9706 t/idempotent.t
SHA1 f884176ed69eee995d27f355906f9c4089fbd207 t/idempotent_pp.t
SHA1 d40cabac0840b217bd9790fcf9c61f53d84561ec t/lib/t/context_0.pm
SHA1 c38cbea405a2738de1e144063993d9958934b828 t/lib/t/context_1.pm
SHA1 f13b20d1b34f6765fa222a387c022e4543aef945 t/lib/t/context_2.pm
SHA1 e9a4397c1e339f95671c1b5e609426f624784efe t/lib/t/eval_0.pm
SHA1 8f88eba8be8441c0e078f3279b9220a2fdcd7c7c t/lib/t/package_0.pm
SHA1 8f7a77729ec67ed32b8faa2492bb0f4ee4f35744 t/lib/t/seal_0.pm
SHA1 881d167b1d9169cef37af0d845af437e90e7869d t/lib/t/seal_1.pm
SHA1 77fb76f802a2669291950d830979738ba34ebd71 t/lib/t/seal_2.pm
SHA1 8bebdc1f1032ee7e2c3448b8c08eb68a30eaac3f t/lib/t/seal_3.pm
SHA1 e8478e388c78af43a2f3b50dd4c2d647dbd3b9ef t/lib/t/seal_4.pm
SHA1 93873dcbc2f0a6d3969da339804fd1b2fb2f7215 t/override.t
SHA1 275ad60cee3db0a156dd290e10bffdd2f15b020d t/override_pp.t
SHA1 c4b1c66405db4fb0236d793355669f46b4239247 t/package.t
SHA1 32a8ee26109cebb5294d304f8e26e5f2fc41357c t/package_pp.t
SHA1 ec7947b4fd26dfa4c85ce4cddf2e0d9b9f7b6fcc t/pod_cvg.t
SHA1 8b0ef0af30cd5064cf1b3d57c5fdbab11f8c567c t/pod_cvg_pp.t
SHA1 65c75abdef6f01a5d1588a307f2ddfe2333dc961 t/pod_syn.t
SHA1 b98b2fdbda12097de5f07efb0e385a0d541c325a t/seal.t
SHA1 e55bad95386f7c6a7fa706879ee4a57c65d1d2ff t/seal_pp.t
SHA1 f8bd31bc8099cbb21c36cddc0508652fd092e332 t/setup_pp.pl
SHA1 8b64b9e77d907e8a27f665b86c0ddbf80c54fd81 t/swash.t
SHA1 80c995c18004f3bbf08ee665456aa90591cf75af t/swash_pp.t
SHA1 2e0c5b75f050c8a561c75808e866f002cbab7162 t/threads.t
SHA1 36fd6f457842f0c87a7b766d264a3bcc6fccc889 t/threads_pp.t
SHA1 0ec3dd0164e1e852b1be5f78bbacebd4990f085e t/version_check.t
SHA1 8cb66e045a1218a108c7d4acf723a3eafea1a42c t/version_check_pp.t
SHA1 cbff8c2d9481b01beb691a498ae98511d0b25cbe t/version_feature.t
SHA1 e433dba0073843f1b0b2546776904c41e03e337f t/version_feature_pp.t
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1
iEYEARECAAYFAllqgWgACgkQOV9mt2VyAVG42gCgiQ/tfw+0miisvMiqXiU1m7xW
fkkAn0CbNVe9pmiHogY4f3UMmsuLd0gg
=1LYu
-----END PGP SIGNATURE-----
liblexical-sealrequirehints-perl (0.011-4) unstable; urgency=medium
* Team upload.
* Upload to unstable.
-- Niko Tyni <ntyni@debian.org> Wed, 17 Jul 2019 09:13:18 +0300
liblexical-sealrequirehints-perl (0.011-3) experimental; urgency=medium
* Team upload.
* Remove override_dh_installchangelogs from debian/rules after fix
for #899248.
* Drop patch lexical_sealrequirehints_5_27.11.diff.
This was only needed for perl 5.27.11 and early 5.28 release candidates,
until a change in 5.28.0 obsoleted it.
(Closes: #930051)
* debian/control: make build dependency versioned to exclude the version
which breaks a test. Cf. #930051
* Declare compliance with Debian Policy 4.3.0.
* Bump debhelper-compat to 12.
* debian/watch: use uscan version 4.
-- gregor herrmann <gregoa@debian.org> Fri, 07 Jun 2019 10:51:23 +0200
liblexical-sealrequirehints-perl (0.011-2) unstable; urgency=medium
* Team upload.
[ Damyan Ivanov ]
* declare conformance with Policy 4.1.3 (no changes needed)
[ Salvatore Bonaccorso ]
* Update Vcs-* headers for switch to salsa.debian.org
[ gregor herrmann ]
* Take patch from CPAN RT for compatibility of tests with
perl >= 5.27.11.
* Declare compliance with Debian Policy 4.1.4.
* Bump debhelper compatibility level to 10.
* debian/rules: temporarily override dh_installchangelogs (#899248).
-- gregor herrmann <gregoa@debian.org> Tue, 22 May 2018 21:51:16 +0200
liblexical-sealrequirehints-perl (0.011-1) unstable; urgency=medium
[ gregor herrmann ]
* debian/copyright: change Copyright-Format 1.0 URL to HTTPS.
[ Florian Schlichting ]
* Import upstream version 0.011
* Update copyright years
* Declare compliance with Debian Policy 4.1.0
-- Florian Schlichting <fsfs@debian.org> Mon, 18 Sep 2017 22:24:23 +0200
liblexical-sealrequirehints-perl (0.010-1) unstable; urgency=medium
[ Salvatore Bonaccorso ]
* debian/control: Use HTTPS transport protocol for Vcs-Git URI
[ Florian Schlichting ]
* Add debian/upstream/metadata
* Import upstream version 0.010
* Update copyright years
* Declare compliance with Debian Policy 3.9.7
* Enable all hardening flags
-- Florian Schlichting <fsfs@debian.org> Mon, 18 Apr 2016 21:39:29 +0200
liblexical-sealrequirehints-perl (0.009-1) unstable; urgency=low
[ Salvatore Bonaccorso ]
* Change Vcs-Git to canonical URI (git://anonscm.debian.org)
* Change search.cpan.org based URIs to metacpan.org based URIs
[ gregor herrmann ]
* Strip trailing slash from metacpan URLs.
[ Salvatore Bonaccorso ]
* Update Vcs-Browser URL to cgit web frontend
[ Florian Schlichting ]
* Import Upstream version 0.009
* Email change: Florian Schlichting -> fsfs@debian.org
* Update copyright years
* Add autopkgtest header
* Add explicit dependency on M::B
* Declare compliance with Debian Policy 3.9.6 (no changes necessary)
-- Florian Schlichting <fsfs@debian.org> Mon, 04 May 2015 21:12:39 +0200
liblexical-sealrequirehints-perl (0.007-1) unstable; urgency=low
* Initial Release. (Closes: #668108)
-- Florian Schlichting <fschlich@zedat.fu-berlin.de> Mon, 09 Apr 2012 01:06:20 +0200
Source: liblexical-sealrequirehints-perl
Maintainer: Debian Perl Group <pkg-perl-maintainers@lists.alioth.debian.org>
Uploaders: Florian Schlichting <fsfs@debian.org>
Section: perl
Testsuite: autopkgtest-pkg-perl
Priority: optional
Build-Depends: debhelper-compat (= 12),
perl (>= 5.28.0) | perl (<< 5.27.11),
libmodule-build-perl,
libtest-pod-perl,
libtest-pod-coverage-perl
Standards-Version: 4.3.0
Vcs-Browser: https://salsa.debian.org/perl-team/modules/packages/liblexical-sealrequirehints-perl
Vcs-Git: https://salsa.debian.org/perl-team/modules/packages/liblexical-sealrequirehints-perl.git
Homepage: https://metacpan.org/release/Lexical-SealRequireHints
Package: liblexical-sealrequirehints-perl
Architecture: any
Depends: ${misc:Depends},
${perl:Depends},
${shlibs:Depends}
Description: Perl module to prevent the leakage of lexical hints
Lexical::SealRequireHints is a module that works around two historical
bugs in Perl's handling of the %^H (lexical hints) variable, which cause
lexical state in one file to leak into another.
Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
Upstream-Contact: Andrew Main (Zefram) <zefram@fysh.org>
Source: https://metacpan.org/release/Lexical-SealRequireHints
Upstream-Name: Lexical-SealRequireHints
Files: *
Copyright: 2009-2017, Andrew Main (Zefram) <zefram@fysh.org>
License: Artistic or GPL-1+
Files: debian/*
Copyright: 2012-2017, Florian Schlichting <fsfs@debian.org>
License: Artistic or GPL-1+
License: Artistic
This program is free software; you can redistribute it and/or modify
it under the terms of the Artistic License, which comes with Perl.
.
On Debian systems, the complete text of the Artistic License can be
found in `/usr/share/common-licenses/Artistic'.
License: GPL-1+
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 1, or (at your option)
any later version.
.
On Debian systems, the complete text of version 1 of the GNU General
Public License can be found in `/usr/share/common-licenses/GPL-1'.
#!/usr/bin/make -f
export DEB_BUILD_MAINT_OPTIONS = hardening=+all
%:
dh $@
---
Archive: CPAN
Contact: Andrew Main (Zefram) <zefram@fysh.org>
Name: Lexical-SealRequireHints
version=4
https://metacpan.org/release/Lexical-SealRequireHints .*/Lexical-SealRequireHints-v?@ANY_VERSION@@ARCHIVE_EXT@$
This diff is collapsed.
#define PERL_NO_GET_CONTEXT 1
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#define PERL_VERSION_DECIMAL(r,v,s) (r*1000000 + v*1000 + s)
#define PERL_DECIMAL_VERSION \
PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)
#define PERL_VERSION_GE(r,v,s) \
(PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s))
#ifndef cBOOL
# define cBOOL(x) ((bool)!!(x))
#endif /* !cBOOL */
#ifndef croak
# define croak Perl_croak_nocontext
#endif /* !croak */
#define Q_MUST_WORKAROUND (!PERL_VERSION_GE(5,12,0))
#define Q_HAVE_COP_HINTS_HASH PERL_VERSION_GE(5,9,4)
#if Q_MUST_WORKAROUND
# if !PERL_VERSION_GE(5,9,3)
typedef OP *(*Perl_check_t)(pTHX_ OP *);
# endif /* <5.9.3 */
# if !PERL_VERSION_GE(5,10,1)
typedef unsigned Optype;
# endif /* <5.10.1 */
# ifndef OpMORESIB_set
# define OpMORESIB_set(o, sib) ((o)->op_sibling = (sib))
# define OpLASTSIB_set(o, parent) ((o)->op_sibling = NULL)
# define OpMAYBESIB_set(o, sib, parent) ((o)->op_sibling = (sib))
# endif /* !OpMORESIB_set */
# ifndef OpSIBLING
# define OpHAS_SIBLING(o) (cBOOL((o)->op_sibling))
# define OpSIBLING(o) (0 + (o)->op_sibling)
# endif /* !OpSIBLING */
# ifndef wrap_op_checker
# define wrap_op_checker(c,n,o) THX_wrap_op_checker(aTHX_ c,n,o)
static void THX_wrap_op_checker(pTHX_ Optype opcode,
Perl_check_t new_checker, Perl_check_t *old_checker_p)
{
if(*old_checker_p) return;
OP_REFCNT_LOCK;
if(!*old_checker_p) {
*old_checker_p = PL_check[opcode];
PL_check[opcode] = new_checker;
}
OP_REFCNT_UNLOCK;
}
# endif /* !wrap_op_checker */
# ifndef SvVOK
# define SvVOK(sv) 0
# endif /* !SvVOK */
# define refcounted_he_free(he) Perl_refcounted_he_free(aTHX_ he)
# define newDEFSVOP() THX_newDEFSVOP(aTHX)
static OP *THX_newDEFSVOP(pTHX)
{
# if PERL_VERSION_GE(5,9,1)
/* hope nothing overrides the meaning of defined() */
OP *dop = newOP(OP_DEFINED, 0);
if(dop->op_type == OP_DEFINED && (dop->op_flags & OPf_KIDS)) {
OP *op = cUNOPx(dop)->op_first;
if(OpHAS_SIBLING(op)) {
cUNOPx(dop)->op_first = OpSIBLING(op);
} else {
cUNOPx(dop)->op_first = NULL;
dop->op_flags &= ~OPf_KIDS;
}
OpLASTSIB_set(op, NULL);
op_free(dop);
return op;
}
op_free(dop);
# endif /* >=5.9.1 */
return newSVREF(newGVOP(OP_GV, 0, PL_defgv));
}
# define op_scalar(op) THX_op_scalar(aTHX_ op)
static OP *THX_op_scalar(pTHX_ OP *op)
{
OP *sop = newUNOP(OP_SCALAR, 0, op);
if(!(sop->op_type == OP_SCALAR && (sop->op_flags & OPf_KIDS)))
return sop;
op = cUNOPx(sop)->op_first;
if(OpHAS_SIBLING(op)) {
cUNOPx(sop)->op_first = OpSIBLING(op);
} else {
cUNOPx(sop)->op_first = NULL;
sop->op_flags &= ~OPf_KIDS;
}
OpLASTSIB_set(op, NULL);
op_free(sop);
return op;
}
# define pp_squashhints() THX_pp_squashhints(aTHX)
static OP *THX_pp_squashhints(pTHX)
{
/*
* SAVEHINTS() won't actually localise %^H unless the
* HINT_LOCALIZE_HH bit is set. Normally that bit would be set if
* there were anything in %^H, but when affected by [perl #73174]
* the core's swash-loading code clears $^H without changing
* %^H, so we set the bit here. We localise $^H while doing this,
* in order to not clobber $^H across a normal require where the
* bit is legitimately clear, except on Perl 5.11, where the bit
* needs to stay set in order to get proper restoration of %^H.
*/
# if !PERL_VERSION_GE(5,11,0)
SAVEI32(PL_hints);
# endif /* <5.11.0 */
PL_hints |= HINT_LOCALIZE_HH;
SAVEHINTS();
hv_clear(GvHV(PL_hintgv));
# if Q_HAVE_COP_HINTS_HASH
if(PL_compiling.cop_hints_hash) {
refcounted_he_free(PL_compiling.cop_hints_hash);
PL_compiling.cop_hints_hash = NULL;
}
# endif /* Q_HAVE_COP_HINTS_HASH */
return PL_op->op_next;
}
# define newOP_squashhints() THX_newOP_squashhints(aTHX)
static OP *THX_newOP_squashhints(pTHX)
{
OP *squashhints_op = newOP(OP_PUSHMARK, 0);
squashhints_op->op_type = OP_RAND;
squashhints_op->op_ppaddr = THX_pp_squashhints;
return squashhints_op;
}
# define pp_maybesquashhints() THX_pp_maybesquashhints(aTHX)
static OP *THX_pp_maybesquashhints(pTHX)
{
dSP;
SV *arg = TOPs;
return SvNIOKp(arg) || (PERL_VERSION_GE(5,9,2) && SvVOK(arg)) ?
PL_op->op_next : pp_squashhints();
}
# define newOP_maybesquashhints(argop) THX_newOP_maybesquashhints(aTHX_ argop)
static OP *THX_newOP_maybesquashhints(pTHX_ OP *argop)
{
OP *msh_op = newUNOP(OP_NULL, 0, argop);
msh_op->op_type = OP_RAND;
msh_op->op_ppaddr = THX_pp_maybesquashhints;
return msh_op;
}
static OP *(*THX_nxck_require)(pTHX_ OP *op);
static OP *THX_myck_require(pTHX_ OP *op)
{
OP *argop;
if(!(op->op_flags & OPf_KIDS)) {
/*
* We need to expand the implicit-parameter case
* to an explicit parameter that we can operate on.
* This duplicates what ck_fun() would do, including
* its invocation of a fresh chain of op checkers.
*/
op_free(op);
return newUNOP(OP_REQUIRE, 0, newDEFSVOP());
}
argop = cUNOPx(op)->op_first;
if(argop->op_type == OP_CONST && (argop->op_private & OPpCONST_BARE)) {
/*
* Bareword argument gets special handling in standard
* checker, which we'd rather not interfere with by the
* process that we'd need to use a maybesquashhints op.
* Fortunately, we don't need access to the runtime
* argument in this case: we know it must be a module
* name, so we definitely want to squash hints at runtime.
* So build op tree with an unconditional squashhints op.
*/
op = THX_nxck_require(aTHX_ op);
op = append_list(OP_LINESEQ, (LISTOP*)newOP_squashhints(),
(LISTOP*)op);
} else {
/*
* Whether we want to squash hints depends on whether
* the argument at runtime is a version number or not.
* So we wrap the argument op, separating it from the
* require op.
*/
OP *sib = OpSIBLING(argop);
OpLASTSIB_set(argop, NULL);
argop = newOP_maybesquashhints(op_scalar(argop));
OpMAYBESIB_set(argop, sib, op);
cUNOPx(op)->op_first = argop;
}
op = prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), op);
op->op_type = OP_LEAVE;
op->op_ppaddr = PL_ppaddr[OP_LEAVE];
op->op_flags |= OPf_PARENS;
return op;
}
#endif /* Q_MUST_WORKAROUND */
MODULE = Lexical::SealRequireHints PACKAGE = Lexical::SealRequireHints
PROTOTYPES: DISABLE
void
import(SV *classname)
CODE:
PERL_UNUSED_VAR(classname);
#if Q_MUST_WORKAROUND
wrap_op_checker(OP_REQUIRE, THX_myck_require, &THX_nxck_require);
#endif /* Q_MUST_WORKAROUND */
void
unimport(SV *classname, ...)
CODE:
PERL_UNUSED_VAR(classname);
croak("Lexical::SealRequireHints does not support unimportation");
# This script checks whether L:SRH takes effect sufficiently early. It is
# specifically concerned with the "require Carp" or "require Carp::Heavy"
# that warnings.pm may execute in a delayed manner. Either it must
# be possible to delay loading warnings.pm until after L:SRH has taken
# effect, so that its require statements will be appropriately altered
# to avoid hint leakage, or L:SRH must cause Carp to load, so that it's
# loaded without problematic hints in existence. We test this by loading
# L:SRH first thing, and checking what's been loaded. This script,
# as a result, can't use warnings.pm or anything that might load it.
# The test is only applied on Perls where L:SRH makes a difference,
# so that infrastructure modules can start using warnings in the future.
BEGIN {
if("$]" >= 5.012) {
print "1..0 # SKIP no problem on this Perl\n";
exit 0;
}
}
BEGIN { print "1..1\n"; }
use Lexical::SealRequireHints;
BEGIN {
if(exists($INC{"warnings.pm"}) &&
!(exists($INC{"Carp.pm"}) &&
exists($INC{"Carp/Heavy.pm"}))) {
print "not ok 1\n";
exit 1;
}
}
print "ok 1\n";
exit 0;
1;
# No "use warnings" here because of the unique requirements of
# before_warnings.t.
do "./t/setup_pp.pl" or die $@ || $!;
do "./t/before_warnings.t" or die $@ || $!;
1;
use warnings;
use strict;
use Test::More tests => 14;
BEGIN { use_ok "Lexical::SealRequireHints"; }
BEGIN { unshift @INC, "./t/lib"; }
my $retval;
eval { $retval = require t::context_0; 1 };
is $@, "";
is $retval, "t::context_0 return";
eval { $retval = require t::context_0; 1 };
is $@, "";
is $retval, 1;
eval { $retval = [ require t::context_1 ]; 1 };
is $@, "";
is_deeply $retval, ["t::context_1 return"];
eval { $retval = [ require t::context_1 ]; 1 };
is $@, "";
is_deeply $retval, [1];
eval { require t::context_2; 1 };
is $@, "";
eval { require t::context_2; 1 };
is $@, "";
sub diecxt() {
die wantarray ? "ARRAY\n" : defined(wantarray) ? "SCALAR\n" : "VOID\n";
}
eval { $retval = require(diecxt()); 1 };
is $@, "SCALAR\n";
eval { $retval = [ require(diecxt()) ]; 1 };
is $@, "SCALAR\n";
eval { require(diecxt()); 1 };
is $@, "SCALAR\n";
1;
use warnings;
use strict;
do "./t/setup_pp.pl" or die $@ || $!;
do "./t/context.t" or die $@ || $!;
1;
use warnings;
use strict;
use Test::More tests => 5;
BEGIN { use_ok "Lexical::SealRequireHints"; }
BEGIN { unshift @INC, "./t/lib"; }
SKIP: {
skip "CORE::GLOBAL::require breaks require() on this perl", 4
if defined(&CORE::GLOBAL::require) && "$]" < 5.015005;
my $retval;
eval q{ our $_ = "t/context_0.pm"; $retval = require; 1 };
is $@, "";
is $retval, "t::context_0 return";
SKIP: {
skip "no lexical \$_ on this perl", 2
if "$]" < 5.009001 || "$]" >= 5.023004;
eval q{
no warnings "$]" >= 5.017009 ? "experimental" :
"deprecated";
my $_ = "t/context_1.pm";
$retval = require;
1;
};
is $@, "";
is $retval, "t::context_1 return";
}
}
1;
use warnings;
use strict;
BEGIN {
if("$]" < 5.006001) {
require Test::More;
Test::More::plan(skip_all => "core bug makes this test crash");
}
}
use Test::More tests => 5;
BEGIN { use_ok "Lexical::SealRequireHints"; }
BEGIN { unshift @INC, "./t/lib"; }
use t::eval_0;
ok 1;
1;
use warnings;
use strict;
do "./t/setup_pp.pl" or die $@ || $!;
do "./t/eval.t" or die $@ || $!;
1;
use warnings;
use strict;
alarm 10;
use Lexical::SealRequireHints;
do "./t/seal.t" or die $@ || $!;
1;
use warnings;
use strict;
do "./t/setup_pp.pl" or die $@ || $!;
do "./t/idempotent.t" or die $@ || $!;
1;
package t::context_0;
{ use 5.006; }
use warnings;
use strict;
die "t::context_0 sees array context at file scope" if wantarray;
die "t::context_0 sees void context at file scope" unless defined wantarray;
"t::context_0 return";
package t::context_1;
{ use 5.006; }
use warnings;
use strict;
die "t::context_1 sees array context at file scope" if wantarray;
die "t::context_1 sees void context at file scope" unless defined wantarray;
"t::context_1 return";
package t::context_2;
{ use 5.006; }
use warnings;
use strict;
die "t::context_2 sees array context at file scope" if wantarray;
die "t::context_2 sees void context at file scope" unless defined wantarray;
"t::context_2 return";
package t::eval_0;
use warnings;
use strict;
use Test::More 0.41;
sub _ok_no_eval() {
my $lastsub = "";
my $i = 0;
while(1) {
my @c = caller($i);
unless(@c) {
ok 0;
diag "failed to find main program in stack trace";
return;
}
my $sub = $c[3];
if($sub eq "main::BEGIN") {
ok 1;
return;
}
my $type = $sub ne "(eval)" ? "subroutine" :
$c[7] ? "require" :
defined($c[6]) ? "string eval" : "block eval";
if($type =~ /eval/ && !($lastsub eq "t::eval_0::BEGIN" &&
$type eq "block eval")) {
ok 0;
diag "have $type between module and main program";
return;
}
$lastsub = $sub;
$i++;
}
}
BEGIN { _ok_no_eval(); }
_ok_no_eval();
sub import { _ok_no_eval(); }
1;
$main::package = __PACKAGE__;
1;
package t::seal_0;
use warnings;
use strict;
use Test::More;
BEGIN { is $^H{"Lexical::SealRequireHints/test"}, undef; }
main::test_runtime_hint_hash "Lexical::SealRequireHints/test", undef;
sub import {
is $^H{"Lexical::SealRequireHints/test"}, 1;
$^H |= 0x20000 if "$]" < 5.009004;
$^H{"Lexical::SealRequireHints/test0"}++;
}
1;
package t::seal_1;
use warnings;
use strict;
use Test::More;
BEGIN { is $^H{"Lexical::SealRequireHints/test"}, undef; }
main::test_runtime_hint_hash "Lexical::SealRequireHints/test", undef;
sub import {
is $^H{"Lexical::SealRequireHints/test"}, 1;
$^H |= 0x20000 if "$]" < 5.009004;
$^H{"Lexical::SealRequireHints/test1"}++;
}
1;
package t::seal_2;
use warnings;
use strict;
10;
package t::seal_3;
use warnings;
use strict;
BEGIN { die "seal_3 death\n"; }
1;
package t::seal_4;
use warnings;
use strict;
die "seal_4 death\n";
1;
use warnings;
use strict;
BEGIN {
if("$]" < 5.007002) {
require Test::More;
Test::More::plan(skip_all =>
"CORE::GLOBAL::require can't work on this perl");
}
}
use Test::More tests => 10;
our @warnings;
BEGIN {
$^W = 1;
$SIG{__WARN__} = sub { push @warnings, $_[0] };
}
our $have_runtime_hint_hash;
BEGIN { $have_runtime_hint_hash = "$]" >= 5.009004; }
sub test_runtime_hint_hash($$) {
SKIP: {
skip "no runtime hint hash", 1 unless $have_runtime_hint_hash;
is +((caller(0))[10] || {})->{$_[0]}, $_[1];
}
}
our @require_activity;
BEGIN {
my $next_require = defined(&CORE::GLOBAL::require) ?
\&CORE::GLOBAL::require : sub { CORE::require($_[0]) };
no warnings "redefine";
*CORE::GLOBAL::require = sub {
push @require_activity, "a";
return $next_require->(@_);
};
}
BEGIN { use_ok "Lexical::SealRequireHints"; }
BEGIN { unshift @INC, "./t/lib"; }
BEGIN {
my $next_require = defined(&CORE::GLOBAL::require) ?
\&CORE::GLOBAL::require : sub { CORE::require($_[0]) };
no warnings "redefine";
no warnings "prototype";
*CORE::GLOBAL::require = sub ($) {
push @require_activity, "b";
return $next_require->(@_);
};
}
BEGIN {
$^H |= 0x20000 if "$]" < 5.009004;
$^H{"Lexical::SealRequireHints/test"} = 1;
}
BEGIN {
is $^H{"Lexical::SealRequireHints/test"}, 1;
@require_activity = ();
}
use t::seal_0;
BEGIN {
is $^H{"Lexical::SealRequireHints/test"}, 1;
is $^H{"Lexical::SealRequireHints/test0"}, 1;
isnt scalar(@require_activity), 0;
is_deeply \@require_activity, [("b","a") x (@require_activity>>1)];
}
is_deeply \@warnings, [];
1;
use warnings;
use strict;
do "./t/setup_pp.pl" or die $@ || $!;
do "./t/override.t" or die $@ || $!;
1;
use warnings;
use strict;
use Test::More tests => 2;
BEGIN { unshift @INC, "./t/lib"; }
our $native_package;
BEGIN {
our $package;
{
package Foo;
require t::package_0;
}
$native_package = $package;
$package = undef;
delete $INC{"t/package_0.pm"};
}
BEGIN { use_ok "Lexical::SealRequireHints"; }
our $package;
{
package Foo;
require t::package_0;
}
is $package, $native_package;
1;
use warnings;
use strict;
do "./t/setup_pp.pl" or die $@ || $!;
do "./t/package.t" or die $@ || $!;
1;
use warnings;
use strict;
use Test::More;
plan skip_all => "Test::Pod::Coverage not available"
unless eval "use Test::Pod::Coverage; 1";
Test::Pod::Coverage::all_pod_coverage_ok({also_private=>[qr/\Aunimport\z/]});
1;
use warnings;
use strict;
do "./t/setup_pp.pl" or die $@ || $!;
do "./t/pod_cvg.t" or die $@ || $!;
1;
use warnings;
use strict;
use Test::More;
plan skip_all => "Test::Pod not available" unless eval "use Test::Pod 1.00; 1";
Test::Pod::all_pod_files_ok();
1;
use warnings;
use strict;
use Test::More tests => 31;
our @warnings;
BEGIN {
$^W = 1;
$SIG{__WARN__} = sub { push @warnings, $_[0] };
}