Lexical-SealRequireHints-0.009000755001750001750 012503116220 16253 5ustar00zeframzefram000000000000Lexical-SealRequireHints-0.009/.gitignore000444001750001750 30112503116210 20351 0ustar00zeframzefram000000000000/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 Lexical-SealRequireHints-0.009/MANIFEST000444001750001750 130412503116210 17536 0ustar00zeframzefram000000000000.gitignore Build.PL Changes MANIFEST META.json META.yml Makefile.PL README lib/Lexical/SealRequireHints.pm lib/Lexical/SealRequireHints.xs t/before_warnings.t t/before_warnings_pp.t t/context.t 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 t/package_0.pm t/package_pp.t t/pod_cvg.t t/pod_cvg_pp.t t/pod_syn.t t/seal.t t/seal_0.pm t/seal_1.pm t/seal_2.pm t/seal_3.pm t/seal_4.pm 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 Lexical-SealRequireHints-0.009/Makefile.PL000444001750001750 233312503116210 20362 0ustar00zeframzefram000000000000# 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'); Lexical-SealRequireHints-0.009/META.json000444001750001750 252412503116210 20033 0ustar00zeframzefram000000000000{ "abstract" : "prevent leakage of lexical hints", "author" : [ "Andrew Main (Zefram) " ], "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" } Lexical-SealRequireHints-0.009/Build.PL000444001750001750 503512503116210 17706 0ustar00zeframzefram000000000000{ 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" }, create_makefile_pl => "passthrough", sign => 1, )->create_build_script; 1; Lexical-SealRequireHints-0.009/META.yml000444001750001750 144012503116210 17657 0ustar00zeframzefram000000000000--- abstract: 'prevent leakage of lexical hints' author: - 'Andrew Main (Zefram) ' 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' Lexical-SealRequireHints-0.009/README000444001750001750 527112503116210 17274 0ustar00zeframzefram000000000000NAME 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) COPYRIGHT Copyright (C) 2009, 2010, 2011, 2012, 2015 Andrew Main (Zefram) LICENSE This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Lexical-SealRequireHints-0.009/Changes000444001750001750 1360712503116210 17731 0ustar00zeframzefram000000000000version 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 Lexical-SealRequireHints-0.009/SIGNATURE000644001750001750 675112503116220 17707 0ustar00zeframzefram000000000000This 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----- Lexical-SealRequireHints-0.009/lib000755001750001750 012503116210 17020 5ustar00zeframzefram000000000000Lexical-SealRequireHints-0.009/lib/Lexical000755001750001750 012503116210 20401 5ustar00zeframzefram000000000000Lexical-SealRequireHints-0.009/lib/Lexical/SealRequireHints.xs000444001750001750 1341712503116210 24367 0ustar00zeframzefram000000000000#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 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 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; 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 * %^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 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 = 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 *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]; 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, myck_require, &nxck_require); #endif /* Q_MUST_WORKAROUND */ void unimport(SV *classname, ...) CODE: PERL_UNUSED_VAR(classname); croak("Lexical::SealRequireHints does not support unimportation"); Lexical-SealRequireHints-0.009/lib/Lexical/SealRequireHints.pm000444001750001750 2563712503116210 24360 0ustar00zeframzefram000000000000=head1 NAME Lexical::SealRequireHints - prevent leakage of lexical hints =head1 SYNOPSIS use Lexical::SealRequireHints; =head1 DESCRIPTION This module works around two historical bugs in Perl's handling of the C<%^H> (lexical hints) variable. One bug causes lexical state in one file to leak into another that is Cd/Cd 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 C<%^H> once the first bug is fixed) to leak outwards from C, 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 C<%^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 C, including C and the implicit C 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 C method is called. Typically this will be done by means of a C statement. This should be done as early as possible, because it only affects C/C statements that are compiled after the workaround goes into effect. For C statements, and C 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 C 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 C handling. 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 breaks the use of C without an explicit parameter (implicitly using C<$_>). =head1 PERL VERSION DIFFERENCES The history of the C<%^H> bugs is complex. Here is a chronological statement of the relevant changes. =over =item Perl 5.6.0 C<%^H> introduced. It exists only as a hash at compile time. It is not localised by C, so lexical hints leak into every module loaded, which is bug [perl #68590]. The C mechanism doesn't work cleanly for C, because overriding C loses the necessary special parsing of bareword arguments to it. As a result, pure Perl code can't properly globally affect the behaviour of C. Pure Perl code can localise C<%^H> itself for any particular C invocation, but a global fix is only possible through XS. =item Perl 5.7.2 The C mechanism now works cleanly for C, so pure Perl code can globally affect the behaviour of C to achieve a global fix for the bug. =item Perl 5.8.7 When C is automatically loaded during Unicode regular expression matching, C<%^H> now leaks outward from it into whatever source is compiling at the time of the regexp match, which is bug [perl #73174]. It often goes unnoticed, because [perl #68590] makes C<%^H> leak into C which then doesn't modify it, so what leaks out tends to be identical to what leaked in. If [perl #68590] is worked around, however, C<%^H> tends to be (correctly) blank inside C, and this bug therefore blanks it for the outer module. =item Perl 5.9.4 C<%^H> now exists in two forms. In addition to the relatively ordinary hash that is modified during compilation, the value that it had at each point in compilation is recorded in the compiled op tree, for later examination at runtime. It is in a special representation-sharing format, and writes to C<%^H> are meant to be performed on both forms. C does not localise the runtime form of C<%^H> (and still doesn't localise the compile-time form). A couple of special C<%^H> entries are erroneously written only to the runtime form. Pure Perl code, although it can localise the compile-time C<%^H> by normal means, can't adequately localise the runtime C<%^H>, except by using a string eval stack frame. This makes a satisfactory global fix for the leakage bug impossible in pure Perl. =item Perl 5.10.1 C now properly localises the runtime form of C<%^H>, but still not the compile-time form. A global fix is once again possible in pure Perl, because the fix only needs to localise the compile-time form. =item Perl 5.11.0 C now properly localises both forms of C<%^H>, fixing [perl #68590]. This makes [perl #73174] apparent without any workaround for [perl #68590]. The special C<%^H> entries are now correctly written to both forms of the hash. =item Perl 5.12.0 The automatic loading of C during Unicode regular expression matching now properly restores C<%^H>, fixing [perl #73174]. =back =cut package Lexical::SealRequireHints; { use 5.006; } # Don't "use warnings" here because warnings.pm can include require # statements that execute at runtime, and if they're compiled before # this module takes effect then they won't get the magic needed to avoid # leaking hints generated later. We do need to set warning bits here, # because it is necessary to turn *off* redefinition warnings for the # pure Perl implementation (which can redefine CORE::GLOBAL::require). # Not wanting to encode knowledge of specific warning bits, the only # safe thing to do is to turn them all off. BEGIN { ${^WARNING_BITS} = ""; } # Also don't "use strict", because of consequences of compiling # strict.pm's code. our $VERSION = "0.009"; if("$]" >= 5.012) { # bug not present *import = sub { die "$_[0] does not take any importation arguments\n" unless @_ == 1; }; *unimport = sub { die "$_[0] does not support unimportation\n" }; } elsif(eval { local $SIG{__DIE__}; require XSLoader; XSLoader::load(__PACKAGE__, $VERSION); 1; }) { # Successfully loaded XS. Now preemptively load modules that # 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($_); 1; }; } } 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" unless @_ == 1; return if $done; $done = 1; my $next_require = defined(&CORE::GLOBAL::require) ? \&CORE::GLOBAL::require : sub { my($arg) = @_; # The shenanigans with $CORE::GLOBAL::{require} # are required because if there's a # &CORE::GLOBAL::require when the eval is # executed (compiling the CORE::require it # contains) then the CORE::require in there is # interpreted as plain require on some Perl # versions, leading to recursion. my $grequire = $CORE::GLOBAL::{require}; delete $CORE::GLOBAL::{require}; my $requirer = eval qq{ package @{[scalar(caller(0))]}; sub { scalar(CORE::require(\$_[0])) }; }; $CORE::GLOBAL::{require} = $grequire; return scalar($requirer->($arg)); }; *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. 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 # correctly localised by require. Between those # two regimes there's an area where we can't # 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. local %^H if $must_localise; return scalar($requirer->($arg)); }; }; *unimport = sub { die "$_[0] does not support unimportation\n" }; } =head1 BUGS The operation of this module depends on influencing the compilation of C. As a result, it cannot prevent lexical state leakage through a C 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 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. The use of implicit C<$_> with C 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 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. =head1 SEE ALSO L =head1 AUTHOR Andrew Main (Zefram) =head1 COPYRIGHT Copyright (C) 2009, 2010, 2011, 2012, 2015 Andrew Main (Zefram) =head1 LICENSE This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Lexical-SealRequireHints-0.009/t000755001750001750 012503116210 16515 5ustar00zeframzefram000000000000Lexical-SealRequireHints-0.009/t/context.t000444001750001750 147212503116210 20527 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 14; BEGIN { use_ok "Lexical::SealRequireHints"; } 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; Lexical-SealRequireHints-0.009/t/pod_syn.t000444001750001750 23612503116210 20473 0ustar00zeframzefram000000000000use 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; Lexical-SealRequireHints-0.009/t/setup_pp.pl000444001750001750 102112503116210 21040 0ustar00zeframzefram000000000000if("$]" < 5.007002 || ("$]" >= 5.009004 && "$]" < 5.010001)) { require Test::More; Test::More::plan(skip_all => "pure Perl Lexical::SealRequireHints can't work on this perl"); } require XSLoader; my $orig_load = \&XSLoader::load; # Suppress redefinition warning, without loading warnings.pm, for the # benefit of before_warnings.t. BEGIN { ${^WARNING_BITS} = ""; } *XSLoader::load = sub { die "XS loading disabled for Lexical::SealRequireHints" if ($_[0] || "") eq "Lexical::SealRequireHints"; goto &$orig_load; }; 1; Lexical-SealRequireHints-0.009/t/seal_4.pm000444001750001750 11112503116210 20330 0ustar00zeframzefram000000000000package t::seal_4; use warnings; use strict; die "seal_4 death\n"; 1; Lexical-SealRequireHints-0.009/t/eval.t000444001750001750 37512503116210 17753 0ustar00zeframzefram000000000000use 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"; } use t::eval_0; ok 1; 1; Lexical-SealRequireHints-0.009/t/swash.t000444001750001750 206612503116210 20170 0ustar00zeframzefram000000000000use warnings; use strict; BEGIN { if("$]" < 5.008) { require Test::More; Test::More::plan(skip_all => "swash loading disagrees with infrastructure"); } } use Test::More tests => 6; use Lexical::SealRequireHints; BEGIN { SKIP: { skip "Perl 5.11 doesn't work with localised hint bit", 2 if "$]" >= 5.011 && "$]" < 5.012; $^H = 0; is $^H, 0; require t::package_0; is $^H, 0; } } BEGIN { %^H = ( foo=>1, bar=>2 ); $^H |= 0x20000; is_deeply [ sort keys(%^H) ], [qw(bar foo)]; 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 # that triggers swash loading. From Perl 5.7.1 onwards, it # is the execution. Hence for this test we must arrange for # both to occur between the surrounding segments of test code. # A BEGIN block achieves this nicely. my $x = "foo\x{666}"; $x =~ /foo\p{Alnum}/; } BEGIN { ok exists($INC{"utf8.pm"}); is_deeply [ sort keys(%^H) ], [qw(bar foo)]; } 1; Lexical-SealRequireHints-0.009/t/seal_1.pm000444001750001750 52212503116210 20333 0ustar00zeframzefram000000000000package 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; Lexical-SealRequireHints-0.009/t/idempotent.t000444001750001750 15012503116210 21163 0ustar00zeframzefram000000000000use warnings; use strict; alarm 10; use Lexical::SealRequireHints; do "t/seal.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.009/t/package_0.pm000444001750001750 4112503116210 20755 0ustar00zeframzefram000000000000$main::package = __PACKAGE__; 1; Lexical-SealRequireHints-0.009/t/pod_cvg_pp.t000444001750001750 14512503116210 21137 0ustar00zeframzefram000000000000use warnings; use strict; do "t/setup_pp.pl" or die $@ || $!; do "t/pod_cvg.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.009/t/override.t000444001750001750 301012503116210 20650 0ustar00zeframzefram000000000000use 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 { 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; Lexical-SealRequireHints-0.009/t/seal_pp.t000444001750001750 14212503116210 20437 0ustar00zeframzefram000000000000use warnings; use strict; do "t/setup_pp.pl" or die $@ || $!; do "t/seal.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.009/t/seal_3.pm000444001750001750 12312503116210 20332 0ustar00zeframzefram000000000000package t::seal_3; use warnings; use strict; BEGIN { die "seal_3 death\n"; } 1; Lexical-SealRequireHints-0.009/t/idempotent_pp.t000444001750001750 15012503116210 21662 0ustar00zeframzefram000000000000use warnings; use strict; do "t/setup_pp.pl" or die $@ || $!; do "t/idempotent.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.009/t/eval_0.pm000444001750001750 131412503116210 20355 0ustar00zeframzefram000000000000package 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; Lexical-SealRequireHints-0.009/t/threads.t000444001750001750 257012503116210 20475 0ustar00zeframzefram000000000000use warnings; use strict; BEGIN { eval { require threads; }; if($@ =~ /\AThis Perl not built to support threads/) { require Test::More; Test::More::plan(skip_all => "non-threading perl build"); } if($@ ne "") { require Test::More; Test::More::plan(skip_all => "threads unavailable"); } eval { require Thread::Semaphore; }; if($@ ne "") { 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 my $done1 = Thread::Semaphore->new(0); my $exit1 = Thread::Semaphore->new(0); my $done2 = Thread::Semaphore->new(0); my $exit2 = Thread::Semaphore->new(0); my $ok1 :shared; my $thread1 = threads->create(sub { my $ok = 1; eval(q{ use Lexical::SealRequireHints; require t::context_1; 1; }) or $ok = 0; $ok1 = $ok; $done1->up; $exit1->down; }); $done1->down; ok $ok1; my $ok2 :shared; my $thread2 = threads->create(sub { my $ok = 1; eval(q{ use Lexical::SealRequireHints; require t::context_2; 1; }) or $ok = 0; $ok2 = $ok; $done2->up; $exit2->down; }); $done2->down; ok $ok2; $exit1->up; $exit2->up; $thread1->join; $thread2->join; ok 1; 1; Lexical-SealRequireHints-0.009/t/seal.t000444001750001750 351112503116210 17763 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 31; 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]; } } BEGIN { use_ok "Lexical::SealRequireHints"; } BEGIN { $^H |= 0x20000 if "$]" < 5.009004; $^H{"Lexical::SealRequireHints/test"} = 1; } BEGIN { is $^H{"Lexical::SealRequireHints/test"}, 1; } test_runtime_hint_hash "Lexical::SealRequireHints/test", 1; use t::seal_0; test_runtime_hint_hash "Lexical::SealRequireHints/test", 1; BEGIN { is $^H{"Lexical::SealRequireHints/test"}, 1; require t::seal_1; t::seal_1->import; is $^H{"Lexical::SealRequireHints/test"}, 1; } test_runtime_hint_hash "Lexical::SealRequireHints/test", 1; BEGIN { is $^H{"Lexical::SealRequireHints/test"}, 1; } test_runtime_hint_hash "Lexical::SealRequireHints/test", 1; use t::seal_0; test_runtime_hint_hash "Lexical::SealRequireHints/test", 1; BEGIN { is $^H{"Lexical::SealRequireHints/test"}, 1; require t::seal_1; t::seal_1->import; is $^H{"Lexical::SealRequireHints/test"}, 1; } test_runtime_hint_hash "Lexical::SealRequireHints/test", 1; BEGIN { is $^H{"Lexical::SealRequireHints/test"}, 1; is $^H{"Lexical::SealRequireHints/test0"}, 2; is $^H{"Lexical::SealRequireHints/test1"}, 2; } test_runtime_hint_hash "Lexical::SealRequireHints/test", 1; test_runtime_hint_hash "Lexical::SealRequireHints/test0", 2; test_runtime_hint_hash "Lexical::SealRequireHints/test1", 2; BEGIN { is +(1 + require t::seal_2), 11; } BEGIN { eval { require t::seal_3; }; like $@, qr/\Aseal_3 death\n/; } BEGIN { eval { require t::seal_4; }; like $@, qr/\Aseal_4 death\n/; } is_deeply \@warnings, []; 1; Lexical-SealRequireHints-0.009/t/pod_cvg.t000444001750001750 33512503116210 20441 0ustar00zeframzefram000000000000use 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; Lexical-SealRequireHints-0.009/t/threads_pp.t000444001750001750 14512503116210 21150 0ustar00zeframzefram000000000000use warnings; use strict; do "t/setup_pp.pl" or die $@ || $!; do "t/threads.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.009/t/swash_pp.t000444001750001750 14312503116210 20641 0ustar00zeframzefram000000000000use warnings; use strict; do "t/setup_pp.pl" or die $@ || $!; do "t/swash.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.009/t/before_warnings.t000444001750001750 213312503116210 22210 0ustar00zeframzefram000000000000# 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; Lexical-SealRequireHints-0.009/t/context_pp.t000444001750001750 14512503116210 21202 0ustar00zeframzefram000000000000use warnings; use strict; do "t/setup_pp.pl" or die $@ || $!; do "t/context.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.009/t/version_check_pp.t000444001750001750 15312503116210 22337 0ustar00zeframzefram000000000000use warnings; use strict; do "t/setup_pp.pl" or die $@ || $!; do "t/version_check.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.009/t/version_feature_pp.t000444001750001750 15512503116210 22717 0ustar00zeframzefram000000000000use warnings; use strict; do "t/setup_pp.pl" or die $@ || $!; do "t/version_feature.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.009/t/context_0.pm000444001750001750 35012503116210 21071 0ustar00zeframzefram000000000000package 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"; Lexical-SealRequireHints-0.009/t/package_pp.t000444001750001750 14512503116210 21111 0ustar00zeframzefram000000000000use warnings; use strict; do "t/setup_pp.pl" or die $@ || $!; do "t/package.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.009/t/override_pp.t000444001750001750 14612503116210 21336 0ustar00zeframzefram000000000000use warnings; use strict; do "t/setup_pp.pl" or die $@ || $!; do "t/override.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.009/t/defsv.t000444001750001750 115712503116210 20152 0ustar00zeframzefram000000000000use 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; Lexical-SealRequireHints-0.009/t/eval_pp.t000444001750001750 14212503116210 20442 0ustar00zeframzefram000000000000use warnings; use strict; do "t/setup_pp.pl" or die $@ || $!; do "t/eval.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.009/t/context_1.pm000444001750001750 35012503116210 21072 0ustar00zeframzefram000000000000package 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"; Lexical-SealRequireHints-0.009/t/context_2.pm000444001750001750 35012503116210 21073 0ustar00zeframzefram000000000000package 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"; Lexical-SealRequireHints-0.009/t/version_feature.t000444001750001750 72712503116210 22225 0ustar00zeframzefram000000000000use warnings; use strict; BEGIN { if("$]" < 5.009005) { require Test::More; Test::More::plan(skip_all => "no version-implied features on this perl"); } } use Test::More tests => 4; BEGIN { use_ok "Lexical::SealRequireHints"; } eval q{ use 5.009005; sub t0 { say "foo"; } }; is $@, ""; eval q{ no warnings "portable"; use 5.9.5; sub t1 { say "foo"; } }; is $@, ""; eval q{ no warnings "portable"; use v5.9.5; sub t2 { say "foo"; } }; is $@, ""; 1; Lexical-SealRequireHints-0.009/t/seal_0.pm000444001750001750 52212503116210 20332 0ustar00zeframzefram000000000000package 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; Lexical-SealRequireHints-0.009/t/before_warnings_pp.t000444001750001750 24712503116210 22673 0ustar00zeframzefram000000000000# 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; Lexical-SealRequireHints-0.009/t/seal_2.pm000444001750001750 6312503116210 20314 0ustar00zeframzefram000000000000package t::seal_2; use warnings; use strict; 10; Lexical-SealRequireHints-0.009/t/version_check.t000444001750001750 137712503116210 21671 0ustar00zeframzefram000000000000use 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; }, q{ require 6.006; }, q{ require 6.6.0; }, q{ require v6.6.0; }, q{ require(6.006); }, ("$]" >= 5.009002 ? ( q{ my $v = 6.6.0; require($v); }, q{ my $v = 6.6.0; require($v); }, ) : ("use 6.006;", "use 6.006;")), ) { eval $_; like $@, qr/\APerl v6\.6\.0 required/; } 1; Lexical-SealRequireHints-0.009/t/package.t000444001750001750 55412503116210 20416 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 2; 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;