Commit 19c22a12 authored by Florian Schlichting's avatar Florian Schlichting

Imported Upstream version 0.009

parent 6f231de3
/Build
/Makefile
/_build
/blib
/META.json
/META.yml
/MYMETA.json
/MYMETA.yml
/Makefile.PL
/SIGNATURE
/Lexical-SealRequireHints-*
/lib/Lexical/SealRequireHints.c
/lib/Lexical/SealRequireHints.o
......@@ -68,7 +68,7 @@ Module::Build->subclass(code => q{
},
build_requires => {
"Module::Build" => 0,
"Test::More" => 0,
"Test::More" => "0.41",
"perl" => "5.006",
"strict" => 0,
"warnings" => 0,
......
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
......
......@@ -15,9 +15,12 @@ t/context_0.pm
t/context_1.pm
t/context_2.pm
t/context_pp.t
t/defsv.t
t/eval.t
t/eval_0.pm
t/eval_pp.t
t/idempotent.t
t/idempotent_pp.t
t/override.t
t/override_pp.t
t/package.t
......@@ -38,4 +41,8 @@ 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.4205",
"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.009"
}
},
"release_status" : "stable",
"resources" : {
"license" : [
"http://dev.perl.org/licenses/"
]
},
"version" : "0.009"
}
---
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.4205, CPAN::Meta::Converter version 2.131560'
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.009'
recommends:
XSLoader: '0'
requires:
perl: '5.006'
resources:
license: http://dev.perl.org/licenses/
version: '0.009'
# Note: this file was auto-generated by Module::Build::Compat version 0.4205
require 5.006;
unless (eval "use Module::Build::Compat 0.02; 1" ) {
print "This module requires Module::Build to install itself.\n";
require ExtUtils::MakeMaker;
my $yn = ExtUtils::MakeMaker::prompt
(' Install Module::Build now from CPAN?', 'y');
unless ($yn =~ /^y/i) {
die " *** Cannot install without Module::Build. Exiting ...\n";
}
require Cwd;
require File::Spec;
require CPAN;
# Save this 'cause CPAN will chdir all over the place.
my $cwd = Cwd::cwd();
CPAN::Shell->install('Module::Build::Compat');
CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate
or die "Couldn't install Module::Build, giving up.\n";
chdir $cwd or die "Cannot chdir() back to $cwd: $!";
}
eval "use Module::Build::Compat 0.02; 1" or die $@;
use lib '_build/lib';
Module::Build::Compat->run_build_pl(args => \@ARGV);
my $build_script = 'Build';
$build_script .= '.com' if $^O eq 'VMS';
exit(0) unless(-e $build_script); # cpantesters convention
require MyModuleBuilder;
Module::Build::Compat->write_makefile(build_class => 'MyModuleBuilder');
......@@ -55,7 +55,7 @@ Andrew Main (Zefram) <zefram@fysh.org>
COPYRIGHT
Copyright (C) 2009, 2010, 2011, 2012
Copyright (C) 2009, 2010, 2011, 2012, 2015
Andrew Main (Zefram) <zefram@fysh.org>
LICENSE
......
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 cd9729601cf687ddd61f76175d4aaae77c89be3e Build.PL
SHA1 d7013975ca8dd0bdc62762310f2fee0d0671868c Changes
SHA1 8a0fd294cf9c6c2a0aa73eb594811f6ff9d4ad2a MANIFEST
SHA1 420110294ca08a77f892b26f21ead15e7e99295a META.json
SHA1 c2b3c2080c3ef9d87770c908ffd9ea3ebb9f6b53 META.yml
SHA1 01014dbee096cf5abd3f05069cefa9c907a4aea1 Makefile.PL
SHA1 e220c3530b5f359a04b0eca0c76ffe38e4b8e7c5 README
SHA1 365f2fbb42b1aa995f0cdbc1d7d0863c92ffbf87 lib/Lexical/SealRequireHints.pm
SHA1 b37bc49474485b81053e6140531279187db2c1ff lib/Lexical/SealRequireHints.xs
SHA1 85aaf18e006530f42082c756aa1040649c8b09a0 t/before_warnings.t
SHA1 61999cf7732bd0ae59043f1718b294598366bdeb t/before_warnings_pp.t
SHA1 3df41730d40647226f508e56d154aa432491d004 t/context.t
SHA1 d40cabac0840b217bd9790fcf9c61f53d84561ec t/context_0.pm
SHA1 c38cbea405a2738de1e144063993d9958934b828 t/context_1.pm
SHA1 f13b20d1b34f6765fa222a387c022e4543aef945 t/context_2.pm
SHA1 82657c96b6ed89ce7bdb6285dbcfbb05d68eaeb3 t/context_pp.t
SHA1 18a96f78b97cc043c8ced0aceefb8216a50e44b0 t/defsv.t
SHA1 cafd4c3b6c5ea236bc2abec70b819b730cb90c4c t/eval.t
SHA1 e9a4397c1e339f95671c1b5e609426f624784efe t/eval_0.pm
SHA1 b110d57bc147139e44f07d931e3d3698b404c244 t/eval_pp.t
SHA1 bba5f7f0083a8575478ddb642d80e27d6bf111c9 t/idempotent.t
SHA1 ef1eea9ae1774a96b0955b0da0d703de32bbcfe2 t/idempotent_pp.t
SHA1 1c2bfdf067bb2215729fe8ff60990c875799a22a t/override.t
SHA1 d151cfac8c90f19137177b72eb2bff07488401ea t/override_pp.t
SHA1 b064a061f38ee4924c7100180e8e8ff877bb25d1 t/package.t
SHA1 8f88eba8be8441c0e078f3279b9220a2fdcd7c7c t/package_0.pm
SHA1 4b0236dd669efdacdadba6e11d9fe43364612c58 t/package_pp.t
SHA1 ec7947b4fd26dfa4c85ce4cddf2e0d9b9f7b6fcc t/pod_cvg.t
SHA1 3f447b1d0b8a6247c3a311087f8d66da1c3ca5db t/pod_cvg_pp.t
SHA1 65c75abdef6f01a5d1588a307f2ddfe2333dc961 t/pod_syn.t
SHA1 a19a2542b1e955fa78ab677edfd70a3fae8f972d t/seal.t
SHA1 8f7a77729ec67ed32b8faa2492bb0f4ee4f35744 t/seal_0.pm
SHA1 881d167b1d9169cef37af0d845af437e90e7869d t/seal_1.pm
SHA1 77fb76f802a2669291950d830979738ba34ebd71 t/seal_2.pm
SHA1 8bebdc1f1032ee7e2c3448b8c08eb68a30eaac3f t/seal_3.pm
SHA1 e8478e388c78af43a2f3b50dd4c2d647dbd3b9ef t/seal_4.pm
SHA1 bf9f3734c090121ff387eb85351b8abe17d6cff6 t/seal_pp.t
SHA1 f8bd31bc8099cbb21c36cddc0508652fd092e332 t/setup_pp.pl
SHA1 6912741c04aa7b1a080bbe9216e453e489e9c218 t/swash.t
SHA1 c2be3b40bb344403ac14899f5dfe05196373d1f9 t/swash_pp.t
SHA1 923e318828faaccdd2585f228535f44fae8b1842 t/threads.t
SHA1 3dcc432bbe2d8f67f875e68d6501fd69683fab9f t/threads_pp.t
SHA1 0ec3dd0164e1e852b1be5f78bbacebd4990f085e t/version_check.t
SHA1 ed1cbf6ff3eed2268c517087e01814a940da658e t/version_check_pp.t
SHA1 cbff8c2d9481b01beb691a498ae98511d0b25cbe t/version_feature.t
SHA1 04c0a2e7e2291f9e74f8add832caa29eb2b538d4 t/version_feature_pp.t
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.12 (GNU/Linux)
iEYEARECAAYFAlUMnIgACgkQOV9mt2VyAVGo8gCdEl9TWsnI/5dj5/o4o1krfFf9
bKQAn0BXT0KTTLj/kiOqfB/9oJW6yrlq
=l4Ln
-----END PGP SIGNATURE-----
......@@ -44,10 +44,12 @@ 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 C<require> handling.
The pure Perl version can't work at all on some Perl versions; users of
those versions must use the XS.
The pure Perl version can't work at all on some Perl versions; users
of those versions must use the XS. On all Perl versions suffering the
underlying hint leakage bug, pure Perl hooking of C<require> breaks the
use of C<require> without an explicit parameter (implicitly using C<$_>).
=head1 PERL VERION DIFFERENCES
=head1 PERL VERSION DIFFERENCES
The history of the C<%^H> bugs is complex. Here is a chronological
statement of the relevant changes.
......@@ -143,7 +145,7 @@ BEGIN { ${^WARNING_BITS} = ""; }
# Also don't "use strict", because of consequences of compiling
# strict.pm's code.
our $VERSION = "0.007";
our $VERSION = "0.009";
if("$]" >= 5.012) {
# bug not present
......@@ -161,9 +163,13 @@ if("$]" >= 5.012) {
# may be subject to delayed require statements in XSLoader or
# things that it loaded.
foreach(qw(Carp.pm Carp/Heavy.pm)) {
eval { local $SIG{__DIE__}; require($_); };
eval { local $SIG{__DIE__}; require($_); 1; };
}
} elsif("$]" >= 5.007002 && !("$]" >= 5.009004 && "$]" < 5.010001)) {
} elsif("$]" < 5.007002) {
die "pure Perl version of @{[__PACKAGE__]} can't work on pre-5.8 perl";
} elsif("$]" >= 5.009004 && "$]" < 5.010001) {
die "pure Perl version of @{[__PACKAGE__]} can't work on perl 5.10.0";
} else {
my $done;
*import = sub {
die "$_[0] does not take any importation arguments\n"
......@@ -189,15 +195,36 @@ if("$]" >= 5.012) {
$CORE::GLOBAL::{require} = $grequire;
return scalar($requirer->($arg));
};
*CORE::GLOBAL::require = sub {
*CORE::GLOBAL::require = sub ($) {
die "wrong number of arguments to require\n"
unless @_ == 1;
my($arg) = @_;
# Some reference to $next_require is required
# at this level of subroutine so that it will
# be closed over and hence made available to
# the string eval below.
# the string eval.
my $nr = $next_require;
my $requirer = eval qq{
package @{[scalar(caller(0))]};
sub { scalar(\$next_require->(\$_[0])) };
};
# We must localise %^H when performing a require
# with a filename, but not a require with a
# version number. This is because on Perl 5.9.5
# and above require with a version number does an
# internal importation from the "feature" module,
# which is intentional behaviour that must be
# allowed to affect %^H. (That's logically the
# wrong place for the feature importation, but
# it's too late to change how old Perls do it.)
# A version number is an argument that is either
# numeric or, from Perl 5.9.2 onwards, a v-string.
my $must_localise = ($arg^$arg) ne "0" &&
!("$]" >= 5.009002 && ref(\$arg) eq "VSTRING");
# On Perl 5.11 we need to set the HINT_LOCALIZE_HH
# bit to get proper restoration of %^H by the
# swash loading code.
$^H |= 0x20000 if "$]" >= 5.011 && $must_localise;
# Compile-time %^H gets localised by the
# "local %^H". Runtime %^H doesn't exist prior
# to Perl 5.9.4, and on Perl 5.10.1 and above is
......@@ -206,21 +233,12 @@ if("$]" >= 5.012) {
# correctly localise runtime %^H in pure Perl,
# short of putting an eval frame around the
# require, so we don't use this implementation in
# that region. On Perl 5.11 we need to set the
# HINT_LOCALIZE_HH bit to get proper restoration
# of %^H by the swash loading code.
my $requirer = eval qq{
package @{[scalar(caller(0))]};
sub { scalar(\$next_require->(\$_[0])) };
};
$^H |= 0x20000 if "$]" >= 5.011;
local %^H;
# that region.
local %^H if $must_localise;
return scalar($requirer->($arg));
};
};
*unimport = sub { die "$_[0] does not support unimportation\n" };
} else {
die "pure Perl version of @{[__PACKAGE__]} can't work on pre-5.8 perl";
}
=head1 BUGS
......@@ -230,6 +248,18 @@ C<require>. As a result, it cannot prevent lexical state leakage through
a C<require> statement that was compiled before this module was invoked.
Where problems occur, this module must be invoked earlier.
On all Perl versions that need a fix for the lexical hint leakage bug,
the pure Perl implementation of this module unavoidably breaks the use
of C<require> without an explicit parameter (implicitly using C<$_>).
This is due to another bug in the Perl core, fixed in Perl 5.15.5, and is
inherent to the mechanism by which pure Perl code can hook C<require>.
The use of implicit C<$_> with C<require> is rare, so although this
state of affairs is faulty it will actually work for most programs.
Perl versions 5.12.0 and greater, despite having the C<require> hooking
bug, don't actually exhibit a problem with the pure Perl version of this
module, because with the lexical hint leakage bug fixed there is no need
for this module to hook C<require>.
=head1 SEE ALSO
L<perlpragma>
......@@ -240,7 +270,7 @@ Andrew Main (Zefram) <zefram@fysh.org>
=head1 COPYRIGHT
Copyright (C) 2009, 2010, 2011, 2012
Copyright (C) 2009, 2010, 2011, 2012, 2015
Andrew Main (Zefram) <zefram@fysh.org>
=head1 LICENSE
......
......@@ -41,15 +41,53 @@ Perl_check_t new_checker, Perl_check_t *old_checker_p)
}
# endif /* !wrap_op_checker */
# ifndef SvVOK
# define SvVOK(sv) 0
# endif /* !SvVOK */
# define refcounted_he_free(he) Perl_refcounted_he_free(aTHX_ he)
static OP *pp_squashhints(pTHX)
# 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;
cUNOPx(dop)->op_first = op->op_sibling;
if(!op->op_sibling) dop->op_flags &= ~OPf_KIDS;
op->op_sibling = 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;
cUNOPx(sop)->op_first = op->op_sibling;
if(!op->op_sibling) sop->op_flags &= ~OPf_KIDS;
op->op_sibling = 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
* 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
......@@ -70,22 +108,75 @@ static OP *pp_squashhints(pTHX)
return PL_op->op_next;
}
#define gen_squashhints_op() THX_gen_squashhints_op(aTHX)
# define gen_squashhints_op() THX_gen_squashhints_op(aTHX)
static OP *THX_gen_squashhints_op(pTHX)
{
OP *squashhints_op = newOP(OP_PUSHMARK, 0);
squashhints_op->op_type = OP_RAND;
squashhints_op->op_ppaddr = pp_squashhints;
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 gen_maybesquashhints_op(argop) THX_gen_maybesquashhints_op(aTHX_ argop)
static OP *THX_gen_maybesquashhints_op(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 *(*nxck_require)(pTHX_ OP *op);
static OP *myck_require(pTHX_ OP *op)
{
op = nxck_require(aTHX_ op);
op = append_list(OP_LINESEQ, (LISTOP*)gen_squashhints_op(),
(LISTOP*)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 = nxck_require(aTHX_ op);
op = append_list(OP_LINESEQ, (LISTOP*)gen_squashhints_op(),
(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 = argop->op_sibling;
argop->op_sibling = NULL;
argop = gen_maybesquashhints_op(op_scalar(argop));
argop->op_sibling = sib;
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];
......
use warnings;
use strict;
use Test::More tests => 11;
use Test::More tests => 14;
BEGIN { use_ok "Lexical::SealRequireHints"; }
......@@ -29,4 +29,14 @@ 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;
use Test::More tests => 5;
BEGIN { use_ok "Lexical::SealRequireHints"; }
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;
eval q{
no warnings "$]" >= 5.017009 ? "experimental" :
"deprecated";
my $_ = "t/context_1.pm";
$retval = require;
1;
};
is $@, "";
is $retval, "t::context_1 return";
}
}
1;
......@@ -3,7 +3,7 @@ package t::eval_0;
use warnings;
use strict;
use Test::More;
use Test::More 0.41;
sub _ok_no_eval() {
my $lastsub = "";
......
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;
......@@ -44,7 +44,8 @@ BEGIN {
my $next_require = defined(&CORE::GLOBAL::require) ?
\&CORE::GLOBAL::require : sub { CORE::require($_[0]) };
no warnings "redefine";
*CORE::GLOBAL::require = sub {
no warnings "prototype";
*CORE::GLOBAL::require = sub ($) {
push @require_activity, "b";
return $next_require->(@_);
};
......
......@@ -28,7 +28,14 @@ BEGIN {
%^H = ( foo=>1, bar=>2 );
$^H |= 0x20000;
is_deeply [ sort keys(%^H) ], [qw(bar foo)];
ok !exists($INC{"utf8.pm"});
if(exists $INC{"utf8.pm"}) {
SKIP: {
skip "utf8.pm loaded too early ".
"(breaking following tests)", 1;
}
} else {
pass;
}
}
BEGIN {
# Up to Perl 5.7.0, it is the compilation of this regexp match
......
......@@ -16,12 +16,18 @@ BEGIN {
require Test::More;
Test::More::plan(skip_all => "Thread::Semaphore unavailable");
}
eval { require threads::shared; };
if($@ ne "") {
require Test::More;
Test::More::plan(skip_all => "threads::shared unavailable");
}
}
use threads;
use Test::More tests => 3;
use Thread::Semaphore ();
use threads::shared;
alarm 10; # failure mode may involve an infinite loop
......@@ -30,26 +36,30 @@ my $exit1 = Thread::Semaphore->new(0);
my $done2 = Thread::Semaphore->new(0);
my $exit2 = Thread::Semaphore->new(0);
my $ok1 = 1;
my $ok1 :shared;
my $thread1 = threads->create(sub {
my $ok = 1;
eval(q{
use Lexical::SealRequireHints;
require t::context_1;
1;
}) or $ok1 = 0;
}) or $ok = 0;
$ok1 = $ok;
$done1->up;
$exit1->down;
});
$done1->down;
ok $ok1;
my $ok2 = 1;
my $ok2 :shared;
my $thread2 = threads->create(sub {
my $ok = 1;
eval(q{
use Lexical::SealRequireHints;
require t::context_2;
1;
}) or $ok2 = 0;
}) or $ok = 0;
$ok2 = $ok;
$done2->up;
$exit2->down;
});
......
use warnings;
use strict;
use Test::More tests => 19;
BEGIN { use_ok "Lexical::SealRequireHints"; }
no warnings "portable";
foreach(
q{ use 5.006; },
q{ use 5.6.0; },
q{ use v5.6.0; },
q{ require 5.006; },
q{ require 5.6.0; },
q{ require v5.6.0; },
q{ require(5.006); },
("$]" >= 5.009002 ? (
q{ my $v = 5.6.0; require($v); },
q{ my $v = 5.6.0; require($v); },
) : ("", "")),
) {
eval $_;
is $@, "";
}
foreach(
q{ use 6.006; },
q{ use 6.6.0; },
q{ use v6.6.0; },