Lexical-SealRequireHints-0.012000755001750001750 014402525365 16263 5ustar00zeframzefram000000000000Lexical-SealRequireHints-0.012/.gitignore000444001750001750 30114402525354 20360 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.012/Build.PL000444001750001750 544214402525354 17717 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 => { "Exporter" => 0, "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" }, meta_merge => { "meta-spec" => { version => "2" }, resources => { bugtracker => { mailto => "bug-Lexical-SealRequireHints". "\@rt.cpan.org", web => "https://rt.cpan.org/Public/Dist/". "Display.html?Name=". "Lexical-SealRequireHints", }, }, }, sign => 1, )->create_build_script; 1; Lexical-SealRequireHints-0.012/Changes000444001750001750 2234114402525354 17733 0ustar00zeframzefram000000000000version 0.012; 2023-03-10 * bugfix: comprehensive set of preemptive loads of modules for which a delayed load might have been compiled while loading this module * bugfix: if AutoLoader was loaded during (or before) loading this module, flush its compiled code and reload it, to make subsequent autoloads of *.al files not leak hints * bugfix: if utf8_heavy.pl was loaded during (or before) loading this module, flush its compiled code and reload it, to make subsequent loads of Unicode data files not leak hints * bugfix: perform preemptive loads, of modules for which a delayed load might have been compiled while loading this module, regardless of whether XS module loading was successful * bugfix: also work around hint leakage affecting do-file, which suffers exactly the same problem as require * correct thread behaviour: make the XS implementation behave the way the pure Perl implementation already did, by not applying workaround until it has been requested in a particular thread (including being requested pre-cloning in a thread from which this thread was cloned) * be more conservative about maintaining op tree structure * port to Perl 5.33.1, which defines a PERL_VERSION_GE() macro that clashes with the one this module previously had * delay the preemptive module loads, of modules potentially subject to early-compiled delayed loads, until applying the fix * update swash test for Perl 5.27.11, which avoids actually loading swashes most of the time * skip thread tests on some old versions of Perl (around 5.10.0) where a core bug makes thread creation violate an internal assertion and causes crashes * skip thread tests on pre-5.8.9 Perls where a core bug makes thread creation corrupt memory * skip thread tests on pre-5.8.3 Perls where a core bug makes thread completion break the global PL_sv_placeholder * in t/override.t, make the test overrides of require() provide the correct context to the file scope of each file being loaded * test the point at which the workaround goes into effect * in documentation, describe the bug affecting "do" on Perls 5.15.{5..7} * in documentation, use four-column indentation for all verbatim material * in META.{yml,json}, point to public bug tracker * use full stricture in the module, now that delayed module loads compiled while loading this module are properly handled so there's no need to try avoiding them entirely * in XS, better argument parenthesisation in a macro * avoid some compiler warnings that arise on Perl 5.6 * fix indentation in the reserve definition of wrap_op_checker() 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 * bugfix: in the pure Perl implementation, provide the correct context to the file scope of each file being loaded * 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.012/MANIFEST000444001750001750 207714402525354 17555 0ustar00zeframzefram000000000000.gitignore Build.PL Changes MANIFEST META.json META.yml README lib/Lexical/SealRequireHints.pm lib/Lexical/SealRequireHints.xs t/autoloader.t t/autoloader_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/auto/t/auto_0/auto_1.al t/lib/t/auto_0.pm t/lib/t/context_0.pm t/lib/t/context_1.pm t/lib/t/context_2.pm t/lib/t/context_d0.pl t/lib/t/context_d1.pl t/lib/t/context_d2.pl t/lib/t/eval_0.pm t/lib/t/onset.pl 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/lib/t/seal_d0.pl t/lib/t/seal_d1.pl t/lib/t/seal_d2.pl t/lib/t/seal_d3.pl t/onset.t t/onset_pp.t t/override_do.t t/override_do_pp.t t/override_require.t t/override_require_pp.t t/package.t t/package_pp.t t/pod_cvg.t t/pod_cvg_pp.t t/pod_syn.t t/preempt.t t/preempt_pp.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/utf8_heavy.t t/utf8_heavy_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.012/META.json000444001750001750 314614402525354 20043 0ustar00zeframzefram000000000000{ "abstract" : "prevent leakage of lexical hints", "author" : [ "Andrew Main (Zefram) " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4232", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Lexical-SealRequireHints", "prereqs" : { "build" : { "requires" : { "Exporter" : "0", "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.012" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-Lexical-SealRequireHints@rt.cpan.org", "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=Lexical-SealRequireHints" }, "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "0.012", "x_serialization_backend" : "JSON::PP version 2.93" } Lexical-SealRequireHints-0.012/META.yml000444001750001750 170314402525354 17670 0ustar00zeframzefram000000000000--- abstract: 'prevent leakage of lexical hints' author: - 'Andrew Main (Zefram) ' build_requires: Exporter: '0' 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.4232, 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.012' recommends: XSLoader: '0' requires: perl: '5.006' resources: bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Lexical-SealRequireHints license: http://dev.perl.org/licenses/ version: '0.012' x_serialization_backend: 'CPAN::Meta::YAML version 0.012' Lexical-SealRequireHints-0.012/README000444001750001750 566214402525354 17307 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/"do"ed 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, and of "do", so that they no longer exhibit 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"/"do" statements that are compiled after the workaround goes into effect. For "use" statements, and "require" and "do" 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" and "do" 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" or "do" 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 "require" breaks the use of "require" without an explicit parameter (implicitly using "$_"). INSTALLATION perl Build.PL ./Build ./Build test ./Build install AUTHOR Andrew Main (Zefram) COPYRIGHT Copyright (C) 2009, 2010, 2011, 2012, 2015, 2016, 2017, 2023 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.012/SIGNATURE000644001750001750 1432414402525365 17732 0ustar00zeframzefram000000000000This file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.88. 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: RIPEMD160 SHA256 b7cf8d30d78c9679d88d2ce8eae9c31fabf5e990b983481e50910c775e0df09d .gitignore SHA256 9ee17b73fe6a98ee094ac03fea212a13a0643bc33dbe9e5560d85374f0b945fe Build.PL SHA256 0d5bd15d71572a8650ce8267bfcd7428c6d6872873280de76a57bb91a99be5e6 Changes SHA256 295ca443b336f4fb92750aab1e4275c9e0300ce0a942a93fc94ff211bca37479 MANIFEST SHA256 7701575f6e5807fb5b425f8ea73dc2b94544dc516736089c25e2d705b15c00b7 META.json SHA256 8aa35cb0c0ef169f93d96488823a70b6c583149154952b2605ea73b562e21248 META.yml SHA256 7f77605f9485a22c7147cb905b2e0f9b3891661edc543828d508077d6b2aae53 README SHA256 94fe5243eeda44bfdce38249f602bfdcfee26b638fc0c32d26c0a86aa1a754f1 lib/Lexical/SealRequireHints.pm SHA256 767eb77e07c58c585e875745171cd0bfa100540c9258ff3230319229a3b33905 lib/Lexical/SealRequireHints.xs SHA256 9b494d4de2ab796ef69254f82704fb6ac197dcc78d8e692d0455745595aecd6d t/autoloader.t SHA256 0a5274a6d16a5438fd2aea44bd5545146446b2ca262b7eebc8d3883d58006b7d t/autoloader_pp.t SHA256 f08185599c72a9e762c9dc5081b41defb27b1731b3195caf4704cc5a283be2b0 t/context.t SHA256 2222b5d0c3f03665ba12bac4fa15d389171d16afc9fea64d3200d561ee1cefc7 t/context_pp.t SHA256 64ea4e80445fe54e3e706886e9a636e3bb12ae447effaff1b9aca4bfa24b47a3 t/defsv.t SHA256 02207e00cfd451eadd2e109cec7d5f98445ecc06998e461e7f92e52583bd8c8e t/eval.t SHA256 bdc0465054ea7a54361827f4843a5b0dc102191826497944fb844dba0e439348 t/eval_pp.t SHA256 f19c658371f734c4350da2b3f3ef14b6eebda99b089369620c1fda6129514dcd t/idempotent.t SHA256 e4ee56c9ee012eab41c656f628064683e72a11fd4e9589d9efc185a52e220e0a t/idempotent_pp.t SHA256 6bf1c3b8a7778b56558aaa97fb846b528b68956634daf06d85061dd46c4916d0 t/lib/auto/t/auto_0/auto_1.al SHA256 a1a96f54e67eb135facccf93eb31aaba0f2ff31c2f1c20d2c42bbf72ab96dd07 t/lib/t/auto_0.pm SHA256 98799ce93793c45be2daadbd0b2c337db76823e6bb536b3a673d5718348cc46a t/lib/t/context_0.pm SHA256 ac62e234a285d20c39d363566306262a1187bc8044671857bffd9c275f63774a t/lib/t/context_1.pm SHA256 b70888610eb494e1fb12fa324090087df4a1ce9fdebfac2a3af036eb2f644c95 t/lib/t/context_2.pm SHA256 fbc422c21c4931c3ef5c7a11fc692720158651e43f7733f1e27837839c8a991d t/lib/t/context_d0.pl SHA256 77d0885c6869bca2294acfd21c585e4f4fd0449f47ce64bfbbb1fc273edba61d t/lib/t/context_d1.pl SHA256 e08c46f30c9234df75cd4c8e7f61bf91637edb4b6da46c6cee4387aac1e30b11 t/lib/t/context_d2.pl SHA256 755751048de220ffb9a10dd4a6b9717d7172bdb006d3915f7bca7fee97931c60 t/lib/t/eval_0.pm SHA256 41beeec46e352aade0a0cd588b6cd6f49ce2a7abb2700ad4cc0f54a98db2b409 t/lib/t/onset.pl SHA256 9353562c60a598dcc5c6cf6390152e11b9fbf145b69d7208847edd131c1dcdd2 t/lib/t/package_0.pm SHA256 f2d694068124dc74f01444ed8334ec72b1971ee859544697ec5c4219ce788a13 t/lib/t/seal_0.pm SHA256 81f26d05240bdf230a780ea7834648b3b69949a2d91d6f2e11d3633dfa9b9734 t/lib/t/seal_1.pm SHA256 669f58a8ad4c670f3b6546b3ef1080974482c0f2f155ed5ea253d418c831ee75 t/lib/t/seal_2.pm SHA256 da04044083e4e7cfb594be1b188b48f592830adcaa017ac0f5dff96b16c48f12 t/lib/t/seal_3.pm SHA256 246038e3d0720eeaad46687b975634cb9ebc08a4977696a5a88e80b0e23bbb16 t/lib/t/seal_4.pm SHA256 48a11525d7ee3c311f3143add65599cc5774ba968d4b0e6dcf68925fc4fc8f6a t/lib/t/seal_d0.pl SHA256 e153a595753c3196176efc4f7382f0965cb9aa1e4460fd0102cf28169594f332 t/lib/t/seal_d1.pl SHA256 d788e18a4be129198e1500522e106f78a3f6e1efe06875c2929eae33898d6699 t/lib/t/seal_d2.pl SHA256 e45d2126cd31f9a3cdeb87ac78a3e792d39d3e9019c87ce1f04152eb1cdf1ff5 t/lib/t/seal_d3.pl SHA256 58d614ec3e6cbd5b1b1d00fb84f1626b14f038704233589ac270a47fd2095e65 t/onset.t SHA256 70766e76a2a2b33f303d28cdfd060c25e5bb5c410a0d16348f0eaf2073d209dd t/onset_pp.t SHA256 6da260e4d33f7c9f76dae8f88343980553a91ac6bb7a601ae062c395b1dd5ab7 t/override_do.t SHA256 43aab259a91b684021722da278057921162f9b38c99b2441c8b8faf85038dbd9 t/override_do_pp.t SHA256 7dfed57d723c3950c342aba97ec9ff0f695d319dd825d9abf47e6e92b29fa41a t/override_require.t SHA256 e6d9e3d08d50c87996c4bea8be8e25e68b99b9d4729a26b64a9bef95b3d0f7cb t/override_require_pp.t SHA256 de6212b09d9583e694c3967329dc759be52511fdd2ca5bcacbf52b5f20c132c8 t/package.t SHA256 8b2ffd906752561ceed9fb7ec99964d25c7ce1c2fc97b1a50401093d6cc32cc0 t/package_pp.t SHA256 921484f3da52792338f21dce7384f6c00c14b030fb115b015e125fb1cf91679f t/pod_cvg.t SHA256 b3eba1173ba1e9569597b23ca28555af91bdf44ec8ec37866da723a62faef594 t/pod_cvg_pp.t SHA256 e16860066c4ca9b2ee9e7d4604297def8a58b53bf0ca03eed863b5d9c5a2ac91 t/pod_syn.t SHA256 f14d2ac58154c3e0afedcef59185d9d49be407071c10e1107d802316f8227c65 t/preempt.t SHA256 8e6fd34c965bdeead106410c2d298a84cecdd07026b4a5efec39fe5611fe1a44 t/preempt_pp.t SHA256 f6f8e0af8b642313b7bf2c407002ec387c7e94962e8ef17cd305e3a306fe6160 t/seal.t SHA256 1b8dd56054c281def633f458a15b3275bc0d412f79d3b783135f69261682e5cc t/seal_pp.t SHA256 8bbbb6fafca481796cf6449b989ee446ada1ef6e76d215d65e0c26c6abaa93a4 t/setup_pp.pl SHA256 13544ed7c64b59d65639b0d40b5bc6a860ef55078d6e33b704bc71503af36bba t/swash.t SHA256 53faca16ffdc3655d4a3954c8aa8a2e06437057921b58d7fce68fa8200e085ab t/swash_pp.t SHA256 04477d2c638acb61e3400e1b639da4c16628cdf69a44eb35365b68b5c41c1a8e t/threads.t SHA256 1e952931e8bc1b73efc8f17e055b724c26ea05d5610893ceae5227a4cc1006b7 t/threads_pp.t SHA256 e6650c7d4a711f012c05385be4ceb7cadb2787a2433078859670ca30ecfc3355 t/utf8_heavy.t SHA256 072480517fec95a528907cb55d521504a73fed913580b9ba924712e8d4cddf79 t/utf8_heavy_pp.t SHA256 d238c1f3ab8e2ead9548a43eb8ed5213e4afcbd407b690bf10691c02894096cc t/version_check.t SHA256 d0046ab353a6f62e5db122878e70f7f91e9931249dd76a9a0ea8dce7e201dac2 t/version_check_pp.t SHA256 807ea478b2b0dca8083bd826268aabff58241d2c382ae756e909b21f618919f9 t/version_feature.t SHA256 d614d9d83778c7c8368f2a994bb26f56016078ac10d4cfec6f3ad4a8712a56c0 t/version_feature_pp.t -----BEGIN PGP SIGNATURE----- iEYEAREDAAYFAmQKquwACgkQOV9mt2VyAVFFbgCfXiu4QWvYA9/sdcsWbfaSjxHp B5YAoKUGBlPltkN05x2vRET5BmOS6Rm9 =xKcy -----END PGP SIGNATURE----- Lexical-SealRequireHints-0.012/lib000755001750001750 014402525354 17027 5ustar00zeframzefram000000000000Lexical-SealRequireHints-0.012/lib/Lexical000755001750001750 014402525354 20410 5ustar00zeframzefram000000000000Lexical-SealRequireHints-0.012/lib/Lexical/SealRequireHints.pm000444001750001750 4014214402525354 24353 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/Ced 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, and of C, so that they no longer exhibit 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/C statements that are compiled after the workaround goes into effect. For C statements, and C 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 and 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 or 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/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/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/C now properly localise 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/C now properly localise 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; } use warnings; use strict; our $VERSION = "0.012"; my($install_compilation_workaround, $install_full_workaround_idempotently); $install_full_workaround_idempotently = sub { $install_full_workaround_idempotently = sub { die "unsuccessful workaround installation" }; my $icw = $install_compilation_workaround; $install_compilation_workaround = undef; $icw->(); if(exists $INC{"AutoLoader.pm"}) { # The "require" statements in AutoLoader were compiled # before we put the workaround in place, and so are # vulnerable. They're capable of loading an open-ended # set of files, so the vulnerability can't be allowed # to stand. So we delete AutoLoader's compiled code # and load in anew, to get it compiled in a form that's # subject to the workaround. no strict "refs"; my $dynaloader_shares = defined(&{"DynaLoader::AUTOLOAD"}) && \&{"DynaLoader::AUTOLOAD"} == \&{"AutoLoader::AUTOLOAD"}; foreach my $k (sort keys %{"AutoLoader::"}) { undef *{"AutoLoader::$k"} unless $k =~ /::\z/; } delete $INC{"AutoLoader.pm"}; scalar(require AutoLoader); if($dynaloader_shares) { no warnings "redefine"; *{"DynaLoader::AUTOLOAD"} = \&{"AutoLoader::AUTOLOAD"}; } } if(exists $INC{"utf8_heavy.pl"}) { # The "require" and "do" statements in utf8_heavy.pl # were compiled before we put the workaround in place, # and so are vulnerable. They're capable of loading an # open-ended set of files, so the vulnerability can't # be allowed to stand. So we delete utf8_heavy.pl's # compiled code and load in anew, to get it compiled in # a form that's subject to the workaround. no strict "refs"; foreach(qw(DEBUG SWASHGET SWASHNEW croak DESTROY)) { undef *{"utf8::$_"} if exists ${"utf8::"}{$_}; } delete $INC{"utf8_heavy.pl"}; scalar(require "utf8_heavy.pl"); } my %direct_delayed_loads = ( # This hash lists all the files that may be loaded in # a delayed fashion by files that may be loaded as a # result of loading this module or which may be loaded # too early to get this module in first. Delayed loading # refers to loading by means of a "require" that is not # executed during loading of the file containing the # "require". The significance of that is that such a # "require" may have been compiled before we installed # the workaround, thus being vulnerable to hint leakage, # and is liable to be executed later when some hints # have actually been set. "AutoLoader.pm" => [ # AutoLoader has a specific delayed load of # Carp.pm, and no other specific delayed loads, # but it also performs delayed loads of an # open-ended set of files. Doing so is its # core purpose. This situation can't be dealt # with by the preemptive loading that this hash # supports, and needs its own handling (above). ], "B.pm" => [], "Carp.pm" => [qw(Carp/Heavy.pm)], "Carp/Heavy.pm" => [], "Config.pm" => ["$]" >= 5.008007 ? qw(Config_heavy.pl) : ()], "Config_git.pl" => [], "Config_heavy.pl" => [ ("$]" >= 5.010001 ? qw(Config_git.pl) : ()), ], "DynaLoader.pm" => [qw(Carp.pm)], "Exporter.pm" => [qw(Carp.pm Exporter/Heavy.pm)], "Exporter/Heavy.pm" => [qw(Carp.pm)], "List/Util.pm" => [], "List/Util/PP.pm" => [qw(Carp.pm Scalar/Util.pm)], "Mac/FileSpec/Unixish.pm" => [], "Scalar/Util.pm" => [qw(Carp.pm)], "Scalar/Util/PP.pm" => [qw(overload.pm)], "XSLoader.pm" => [qw(Carp.pm DynaLoader.pm)], "feature.pm" => [qw(Carp.pm)], "mro.pm" => [], "overload.pm" => [ ("$]" >= 5.008001 ? qw(Scalar/Util.pm) : ()), ("$]" >= 5.011000 ? qw(mro.pm) : ()), ], "overload/numbers.pm" => [], "overloading.pm" => [qw(overload/numbers.pm)], "strict.pm" => [qw(Carp.pm)], "utf8.pm" => [qw(Carp.pm utf8_heavy.pl)], "utf8_heavy.pl" => [ # utf8_heavy.pl has a specific delayed load of # Carp.pm, but it also performs delayed loads # of an open-ended set of files. This situation # can't be dealt with by the preemptive loading # that this hash supports, and needs its own # handling (above). ], "vars.pm" => [qw(Carp.pm)], "warnings.pm" => [qw(Carp.pm Carp/Heavy.pm)], "warnings/register.pm" => [], ); foreach my $already (sort keys %INC) { foreach my $need (@{$direct_delayed_loads{$already} || []}) { # Loading the target file now means that if the # vulnerable "require" executes later then it # won't actually be causing file loading, so no # hint leakage will happen. This "require" is # itself vulnerable, but so are all the "require"s # that happened immediately during loading of # this module; we expect that this module is # loaded early enough that there are no hints set # that would be a problem. Because we're doing # this loading after installing the workaround, # the target file's "require"s won't themselves # be vulnerable, so we don't need to recurse. scalar(require($need)); } } $install_full_workaround_idempotently = sub {}; }; if("$]" >= 5.012) { # bug not present $install_full_workaround_idempotently = sub {}; } elsif(eval { local $SIG{__DIE__}; require XSLoader; XSLoader::load(__PACKAGE__, $VERSION); 1; }) { # successfully loaded XS $install_compilation_workaround = \&_install_compilation_workaround; } 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 { $install_compilation_workaround = sub { 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)); }; no warnings qw(redefine prototype); *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)); }; my $next_do = defined(&CORE::GLOBAL::do) ? \&CORE::GLOBAL::do : sub { my($arg) = @_; my $gdo = $CORE::GLOBAL::{do}; delete $CORE::GLOBAL::{do}; my $doer = eval qq{ package @{[scalar(caller(0))]}; sub { CORE::do(\$_[0]) }; }; $CORE::GLOBAL::{do} = $gdo; return $doer->($arg); }; no warnings qw(redefine prototype); *CORE::GLOBAL::do = sub ($) { die "wrong number of arguments to do\n" unless @_ == 1; my($arg) = @_; my $nd = $next_do; my $doer = eval qq{ package @{[scalar(caller(0))]}; sub { \$next_do->(\$_[0]) }; }; $^H |= 0x20000 if "$]" >= 5.011; local %^H; return $doer->($arg); }; }; } sub import { die "$_[0] does not take any importation arguments\n" unless @_ == 1; $install_full_workaround_idempotently->(); return; } sub unimport { die "$_[0] does not support unimportation\n"; } =head1 BUGS The operation of this module depends on influencing the compilation of C and C. As a result, it cannot prevent lexical state leakage through a C/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. There is a bug on Perl versions 5.15.5 to 5.15.7 affecting C which, among other effects, causes C<%^H> to leak into Ced files. It is not the same bug that affected Perl 5.6 to 5.11. This module currently does not work around this bug at all, but its test suite does detect it. As a result, this module fails its test suite on those Perl versions. This could change in future versions of this module. =head1 SEE ALSO L =head1 AUTHOR Andrew Main (Zefram) =head1 COPYRIGHT Copyright (C) 2009, 2010, 2011, 2012, 2015, 2016, 2017, 2023 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.012/lib/Lexical/SealRequireHints.xs000444001750001750 2274414402525354 24401 0ustar00zeframzefram000000000000#define PERL_NO_GET_CONTEXT 1 #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #define Q_PERL_VERSION_DECIMAL(r,v,s) ((r)*1000000 + (v)*1000 + (s)) #define Q_PERL_DECIMAL_VERSION \ Q_PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION) #define Q_PERL_VERSION_GE(r,v,s) \ (Q_PERL_DECIMAL_VERSION >= Q_PERL_VERSION_DECIMAL(r,v,s)) #if !Q_PERL_VERSION_GE(5,7,2) # undef dNOOP # define dNOOP extern int Perl___notused_func(void) #endif /* <5.7.2 */ #ifndef cBOOL # define cBOOL(x) ((bool)!!(x)) #endif /* !cBOOL */ #ifndef croak # define croak Perl_croak_nocontext #endif /* !croak */ #ifndef hv_existss # define hv_existss(hv, key) hv_exists(hv, "" key "", sizeof(key)-1) #endif /* !hv_existss */ #ifndef hv_stores # define hv_stores(hv, key, val) hv_store(hv, "" key "", sizeof(key)-1, val, 0) #endif /* !hv_stores */ #define Q_MUST_WORKAROUND (!Q_PERL_VERSION_GE(5,12,0)) #define Q_HAVE_COP_HINTS_HASH Q_PERL_VERSION_GE(5,9,4) #if Q_MUST_WORKAROUND # if !Q_PERL_VERSION_GE(5,9,3) typedef OP *(*Perl_check_t)(pTHX_ OP *); # endif /* <5.9.3 */ # if !Q_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 */ # if Q_PERL_VERSION_GE(5,7,3) # define PERL_UNUSED_THX() NOOP # else /* <5.7.3 */ # define PERL_UNUSED_THX() ((void)(aTHX+0)) # endif /* <5.7.3 */ # 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) { PERL_UNUSED_THX(); 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 Q_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 Q_MODGLOBAL_WORKAROUND_KEY \ "Lexical::SealRequireHints/applying_workaround" # 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 !Q_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_nullarysquashhints() THX_newOP_nullarysquashhints(aTHX) static OP *THX_newOP_nullarysquashhints(pTHX) { OP *nsh_op = newOP(OP_PUSHMARK, 0); nsh_op->op_type = OP_RAND; nsh_op->op_ppaddr = THX_pp_squashhints; return nsh_op; } # define newOP_unarysquashhints(argop) THX_newOP_unarysquashhints(aTHX_ argop) static OP *THX_newOP_unarysquashhints(pTHX_ OP *argop) { OP *ush_op = newUNOP(OP_NULL, 0, argop); ush_op->op_type = OP_RAND; ush_op->op_ppaddr = THX_pp_squashhints; return ush_op; } # define pp_maybesquashhints() THX_pp_maybesquashhints(aTHX) static OP *THX_pp_maybesquashhints(pTHX) { dSP; SV *arg = TOPs; return SvNIOKp(arg) || (Q_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(!hv_existss(PL_modglobal, Q_MODGLOBAL_WORKAROUND_KEY)) return THX_nxck_require(aTHX_ op); 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_nullarysquashhints(), (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 *standinop = newOP(OP_NULL, 0); OP *sib = OpSIBLING(argop); OpLASTSIB_set(argop, NULL); OpMAYBESIB_set(standinop, sib, op); cUNOPx(op)->op_first = standinop; argop = newOP_maybesquashhints(op_scalar(argop)); OpLASTSIB_set(standinop, NULL); OpMAYBESIB_set(argop, sib, op); cUNOPx(op)->op_first = argop; op_free(standinop); } 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; } static OP *(*THX_nxck_dofile)(pTHX_ OP *op); static OP *THX_myck_dofile(pTHX_ OP *op) { OP *argop, *standinop, *sib; if(!hv_existss(PL_modglobal, Q_MODGLOBAL_WORKAROUND_KEY)) return THX_nxck_dofile(aTHX_ op); if(!(op->op_flags & OPf_KIDS)) return THX_nxck_dofile(aTHX_ op); argop = cUNOPx(op)->op_first; standinop = newOP(OP_NULL, 0); sib = OpSIBLING(argop); OpLASTSIB_set(argop, NULL); OpMAYBESIB_set(standinop, sib, op); cUNOPx(op)->op_first = standinop; argop = newOP_unarysquashhints(op_scalar(argop)); OpLASTSIB_set(standinop, NULL); OpMAYBESIB_set(argop, sib, op); cUNOPx(op)->op_first = argop; op_free(standinop); 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; } static OP *(*THX_nxck_entersub)(pTHX_ OP *op); static OP *THX_myck_entersub(pTHX_ OP *op) { OP *pushop, *argop, *cvop, *gvop, *standinop; GV *gv; char *name; pushop = cUNOPx(op)->op_first; if(!OpHAS_SIBLING(pushop)) pushop = cUNOPx(pushop)->op_first; if(!((argop = OpSIBLING(pushop)) && (cvop = OpSIBLING(argop)) && !OpHAS_SIBLING(cvop) && cvop->op_type == OP_RV2CV && !(cvop->op_private & OPpENTERSUB_AMPER) && (cvop->op_flags & OPf_KIDS) && (gvop = cUNOPx(cvop)->op_first, gvop->op_type == OP_GV) && (gv = cGVOPx_gv(gvop), SvTYPE((SV*)gv) == SVt_PVGV) && GvSTASH(gv) == PL_globalstash && GvNAMELEN(gv) == 2 && (name = GvNAME(gv), name[0] == 'd' && name[1] == 'o'))) return THX_nxck_entersub(aTHX_ op); standinop = newOP(OP_NULL, 0); OpLASTSIB_set(argop, NULL); OpMORESIB_set(standinop, cvop); OpMORESIB_set(pushop, standinop); argop = newOP_unarysquashhints(op_scalar(argop)); OpLASTSIB_set(standinop, NULL); OpMORESIB_set(argop, cvop); OpMORESIB_set(pushop, argop); op_free(standinop); 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 _install_compilation_workaround() CODE: #if Q_MUST_WORKAROUND wrap_op_checker(OP_REQUIRE, THX_myck_require, &THX_nxck_require); wrap_op_checker(OP_DOFILE, THX_myck_dofile, &THX_nxck_dofile); wrap_op_checker(OP_ENTERSUB, THX_myck_entersub, &THX_nxck_entersub); (void) hv_stores(PL_modglobal, Q_MODGLOBAL_WORKAROUND_KEY, &PL_sv_yes); #endif /* Q_MUST_WORKAROUND */ Lexical-SealRequireHints-0.012/t000755001750001750 014402525354 16524 5ustar00zeframzefram000000000000Lexical-SealRequireHints-0.012/t/autoloader.t000444001750001750 163314402525354 21210 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 14; our @warnings; BEGIN { $^W = 1; $SIG{__WARN__} = sub { push @warnings, $_[0] }; } use AutoLoader (); BEGIN { use_ok "Lexical::SealRequireHints"; } BEGIN { unshift @INC, "./t/lib"; } BEGIN { $^H |= 0x20000 if "$]" < 5.009004; $^H{"Lexical::SealRequireHints/test"} = 1; } $^H |= 0x20000 if "$]" < 5.009004; $^H{"Lexical::SealRequireHints/test"} = 2; BEGIN { is $^H{"Lexical::SealRequireHints/test"}, 1; } is $^H{"Lexical::SealRequireHints/test"}, 2; use t::auto_0 (); BEGIN { is $^H{"Lexical::SealRequireHints/test"}, 1; } is $^H{"Lexical::SealRequireHints/test"}, 2; is t::auto_0::auto_1(), 42; BEGIN { is $^H{"Lexical::SealRequireHints/test"}, 1; } is $^H{"Lexical::SealRequireHints/test"}, 2; is t::auto_0::auto_1(), 42; BEGIN { is $^H{"Lexical::SealRequireHints/test"}, 1; } is $^H{"Lexical::SealRequireHints/test"}, 2; is_deeply \@warnings, []; 1; Lexical-SealRequireHints-0.012/t/autoloader_pp.t000444001750001750 15414402525354 21664 0ustar00zeframzefram000000000000use warnings; use strict; do "./t/setup_pp.pl" or die $@ || $!; do "./t/autoloader.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.012/t/context.t000444001750001750 311614402525354 20533 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 27; 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 $@, ""; eval { $retval = do "t/context_d0.pl"; 1 }; is $@, ""; is $retval, "t::context_d0 return"; eval { $retval = do "t/context_d0.pl"; 1 }; is $@, ""; is $retval, "t::context_d0 return"; eval { $retval = [ do "t/context_d1.pl" ]; 1 }; is $@, ""; is_deeply $retval, [ ("$]" >= 5.007001 ? ("t::context_d1 return", "in three") : ()), "parts", ]; eval { $retval = [ do "t/context_d1.pl" ]; 1 }; is $@, ""; is_deeply $retval, [ ("$]" >= 5.007001 ? ("t::context_d1 return", "in three") : ()), "parts", ]; eval { do "t/context_d2.pl"; 1 }; is $@, ""; eval { do "t/context_d2.pl"; 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"; eval { $retval = do(diecxt()); 1 }; is $@, "SCALAR\n"; eval { $retval = [ do(diecxt()) ]; 1 }; is $@, "SCALAR\n"; eval { do(diecxt()); 1 }; is $@, "SCALAR\n"; 1; Lexical-SealRequireHints-0.012/t/context_pp.t000444001750001750 15114402525354 21206 0ustar00zeframzefram000000000000use warnings; use strict; do "./t/setup_pp.pl" or die $@ || $!; do "./t/context.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.012/t/defsv.t000444001750001750 125114402525354 20154 0ustar00zeframzefram000000000000use 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; Lexical-SealRequireHints-0.012/t/eval.t000444001750001750 63114402525354 17755 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 => 9; BEGIN { use_ok "Lexical::SealRequireHints"; } BEGIN { unshift @INC, "./t/lib"; } use t::eval_0; BEGIN { undef *t::eval_0::_ok_no_eval; undef *t::eval_0::import; ok +scalar(do "t/eval_0.pm"); t::eval_0->import; } ok 1; 1; Lexical-SealRequireHints-0.012/t/eval_pp.t000444001750001750 14614402525354 20455 0ustar00zeframzefram000000000000use warnings; use strict; do "./t/setup_pp.pl" or die $@ || $!; do "./t/eval.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.012/t/idempotent.t000444001750001750 15214402525354 21174 0ustar00zeframzefram000000000000use warnings; use strict; alarm 10; use Lexical::SealRequireHints; do "./t/seal.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.012/t/idempotent_pp.t000444001750001750 15414402525354 21675 0ustar00zeframzefram000000000000use warnings; use strict; do "./t/setup_pp.pl" or die $@ || $!; do "./t/idempotent.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.012/t/onset.t000444001750001750 123514402525354 20177 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 4; BEGIN { unshift @INC, "./t/lib"; } our $onset_test; my $onset_unfixed; $^H |= 0x20000 if "$]" < 5.009004; $^H{"Lexical::SealRequireHints/test"} = 1; $onset_test = ""; eval q{ require "t/onset.pl"; 1 } or die $@; delete $INC{"t/onset.pl"}; $onset_unfixed = $onset_test; require_ok "Lexical::SealRequireHints"; $onset_test = ""; eval q{ require "t/onset.pl"; 1 } or die $@; delete $INC{"t/onset.pl"}; is $onset_test, $onset_unfixed; foreach (0..1) { Lexical::SealRequireHints->import; $onset_test = ""; eval q{ require "t/onset.pl"; 1 } or die $@; delete $INC{"t/onset.pl"}; is $onset_test, "undef"; } 1; Lexical-SealRequireHints-0.012/t/onset_pp.t000444001750001750 14714402525354 20657 0ustar00zeframzefram000000000000use warnings; use strict; do "./t/setup_pp.pl" or die $@ || $!; do "./t/onset.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.012/t/override_do.t000444001750001750 255714402525354 21360 0ustar00zeframzefram000000000000use warnings; use strict; 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 @do_activity; BEGIN { my $next_do = defined(&CORE::GLOBAL::do) ? \&CORE::GLOBAL::do : sub { CORE::do($_[0]) }; no warnings "redefine"; *CORE::GLOBAL::do = sub { push @do_activity, "a"; return $next_do->(@_); }; } BEGIN { use_ok "Lexical::SealRequireHints"; } BEGIN { unshift @INC, "./t/lib"; } BEGIN { my $next_do = defined(&CORE::GLOBAL::do) ? \&CORE::GLOBAL::do : sub { CORE::do($_[0]) }; no warnings "redefine"; no warnings "prototype"; *CORE::GLOBAL::do = sub ($) { push @do_activity, "b"; return $next_do->(@_); }; } BEGIN { $^H |= 0x20000 if "$]" < 5.009004; $^H{"Lexical::SealRequireHints/test"} = 1; } BEGIN { is $^H{"Lexical::SealRequireHints/test"}, 1; @do_activity = (); } BEGIN { do "t/seal_0.pm" or die $@ || $!; t::seal_0->import; } BEGIN { is $^H{"Lexical::SealRequireHints/test"}, 1; is $^H{"Lexical::SealRequireHints/test0"}, 1; isnt scalar(@do_activity), 0; is_deeply \@do_activity, [("b","a") x (@do_activity>>1)]; } is_deeply \@warnings, []; 1; Lexical-SealRequireHints-0.012/t/override_do_pp.t000444001750001750 15514402525354 22027 0ustar00zeframzefram000000000000use warnings; use strict; do "./t/setup_pp.pl" or die $@ || $!; do "./t/override_do.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.012/t/override_require.t000444001750001750 311314402525354 22417 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 { scalar(CORE::require($_[0])) }; no warnings "redefine"; *CORE::GLOBAL::require = sub { push @require_activity, "a"; return scalar($next_require->(@_)); }; } BEGIN { use_ok "Lexical::SealRequireHints"; } BEGIN { unshift @INC, "./t/lib"; } BEGIN { my $next_require = defined(&CORE::GLOBAL::require) ? \&CORE::GLOBAL::require : sub { scalar(CORE::require($_[0])) }; no warnings "redefine"; no warnings "prototype"; *CORE::GLOBAL::require = sub ($) { push @require_activity, "b"; return scalar($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.012/t/override_require_pp.t000444001750001750 16214402525354 23077 0ustar00zeframzefram000000000000use warnings; use strict; do "./t/setup_pp.pl" or die $@ || $!; do "./t/override_require.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.012/t/package.t000444001750001750 111114402525354 20433 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 3; 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; $package = undef; delete $INC{"t/package_0.pm"}; { package Foo; do "t/package_0.pm" or die $@ || $!; } is $package, $native_package; $package = undef; delete $INC{"t/package_0.pm"}; 1; Lexical-SealRequireHints-0.012/t/package_pp.t000444001750001750 15114402525354 21115 0ustar00zeframzefram000000000000use warnings; use strict; do "./t/setup_pp.pl" or die $@ || $!; do "./t/package.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.012/t/pod_cvg.t000444001750001750 33514402525354 20450 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.012/t/pod_cvg_pp.t000444001750001750 15114402525354 21143 0ustar00zeframzefram000000000000use warnings; use strict; do "./t/setup_pp.pl" or die $@ || $!; do "./t/pod_cvg.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.012/t/pod_syn.t000444001750001750 23614402525354 20502 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.012/t/preempt.t000444001750001750 202514402525354 20521 0ustar00zeframzefram000000000000use warnings; use strict; BEGIN { if("$]" >= 5.012) { require Test::More; Test::More::plan(skip_all => "no problem on this Perl"); } } # This test checks whether L:SRH is properly handling delayed loads in # modules that are liable to be loaded during the loading of L:SRH. # Our test case is the delayed load of Exporter::Heavy by Exporter. # Exporter is likely to be loaded during the loading of L:SRH, and # to ensure that we're performing the test we actually force it to be # loaded before we load L:SRH. The delayed load of Exporter::Heavy is # unlikely to be executed by loading of L:SRH, Exporter, or stricture, # but it likely would be executed by loading Test::More, so we don't # use Test::More. BEGIN { print "1..1\n"; } use Exporter (); my %early_loaded; BEGIN { %early_loaded = %INC; } use Lexical::SealRequireHints; if(exists($early_loaded{"Exporter/Heavy.pm"})) { print "ok 1 # skip Exporter::Heavy loaded early\n"; } elsif(exists($INC{"Exporter/Heavy.pm"})) { print "ok 1\n"; } else { print "not ok 1\n"; } 1; Lexical-SealRequireHints-0.012/t/preempt_pp.t000444001750001750 15114402525354 21176 0ustar00zeframzefram000000000000use warnings; use strict; do "./t/setup_pp.pl" or die $@ || $!; do "./t/preempt.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.012/t/seal.t000444001750001750 446714402525354 20005 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 42; 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 { unshift @INC, "./t/lib"; } 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/; } test_runtime_hint_hash "Lexical::SealRequireHints/test", 1; BEGIN { is $^H{"Lexical::SealRequireHints/test"}, 1; do "t/seal_d0.pl" or die $@ || $!; is $^H{"Lexical::SealRequireHints/test"}, 1; } test_runtime_hint_hash "Lexical::SealRequireHints/test", 1; BEGIN { is +(1 + (do "t/seal_d1.pl")), 21; } BEGIN { is +(do "t/seal_d2.pl"), undef; like $@, qr/\Aseal_d2 death\n/; } BEGIN { is +(do "t/seal_d3.pl"), undef; like $@, qr/\Aseal_d3 death\n/; } is_deeply \@warnings, []; 1; Lexical-SealRequireHints-0.012/t/seal_pp.t000444001750001750 14614402525354 20452 0ustar00zeframzefram000000000000use warnings; use strict; do "./t/setup_pp.pl" or die $@ || $!; do "./t/seal.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.012/t/setup_pp.pl000444001750001750 136614402525354 21063 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 { if(($_[0] || "") eq "Lexical::SealRequireHints") { # Load DynaLoader before dying in order to better # replicate the module loading status of a failed XS load, # in order to make the pure Perl tests more realistic. eval { local $SIG{__DIE__}; require DynaLoader; }; die "XS loading disabled for Lexical::SealRequireHints"; } goto &$orig_load; }; 1; Lexical-SealRequireHints-0.012/t/swash.t000444001750001750 215514402525354 20176 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 { unshift @INC, "./t/lib"; } 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 = "bar\x{666}"; $x =~ /bar\p{Alnum}/; } BEGIN { ok "$]" >= 5.027011 || exists($INC{"utf8.pm"}); is_deeply [ sort keys(%^H) ], [qw(bar foo)]; } 1; Lexical-SealRequireHints-0.012/t/swash_pp.t000444001750001750 14714402525354 20654 0ustar00zeframzefram000000000000use warnings; use strict; do "./t/setup_pp.pl" or die $@ || $!; do "./t/swash.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.012/t/threads.t000444001750001750 677514402525354 20517 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"); } if("$]" < 5.008003) { require Test::More; Test::More::plan(skip_all => "threading breaks PL_sv_placeholder on this Perl"); } if("$]" < 5.008009) { require Test::More; Test::More::plan(skip_all => "threading corrupts memory on this Perl"); } if("$]" >= 5.009005 && "$]" < 5.010001) { require Test::More; Test::More::plan(skip_all => "threading breaks assertions on this Perl"); } 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 => 12; use Thread::Semaphore (); use threads::shared; alarm 10; # failure mode may involve an infinite loop my(@exit_sems, @threads); sub test_in_thread($) { my($test_code) = @_; my $done_sem = Thread::Semaphore->new(0); my $exit_sem = Thread::Semaphore->new(0); push @exit_sems, $exit_sem; my $ok :shared; push @threads, threads->create(sub { $ok = !!$test_code->(); $done_sem->up; $exit_sem->down; }); $done_sem->down; ok $ok; } BEGIN { unshift @INC, "./t/lib"; } our $onset_test; my $onset_unfixed; $^H |= 0x20000 if "$]" < 5.009004; $^H{"Lexical::SealRequireHints/test"} = 1; $onset_test = ""; eval q{ require "t/onset.pl"; 1 } or die $@; delete $INC{"t/onset.pl"}; $onset_unfixed = $onset_test; test_in_thread(sub { $onset_test = ""; eval q{ require "t/onset.pl"; 1 } or die $@; delete $INC{"t/onset.pl"}; return $onset_test eq $onset_unfixed; }); test_in_thread(sub { require Lexical::SealRequireHints; Lexical::SealRequireHints->import; $onset_test = ""; eval q{ require "t/onset.pl"; 1 } or die $@; delete $INC{"t/onset.pl"}; return $onset_test eq "undef"; }); $onset_test = ""; eval q{ require "t/onset.pl"; 1 } or die $@; delete $INC{"t/onset.pl"}; is $onset_test, $onset_unfixed; test_in_thread(sub { $onset_test = ""; eval q{ require "t/onset.pl"; 1 } or die $@; delete $INC{"t/onset.pl"}; return $onset_test eq $onset_unfixed; }); test_in_thread(sub { require Lexical::SealRequireHints; $onset_test = ""; eval q{ require "t/onset.pl"; 1 } or die $@; delete $INC{"t/onset.pl"}; return $onset_test eq $onset_unfixed; }); test_in_thread(sub { eval(q{ use Lexical::SealRequireHints; require t::context_1; 1; }) }); require Lexical::SealRequireHints; $onset_test = ""; eval q{ require "t/onset.pl"; 1 } or die $@; delete $INC{"t/onset.pl"}; is $onset_test, $onset_unfixed; test_in_thread(sub { $onset_test = ""; eval q{ require "t/onset.pl"; 1 } or die $@; delete $INC{"t/onset.pl"}; return $onset_test eq $onset_unfixed; }); test_in_thread(sub { Lexical::SealRequireHints->import; $onset_test = ""; eval q{ require "t/onset.pl"; 1 } or die $@; delete $INC{"t/onset.pl"}; return $onset_test eq "undef"; }); Lexical::SealRequireHints->import; $onset_test = ""; eval q{ require "t/onset.pl"; 1 } or die $@; delete $INC{"t/onset.pl"}; is $onset_test, "undef"; test_in_thread(sub { $onset_test = ""; eval q{ require "t/onset.pl"; 1 } or die $@; delete $INC{"t/onset.pl"}; return $onset_test eq "undef"; }); $_->up foreach @exit_sems; $_->join foreach @threads; ok 1; 1; Lexical-SealRequireHints-0.012/t/threads_pp.t000444001750001750 15114402525354 21154 0ustar00zeframzefram000000000000use warnings; use strict; do "./t/setup_pp.pl" or die $@ || $!; do "./t/threads.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.012/t/utf8_heavy.t000444001750001750 77714402525354 21123 0ustar00zeframzefram000000000000use warnings; use strict; BEGIN { if("$]" < 5.006001) { require Test::More; Test::More::plan(skip_all => "this Perl can't parse this test script"); } } use Test::More tests => 6; our @warnings; BEGIN { $^W = 1; $SIG{__WARN__} = sub { push @warnings, $_[0] }; } BEGIN { ok "\x{666}" =~ /\A\p{Digit}\z/; ok "\x{676}" !~ /\A\p{Digit}\z/; } BEGIN { use_ok "Lexical::SealRequireHints"; } BEGIN { ok "\x{666}" !~ /\A\p{Alpha}\z/; ok "\x{676}" =~ /\A\p{Alpha}\z/; } is_deeply \@warnings, []; 1; Lexical-SealRequireHints-0.012/t/utf8_heavy_pp.t000444001750001750 15414402525354 21607 0ustar00zeframzefram000000000000use warnings; use strict; do "./t/setup_pp.pl" or die $@ || $!; do "./t/utf8_heavy.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.012/t/version_check.t000444001750001750 137714402525354 21700 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.012/t/version_check_pp.t000444001750001750 15714402525354 22352 0ustar00zeframzefram000000000000use warnings; use strict; do "./t/setup_pp.pl" or die $@ || $!; do "./t/version_check.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.012/t/version_feature.t000444001750001750 72714402525354 22234 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.012/t/version_feature_pp.t000444001750001750 16114402525354 22723 0ustar00zeframzefram000000000000use warnings; use strict; do "./t/setup_pp.pl" or die $@ || $!; do "./t/version_feature.t" or die $@ || $!; 1; Lexical-SealRequireHints-0.012/t/lib000755001750001750 014402525354 17272 5ustar00zeframzefram000000000000Lexical-SealRequireHints-0.012/t/lib/auto000755001750001750 014402525354 20242 5ustar00zeframzefram000000000000Lexical-SealRequireHints-0.012/t/lib/auto/t000755001750001750 014402525354 20505 5ustar00zeframzefram000000000000Lexical-SealRequireHints-0.012/t/lib/auto/t/auto_0000755001750001750 014402525354 21674 5ustar00zeframzefram000000000000Lexical-SealRequireHints-0.012/t/lib/auto/t/auto_0/auto_1.al000444001750001750 24114402525354 23514 0ustar00zeframzefram000000000000package t::auto_0; use warnings; use strict; use Test::More (); BEGIN { Test::More::is $^H{"Lexical::SealRequireHints/test"}, undef; } sub auto_1 { 42 } 1; Lexical-SealRequireHints-0.012/t/lib/t000755001750001750 014402525354 17535 5ustar00zeframzefram000000000000Lexical-SealRequireHints-0.012/t/lib/t/auto_0.pm000444001750001750 42314402525354 21376 0ustar00zeframzefram000000000000package t::auto_0; { use 5.006; } use warnings; use strict; use Test::More (); BEGIN { Test::More::is $^H{"Lexical::SealRequireHints/test"}, undef; } use AutoLoader (); our $AUTOLOAD; sub AUTOLOAD { $AutoLoader::AUTOLOAD = $AUTOLOAD; goto &AutoLoader::AUTOLOAD; } 1; Lexical-SealRequireHints-0.012/t/lib/t/context_0.pm000444001750001750 35014402525354 22111 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.012/t/lib/t/context_1.pm000444001750001750 35014402525354 22112 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.012/t/lib/t/context_2.pm000444001750001750 35014402525354 22113 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.012/t/lib/t/context_d0.pl000444001750001750 35414402525354 22260 0ustar00zeframzefram000000000000package t::context_d0; { use 5.006; } use warnings; use strict; die "t::context_d0 sees array context at file scope" if wantarray; die "t::context_d0 sees void context at file scope" unless defined wantarray; "t::context_d0 return"; Lexical-SealRequireHints-0.012/t/lib/t/context_d1.pl000444001750001750 63314402525354 22261 0ustar00zeframzefram000000000000package t::context_d1; { use 5.006; } use warnings; no warnings "void"; use strict; die "t::context_d1 sees array context at file scope" if "$]" < 5.007001 && wantarray; die "t::context_d1 sees scalar context at file scope" if "$]" >= 5.007001 && !wantarray && defined(wantarray); die "t::context_d1 sees void context at file scope" unless defined wantarray; ("t::context_d1 return", "in three", "parts"); Lexical-SealRequireHints-0.012/t/lib/t/context_d2.pl000444001750001750 55614402525354 22266 0ustar00zeframzefram000000000000package t::context_d2; { use 5.006; } use warnings; use strict; die "t::context_d2 sees array context at file scope" if wantarray; die "t::context_d2 sees scalar context at file scope" if "$]" >= 5.007001 && !wantarray && defined(wantarray); die "t::context_d2 sees void context at file scope" if "$]" < 5.007001 && !defined(wantarray); "t::context_d2 return"; Lexical-SealRequireHints-0.012/t/lib/t/eval_0.pm000444001750001750 131414402525354 21375 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.012/t/lib/t/onset.pl000444001750001750 21214402525354 21332 0ustar00zeframzefram000000000000use warnings; use strict; BEGIN { my $v = $^H{"Lexical::SealRequireHints/test"}; $main::onset_test = defined($v) ? $v : "undef"; } 1; Lexical-SealRequireHints-0.012/t/lib/t/package_0.pm000444001750001750 4114402525354 21775 0ustar00zeframzefram000000000000$main::package = __PACKAGE__; 1; Lexical-SealRequireHints-0.012/t/lib/t/seal_0.pm000444001750001750 52214402525354 21352 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.012/t/lib/t/seal_1.pm000444001750001750 52214402525354 21353 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.012/t/lib/t/seal_2.pm000444001750001750 6314402525354 21334 0ustar00zeframzefram000000000000package t::seal_2; use warnings; use strict; 10; Lexical-SealRequireHints-0.012/t/lib/t/seal_3.pm000444001750001750 12314402525354 21352 0ustar00zeframzefram000000000000package t::seal_3; use warnings; use strict; BEGIN { die "seal_3 death\n"; } 1; Lexical-SealRequireHints-0.012/t/lib/t/seal_4.pm000444001750001750 11114402525354 21350 0ustar00zeframzefram000000000000package t::seal_4; use warnings; use strict; die "seal_4 death\n"; 1; Lexical-SealRequireHints-0.012/t/lib/t/seal_d0.pl000444001750001750 30614402525354 21515 0ustar00zeframzefram000000000000package t::seal_d0; use warnings; use strict; use Test::More; BEGIN { is $^H{"Lexical::SealRequireHints/test"}, undef; } main::test_runtime_hint_hash "Lexical::SealRequireHints/test", undef; 1; Lexical-SealRequireHints-0.012/t/lib/t/seal_d1.pl000444001750001750 6414402525354 21477 0ustar00zeframzefram000000000000package t::seal_d1; use warnings; use strict; 20; Lexical-SealRequireHints-0.012/t/lib/t/seal_d2.pl000444001750001750 12514402525354 21516 0ustar00zeframzefram000000000000package t::seal_d2; use warnings; use strict; BEGIN { die "seal_d2 death\n"; } 1; Lexical-SealRequireHints-0.012/t/lib/t/seal_d3.pl000444001750001750 11314402525354 21514 0ustar00zeframzefram000000000000package t::seal_d3; use warnings; use strict; die "seal_d3 death\n"; 1;