Lexical-Var-0.010000755001750001750 014407273375 13570 5ustar00zeframzefram000000000000Lexical-Var-0.010/.gitignore000444001750001750 23214407273365 15671 0ustar00zeframzefram000000000000/Build /Makefile /_build /blib /META.json /META.yml /MYMETA.json /MYMETA.yml /Makefile.PL /SIGNATURE /Lexical-Var-* /lib/Lexical/Var.c /lib/Lexical/Var.o Lexical-Var-0.010/Build.PL000444001750001750 167614407273365 15232 0ustar00zeframzefram000000000000{ use 5.006; } use warnings; use strict; use Module::Build; Module::Build->new( module_name => "Lexical::Var", license => "perl", configure_requires => { "Module::Build" => 0, "perl" => "5.006", "strict" => 0, "warnings" => 0, }, build_requires => { "ExtUtils::CBuilder" => "0.15", "Module::Build" => 0, "Test::More" => 0, "if" => 0, "perl" => "5.006", "strict" => 0, "warnings" => 0, }, requires => { "Lexical::SealRequireHints" => "0.012", "XSLoader" => 0, "perl" => "5.006", "strict" => 0, "warnings" => 0, }, conflicts => { "B::Hooks::OP::Check" => "< 0.19", }, dynamic_config => 0, meta_add => { distribution_type => "module" }, meta_merge => { "meta-spec" => { version => "2" }, resources => { bugtracker => { mailto => "bug-Lexical-Var\@rt.cpan.org", web => "https://rt.cpan.org/Public/Dist/". "Display.html?Name=Lexical-Var", }, }, }, sign => 1, )->create_build_script; 1; Lexical-Var-0.010/Changes000444001750001750 2110314407273365 15234 0ustar00zeframzefram000000000000version 0.010; 2023-03-24 * bugfix: interact nicely with lexical subroutines on Perl 5.17.4 and above * bugfix: avoid overrunning Perl's value stack on threading Perl builds * bugfix: where cancellation of a lexical item is requested via unimportation, and a specific referent to cancel is given, don't cancel if the specific referent was previously set up but has been shadowed by a core lexical item * bugfix: require bugfixed version of Lexical::SealRequireHints (for more comprehensive coverage, for not breaking version-implied features, and for require argument context) * thread safety: use thread-safe wrap_op_checker() API to control op checking * thread safety: avoid using thread-unaware static storage to cache thread-specific Perl values * port to Perl 5.21.7 which made PADNAME a distinct type * update test suite to not rely on . in @INC, which is no longer necessarily there from Perl 5.25.7 * port to Perl 5.33.1, which defines a PERL_VERSION_GE() macro that clashes with the one this module previously had * in a couple of tests, work around a bug in Perl 5.37.4 (which was fixed in Perl 5.37.5) which caused false test failures * in documentation and error messages, make explicit distinction between Lexical::Var lexical variables/subroutines and core lexical variables/subroutines * use some pad API features more cleanly * be more conservative about the fake referent used when constructing references to lexically-established scalars * in a test, avoid a context problem when combining is_deeply and eval * future-proof pad handling for the possibility of PL_comppad being the target pad * put whitespace around C string literals being pasted, for C++11 compatibility * make ->unimport methods return an empty list * test that suppression of a lexical subroutine brings the package subroutine back into effect not just for calling, but also for the syntactic and semantic effects of prototypes * test with key/value array slices and key/value hash slices available from Perl 5.19.4 * test that pad operations work correctly around lexical imports from the builtin modle available from Perl 5.35.7 * test that pad operations work correctly around fields and $self in the new core class system available from Perl 5.37.9 * test superficially the ability to operate with threads * test that all modules have matching version numbers * don't apply the fake referent workaround for buggy core checking of rv2Xv ops on Perl 5.21.4 and above, where the bug has been fixed * in test suite, suppress shadowing warnings by category, rather than discarding all warnings * no longer include a Makefile.PL in the distribution * in documentation, use four-column indentation for all verbatim material * in META.{yml,json}, point to public bug tracker * delete undocumented partially-developed functions * in XS declare as const some data that never changes * update the manipulation of read-only flags to account for the SVf_PROTECT introduced in Perl 5.21.5, although the only code that manipulates those flags isn't actually used on Perl versions new enough to have the new flag * use new names for pad API items such as PadnameOURSTASH() * in XS, rename some poorly-named variables and functions * in XS, refactor Perl version comparisons * in XS, better argument parenthesisation in some macros * avoid some compiler warnings that arise on Perl 5.6 * rename internal gen_*_op() function into a better style * consistently use THX_ prefix on internal function names version 0.009; 2013-08-25 * update for perl 5.19.3's tracking of the last named item in a pad version 0.008; 2013-08-17 * update for perl 5.17.4's new pad API * update for perl 5.17.5's new arrangement for PL_compcv with BEGIN * in documentation, refer to the new module Scalar::Construct version 0.007; 2012-02-04 * bugfix: preserve referential identity of named constant scalars on threading Perl builds * bugfix: require bugfixed version of Lexical::SealRequireHints (for compatibility with early-loaded warnings.pm) and invoke it earlier to make sure it takes effect in time * in documentation, note the problems that threading Perls have with objects originating from source literals * in documentation, note that the problem with eval/require/do inside a BEGIN block is fixed in Perl 5.15.5 * in documentation, note that constant scalars participate in constant folding * fix an outdated documentation note about bareword subroutine calls * in documentation, tweak description of intended users * additional tests regarding const ops, constant folding, and object identity preservation * additional tests for the Lexical::Sub interface * in Build.PL, declare incompatibility with pre-0.19 B::Hooks::OP::Check, which doesn't play nicely around op check hooking * reorganise some of the test suite * convert .cvsignore to .gitignore * sort MANIFEST version 0.006; 2011-07-27 * bugfix: require bugfixed version of Lexical::SealRequireHints (for working around [perl #73174]) * in documentation, note problem with indirect object syntax and lexical subroutines * include META.json in distribution * add MYMETA.json to .cvsignore version 0.005; 2011-02-27 * port to Perl 5.13.10, where the value of PAD_MAX has changed * in XS, use gv_stashpvs() wherever appropriate * in XS, use PERL_NO_GET_CONTEXT for efficiency * in XS, declare "PROTOTYPES: DISABLE" to prevent automatic generation of unintended prototypes * jump through hoops to avoid compiler warnings * use full stricture in test suite * in test suite, 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, complete declaration of configure-time requirements version 0.004; 2010-04-11 * bugfix: require bugfixed version of Lexical::SealRequireHints (for passing package through to required code in pure-Perl version of Lexical::SealRequireHints) * in XS, use macros to avoid explicit passing of aTHX, in the manner of the core * add Lexical::Import to "see also" list * add MYMETA.yml to .cvsignore version 0.003; 2010-01-11 * fully support bareword subroutine references on Perl 5.11.2 and later * in XS, avoid using "class" as a variable name, for compatibility with C++ compilers * correct data type for the PAD_MAX constant * in Build.PL, explicitly declare configure-time requirements version 0.002; 2009-10-26 * port to Perl 5.11.0, supporting the addition of first-class regexp objects (which are actually a type of scalar) and the removal of the distinct RV type * where the compilation %^H and PL_compcv are unavailable due to string eval or similar, detect this earlier and regardless of the type of item being set up (previously it was not detected for subroutines or globs) * when a lexical scalar has readonly value, generate a const op instead of the usual rv2sv * document the problem of %^H and PL_compcv being unavailable due to string eval * preserve op flags when building new rv2Xv ops; this doesn't seem to matter in any currently achievable situation, but will be required for bareword subroutine references in the future * in XS, properly parenthesise some macro definitions * test writability of lexical variables * in t/error.t, check for unexpected warnings * add experimental code, all disabled, to support bareword subroutine references on a suitably modified Perl core version 0.001; 2009-09-30 * bugfix: make array and hash indexing work * bugfix: avoid core checks that would reject use of a glob as a scalar value * bugfix: avoid modifying the reference stored in the hint hash (which happened through reusing it in const ops) * bugfix: repair a reference leak in unimportation * bugfix: change a memNE() to strnNE(), to avoid reading off the end of a string * bugfix: require bugfixed version of Lexical::SealRequireHints (for fixes around usability of its pure-Perl implementation) * port to pre-5.10 Perls * more tests: Lexical::Sub, array and hash variables, glob variables, acceptability of value types for references to lexical variables, erroneous invocation of import and unimport * in XS, add some casts to avoid compiler warnings * check for required Perl version at runtime version 0.000; 2009-09-23 * initial released version Lexical-Var-0.010/MANIFEST000444001750001750 225014407273365 15054 0ustar00zeframzefram000000000000.gitignore Build.PL Changes MANIFEST META.json META.yml README lib/Lexical/Sub.pm lib/Lexical/Var.pm lib/Lexical/Var.xs t/array_ident.t t/array_ops.t t/array_scope.t t/array_type.t t/array_write.t t/code_bare.t t/code_bare_no.t t/code_const.t t/code_ident.t t/code_ops.t t/code_scope.t t/code_type.t t/error.t t/glob_ident.t t/glob_scope.t t/glob_type.t t/glob_write.t t/hash_ident.t t/hash_ops.t t/hash_scope.t t/hash_type.t t/hash_write.t t/import_return.t t/lib/t/code_0.pm t/lib/t/code_1.pm t/lib/t/code_2.pm t/lib/t/code_3.pm t/lib/t/code_4.pm t/lib/t/scalar_0.pm t/lib/t/scalar_0n.pm t/lib/t/scalar_1.pm t/lib/t/scalar_2.pm t/lib/t/scalar_3.pm t/lib/t/scalar_4.pm t/lib/t/scalar_4n.pm t/lib/t/setup_c_4.pm t/lib/t/setup_c_5.pm t/lib/t/setup_c_6.pm t/lib/t/setup_c_7.pm t/lib/t/setup_s_4.pm t/lib/t/setup_s_5.pm t/lib/t/setup_s_6.pm t/lib/t/setup_s_7.pm t/once.t t/pod_cvg.t t/pod_syn.t t/scalar_const.t t/scalar_ident.t t/scalar_scope.t t/scalar_type.t t/scalar_write.t t/setup_code.t t/setup_scalar.t t/sub_bare.t t/sub_bare_no.t t/sub_const.t t/sub_ident.t t/sub_ops.t t/sub_scope.t t/sub_type.t t/threads.t t/uncover_code.t t/version_synch.t SIGNATURE Added here by Module::Build Lexical-Var-0.010/META.json000444001750001750 340214407273365 15344 0ustar00zeframzefram000000000000{ "abstract" : "static variables without namespace pollution", "author" : [ "Andrew Main (Zefram) " ], "dynamic_config" : 0, "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-Var", "prereqs" : { "build" : { "requires" : { "ExtUtils::CBuilder" : "0.15", "Module::Build" : "0", "Test::More" : "0", "if" : "0", "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" }, "requires" : { "Lexical::SealRequireHints" : "0.012", "XSLoader" : "0", "perl" : "5.006", "strict" : "0", "warnings" : "0" } } }, "provides" : { "Lexical::Sub" : { "file" : "lib/Lexical/Sub.pm", "version" : "0.010" }, "Lexical::Var" : { "file" : "lib/Lexical/Var.pm", "version" : "0.010" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-Lexical-Var@rt.cpan.org", "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=Lexical-Var" }, "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "0.010", "x_serialization_backend" : "JSON::PP version 2.93" } Lexical-Var-0.010/META.yml000444001750001750 205014407273365 15172 0ustar00zeframzefram000000000000--- abstract: 'static variables without namespace pollution' author: - 'Andrew Main (Zefram) ' build_requires: ExtUtils::CBuilder: '0.15' Module::Build: '0' Test::More: '0' if: '0' 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: 0 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-Var provides: Lexical::Sub: file: lib/Lexical/Sub.pm version: '0.010' Lexical::Var: file: lib/Lexical/Var.pm version: '0.010' requires: Lexical::SealRequireHints: '0.012' XSLoader: '0' perl: '5.006' strict: '0' warnings: '0' resources: bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Lexical-Var license: http://dev.perl.org/licenses/ version: '0.010' x_serialization_backend: 'CPAN::Meta::YAML version 0.012' Lexical-Var-0.010/README000444001750001750 563214407273365 14612 0ustar00zeframzefram000000000000NAME Lexical::Var - static variables without namespace pollution DESCRIPTION This module implements lexical scoping of static variables and subroutines. Although it can be used directly, it is mainly intended to be infrastructure for modules that manage namespaces. This module influences the meaning of single-part variable names that appear directly in code, such as "$foo". Normally, in the absence of any particular declaration, or under the effect of an "our" declaration, this would refer to the scalar variable of that name located in the current package. A "Lexical::Var" declaration can change this to refer to any particular scalar, bypassing the package system entirely. A variable name that includes an explicit package part, such as "$main::foo", always refers to the variable in the specified package, and is unaffected by this module. A symbolic reference through a string value, such as "${'foo'}", also looks in the package system, and so is unaffected by this module. The types of name that can be influenced are scalar ("$foo"), array ("@foo"), hash ("%foo"), subroutine ("&foo"), and glob ("*foo"). A definition for any of these names also affects code that logically refers to the same entity, even when the name is spelled without its usual sigil. For example, any definition of "@foo" affects element references such as "$foo[0]". Barewords in filehandle context actually refer to the glob variable. Bareword references to subroutines, such as "foo(123)", only work on Perl 5.11.2 and later; on earlier Perls you must use the "&" sigil, as in "&foo(123)". Where a scalar name is defined to refer to a constant (read-only) scalar, references to the constant through the lexical namespace can participate in compile-time constant folding. This can avoid the need to check configuration values (such as whether debugging is enabled) at runtime. A name definition supplied by this module takes effect from the end of the definition statement up to the end of the immediately enclosing block, except where it is shadowed within a nested block. This is the same lexical scoping that the "my", "our", and "state" keywords supply. Definitions from Lexical::Var and from "my"/"our"/"state" can shadow each other (except that Lexical::Var can't shadow a "my"/"our"/"state" subroutine prior to Perl 5.19.1). These lexical definitions propagate into string "eval"s, on Perl versions that support it (5.9.3 and later). This module only manages variables of static duration (the kind of duration that "our" and "state" variables have). To get a fresh variable for each invocation of a function, use "my". INSTALLATION perl Build.PL ./Build ./Build test ./Build install AUTHOR Andrew Main (Zefram) COPYRIGHT Copyright (C) 2009, 2010, 2011, 2012, 2013, 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-Var-0.010/SIGNATURE000644001750001750 1570514407273375 15243 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 dcace786e97621a538f278622c51bc5b4800dda8b1aa17548161862076c29440 .gitignore SHA256 7e221e0e6eec6a4a1a6980070462deabadac8899d68f2322b78450563f994a33 Build.PL SHA256 416df6a5d92c4514d35b72601149f20798177abea020c93dc696fd3cd84f411f Changes SHA256 638edaba00f4c5b01c2603b3833018361619ca998c402af9aa0227caeb57e1e2 MANIFEST SHA256 7e1771a594630c3cd0bd7919f2dafe2413a0ab69b6e94da38345b56cacf14e71 META.json SHA256 7757ff66877f4556e9afc01e22ca062d2e23919aced8bac6409a44749bd75ca5 META.yml SHA256 d71119585404c47139853db214bd9305c237fe976c6f5ef212203e5e0e934abc README SHA256 cabd79db6d3d67c3fd96bd332a07557af00eb95b5e0853a0fe2e4ffcdec3be59 lib/Lexical/Sub.pm SHA256 d8b5124bc558b92157e49b2b14243d11c70cf03d3c9cb4ec431cbd1f891c654c lib/Lexical/Var.pm SHA256 f5108044449c58b36dd250a4199f288f38417abf6eae580fdb69bdfe9b2bdb6f lib/Lexical/Var.xs SHA256 45eb528850e28e4851e26ab541bf52126b0407d52648936120e9e08aa0ff42e3 t/array_ident.t SHA256 f951db338590e4cbc8940b1dd2d384168d22334ad1d52ce677bad7028475f8f2 t/array_ops.t SHA256 82ea6058e1b3b975a2ef17d36755fde9dc811951e69c52c74472025fb6e78035 t/array_scope.t SHA256 2d269000236e104c972a07b2e0ed185ce9c306073b28ef560cb4e66090603fe0 t/array_type.t SHA256 a9bf8f055dad955fc369fd3dcd6e96edf35176f62dcf4de215943111c2233c39 t/array_write.t SHA256 1256e62c3be6477493f6766570384c31933038ef0c5d174a4053c0ab1fbfda14 t/code_bare.t SHA256 e746129ae3b4dd68ad8d425f5f183b7b34a8935568a82e11bd6edacefde80815 t/code_bare_no.t SHA256 de4ab1dcecd4d892eae3de4d1f6f7f1e6410aaea9881ea5fd5ec1100e3437278 t/code_const.t SHA256 2b762ed3ad459d4ac27fb4eccba93bfefe366315e4061a786b0783e9cff2160b t/code_ident.t SHA256 50d01cebacbde78402cc2a7a7c3ef69eeed95fdec8885e8e681c207880a731d7 t/code_ops.t SHA256 3007ac333f39da03148db814f57edb49165f39d7cba14276fb63424b43290dbf t/code_scope.t SHA256 d0e561c29eb57123f73fc16157378cd7855ebee881f01b532eabe9fe0ea43ec0 t/code_type.t SHA256 bfcdc53736c436784dcb0d7e3865079b1dadc1e611ee9289a14b46dc6dad66a6 t/error.t SHA256 1ce192d9f511733e6c3ee1ca03bff6a495eced9cdfb5ccf1f5072d1e6a7f9643 t/glob_ident.t SHA256 6f5f8a0e78b18329f071d2d7b78313ffcc04cd5af1046b00e4e73d167ac41a03 t/glob_scope.t SHA256 e693e77c3cdbf61289ee175f865e43efbf4a399e6c95794a1e1b7438e1364562 t/glob_type.t SHA256 20e437c8a261a4927543baf82c1002eab707bc380fb81ecae3ec5a6677ef7127 t/glob_write.t SHA256 b5232532018d771b7e539f426525ef13d25547908b045409b74ce781807f9fdd t/hash_ident.t SHA256 c256b61fdc72f06b23e191202e08767f8f5e94e979580e72d3bfe66b166cd124 t/hash_ops.t SHA256 fab1af21ab45cd1f3d3d72ce3f7aef57cc57a526780b29764d54cfecbb147044 t/hash_scope.t SHA256 71b2898a7bbf9058b5877c98b0896750aea7c1261262d5e7df785cc3078ac924 t/hash_type.t SHA256 cbf04441f6ed1eb080cb59aea09c889b4177be4db68a68759b8654e94f072a8d t/hash_write.t SHA256 a528f432151994b88ceb5275918022bb873a7b7d5b7987bb6613ab1f87f96290 t/import_return.t SHA256 97f979d4b083edcf57e493ea5f4b0b097c6f6ed12df706e8d7585c46f903cadd t/lib/t/code_0.pm SHA256 2f33c02f03cf18f87b0cf28bf356f317de827d2b54b788bb139924aa2eb8a76a t/lib/t/code_1.pm SHA256 b176f35531513bd724b4f75c46de4e87a69da16e8c95a06b7042a2269e7494f9 t/lib/t/code_2.pm SHA256 1ac1ca6506eb3ee2b30644882a2e27495eb8004fda6c6871e824bab2097bfab3 t/lib/t/code_3.pm SHA256 a3079615b2e34ae0023e27e52fd3f04a38e6dc19600c4a45ac04c75bf302855b t/lib/t/code_4.pm SHA256 ed0277c45421b18d49619b0ded6a3ff74eeda54a39181d1ea9023b286b80c43a t/lib/t/scalar_0.pm SHA256 723dda24c34b45e91cde080a4ba55d3163fb44419dfaa4982b2cd3b8d7ac08e9 t/lib/t/scalar_0n.pm SHA256 0f31717527642fc7c4ef183b0418666d825af8f404249423b2329d4638171e00 t/lib/t/scalar_1.pm SHA256 54d62146855c2c6eaca5064863419ffedcb56b51cfb606ba8a8b2ac594e0de1a t/lib/t/scalar_2.pm SHA256 60b18e81b07ec43e147ffc011ab82c5afb89f7b8d02dbfd84d930e2120ef87c9 t/lib/t/scalar_3.pm SHA256 df109797ba1cad363de84c56f657bd1cd7f72b86980e6398fffc24de8769ebe7 t/lib/t/scalar_4.pm SHA256 7430789684a1d409bb4f5d2b78f6ea07259528b6ae59a5578ff87f01e416a1ff t/lib/t/scalar_4n.pm SHA256 c5bff484b6b404ae9f663fa8fb19d5ac6107656cd72f14e98e5451b7adfa4506 t/lib/t/setup_c_4.pm SHA256 055e4c6dbc56b203da6a6eb104fc74af28e6b901ac14855e3d70d1933b7820e3 t/lib/t/setup_c_5.pm SHA256 acd97c43fdc404796724832c3ee7484037452d08904323cd59d6e2f6f537b5a2 t/lib/t/setup_c_6.pm SHA256 334b80b5d3ebc53a82b91f539430cd33e741f36cdf0ea2b71c0c51633637e5a4 t/lib/t/setup_c_7.pm SHA256 b22b665921af2136bdb1a040a3b7c02462175f006fbfadd9d8215364ec5eda84 t/lib/t/setup_s_4.pm SHA256 4b9920dbc4d34871fc873ae859c550d4d1a541dfd34ec54efbdae3769cffd4ec t/lib/t/setup_s_5.pm SHA256 6c07a764ecf2a610211271613931381d1e54859984b4f239be3753559c1ca666 t/lib/t/setup_s_6.pm SHA256 47f764c7d7d81f5ed5ac19d207aa015d561a1b59002315ff4d9e8883a71ed8cd t/lib/t/setup_s_7.pm SHA256 ba27e85f48a771aaa359ba67e0de20adbdccb28e1e5a2f314d86267a936c94c6 t/once.t SHA256 3679257bdfb4a07658e98a41325f82c1744f7dae6d1d0151f1b216af0c1df5c9 t/pod_cvg.t SHA256 e16860066c4ca9b2ee9e7d4604297def8a58b53bf0ca03eed863b5d9c5a2ac91 t/pod_syn.t SHA256 4f98a10f74725f7147c03d9e9fafc3bc812bfc3eedda1bb0f5c3e10c6f2ec148 t/scalar_const.t SHA256 31e230d56d5a25152b438baf835b64dcde69591df4f81bd59f6a24a2ff2484ca t/scalar_ident.t SHA256 b83aee5929b4aaf7abd2e23870cdb0f4ac5cd9c56597d529eb4ffdce3a75d346 t/scalar_scope.t SHA256 b65915faf9cd26ee34036ee6c282d6bed058daf80ff66190229c8cd7429e2ba5 t/scalar_type.t SHA256 668e94839156a069021b39161d86b32c7a8282278a11c55a5bf63cd48a67b0f6 t/scalar_write.t SHA256 a86ab7d8494b8cd87ab688f3495576e678062e65aed5c755335bb59d18a027a4 t/setup_code.t SHA256 8fb49ce7b8089fe949cbc6179529e09c9eeeda5455f3f29d3989f2af588770d1 t/setup_scalar.t SHA256 adfd42241dcf8132107e4324f31c11cf0f5ac94b346faeca9455853550dd5f16 t/sub_bare.t SHA256 7125b8013171919b1001b160d16b67a3f073f6bda7e2e245addc6bfec5948676 t/sub_bare_no.t SHA256 a67c9b827d76d69c1fb984ccbf8d37c13423aaba62094153148705e3031e4140 t/sub_const.t SHA256 b0e4c0c32c80a719eefe69ec5115a77fe43a79762ab78a94898c9cd7e5957022 t/sub_ident.t SHA256 583a8d4277a788a2750a352ea7e81cd76bf7dae23a493a9e9c87e0213fb9121e t/sub_ops.t SHA256 f10dbcbbe16010076efae48b9185b6a662a8fdc709c28070b21bd5801db668b8 t/sub_scope.t SHA256 09f22666d7c9410887a1e1202e81b3b39d9cc442bbe13bbfca63d489ae663529 t/sub_type.t SHA256 4903c405c8d7413ece168d2162c8d342b31a3c1e9684e4ae0bc6c81ed2e612f4 t/threads.t SHA256 814f2cc65a2cc48beb8f3d08dfa9e199f2fdc4923c3cd9cc525ec8cba93a4f66 t/uncover_code.t SHA256 77ba1182d1c4e1f8d8c93a84637afa655831a5924b7dfefb32e06529ca1e2a43 t/version_synch.t -----BEGIN PGP SIGNATURE----- iEYEAREDAAYFAmQddvUACgkQOV9mt2VyAVGWJACfaU3K+NbXWSJDDsKXbxxDLCOi 5gUAoJQSsmbBuR12nSdQ1r5EuZjHWp1J =aT4V -----END PGP SIGNATURE----- Lexical-Var-0.010/lib000755001750001750 014407273365 14335 5ustar00zeframzefram000000000000Lexical-Var-0.010/lib/Lexical000755001750001750 014407273365 15716 5ustar00zeframzefram000000000000Lexical-Var-0.010/lib/Lexical/Sub.pm000444001750001750 1514314407273365 17166 0ustar00zeframzefram000000000000=head1 NAME Lexical::Sub - subroutines without namespace pollution =head1 SYNOPSIS use Lexical::Sub quux => sub { $_[0] + 1 }; use Lexical::Sub carp => \&Carp::carp; =head1 DESCRIPTION This module implements lexical scoping of subroutines. Although it can be used directly, it is mainly intended to be infrastructure for modules that manage namespaces. This module influences the meaning of single-part subroutine names that appear directly in code, such as "C<&foo>" and "C". Normally, in the absence of any particular declaration, these would refer to the subroutine of that name located in the current package. A C declaration can change this to refer to any particular subroutine, bypassing the package system entirely. A subroutine name that includes an explicit package part, such as "C<&main::foo>", always refers to the subroutine in the specified package, and is unaffected by this module. A symbolic reference through a string value, such as "C<&{'foo'}>", also looks in the package system, and so is unaffected by this module. Bareword references to subroutines, such as "C", only work on Perl 5.11.2 and later. On earlier Perls you must use the C<&> sigil, as in "C<&foo(123)>". A name definition supplied by this module takes effect from the end of the definition statement up to the end of the immediately enclosing block, except where it is shadowed within a nested block. This is the same lexical scoping that the C, C, and C keywords supply. Definitions from L and from C/C/C can shadow each other, on Perl versions where these duration keywords can be applied to subroutines (5.17.4 and later), except that L can't shadow a C/C/C subroutine prior to Perl 5.19.1. These lexical definitions propagate into string Cs, on Perl versions that support it (5.9.3 and later). This module only manages subroutines of static duration (the kind of duration that subroutines declared without C have). To get a fresh subroutine for each invocation of a function, use C, on a Perl version that supports it (5.17.4 and later). This module is implemented through the mechanism of L. Its distinct name and declaration syntax exist to make L lexical subroutine declarations clearer. =cut package Lexical::Sub; { use 5.006; } use warnings; use strict; our $VERSION = "0.010"; require Lexical::Var; die "mismatched versions of Lexical::Var and Lexical::Sub modules" unless $Lexical::Var::VERSION eq $VERSION; =head1 PACKAGE METHODS These methods are meant to be invoked on the C package. =over =item Lexical::Sub->import(NAME => REF, ...) Sets up lexical subroutine declarations, in the lexical environment that is currently compiling. Each I must be a bare subroutine name (e.g., "B"), and each I must be a reference to a subroutine. The name is lexically associated with the referenced subroutine. =item Lexical::Sub->unimport(NAME [=> REF], ...) Sets up negative lexical subroutine declarations, in the lexical environment that is currently compiling. Each I must be a bare subroutine name (e.g., "B"). If the name is given on its own, it is lexically dissociated from any subroutine. Within the resulting scope, the subroutine name will not be recognised. If a I (which must be a reference to a subroutine) is specified with a name, the name will be dissociated if and only if it is currently associated with that subroutine. =back =head1 BUGS Subroutine invocations without the C<&> sigil cannot be correctly processed on Perl versions earlier than 5.11.2. This is because the parser needs to look up the subroutine early, in order to let any prototype affect parsing, and it looks up the subroutine by a different mechanism than is used to generate the call op. (Some forms of sigilless call have other complications of a similar nature.) If an attempt is made to call a L lexical subroutine via a bareword on an older Perl, this module will probably still be able to intercept the call op, and will throw an exception to indicate that the parsing has gone wrong. However, in some cases compilation goes further wrong before this module can catch it, resulting in either a confusing parse error or (in rare situations) silent compilation to an incorrect op sequence. On Perl 5.11.2 and later, sigilless subroutine calls work correctly, except for an issue noted below. Subroutine calls that have neither sigil nor parentheses (around the argument list) are subject to an ambiguity with indirect object syntax. If the first argument expression begins with a bareword or a scalar variable reference then the Perl parser is liable to interpret the call as an indirect method call. Normally this syntax would be interpreted as a subroutine call if the subroutine exists, but the parser doesn't look at lexically-defined subroutines for this purpose. The call interpretation can be forced by prefixing the first argument expression with a C<+>, or by wrapping the whole argument list in parentheses. In the earlier Perl versions that support C/C/C subroutines, starting from Perl 5.17.4, the mechanism for core lexical subroutines suffers a couple of bugs that mean that L can't shadow subroutines declared that way. This was fixed in Perl 5.19.1. Package hash entries get created for subroutine names that are used, even though the subroutines are not actually being stored or looked up in the package. This can occasionally result in a "used only once" warning failing to occur when it should. On Perls prior to 5.15.5, if this package's C or C method is called from inside a string C inside a C block, it does not have proper access to the compiling environment, and will complain that it is being invoked outside compilation. Calling from the body of a Cd or Ced file causes the same problem on the same Perl versions. Other kinds of indirection within a C block, such as calling via a normal function, do not cause this problem. When judging whether the C method should hide a subroutine, this module can't distinguish between a lexical subroutine established by this module and a C subroutine. This may change in the future. =head1 SEE ALSO L, L =head1 AUTHOR Andrew Main (Zefram) =head1 COPYRIGHT Copyright (C) 2009, 2010, 2011, 2012, 2013, 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-Var-0.010/lib/Lexical/Var.pm000444001750001750 2110514407273365 17160 0ustar00zeframzefram000000000000=head1 NAME Lexical::Var - static variables without namespace pollution =head1 SYNOPSIS use Lexical::Var '$foo' => \$Remote::foo; use Lexical::Var '$const' => \123; use Lexical::Var '@bar' => []; use Lexical::Var '%baz' => { a => 1, b => 2 }; use Lexical::Var '&quux' => sub { $_[0] + 1 }; use Lexical::Var '*wibble' => Symbol::gensym(); =head1 DESCRIPTION This module implements lexical scoping of static variables and subroutines. Although it can be used directly, it is mainly intended to be infrastructure for modules that manage namespaces. This module influences the meaning of single-part variable names that appear directly in code, such as "C<$foo>". Normally, in the absence of any particular declaration, or under the effect of an C declaration, this would refer to the scalar variable of that name located in the current package. A C declaration can change this to refer to any particular scalar, bypassing the package system entirely. A variable name that includes an explicit package part, such as "C<$main::foo>", always refers to the variable in the specified package, and is unaffected by this module. A symbolic reference through a string value, such as "C<${'foo'}>", also looks in the package system, and so is unaffected by this module. The types of name that can be influenced are scalar ("C<$foo>"), array ("C<@foo>"), hash ("C<%foo>"), subroutine ("C<&foo>"), and glob ("C<*foo>"). A definition for any of these names also affects code that logically refers to the same entity, even when the name is spelled without its usual sigil. For example, any definition of "C<@foo>" affects element references such as "C<$foo[0]>". Barewords in filehandle context actually refer to the glob variable. Bareword references to subroutines, such as "C", only work on Perl 5.11.2 and later; on earlier Perls you must use the C<&> sigil, as in "C<&foo(123)>". Where a scalar name is defined to refer to a constant (read-only) scalar, references to the constant through the lexical namespace can participate in compile-time constant folding. This can avoid the need to check configuration values (such as whether debugging is enabled) at runtime. A name definition supplied by this module takes effect from the end of the definition statement up to the end of the immediately enclosing block, except where it is shadowed within a nested block. This is the same lexical scoping that the C, C, and C keywords supply. Definitions from L and from C/C/C can shadow each other (except that L can't shadow a C/C/C subroutine prior to Perl 5.19.1). These lexical definitions propagate into string Cs, on Perl versions that support it (5.9.3 and later). This module only manages variables of static duration (the kind of duration that C and C variables have). To get a fresh variable for each invocation of a function, use C. =cut package Lexical::Var; { use 5.006; } use Lexical::SealRequireHints 0.012; use warnings; use strict; our $VERSION = "0.010"; require XSLoader; XSLoader::load(__PACKAGE__, $VERSION); =head1 PACKAGE METHODS These methods are meant to be invoked on the C package. =over =item Lexical::Var->import(NAME => REF, ...) Sets up lexical variable declarations, in the lexical environment that is currently compiling. Each I must be a variable name (e.g., "B<$foo>") including sigil, and each I must be a reference to a variable/value of the appropriate type. The name is lexically associated with the referenced variable/value. L can be helpful in generating appropriate Is, especially to create constants. There are Perl core bugs to beware of around compile-time constants; see L. =item Lexical::Var->unimport(NAME [=> REF], ...) Sets up negative lexical variable declarations, in the lexical environment that is currently compiling. Each I must be a variable name (e.g., "B<$foo>") including sigil. If the name is given on its own, it is lexically dissociated from any value. Within the resulting scope, the variable name will not be recognised. If a I (which must be a reference to a value of the appropriate type) is specified with a name, the name will be dissociated if and only if it is currently associated with that value. =back =head1 BUGS Subroutine invocations without the C<&> sigil cannot be correctly processed on Perl versions earlier than 5.11.2. This is because the parser needs to look up the subroutine early, in order to let any prototype affect parsing, and it looks up the subroutine by a different mechanism than is used to generate the call op. (Some forms of sigilless call have other complications of a similar nature.) If an attempt is made to call a L lexical subroutine via a bareword on an older Perl, this module will probably still be able to intercept the call op, and will throw an exception to indicate that the parsing has gone wrong. However, in some cases compilation goes further wrong before this module can catch it, resulting in either a confusing parse error or (in rare situations) silent compilation to an incorrect op sequence. On Perl 5.11.2 and later, sigilless subroutine calls work correctly, except for an issue noted below. Subroutine calls that have neither sigil nor parentheses (around the argument list) are subject to an ambiguity with indirect object syntax. If the first argument expression begins with a bareword or a scalar variable reference then the Perl parser is liable to interpret the call as an indirect method call. Normally this syntax would be interpreted as a subroutine call if the subroutine exists, but the parser doesn't look at lexically-defined subroutines for this purpose. The call interpretation can be forced by prefixing the first argument expression with a C<+>, or by wrapping the whole argument list in parentheses. In the earlier Perl versions that support C/C/C subroutines, starting from Perl 5.17.4, the mechanism for core lexical subroutines suffers a couple of bugs that mean that L can't shadow subroutines declared that way. This was fixed in Perl 5.19.1. On Perls built for threading (even if threading is not actually used), scalar constants that are defined by literals in the Perl source don't reliably maintain their object identity. What appear to be multiple references to a single object can end up behaving as references to multiple objects, in surprising ways. The multiple objects all initially have the correct value, but they can be writable even though the original object is a constant. See Perl bug reports [perl #109744] and [perl #109746]. This can affect objects that are placed in the lexical namespace, just as it can affect those in package namespaces or elsewhere. C avoids contributing to the problem itself, but certain ways of building the parameters to C can result in the object in the lexical namespace not being the one that was intended, or can damage the named object so that later referencing operations on it misbehave. L can be used to avoid this problem. Bogus redefinition warnings occur in some cases when C declarations and C declarations shadow each other. Package hash entries get created for subroutine and glob names that are used, even though the subroutines and globs are not actually being stored or looked up in the package. This can occasionally result in a "used only once" warning failing to occur when it should. On Perls prior to 5.15.5, if this package's C or C method is called from inside a string C inside a C block, it does not have proper access to the compiling environment, and will complain that it is being invoked outside compilation. Calling from the body of a Cd or Ced file causes the same problem on the same Perl versions. Other kinds of indirection within a C block, such as calling via a normal function, do not cause this problem. When judging whether the C method should hide a subroutine, this module can't distinguish between a lexical subroutine established by this module and a C subroutine. This may change in the future. =head1 SEE ALSO L, L, L, L =head1 AUTHOR Andrew Main (Zefram) =head1 COPYRIGHT Copyright (C) 2009, 2010, 2011, 2012, 2013, 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-Var-0.010/lib/Lexical/Var.xs000444001750001750 7457514407273365 17221 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)) #define Q_PERL_VERSION_LT(r,v,s) \ (Q_PERL_DECIMAL_VERSION < Q_PERL_VERSION_DECIMAL(r,v,s)) #if Q_PERL_VERSION_LT(5,7,2) # undef dNOOP # define dNOOP extern int Perl___notused_func(void) #endif /* <5.7.2 */ #if Q_PERL_VERSION_LT(5,37,11) # undef NOOP # define NOOP ((void)0) #endif /* <5.37.11 */ #ifndef PERL_UNUSED_VAR # define PERL_UNUSED_VAR(x) ((void)(x)) #endif /* !PERL_UNUSED_VAR */ #ifndef PERL_UNUSED_ARG # define PERL_UNUSED_ARG(x) PERL_UNUSED_VAR(x) #endif /* !PERL_UNUSED_ARG */ #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 */ #if Q_PERL_VERSION_LT(5,9,3) # define SVt_LAST (SVt_PVIO+1) #endif /* <5.9.3 */ #ifdef SVf_PROTECT # define SvREADONLY_fully_on(sv) (SvFLAGS(sv) |= SVf_READONLY|SVf_PROTECT) # define SvREADONLY_fully_off(sv) (SvFLAGS(sv) &= ~(SVf_READONLY|SVf_PROTECT)) # define SvREADONLY_slightly_on(sv) (SvFLAGS(sv) |= SVf_READONLY) # define SvREADONLY_slightly_off(sv) (SvFLAGS(sv) &= ~SVf_READONLY) #else /* !SVf_PROTECT */ # define SvREADONLY_fully_on(sv) SvREADONLY_on(sv) # define SvREADONLY_fully_off(sv) SvREADONLY_off(sv) # define SvREADONLY_slightly_on(sv) SvREADONLY_on(sv) # define SvREADONLY_slightly_off(sv) SvREADONLY_off(sv) #endif /* !SVf_PROTECT */ #ifndef sv_setpvs # define sv_setpvs(SV, STR) sv_setpvn(SV, "" STR "", sizeof(STR)-1) #endif /* !sv_setpvs */ #ifndef gv_stashpvs # define gv_stashpvs(name, flags) gv_stashpvn("" name "", sizeof(name)-1, flags) #endif /* !gv_stashpvs */ #ifndef newSV_type # define newSV_type(type) THX_newSV_type(aTHX_ type) static SV *THX_newSV_type(pTHX_ svtype type) { SV *sv = newSV(0); (void) SvUPGRADE(sv, type); return sv; } #endif /* !newSV_type */ #ifndef PadnameIsOUR # ifdef SvPAD_OUR # define PadnameIsOUR(pn) SvPAD_OUR(pn) # else /* !SvPAD_OUR */ # define PadnameIsOUR(pn) (SvFLAGS(pn) & SVpad_OUR) # endif /* !SvPAD_OUR */ #endif /* !PadnameIsOUR */ #ifndef PadnameIsOUR_on # ifdef SvPAD_OUR_on # define PadnameIsOUR_on(pn) SvPAD_OUR_on(pn) # else /* !SvPAD_OUR_on */ # define PadnameIsOUR_on(pn) (SvFLAGS(pn) |= SVpad_OUR) # endif /* !SvPAD_OUR_on */ #endif /* !PadnameIsOUR_on */ #ifndef PadnameOURSTASH # ifdef SvOURSTASH # define PadnameOURSTASH(pn) SvOURSTASH(pn) # elif defined(OURSTASH) # define PadnameOURSTASH(pn) OURSTASH(pn) # else /* !SvOURSTASH && !OURSTASH */ # define PadnameOURSTASH(pn) GvSTASH(pn) # endif /* !SvOURSTASH && !OURSTASH */ #endif /* !PadnameOURSTASH */ #ifndef PadnameOURSTASH_set # ifdef SvOURSTASH_set # define PadnameOURSTASH_set(pn, st) SvOURSTASH_set(pn, st) # elif defined(OURSTASH_set) # define PadnameOURSTASH_set(pn, st) OURSTASH_set(pn, st) # else /* !SvOURSTASH_set && !OURSTASH_set */ # define PadnameOURSTASH_set(pn, st) (GvSTASH(pn) = (st)) # endif /* !SvOURSTASH_set && !OURSTASH_set */ #endif /* !PadnameOURSTASH_set */ #ifndef PadnameIsSTATE # ifdef SvPAD_STATE # define PadnameIsSTATE(pn) SvPAD_STATE(pn) # else /* !SvPAD_STATE */ # define PadnameIsSTATE(pn) 0 # endif /* !SvPAD_STATE */ #endif /* !PadnameIsSTATE */ #ifndef PadnameIsSTATE_on # ifdef SvPAD_STATE_on # define PadnameIsSTATE_on(pn) SvPAD_STATE_on(pn) # endif /* SvPAD_STATE_on */ #endif /* !PadnameIsSTATE_on */ #ifndef PadMAX # define PadlistARRAY(pl) ((PAD**)AvARRAY(pl)) # define PadlistNAMES(pl) (PadlistARRAY(pl)[0]) # define PadMAX(p) AvFILLp(p) # define PadARRAY(p) AvARRAY(p) typedef SV PADNAME; typedef AV PADNAMELIST; #endif /* !PadMAX */ #ifndef PadnamePV # define PadnamePV(pn) (SvPOK(pn) ? SvPVX(pn) : NULL) #endif /* !PadnamePV */ #ifndef PadnameLEN # define PadnameLEN(pn) SvCUR(pn) #endif /* !PadnameLEN */ #ifndef PadnameOUTER # define PadnameOUTER(pn) SvFAKE(pn) #endif /* !PadnameOUTER */ #if Q_PERL_VERSION_LT(5,8,1) typedef AV PADLIST; typedef AV PAD; #endif /* <5.8.1 */ #ifndef newPADNAMEpvn # if Q_PERL_VERSION_GE(5,9,4) # define SVt_PADNAME SVt_PVMG # else /* <5.9.4 */ # define SVt_PADNAME SVt_PVGV # endif /* <5.9.4 */ # define newPADNAMEpvn(pv, len) THX_newPADNAMEpvn(aTHX_ pv, len) static PADNAME *THX_newPADNAMEpvn(pTHX_ char const *pv, STRLEN len) { PADNAME *name = newSV_type(SVt_PADNAME); sv_setpvn(name, pv, len); return name; } #endif /* !newPADNAMEpvn */ #ifndef padnamelist_store # define padnamelist_store av_store #endif /* !padnamelist_store */ #ifndef padnamelist_fetch # define padnamelist_fetch(pnl, off) THX_padnamelist_fetch(aTHX_ pnl, off) static PADNAME *THX_padnamelist_fetch(pTHX_ PADNAMELIST *pnl, PADOFFSET off) { SV **rp = av_fetch(pnl, off, 0); return rp ? *rp : NULL; } #endif /* !padnamelist_fetch */ #ifndef COP_SEQ_RANGE_LOW # if Q_PERL_VERSION_GE(5,9,5) # define COP_SEQ_RANGE_LOW(sv) ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xlow # define COP_SEQ_RANGE_HIGH(sv) ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh # else /* <5.9.5 */ # define COP_SEQ_RANGE_LOW(sv) ((U32)SvNVX(sv)) # define COP_SEQ_RANGE_HIGH(sv) ((U32)SvIVX(sv)) # endif /* <5.9.5 */ #endif /* !COP_SEQ_RANGE_LOW */ #ifndef COP_SEQ_RANGE_LOW_set # if Q_PERL_VERSION_GE(5,21,7) # define COP_SEQ_RANGE_LOW_set(pn,val) \ do { (pn)->xpadn_low = (val); } while(0) # define COP_SEQ_RANGE_HIGH_set(pn,val) \ do { (pn)->xpadn_high = (val); } while(0) # elif Q_PERL_VERSION_GE(5,9,5) # define COP_SEQ_RANGE_LOW_set(sv,val) \ do { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xlow = (val); } while(0) # define COP_SEQ_RANGE_HIGH_set(sv,val) \ do { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = (val); } while(0) # else /* <5.9.5 */ # define COP_SEQ_RANGE_LOW_set(sv,val) SvNV_set(sv, val) # define COP_SEQ_RANGE_HIGH_set(sv,val) SvIV_set(sv, val) # endif /* <5.9.5 */ #endif /* !COP_SEQ_RANGE_LOW_set */ #ifndef PadnameIN_SCOPE # define PadnameIN_SCOPE(pn, seq) THX_PadnameIN_SCOPE(aTHX_ pn, seq) static int THX_PadnameIN_SCOPE(pTHX_ PADNAME const *pn, U32 seq) { U32 lowseq = COP_SEQ_RANGE_LOW(pn); U32 highseq = COP_SEQ_RANGE_HIGH(pn); PERL_UNUSED_THX(); # if Q_PERL_VERSION_GE(5,13,10) if(lowseq == PERL_PADSEQ_INTRO) { return 0; } else if(highseq == PERL_PADSEQ_INTRO) { return seq > lowseq ? (seq - lowseq) < (U32_MAX>>1) : (lowseq - seq) > (U32_MAX>>1); } else { return lowseq > highseq ? seq > lowseq || seq <= highseq : seq > lowseq && seq <= highseq; } # else /* <5.13.10 */ return seq > lowseq && seq <= highseq; # endif /* <5.13.10 */ } #endif /* !PadnameIN_SCOPE */ #ifndef COP_SEQMAX_INC # if Q_PERL_VERSION_GE(5,13,10) # define COP_SEQMAX_INC \ do { \ PL_cop_seqmax++; \ if(PL_cop_seqmax == PERL_PADSEQ_INTRO) PL_cop_seqmax++; \ } while(0) # else /* <5.13.10 */ # define COP_SEQMAX_INC ((void)(PL_cop_seqmax++)) # endif /* <5.13.10 */ #endif /* !COP_SEQMAX_INC */ #ifndef SvRV_set # define SvRV_set(SV, VAL) (SvRV(SV) = (VAL)) #endif /* !SvRV_set */ #ifndef SVfARG # define SVfARG(p) ((void *)(p)) #endif /* !SVfARG */ #ifndef GV_NOTQUAL # define GV_NOTQUAL 0 #endif /* !GV_NOTQUAL */ #if Q_PERL_VERSION_LT(5,9,3) typedef OP *(*Perl_check_t)(pTHX_ OP *); #endif /* <5.9.3 */ #if Q_PERL_VERSION_LT(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) { 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 */ /* * scalar classification * * Logic borrowed from Params::Classify. */ #define sv_is_glob(sv) (SvTYPE(sv) == SVt_PVGV) #if Q_PERL_VERSION_GE(5,11,0) # define sv_is_regexp(sv) (SvTYPE(sv) == SVt_REGEXP) #else /* <5.11.0 */ # define sv_is_regexp(sv) 0 #endif /* <5.11.0 */ #define sv_is_string(sv) \ (!sv_is_glob(sv) && !sv_is_regexp(sv) && \ (SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK|SVp_IOK|SVp_NOK|SVp_POK))) #define Q_CODE_AS_STATE_IN_PAD Q_PERL_VERSION_GE(5,19,1) #define Q_CODE_OUTSIDE_PAD Q_PERL_VERSION_LT(5,17,4) #define Q_CODE_CLASHES_WITH_PAD (!Q_CODE_OUTSIDE_PAD && !Q_CODE_AS_STATE_IN_PAD) /* * newOP_const_identity() * * This function generate op that evaluates to a fixed object identity * and can also participate in constant folding. * * Lexical::Var generally needs to make ops that evaluate to fixed * identities, that being what a name that it handles represents. * Normally it can do this by means of an rv2xv op applied to a const op, * where the const op holds an RV that references the object of interest. * However, rv2xv can't undergo constant folding. Where the object is * a readonly scalar, we'd like it to take part in constant folding. * The obvious way to make it work as a constant for folding is to use a * const op that directly holds the object. However, in a Perl built for * ithreads, the value in a const op gets moved into the pad to achieve * clonability, and in the process the value may be copied rather than the * object merely rereferenced. Generally, the const op only guarantees * to provide a fixed *value*, not a fixed object identity. * * Where a const op might not preserve object identity, we can achieve * preservation by means of a customised variant of the const op. The op * directly holds an RV that references the object of interest, and its * variant pp function dereferences it (as rv2sv would). The pad logic * operates on the op structure as normal, and may copy the RV without * preserving its identity, which is OK because the RV isn't what we * need to preserve. Being labelled as a const op, it is eligible for * constant folding. When actually executed, it evaluates to the object * of interest, providing both fixed value and fixed identity. */ #ifdef USE_ITHREADS # define Q_USE_ITHREADS 1 #else /* !USE_ITHREADS */ # define Q_USE_ITHREADS 0 #endif /* !USE_ITHREADS */ #define Q_CONST_COPIES Q_USE_ITHREADS #if Q_CONST_COPIES static OP *THX_pp_const_via_ref(pTHX) { dSP; SV *reference_sv = cSVOPx_sv(PL_op); SV *referent_sv = SvRV(reference_sv); XPUSHs(referent_sv); RETURN; } #endif /* Q_CONST_COPIES */ #define newOP_const_identity(sv) THX_newOP_const_identity(aTHX_ sv) static OP *THX_newOP_const_identity(pTHX_ SV *sv) { #if Q_CONST_COPIES OP *op = newSVOP(OP_CONST, 0, newRV_noinc(sv)); op->op_ppaddr = THX_pp_const_via_ref; return op; #else /* !Q_CONST_COPIES */ return newSVOP(OP_CONST, 0, sv); #endif /* !Q_CONST_COPIES */ } /* * %^H key names */ #define KEYPREFIX "Lexical::Var/" #define KEYPREFIXLEN (sizeof(KEYPREFIX)-1) #define LVOURPREFIX "Lexical::Var::" #define LVOURPREFIXLEN (sizeof(LVOURPREFIX)-1) #define CHAR_IDSTART 0x01 #define CHAR_IDCONT 0x02 #define CHAR_SIGIL 0x10 #define CHAR_USEPAD 0x20 static U8 const char_attr[256] = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* NUL to BEL */ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* BS to SI */ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* DLE to ETB */ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* CAN to US */ 0x00, 0x00, 0x00, 0x00, 0x30, 0x30, Q_CODE_AS_STATE_IN_PAD ? 0x30 : 0x10, 0x00, /* SP to ' */ 0x00, 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, /* ( to / */ 0x02, 0x02, 0x02, 0x02, 0x02, 0x02, 0x02, 0x02, /* 0 to 7 */ 0x02, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* 8 to ? */ 0x30, 0x03, 0x03, 0x03, 0x03, 0x03, 0x03, 0x03, /* @ to G */ 0x03, 0x03, 0x03, 0x03, 0x03, 0x03, 0x03, 0x03, /* H to O */ 0x03, 0x03, 0x03, 0x03, 0x03, 0x03, 0x03, 0x03, /* P to W */ 0x03, 0x03, 0x03, 0x00, 0x00, 0x00, 0x00, 0x03, /* X to _ */ 0x00, 0x03, 0x03, 0x03, 0x03, 0x03, 0x03, 0x03, /* ` to g */ 0x03, 0x03, 0x03, 0x03, 0x03, 0x03, 0x03, 0x03, /* h to o */ 0x03, 0x03, 0x03, 0x03, 0x03, 0x03, 0x03, 0x03, /* p to w */ 0x03, 0x03, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, /* x to DEL */ 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, }; #define name_key(sigil, name) THX_name_key(aTHX_ sigil, name) static SV *THX_name_key(pTHX_ char sigil, SV *name) { char const *p, *q, *end; STRLEN len; SV *key; p = SvPV(name, len); end = p + len; if(sigil == 'N') { sigil = *p++; if(!(char_attr[(U8)sigil] & CHAR_SIGIL)) return NULL; } else if(sigil == 'P') { if(strnNE(p, LVOURPREFIX, LVOURPREFIXLEN)) return NULL; p += LVOURPREFIXLEN; sigil = *p++; if(!(char_attr[(U8)sigil] & CHAR_SIGIL)) return NULL; if(p[0] != ':' || p[1] != ':') return NULL; p += 2; } if(!(char_attr[(U8)*p] & CHAR_IDSTART)) return NULL; for(q = p+1; q != end; q++) { if(!(char_attr[(U8)*q] & CHAR_IDCONT)) return NULL; } key = sv_2mortal(newSV(KEYPREFIXLEN + 1 + (end-p))); sv_setpvs(key, KEYPREFIX "?"); SvPVX(key)[KEYPREFIXLEN] = sigil; sv_catpvn(key, p, end-p); return key; } /* * compiling code that uses Lexical::Var lexical variables */ #define gv_mark_multi(name) THX_gv_mark_multi(aTHX_ name) static void THX_gv_mark_multi(pTHX_ SV *name) { GV *gv; #ifdef gv_fetchsv gv = gv_fetchsv(name, GV_NOADD_NOINIT|GV_NOEXPAND|GV_NOTQUAL, SVt_PVGV); #else /* !gv_fetchsv */ gv = gv_fetchpv(SvPVX(name), 0, SVt_PVGV); #endif /* !gv_fetchsv */ if(gv && SvTYPE(gv) == SVt_PVGV) GvMULTI_on(gv); } #define Q_NEED_FAKE_REFERENT Q_PERL_VERSION_LT(5,21,4) #if Q_NEED_FAKE_REFERENT # if Q_USE_THREADS # define fakeSV_inc() newSV(0) # define fakeAV_inc() ((SV*)newAV()) # define fakeHV_inc() ((SV*)newHV()) # else /* !Q_USE_THREADS */ static SV *fake_sv, *fake_av, *fake_hv; # define fakeSV_inc() SvREFCNT_inc(fake_sv) # define fakeAV_inc() SvREFCNT_inc(fake_av) # define fakeHV_inc() SvREFCNT_inc(fake_hv) # endif /* !Q_USE_THREADS */ #endif /* Q_NEED_FAKE_REFERENT */ #define myck_rv2xv(o, sigil, THX_nxck) THX_myck_rv2xv(aTHX_ o, sigil, THX_nxck) static OP *THX_myck_rv2xv(pTHX_ OP *o, char sigil, OP *(*THX_nxck)(pTHX_ OP *o)) { OP *c; SV *ref, *key; HE *he; if((o->op_flags & OPf_KIDS) && (c = cUNOPx(o)->op_first) && c->op_type == OP_CONST && (c->op_private & (OPpCONST_ENTERED|OPpCONST_BARE)) && (ref = cSVOPx(c)->op_sv) && SvPOK(ref) && (key = name_key(sigil, ref))) { if((he = hv_fetch_ent(GvHV(PL_hintgv), key, 0, 0))) { SV *hintref, *referent, *newref; #if Q_NEED_FAKE_REFERENT SV *fake_referent; #endif /* Q_NEED_FAKE_REFERENT */ OP *newop; U16 type, flags; #if Q_PERL_VERSION_LT(5,11,2) if(sigil == '&' && (c->op_private & OPpCONST_BARE)) croak("can't reference Lexical::Var " "lexical subroutine " "without & sigil on this perl"); #endif /* <5.11.2 */ if(sigil != 'P' || Q_PERL_VERSION_LT(5,8,0)) { /* * A bogus symbol lookup has already been * done (by the tokeniser) based on the name * we're using, to support the package-based * interpretation that we're about to * replace. This can cause bogus "used only * once" warnings. The best we can do here * is to flag the symbol as multiply-used to * suppress that warning, though this is at * the risk of muffling an accurate warning. */ gv_mark_multi(ref); } /* * The base checker for rv2Xv checks that the * item being pointed to by the constant ref is of * an appropriate type. There are two problems with * this check. Firstly, it rejects GVs as a scalar * target, whereas they are in fact valid. (This * is in RT as bug #69456 so may be fixed.) Second, * and more serious, sometimes a reference is being * constructed through the wrong op type. An array * indexing expression "$foo[0]" gets constructed as * an rv2sv op, because of the "$" sigil, and then * gets munged later. We have to detect the real * intended type through the pad entry, which the * tokeniser has worked out in advance, and then * work through the wrong op. So it's a bit cheeky * for perl to complain about the wrong type here. * We work around it by making the constant ref * initially point to an innocuous item to pass the * type check, then changing it to the real * reference later. */ hintref = HeVAL(he); if(!SvROK(hintref)) croak("non-reference hint for Lexical::Var"); referent = SvREFCNT_inc(SvRV(hintref)); type = o->op_type; flags = o->op_flags | (((U16)o->op_private) << 8); if(type == OP_RV2SV && sigil == 'P' && SvPVX(ref)[LVOURPREFIXLEN] == '$' && SvREADONLY(referent)) { op_free(o); return newOP_const_identity(referent); } #if Q_NEED_FAKE_REFERENT switch(type) { case OP_RV2SV: fake_referent = fakeSV_inc(); break; case OP_RV2AV: fake_referent = fakeAV_inc(); break; case OP_RV2HV: fake_referent = fakeHV_inc(); break; default: fake_referent = NULL; break; } if(fake_referent) { newref = newRV_noinc(fake_referent); SvREFCNT_inc(newref); newop = newUNOP(type, flags, newSVOP(OP_CONST, 0, newref)); fake_referent = SvRV(newref); SvREADONLY_fully_off(newref); SvRV_set(newref, referent); SvREADONLY_fully_on(newref); SvREFCNT_dec(fake_referent); SvREFCNT_dec(newref); } else #endif /* Q_NEED_FAKE_REFERENT */ { newref = newRV_noinc(referent); newop = newUNOP(type, flags, newSVOP(OP_CONST, 0, newref)); } op_free(o); return newop; } else if(sigil == 'P') { SV *newref; U16 type, flags; /* * Not a name that we have a defined meaning for, * but it has the form of the "our" hack, implying * that we did put an entry in the pad for it. * Munge this back to what it would have been * without the pad entry. This should mainly * happen due to explicit unimportation, but it * might also happen if the scoping of the pad and * %^H ever get out of synch. */ newref = newSVpvn(SvPVX(ref)+LVOURPREFIXLEN+3, SvCUR(ref)-LVOURPREFIXLEN-3); if(SvUTF8(ref)) SvUTF8_on(newref); type = o->op_type; flags = o->op_flags | (((U16)o->op_private) << 8); op_free(o); return newUNOP(type, flags, newSVOP(OP_CONST, 0, newref)); } } return THX_nxck(aTHX_ o); } static OP *(*THX_nxck_rv2sv)(pTHX_ OP *o); static OP *(*THX_nxck_rv2av)(pTHX_ OP *o); static OP *(*THX_nxck_rv2hv)(pTHX_ OP *o); static OP *(*THX_nxck_rv2cv)(pTHX_ OP *o); static OP *(*THX_nxck_rv2gv)(pTHX_ OP *o); static OP *THX_myck_rv2sv(pTHX_ OP *o) { return myck_rv2xv(o, 'P', THX_nxck_rv2sv); } static OP *THX_myck_rv2av(pTHX_ OP *o) { return myck_rv2xv(o, 'P', THX_nxck_rv2av); } static OP *THX_myck_rv2hv(pTHX_ OP *o) { return myck_rv2xv(o, 'P', THX_nxck_rv2hv); } static OP *THX_myck_rv2cv(pTHX_ OP *o) { return myck_rv2xv(o, Q_CODE_AS_STATE_IN_PAD ? 'P' : '&', THX_nxck_rv2cv); } static OP *THX_myck_rv2gv(pTHX_ OP *o) { return myck_rv2xv(o, '*', THX_nxck_rv2gv); } /* * setting up Lexical::Var lexical names */ #if !Q_USE_THREADS static HV *lvour_sv_stash, *lvour_av_stash, *lvour_hv_stash; # if Q_CODE_AS_STATE_IN_PAD static HV *lvour_cv_stash; # endif /* Q_CODE_AS_STATE_IN_PAD */ #endif /* !Q_USE_THREADS */ #define lvour_stash(sigil) THX_lvour_stash(aTHX_ sigil) static HV *THX_lvour_stash(pTHX_ char sigil) { #if Q_USE_THREADS if(sigil == '$' || sigil == '@' || sigil == '%' || (Q_CODE_AS_STATE_IN_PAD && sigil == '&')) { char sname[LVOURPREFIXLEN+2]; memcpy(sname, LVOURPREFIX, LVOURPREFIXLEN); sname[LVOURPREFIXLEN] = sigil; sname[LVOURPREFIXLEN+1] = 0; return gv_stashpvn(sname, LVOURPREFIXLEN+1, GV_ADD); } else { return NULL; } #else /* !Q_USE_THREADS */ PERL_UNUSED_THX(); # if Q_CODE_AS_STATE_IN_PAD if(sigil == '&') return lvour_cv_stash; # endif /* Q_CODE_AS_STATE_IN_PAD */ return sigil == '$' ? lvour_sv_stash : sigil == '@' ? lvour_av_stash : sigil == '%' ? lvour_hv_stash : NULL; #endif /* !Q_USE_THREADS */ } #define padseq_intro() THX_padseq_intro(aTHX) static U32 THX_padseq_intro(pTHX) { #if Q_PERL_VERSION_GE(5,13,10) PERL_UNUSED_THX(); return PERL_PADSEQ_INTRO; #elif Q_PERL_VERSION_GE(5,9,5) PERL_UNUSED_THX(); return I32_MAX; #elif Q_PERL_VERSION_GE(5,9,0) PERL_UNUSED_THX(); return 999999999; #elif Q_PERL_VERSION_GE(5,8,0) static U32 max; if(!max) { SV *versv = get_sv("]", 0); char *verp = SvPV_nolen(versv); max = strGE(verp, "5.008009") ? I32_MAX : 999999999; } return max; #else /* <5.8.0 */ PERL_UNUSED_THX(); return 999999999; #endif /* <5.8.0 */ } #define find_compcv(vari_word) THX_find_compcv(aTHX_ vari_word) static CV *THX_find_compcv(pTHX_ char const *vari_word) { CV *compcv; #if Q_PERL_VERSION_GE(5,17,5) if(!((compcv = PL_compcv) && CvPADLIST(compcv))) compcv = NULL; #else /* <5.17.5 */ GV *compgv; /* * Given that we're being invoked from a BEGIN block, * PL_compcv here doesn't actually point to the sub * being compiled. Instead it points to the BEGIN block. * The code that we want to affect is the parent of that. * Along the way, better check that we are actually being * invoked that way: PL_compcv may be null, indicating * runtime, or it can be non-null in a couple of * other situations (require, string eval). */ if(!(PL_compcv && CvSPECIAL(PL_compcv) && (compgv = CvGV(PL_compcv)) && strEQ(GvNAME(compgv), "BEGIN") && (compcv = CvOUTSIDE(PL_compcv)) && CvPADLIST(compcv))) compcv = NULL; #endif /* <5.17.5 */ if(!compcv) croak("can't set up Lexical::Var lexical %s " "outside compilation", vari_word); return compcv; } #define setup_pad(compcv, name, referent) \ THX_setup_pad(aTHX_ compcv, name, referent) static void THX_setup_pad(pTHX_ CV *compcv, char const *name, SV *referent) { PADLIST *padlist = CvPADLIST(compcv); PADNAMELIST *padname = PadlistNAMES(padlist); PAD *padvar = PadlistARRAY(padlist)[1]; PADOFFSET ouroffset; PADNAME *ourname; SV *ourvar; #if !Q_CODE_AS_STATE_IN_PAD PERL_UNUSED_ARG(referent); #endif /* !Q_CODE_AS_STATE_IN_PAD */ ourname = newPADNAMEpvn(name, strlen(name)); COP_SEQ_RANGE_LOW_set(ourname, PL_cop_seqmax); COP_SEQ_RANGE_HIGH_set(ourname, padseq_intro()); COP_SEQMAX_INC; #if Q_CODE_AS_STATE_IN_PAD if(referent) { PadnameIsSTATE_on(ourname); ourvar = SvREFCNT_inc(referent); } else #endif /* Q_CODE_AS_STATE_IN_PAD */ { HV *stash = lvour_stash(name[0]); PadnameIsOUR_on(ourname); PadnameOURSTASH_set(ourname, (HV*)SvREFCNT_inc((SV*)stash)); ourvar = newSV(0); SvPADMY_on(ourvar); } ouroffset = PadMAX(padvar) + 1; padnamelist_store(padname, ouroffset, ourname); #ifdef PadnamelistMAXNAMED PadnamelistMAXNAMED(padname) = ouroffset; #endif /* PadnamelistMAXNAMED */ av_store(padvar, ouroffset, ourvar); if(PL_comppad == padvar) PL_curpad = PadARRAY(padvar); } static int svt_scalar(svtype t) { switch(t) { case SVt_NULL: case SVt_IV: case SVt_NV: #if Q_PERL_VERSION_LT(5,11,0) case SVt_RV: #endif /* <5.11.0 */ case SVt_PV: case SVt_PVIV: case SVt_PVNV: case SVt_PVMG: case SVt_PVLV: case SVt_PVGV: #if Q_PERL_VERSION_GE(5,11,0) case SVt_REGEXP: #endif /* >=5.11.0 */ return 1; default: return 0; } } enum { PADLOOKUP_NOTHING, PADLOOKUP_STATE, PADLOOKUP_LVOUR, PADLOOKUP_OTHER }; #define pad_lookup(compcv, name, value_ptr) \ THX_pad_lookup(aTHX_ compcv, name, value_ptr) static int THX_pad_lookup(pTHX_ CV *compcv, char const *name, SV **value_ptr) { STRLEN namelen = strlen(name); CV *cv = compcv; U32 seq = PL_cop_seqmax; for(; cv; #ifdef CvOUTSIDE_SEQ seq = CvOUTSIDE_SEQ(cv), #endif /* CvOUTSIDE_SEQ */ cv = CvOUTSIDE(cv)) { PADLIST *padlist = CvPADLIST(cv); PADNAMELIST *padname; PAD *pad; PADOFFSET off; #ifdef CvOUTSIDE_SEQ PADOFFSET outer_off = 0; #endif /* CvOUTSIDE_SEQ */ PADNAME *pname; if(!padlist) continue; padname = PadlistNAMES(padlist); pad = PadlistARRAY(padlist)[1]; #ifdef PadnamelistMAXNAMED off = PadnamelistMAXNAMED(padname); #else /* !PadnamelistMAXNAMED */ off = PadMAX(pad); #endif /* PadnamelistMAXNAMED */ for(; off != 0; off--) { char *pnamepv; pname = padnamelist_fetch(padname, off); if(!pname) continue; #if Q_PERL_VERSION_LT(5,19,3) if(pname == &PL_sv_undef) continue; #endif /* <5.19.3 */ pnamepv = PadnamePV(pname); if(!(pnamepv && PadnameLEN(pname) == namelen && memcmp(pnamepv, name, namelen) == 0)) continue; #ifdef CvOUTSIDE_SEQ if(PadnameOUTER(pname)) { outer_off = off; continue; } #endif /* CvOUTSIDE_SEQ */ if(!PadnameIN_SCOPE(pname, seq)) continue; #ifdef CvOUTSIDE_SEQ found: #endif /* CvOUTSIDE_SEQ */ if(PadnameIsSTATE(pname)) { *value_ptr = *av_fetch(pad, off, 0); return PADLOOKUP_STATE; } else if(PadnameIsOUR(pname) && PadnameOURSTASH(pname) == lvour_stash(name[0])) { return PADLOOKUP_LVOUR; } else { return PADLOOKUP_OTHER; } } #ifdef CvOUTSIDE_SEQ if(outer_off) { off = outer_off; pname = padnamelist_fetch(padname, off); goto found; } #endif /* CvOUTSIDE_SEQ */ } return PADLOOKUP_NOTHING; } #define current_referent(key) THX_current_referent(aTHX_ compcv, key) static SV *THX_current_referent(pTHX_ CV *compcv, SV *key) { static SV sv_other; char *keypv = SvPVX(key); char sigil = keypv[KEYPREFIXLEN]; if(!(sigil == '*' || (Q_CODE_OUTSIDE_PAD && sigil == '&'))) { SV *state_value; int padstate = pad_lookup(compcv, keypv+KEYPREFIXLEN, &state_value); if(Q_CODE_CLASHES_WITH_PAD && sigil == '&') { if(padstate != PADLOOKUP_NOTHING) return &sv_other; } else { if(padstate == PADLOOKUP_NOTHING) return NULL; if(Q_CODE_AS_STATE_IN_PAD && sigil == '&' && padstate == PADLOOKUP_STATE) return state_value; if(padstate != PADLOOKUP_LVOUR) return &sv_other; } } { SV *cref; HE *he = hv_fetch_ent(GvHV(PL_hintgv), key, 0, 0); if(!he) return NULL; cref = HeVAL(he); if(!SvROK(cref)) return &sv_other; return SvRV(cref); } } #if Q_CODE_CLASHES_WITH_PAD # define check_for_pad_clash(compcv, name) \ THX_check_for_pad_clash(aTHX_ compcv, name) static void THX_check_for_pad_clash(pTHX_ CV *compcv, char const *name) { SV *state_value; if(name[0] == '&' && pad_lookup(compcv, name, &state_value) != PADLOOKUP_NOTHING) croak("can't shadow core lexical subroutine"); } #else /* !Q_CODE_CLASHES_WITH_PAD */ # define check_for_pad_clash(compcv, name) ((void) 0) #endif /* !Q_CODE_CLASHES_WITH_PAD */ #define import(base_sigil, vari_word) THX_import(aTHX_ base_sigil, vari_word) static void THX_import(pTHX_ char base_sigil, char const *vari_word) { dXSARGS; CV *compcv; int i; SP -= items; if(items < 1) croak("too few arguments for import"); if(items == 1) croak("%" SVf " does no default importation", SVfARG(ST(0))); if(!(items & 1)) croak("import list for %" SVf " must alternate name and reference", SVfARG(ST(0))); compcv = find_compcv(vari_word); PL_hints |= HINT_LOCALIZE_HH; gv_HVadd(PL_hintgv); for(i = 1; i != items; i += 2) { SV *name = ST(i), *ref = ST(i+1), *key, *val, *referent; svtype rt; bool rok; char const *vt; char sigil; HE *he; if(!sv_is_string(name)) croak("%s name is not a string", vari_word); key = name_key(base_sigil, name); if(!key) croak("malformed %s name", vari_word); sigil = SvPVX(key)[KEYPREFIXLEN]; rt = SvROK(ref) ? SvTYPE(SvRV(ref)) : SVt_LAST; switch(sigil) { case '$': rok = svt_scalar(rt); vt="scalar"; break; case '@': rok = rt == SVt_PVAV; vt="array"; break; case '%': rok = rt == SVt_PVHV; vt="hash"; break; case '&': rok = rt == SVt_PVCV; vt="code"; break; case '*': rok = rt == SVt_PVGV; vt="glob"; break; default: rok = 0; vt = "wibble"; break; } if(!rok) croak("%s is not %s reference", vari_word, vt); check_for_pad_clash(compcv, SvPVX(key)+KEYPREFIXLEN); referent = SvRV(ref); if(char_attr[(U8)sigil] & CHAR_USEPAD) setup_pad(compcv, SvPVX(key)+KEYPREFIXLEN, Q_CODE_AS_STATE_IN_PAD && sigil == '&' ? referent : NULL); val = newRV_inc(referent); he = hv_store_ent(GvHV(PL_hintgv), key, val, 0); if(he) { val = HeVAL(he); SvSETMAGIC(val); } else { SvREFCNT_dec(val); } } PUTBACK; } #define unimport(base_sigil, vari_word) \ THX_unimport(aTHX_ base_sigil, vari_word) static void THX_unimport(pTHX_ char base_sigil, char const *vari_word) { dXSARGS; CV *compcv; int i; SP -= items; if(items < 1) croak("too few arguments for unimport"); if(items == 1) croak("%" SVf " does no default unimportation", SVfARG(ST(0))); compcv = find_compcv(vari_word); PL_hints |= HINT_LOCALIZE_HH; gv_HVadd(PL_hintgv); for(i = 1; i != items; i++) { SV *name = ST(i), *ref, *key; char sigil; if(!sv_is_string(name)) croak("%s name is not a string", vari_word); key = name_key(base_sigil, name); if(!key) croak("malformed %s name", vari_word); sigil = SvPVX(key)[KEYPREFIXLEN]; if(i != items && (ref = ST(i+1), SvROK(ref))) { i++; if(current_referent(key) != SvRV(ref)) continue; } check_for_pad_clash(compcv, SvPVX(key)+KEYPREFIXLEN); (void) hv_delete_ent(GvHV(PL_hintgv), key, G_DISCARD, 0); if(char_attr[(U8)sigil] & CHAR_USEPAD) setup_pad(compcv, SvPVX(key)+KEYPREFIXLEN, NULL); } PUTBACK; } MODULE = Lexical::Var PACKAGE = Lexical::Var PROTOTYPES: DISABLE BOOT: #if !Q_USE_THREADS # if Q_NEED_FAKE_REFERENT fake_sv = newSV(0); fake_av = (SV*)newAV(); fake_hv = (SV*)newHV(); # endif /* Q_NEED_FAKE_REFERENT */ lvour_sv_stash = gv_stashpvs(LVOURPREFIX "$", 1); lvour_av_stash = gv_stashpvs(LVOURPREFIX "@", 1); lvour_hv_stash = gv_stashpvs(LVOURPREFIX "%", 1); # if Q_CODE_AS_STATE_IN_PAD lvour_cv_stash = gv_stashpvs(LVOURPREFIX "&", 1); # endif /* Q_CODE_AS_STATE_IN_PAD */ #endif /* !Q_USE_THREADS */ wrap_op_checker(OP_RV2SV, THX_myck_rv2sv, &THX_nxck_rv2sv); wrap_op_checker(OP_RV2AV, THX_myck_rv2av, &THX_nxck_rv2av); wrap_op_checker(OP_RV2HV, THX_myck_rv2hv, &THX_nxck_rv2hv); wrap_op_checker(OP_RV2CV, THX_myck_rv2cv, &THX_nxck_rv2cv); wrap_op_checker(OP_RV2GV, THX_myck_rv2gv, &THX_nxck_rv2gv); void import(SV *classname, ...) PPCODE: PERL_UNUSED_VAR(classname); PUSHMARK(SP); /* the modified SP is intentionally lost here */ import('N', "variable"); SPAGAIN; void unimport(SV *classname, ...) PPCODE: PERL_UNUSED_VAR(classname); PUSHMARK(SP); /* the modified SP is intentionally lost here */ unimport('N', "variable"); SPAGAIN; MODULE = Lexical::Var PACKAGE = Lexical::Sub void import(SV *classname, ...) PPCODE: PERL_UNUSED_VAR(classname); PUSHMARK(SP); /* the modified SP is intentionally lost here */ import('&', "subroutine"); SPAGAIN; void unimport(SV *classname, ...) PPCODE: PERL_UNUSED_VAR(classname); PUSHMARK(SP); /* the modified SP is intentionally lost here */ unimport('&', "subroutine"); SPAGAIN; Lexical-Var-0.010/t000755001750001750 014407273365 14032 5ustar00zeframzefram000000000000Lexical-Var-0.010/t/array_ident.t000444001750001750 65014407273365 16636 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 3*3; BEGIN { $^H |= 0x20000 if "$]" < 5.008; } $SIG{__WARN__} = sub { die "WARNING: $_[0]" }; our @x; our($oref, $aref, $bref); foreach( \@x, do { my @x; \@x }, sub { my @x; \@x }->(), ) { $oref = $_; $aref = $bref = undef; eval q{ use Lexical::Var '@foo' => $oref; $aref = \@foo; $bref = \@foo; }; is $@, ""; ok $aref == $oref; ok $bref == $oref; } 1; Lexical-Var-0.010/t/array_ops.t000444001750001750 307014407273365 16353 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 14; BEGIN { $^H |= 0x20000 if "$]" < 5.008; } $SIG{__WARN__} = sub { return if $_[0] =~ /\AVariable \"\@foo\" is not imported /; return if $_[0] =~ /\AAttempt to free unreferenced scalar[ :]/ && "$]" < 5.008004; die "WARNING: $_[0]"; }; @main::foo = (undef); @main::foo = (undef); our @values; @values = (); eval q{ use strict; use Lexical::Var '@foo' => [qw(a b c)]; push @values, $#foo; }; is $@, ""; is_deeply \@values, [ 2 ]; @values = (); eval q{ use strict; use Lexical::Var '@foo' => [qw(a b c)]; push @values, $foo[1]; }; is $@, ""; is_deeply \@values, [ "b" ]; @values = (); eval q{ use strict; use Lexical::Var '@foo' => [qw(a b c)]; my $i = 1; push @values, $foo[$i]; }; is $@, ""; is_deeply \@values, [ "b" ]; @values = (); eval q{ use strict; use Lexical::Var '@foo' => [qw(a b c)]; push @values, @foo[1,2,0]; }; is $@, ""; is_deeply \@values, [ qw(b c a) ]; @values = (); eval q{ use strict; use Lexical::Var '@foo' => [qw(a b c)]; my @i = (1, 2, 0); push @values, @foo[@i]; }; is $@, ""; is_deeply \@values, [ qw(b c a) ]; SKIP: { skip "key/value array slicing not available on this Perl", 4 unless "$]" >= 5.019004; @values = (); eval q{ use strict; use Lexical::Var '@foo' => [qw(a b c)]; push @values, %foo[1,2,0]; }; is $@, ""; is_deeply \@values, [ 1, "b", 2, "c", 0, "a" ]; @values = (); eval q{ use strict; use Lexical::Var '@foo' => [qw(a b c)]; my @i = (1, 2, 0); push @values, %foo[@i]; }; is $@, ""; is_deeply \@values, [ 1, "b", 2, "c", 0, "a" ]; } 1; Lexical-Var-0.010/t/array_scope.t000444001750001750 363014407273365 16665 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 22; BEGIN { $^H |= 0x20000 if "$]" < 5.008; } $SIG{__WARN__} = sub { return if $_[0] =~ /\AVariable \"\@foo\" is not imported /; return if $_[0] =~ /\AAttempt to free unreferenced scalar[ :]/ && "$]" < 5.008004; die "WARNING: $_[0]"; }; @main::foo = (undef); @main::foo = (undef); our @values; @values = (); eval q{ use strict; push @values, @foo; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ no strict; push @values, @foo; }; is $@, ""; is_deeply \@values, [ undef ]; @values = (); eval q{ use strict; use Lexical::Var '@foo' => [1]; push @values, @foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use strict; use Lexical::Var '@foo' => [1]; use Lexical::Var '@foo' => [2]; push @values, @foo; }; is $@, ""; is_deeply \@values, [ 2 ]; @values = (); eval q{ use strict; use Lexical::Var '@foo' => [1]; { push @values, @foo; } }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use strict; use Lexical::Var '@foo' => [1]; { ; } push @values, @foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use strict; { use Lexical::Var '@foo' => [1]; } push @values, @foo; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ no strict; { use Lexical::Var '@foo' => [1]; } push @values, @foo; }; is $@, ""; is_deeply \@values, [ undef ]; @values = (); eval q{ use strict; use Lexical::Var '@foo' => [1]; { use Lexical::Var '@foo' => [2]; push @values, @foo; } }; is $@, ""; is_deeply \@values, [ 2 ]; @values = (); eval q{ use strict; use Lexical::Var '@foo' => [1]; { use Lexical::Var '@foo' => [2]; } push @values, @foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use strict; use Lexical::Var '@foo' => [1]; { use Lexical::Var '@foo' => [2]; push @values, @foo; } push @values, @foo; }; is $@, ""; is_deeply \@values, [ 2, 1 ]; 1; Lexical-Var-0.010/t/array_type.t000444001750001750 231714407273365 16536 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 18; BEGIN { $^H |= 0x20000 if "$]" < 5.008; } $SIG{__WARN__} = sub { die "WARNING: $_[0]" }; eval q{use Lexical::Var '@foo' => \undef;}; isnt $@, ""; eval q{use Lexical::Var '@foo' => \1;}; isnt $@, ""; eval q{use Lexical::Var '@foo' => \1.5;}; isnt $@, ""; eval q{use Lexical::Var '@foo' => \[];}; isnt $@, ""; eval q{use Lexical::Var '@foo' => \"abc";}; isnt $@, ""; eval q{use Lexical::Var '@foo' => bless(\(my$x="abc"));}; isnt $@, ""; eval q{use Lexical::Var '@foo' => \*main::wibble;}; isnt $@, ""; eval q{use Lexical::Var '@foo' => bless(\*main::wibble);}; isnt $@, ""; eval q{use Lexical::Var '@foo' => qr/xyz/;}; isnt $@, ""; eval q{use Lexical::Var '@foo' => bless(qr/xyz/);}; isnt $@, ""; eval q{use Lexical::Var '@foo' => [];}; is $@, ""; eval q{use Lexical::Var '@foo' => bless([]);}; is $@, ""; eval q{use Lexical::Var '@foo' => {};}; isnt $@, ""; eval q{use Lexical::Var '@foo' => bless({});}; isnt $@, ""; eval q{use Lexical::Var '@foo' => sub{};}; isnt $@, ""; eval q{use Lexical::Var '@foo' => bless(sub{});}; isnt $@, ""; eval q{use Lexical::Var '@foo' => []; @foo if 0;}; is $@, ""; eval q{use Lexical::Var '@foo' => bless([]); @foo if 0;}; is $@, ""; 1; Lexical-Var-0.010/t/array_write.t000444001750001750 47414407273365 16671 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 4; BEGIN { $SIG{__WARN__} = sub { die "WARNING: $_[0]" }; } use Lexical::Var '@foo' => []; is_deeply \@foo, []; push @foo, qw(x y); is_deeply \@foo, [qw(x y)]; push @foo, qw(a b); is_deeply \@foo, [qw(x y a b)]; $foo[2] = "A"; is_deeply \@foo, [qw(x y A b)]; 1; Lexical-Var-0.010/t/code_bare.t000444001750001750 2166514407273365 16311 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More; BEGIN { plan skip_all => "bare subs impossible on this perl" if "$]" < 5.011002; } plan tests => 2*10*6; BEGIN { $^H |= 0x20000 if "$]" < 5.008; } $SIG{__WARN__} = sub { return if $_[0] =~ /\AAttempt to free unreferenced scalar[ :]/ && "$]" < 5.008004; die "WARNING: $_[0]"; }; our @x = (100, 200); our @values; @values = (); eval q{ use Lexical::Var '&foo' => sub () { rand() < 2 ? 123 : 0 }; push @values, foo; }; is $@, ""; is_deeply \@values, [ 123 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub () { rand() < 2 ? 123 : 0 }; push @values, foo + 10; }; is $@, ""; is_deeply \@values, [ 133 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub () { rand() < 2 ? 123 : 0 }; push @values, foo 10; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub () { rand() < 2 ? 123 : 0 }; push @values, foo 10, 20; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub () { rand() < 2 ? 123 : 0 }; push @values, foo @x; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub () { rand() < 2 ? 123 : 0 }; push @values, foo { 10+20; }; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub () { rand() < 2 ? 123 : 0 }; push @values, foo(); }; is $@, ""; is_deeply \@values, [ 123 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub () { rand() < 2 ? 123 : 0 }; push @values, foo(10); }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub () { rand() < 2 ? 123 : 0 }; push @values, foo(10, 20); }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub () { rand() < 2 ? 123 : 0 }; push @values, foo(@x); }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub () { 123 }; push @values, foo; }; is $@, ""; is_deeply \@values, [ 123 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub () { 123 }; push @values, foo + 10; }; is $@, ""; is_deeply \@values, [ 133 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub () { 123 }; push @values, foo 10; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub () { 123 }; push @values, foo 10, 20; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub () { 123 }; push @values, foo @x; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub () { 123 }; push @values, foo { 10+20; }; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub () { 123 }; push @values, foo(); }; is $@, ""; is_deeply \@values, [ 123 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub () { 123 }; push @values, foo(10); }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub () { 123 }; push @values, foo(10, 20); }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub () { 123 }; push @values, foo(@x); }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub ($) { $_[0]+1 }; push @values, foo; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub ($) { $_[0]+1 }; push @values, foo + 10; }; is $@, ""; is_deeply \@values, [ 11 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub ($) { $_[0]+1 }; push @values, foo 10; }; is $@, ""; is_deeply \@values, [ 11 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub ($) { $_[0]+1 }; push @values, foo 10, 20; }; is $@, ""; is_deeply \@values, [ 11, 20 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub ($) { $_[0]+1 }; push @values, foo @x; }; is $@, ""; is_deeply \@values, [ 3 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub ($) { $_[0]+1 }; push @values, foo { 10+20; }; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub ($) { $_[0]+1 }; push @values, foo(); }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub ($) { $_[0]+1 }; push @values, foo(10); }; is $@, ""; is_deeply \@values, [ 11 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub ($) { $_[0]+1 }; push @values, foo(10, 20); }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub ($) { $_[0]+1 }; push @values, foo(@x); }; is $@, ""; is_deeply \@values, [ 3 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub (@) { "a", map { $_+1 } @_ }; push @values, foo; }; is $@, ""; is_deeply \@values, [ "a" ]; @values = (); eval q{ use Lexical::Var '&foo' => sub (@) { "a", map { $_+1 } @_ }; push @values, foo + 10; }; is $@, ""; is_deeply \@values, [ "a", 11 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub (@) { "a", map { $_+1 } @_ }; push @values, foo 10; }; is $@, ""; is_deeply \@values, [ "a", 11 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub (@) { "a", map { $_+1 } @_ }; push @values, foo 10, 20; }; is $@, ""; is_deeply \@values, [ "a", 11, 21 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub (@) { "a", map { $_+1 } @_ }; push @values, foo @x; }; is $@, ""; is_deeply \@values, [ "a", 101, 201 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub (@) { "a", map { $_+1 } @_ }; push @values, foo { 10+20; }; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub (@) { "a", map { $_+1 } @_ }; push @values, foo(); }; is $@, ""; is_deeply \@values, [ "a" ]; @values = (); eval q{ use Lexical::Var '&foo' => sub (@) { "a", map { $_+1 } @_ }; push @values, foo(10); }; is $@, ""; is_deeply \@values, [ "a", 11 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub (@) { "a", map { $_+1 } @_ }; push @values, foo(10, 20); }; is $@, ""; is_deeply \@values, [ "a", 11, 21 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub (@) { "a", map { $_+1 } @_ }; push @values, foo(@x); }; is $@, ""; is_deeply \@values, [ "a", 101, 201 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { "b", map { $_+1 } @_ }; push @values, foo; }; is $@, ""; is_deeply \@values, [ "b" ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { "b", map { $_+1 } @_ }; push @values, foo + 10; }; is $@, ""; is_deeply \@values, [ "b", 11 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { "b", map { $_+1 } @_ }; push @values, foo 10; }; is $@, ""; is_deeply \@values, [ "b", 11 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { "b", map { $_+1 } @_ }; push @values, foo 10, 20; }; is $@, ""; is_deeply \@values, [ "b", 11, 21 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { "b", map { $_+1 } @_ }; push @values, foo @x; }; is $@, ""; is_deeply \@values, [ "b", 101, 201 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { "b", map { $_+1 } @_ }; push @values, foo { 10+20; }; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub { "b", map { $_+1 } @_ }; push @values, foo(); }; is $@, ""; is_deeply \@values, [ "b" ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { "b", map { $_+1 } @_ }; push @values, foo(10); }; is $@, ""; is_deeply \@values, [ "b", 11 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { "b", map { $_+1 } @_ }; push @values, foo(10, 20); }; is $@, ""; is_deeply \@values, [ "b", 11, 21 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { "b", map { $_+1 } @_ }; push @values, foo(@x); }; is $@, ""; is_deeply \@values, [ "b", 101, 201 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub (&) { "c", $_[0]->()+1 }; push @values, foo; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub (&) { "c", $_[0]->()+1 }; push @values, foo + 10; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub (&) { "c", $_[0]->()+1 }; push @values, foo 10; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub (&) { "c", $_[0]->()+1 }; push @values, foo 10, 20; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub (&) { "c", $_[0]->()+1 }; push @values, foo @x; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub (&) { "c", $_[0]->()+1 }; push @values, foo { 10+20; }; }; is $@, ""; is_deeply \@values, [ "c", 31 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub (&) { "c", $_[0]->()+1 }; push @values, foo(); }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub (&) { "c", $_[0]->()+1 }; push @values, foo(10); }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub (&) { "c", $_[0]->()+1 }; push @values, foo(10, 20); }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub (&) { "c", $_[0]->()+1 }; push @values, foo(@x); }; isnt $@, ""; is_deeply \@values, []; 1; Lexical-Var-0.010/t/code_bare_no.t000444001750001750 332214407273365 16753 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More; BEGIN { plan skip_all => "bare subs possible on this perl" if "$]" >= 5.011002; } plan tests => 12; BEGIN { $^H |= 0x20000 if "$]" < 5.008; } $SIG{__WARN__} = sub { return if $_[0] =~ /\AAttempt to free unreferenced scalar[ :]/ && "$]" < 5.008004; die "WARNING: $_[0]"; }; sub main::foo { "main" } sub main::bar () { "main" } our @values; { local $TODO = "bareword ref without parens works funny"; @values = (); eval q{ use Lexical::Var '&foo' => sub () { 1 }; push @values, foo; }; like $@, qr/\Acan't reference Lexical::Var lexical subroutine without \& sigil/; is_deeply \@values, []; } @values = (); eval q{ use Lexical::Var '&foo' => sub () { 1 }; push @values, foo(); }; like $@, qr/\Acan't reference Lexical::Var lexical subroutine without \& sigil/; is_deeply \@values, []; { local $TODO = "bareword ref without parens works funny"; @values = (); eval q{ use Lexical::Var '&foo' => sub ($) { 1+$_[0] }; push @values, foo 10; }; like $@, qr/\Acan't reference Lexical::Var lexical subroutine without \& sigil/; is_deeply \@values, []; } @values = (); eval q{ use Lexical::Var '&foo' => sub ($) { 1+$_[0] }; push @values, foo(10); }; like $@, qr/\Acan't reference Lexical::Var lexical subroutine without \& sigil/; is_deeply \@values, []; { local $TODO = "constant subs work funny"; @values = (); eval q{ use Lexical::Var '&foo' => sub () { 1 }; push @values, bar; }; like $@, qr/\Acan't reference Lexical::Var lexical subroutine without \& sigil/; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub () { 1 }; push @values, bar(); }; like $@, qr/\Acan't reference Lexical::Var lexical subroutine without \& sigil/; is_deeply \@values, []; } 1; Lexical-Var-0.010/t/code_const.t000444001750001750 206514407273365 16477 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More; BEGIN { plan skip_all => "bare subs impossible on this perl" if "$]" < 5.011002; } plan tests => 6; BEGIN { $SIG{__WARN__} = sub { die "WARNING: $_[0]" }; } is eval q{ use Lexical::Var '&foo' => sub () { my $x=123 }; foo(); }, 123; # test that non-constant foo() is not a const op eval q{ use Lexical::Var '&foo' => sub () { my $x=123 }; foo() = 456; die; }; like $@, qr/\ACan't modify non-lvalue subroutine call /; # test that non-constant foo() does not participate in constant folding eval q{ die; use Lexical::Var '&foo' => sub () { my $x=123 }; !foo() = 456; }; like $@, qr/\ACan't modify not /; is eval q{ use Lexical::Var '&foo' => sub () { 123 }; foo(); }, 123; # test that constant foo() is a const op eval q{ die; use Lexical::Var '&foo' => sub () { 123 }; foo() = 456; }; like $@, qr/\ACan't modify constant item /; # test that constant foo() participates in constant folding eval q{ die; use Lexical::Var '&foo' => sub () { 123 }; !foo() = 456; }; like $@, qr/\ACan't modify constant item /; 1; Lexical-Var-0.010/t/code_ident.t000444001750001750 64114407273365 16432 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 3*3; BEGIN { $^H |= 0x20000 if "$]" < 5.008; } $SIG{__WARN__} = sub { die "WARNING: $_[0]" }; sub x {} our($oref, $aref, $bref); foreach( \&x, sub{}, sub { my $x; sub{$x} }->(), ) { $oref = $_; $aref = $bref = undef; eval q{ use Lexical::Var '&foo' => $oref; $aref = \&foo; $bref = \&foo; }; is $@, ""; ok $aref == $oref; ok $bref == $oref; } 1; Lexical-Var-0.010/t/code_ops.t000444001750001750 217014407273365 16147 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 12; BEGIN { $^H |= 0x20000 if "$]" < 5.008; } $SIG{__WARN__} = sub { return if $_[0] =~ /\AAttempt to free unreferenced scalar[ :]/ && "$]" < 5.008004; die "WARNING: $_[0]"; }; sub main::foo { "main" } sub main::bar () { "main" } our @values; @values = (); eval q{ use Lexical::Var '&foo' => sub () { 1 }; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub () { 1 }; push @values, &foo(); }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub ($) { 1+$_[0] }; push @values, &foo(10); push @values, &foo(20); }; is $@, ""; is_deeply \@values, [ 11, 21 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub ($) { 1+$_[0] }; my @a = (10, 20); push @values, &foo(@a); }; is $@, ""; is_deeply \@values, [ 11 ]; @values = (); eval q{ use Lexical::Var '&bar' => sub () { 1 }; push @values, &bar; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Var '&bar' => sub () { 1 }; push @values, &bar(); }; is $@, ""; is_deeply \@values, [ 1 ]; 1; Lexical-Var-0.010/t/code_scope.t000444001750001750 2357514407273365 16513 0ustar00zeframzefram000000000000use warnings; use strict; BEGIN { unshift @INC, "./t/lib"; } use Test::More tests => 86; BEGIN { $^H |= 0x20000 if "$]" < 5.008; } $SIG{__WARN__} = sub { return if $_[0] =~ /\AAttempt to free unreferenced scalar[ :]/ && "$]" < 5.008004; die "WARNING: $_[0]"; }; sub main::foo { "main" } sub wibble::foo { "wibble" } our @values; @values = (); eval q{ push @values, &foo; }; is $@, ""; is_deeply \@values, [ "main" ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { 1 }; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { 1 }; use Lexical::Var '&foo' => sub { 2 }; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 2 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { 1 }; { push @values, &foo; } }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { 1 }; { ; } push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ { use Lexical::Var '&foo' => sub { 1 }; } push @values, &foo; }; is $@, ""; is_deeply \@values, [ "main" ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { 1 }; { use Lexical::Var '&foo' => sub { 2 }; push @values, &foo; } }; is $@, ""; is_deeply \@values, [ 2 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { 1 }; { use Lexical::Var '&foo' => sub { 2 }; } push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { 1 }; { use Lexical::Var '&foo' => sub { 2 }; push @values, &foo; } push @values, &foo; }; is $@, ""; is_deeply \@values, [ 2, 1 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { 1 }; package wibble; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ package wibble; use Lexical::Var '&foo' => sub { 1 }; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ package wibble; use Lexical::Var '&foo' => sub { 1 }; package main; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { 1 }; package wibble; use Lexical::Var '&foo' => sub { 2 }; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 2 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { 1 }; package wibble; use Lexical::Var '&foo' => sub { 2 }; package main; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 2 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { 1 }; { no Lexical::Var '&foo'; push @values, &foo; } }; is $@, ""; is_deeply \@values, [ "main" ]; @values = (); eval q{ use strict; use Lexical::Var '&foo' => sub { 1 }; no Lexical::Var '&bar'; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { 1 }; { no Lexical::Var '&foo'; } push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { 1 }; { no Lexical::Var '&foo' => \&foo; push @values, &foo; } }; is $@, ""; is_deeply \@values, [ "main" ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { 1 }; { no Lexical::Var '&foo' => \&foo; } push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { 1 }; { no Lexical::Var '&foo' => sub { 1 }; push @values, &foo; } }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { 1 }; { no Lexical::Var '&foo' => sub { 1 }; } push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Var '&foo' => \&wibble::foo; sub { no Lexical::Var '&foo' => \&wibble::foo; push @values, &foo; }->(); }; is $@, ""; is_deeply \@values, [ "main" ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { 1 }; BEGIN { my $x = "foo\x{666}"; $x =~ /foo\p{Alnum}/; } push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { 1 }; use t::code_0; push @values, &foo; }; is $@, ""; is_deeply \@values, [ "main", 1 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { 1 }; use t::code_1; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { 1 }; use t::code_2; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 2, 1 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { 1 }; use t::code_3; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { 1 }; use t::code_4; push @values, &foo; }; is $@, ""; is_deeply \@values, [ "main", 1 ]; SKIP: { skip "no lexical propagation into string eval", 10 if "$]" < 5.009003; @values = (); eval q{ use Lexical::Var '&foo' => sub { 1 }; eval q{ push @values, &foo; }; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ eval q{ use Lexical::Var '&foo' => sub { 1 }; }; push @values, &foo; }; is $@, ""; is_deeply \@values, [ "main" ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { 1 }; eval q{ use Lexical::Var '&foo' => sub { 2 }; push @values, &foo; }; }; is $@, ""; is_deeply \@values, [ 2 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { 1 }; eval q{ use Lexical::Var '&foo' => sub { 2 }; }; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { 1 }; eval q{ use Lexical::Var '&foo' => sub { 2 }; push @values, &foo; }; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 2, 1 ]; } SKIP: { skip "\"my sub\" unavailable", 18 if "$]" < 5.017004; @values = (); eval q{ no warnings "$]" >= 5.017005 ? "experimental::lexical_subs" : "experimental"; use feature "lexical_subs"; use Lexical::Var '&foo' => sub { 1 }; push @values, &foo; { push @values, &foo; my sub foo { 2 } push @values, &foo; } push @values, &foo; use Lexical::Var '&foo' => sub { 3 }; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1, 1, 2, 1, 3 ]; @values = (); eval q{ no warnings "$]" >= 5.017005 ? "experimental::lexical_subs" : "experimental"; use feature "lexical_subs"; BEGIN { my sub foo { 2 } "Lexical::Var"->import('&foo' => sub { 1 }); } push @values, &foo; use Lexical::Var '&foo' => sub { 3 }; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1, 3 ]; @values = (); eval q{ no warnings "$]" >= 5.017005 ? "experimental::lexical_subs" : "experimental"; use feature "lexical_subs"; use Lexical::Var '&foo' => sub { 1 }; push @values, &foo; { my sub foo { 2 } push @values, &foo; use Lexical::Var '&foo' => sub { 3 }; push @values, &foo; } push @values, &foo; }; if("$]" < 5.019001) { like $@, qr/\Acan't shadow core lexical subroutine/; ok 1; } else { is $@, ""; is_deeply \@values, [ 1, 2, 3, 1 ]; } @values = (); eval q{ no warnings "$]" >= 5.017005 ? "experimental::lexical_subs" : "experimental"; use feature "lexical_subs"; no warnings "$]" >= 5.027007 ? "shadow" : "misc"; my sub foo { 1 } push @values, &foo; { use Lexical::Var '&foo' => sub { 2 }; push @values, &foo; my sub foo { 3 } push @values, &foo; } push @values, &foo; }; if("$]" < 5.019001) { like $@, qr/\Acan't shadow core lexical subroutine/; ok 1; } else { is $@, ""; is_deeply \@values, [ 1, 2, 3, 1 ]; } @values = (); eval q{ no warnings "$]" >= 5.017005 ? "experimental::lexical_subs" : "experimental"; use feature "lexical_subs"; use Lexical::Var '&foo' => sub { 1 }; push @values, &foo; { our sub foo; push @values, &foo; use Lexical::Var '&foo' => sub { 3 }; push @values, &foo; } push @values, &foo; }; if("$]" < 5.019001) { like $@, qr/\Acan't shadow core lexical subroutine/; ok 1; } else { is $@, ""; is_deeply \@values, [ 1, "main", 3, 1 ]; } @values = (); eval q{ no warnings "$]" >= 5.017005 ? "experimental::lexical_subs" : "experimental"; use feature "lexical_subs"; no warnings "$]" >= 5.027007 ? "shadow" : "misc"; our sub foo; push @values, &foo; { use Lexical::Var '&foo' => sub { 2 }; push @values, &foo; our sub foo; push @values, &foo; } push @values, &foo; }; if("$]" < 5.019001) { like $@, qr/\Acan't shadow core lexical subroutine/; ok 1; } else { is $@, ""; is_deeply \@values, [ "main", 2, "main", "main" ]; } @values = (); eval q{ no warnings "$]" >= 5.017005 ? "experimental::lexical_subs" : "experimental"; use feature "lexical_subs"; our sub foo; push @values, &foo; no Lexical::Var '&foo'; push @values, &foo; }; if("$]" < 5.019001) { like $@, qr/\Acan't shadow core lexical subroutine/; ok 1; } else { is $@, ""; is_deeply \@values, [ "main", "main" ]; } @values = (); eval q{ no warnings "$]" >= 5.017005 ? "experimental::lexical_subs" : "experimental"; use feature "lexical_subs"; no warnings "$]" >= 5.027007 ? "shadow" : "misc"; use Lexical::Var '&foo' => sub { 2 }; push @values, &foo; package wibble; our sub foo; package main; push @values, &foo; no Lexical::Var '&foo' => \&foo; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 2, "wibble", "wibble" ]; @values = (); eval q{ no warnings "$]" >= 5.017005 ? "experimental::lexical_subs" : "experimental"; use feature "lexical_subs"; no warnings "$]" >= 5.027007 ? "shadow" : "misc"; use Lexical::Var '&foo' => sub { 2 }; use Lexical::Var '&foo_alias' => \&foo; push @values, &foo; package wibble; our sub foo; package main; push @values, &foo; no Lexical::Var '&foo' => \&foo_alias; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 2, "wibble", "wibble" ]; } SKIP: { skip "builtin unavailable", 2 if "$]" < 5.035007; @values = (); eval q{ no if "$]" >= 5.035009, warnings => "experimental::builtin"; no warnings "$]" >= 5.027007 ? "shadow" : "misc"; use Lexical::Var '&blessed' => sub { 2 }; push @values, &blessed(bless([])); use builtin qw(blessed); push @values, &blessed(bless([])); use Lexical::Var '&blessed' => sub { 3 }; push @values, &blessed(bless([])); }; is $@, ""; is_deeply \@values, [ 2, "main", 3 ]; } 1; Lexical-Var-0.010/t/code_type.t000444001750001750 232514407273365 16331 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 18; BEGIN { $^H |= 0x20000 if "$]" < 5.008; } $SIG{__WARN__} = sub { die "WARNING: $_[0]" }; eval q{use Lexical::Var '&foo' => \undef;}; isnt $@, ""; eval q{use Lexical::Var '&foo' => \1;}; isnt $@, ""; eval q{use Lexical::Var '&foo' => \1.5;}; isnt $@, ""; eval q{use Lexical::Var '&foo' => \[];}; isnt $@, ""; eval q{use Lexical::Var '&foo' => \"abc";}; isnt $@, ""; eval q{use Lexical::Var '&foo' => bless(\(my$x="abc"));}; isnt $@, ""; eval q{use Lexical::Var '&foo' => \*main::wibble;}; isnt $@, ""; eval q{use Lexical::Var '&foo' => bless(\*main::wibble);}; isnt $@, ""; eval q{use Lexical::Var '&foo' => qr/xyz/;}; isnt $@, ""; eval q{use Lexical::Var '&foo' => bless(qr/xyz/);}; isnt $@, ""; eval q{use Lexical::Var '&foo' => [];}; isnt $@, ""; eval q{use Lexical::Var '&foo' => bless([]);}; isnt $@, ""; eval q{use Lexical::Var '&foo' => {};}; isnt $@, ""; eval q{use Lexical::Var '&foo' => bless({});}; isnt $@, ""; eval q{use Lexical::Var '&foo' => sub{};}; is $@, ""; eval q{use Lexical::Var '&foo' => bless(sub{});}; is $@, ""; eval q{use Lexical::Var '&foo' => sub{}; &foo if 0;}; is $@, ""; eval q{use Lexical::Var '&foo' => bless(sub{}); &foo if 0;}; is $@, ""; 1; Lexical-Var-0.010/t/error.t000444001750001750 1115614407273365 15531 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 53; BEGIN { $SIG{__WARN__} = sub { die "WARNING: $_[0]" }; } require_ok "Lexical::Var"; eval q{ Lexical::Var->import(); }; like $@, qr/\ALexical::Var does no default importation/; eval q{ Lexical::Var->unimport(); }; like $@, qr/\ALexical::Var does no default unimportation/; eval q{ Lexical::Var->import('foo'); }; like $@, qr/\Aimport list for Lexical::Var must alternate /; eval q{ Lexical::Var->import('$foo', \1); }; like $@, qr/\Acan't set up Lexical::Var lexical variable outside compilation/; eval q{ Lexical::Var->unimport('$foo'); }; like $@, qr/\Acan't set up Lexical::Var lexical variable outside compilation/; eval q{ use Lexical::Var; }; like $@, qr/\ALexical::Var does no default importation/; eval q{ no Lexical::Var; }; like $@, qr/\ALexical::Var does no default unimportation/; eval q{ use Lexical::Var 'foo'; }; like $@, qr/\Aimport list for Lexical::Var must alternate /; eval q{ use Lexical::Var undef, \1; }; like $@, qr/\Avariable name is not a string/; eval q{ use Lexical::Var \1, sub{}; }; like $@, qr/\Avariable name is not a string/; eval q{ use Lexical::Var undef, "wibble"; }; like $@, qr/\Avariable name is not a string/; eval q{ use Lexical::Var 'foo', \1; }; like $@, qr/\Amalformed variable name/; eval q{ use Lexical::Var '$', \1; }; like $@, qr/\Amalformed variable name/; eval q{ use Lexical::Var '$foo(bar', \1; }; like $@, qr/\Amalformed variable name/; eval q{ use Lexical::Var '$1foo', \1; }; like $@, qr/\Amalformed variable name/; eval q{ use Lexical::Var '$foo\x{e9}bar', \1; }; like $@, qr/\Amalformed variable name/; eval q{ use Lexical::Var '$foo::bar', \1; }; like $@, qr/\Amalformed variable name/; eval q{ use Lexical::Var '!foo', \1; }; like $@, qr/\Amalformed variable name/; eval q{ use Lexical::Var 'foo', "wibble"; }; like $@, qr/\Amalformed variable name/; eval q{ use Lexical::Var '$foo', "wibble"; }; like $@, qr/\Avariable is not scalar reference/; eval q{ no Lexical::Var undef, \1; }; like $@, qr/\Avariable name is not a string/; eval q{ no Lexical::Var \1, sub{}; }; like $@, qr/\Avariable name is not a string/; eval q{ no Lexical::Var undef, "wibble"; }; like $@, qr/\Avariable name is not a string/; eval q{ no Lexical::Var 'foo', \1; }; like $@, qr/\Amalformed variable name/; eval q{ no Lexical::Var '$', \1; }; like $@, qr/\Amalformed variable name/; eval q{ no Lexical::Var '$foo(bar', \1; }; like $@, qr/\Amalformed variable name/; eval q{ no Lexical::Var '$foo::bar', \1; }; like $@, qr/\Amalformed variable name/; eval q{ no Lexical::Var '!foo', \1; }; like $@, qr/\Amalformed variable name/; require_ok "Lexical::Sub"; eval q{ Lexical::Sub->import(); }; like $@, qr/\ALexical::Sub does no default importation/; eval q{ Lexical::Sub->unimport(); }; like $@, qr/\ALexical::Sub does no default unimportation/; eval q{ Lexical::Sub->import('foo'); }; like $@, qr/\Aimport list for Lexical::Sub must alternate /; eval q{ use Lexical::Sub; }; like $@, qr/\ALexical::Sub does no default importation/; eval q{ no Lexical::Sub; }; like $@, qr/\ALexical::Sub does no default unimportation/; eval q{ use Lexical::Sub 'foo'; }; like $@, qr/\Aimport list for Lexical::Sub must alternate /; eval q{ use Lexical::Sub undef, sub{}; }; like $@, qr/\Asubroutine name is not a string/; eval q{ use Lexical::Sub sub{}, \1; }; like $@, qr/\Asubroutine name is not a string/; eval q{ use Lexical::Sub undef, "wibble"; }; like $@, qr/\Asubroutine name is not a string/; eval q{ use Lexical::Sub '$', sub{}; }; like $@, qr/\Amalformed subroutine name/; eval q{ use Lexical::Sub 'foo(bar', sub{}; }; like $@, qr/\Amalformed subroutine name/; eval q{ use Lexical::Sub '1foo', sub{}; }; like $@, qr/\Amalformed subroutine name/; eval q{ use Lexical::Sub 'foo\x{e9}bar', sub{}; }; like $@, qr/\Amalformed subroutine name/; eval q{ use Lexical::Sub 'foo::bar', sub{}; }; like $@, qr/\Amalformed subroutine name/; eval q{ use Lexical::Sub '!foo', sub{}; }; like $@, qr/\Amalformed subroutine name/; eval q{ use Lexical::Sub 'foo', "wibble"; }; like $@, qr/\Asubroutine is not code reference/; eval q{ no Lexical::Sub undef, sub{}; }; like $@, qr/\Asubroutine name is not a string/; eval q{ no Lexical::Sub sub{}, \1; }; like $@, qr/\Asubroutine name is not a string/; eval q{ no Lexical::Sub undef, "wibble"; }; like $@, qr/\Asubroutine name is not a string/; eval q{ no Lexical::Sub '$', sub{}; }; like $@, qr/\Amalformed subroutine name/; eval q{ no Lexical::Sub 'foo(bar', sub{}; }; like $@, qr/\Amalformed subroutine name/; eval q{ no Lexical::Sub 'foo::bar', sub{}; }; like $@, qr/\Amalformed subroutine name/; eval q{ no Lexical::Sub '!foo', sub{}; }; like $@, qr/\Amalformed subroutine name/; 1; Lexical-Var-0.010/t/glob_ident.t000444001750001750 67514407273365 16452 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 3*3; BEGIN { $^H |= 0x20000 if "$]" < 5.008; } $SIG{__WARN__} = sub { die "WARNING: $_[0]" }; our(@x, @y, @z); our($oref, $aref, $bref); foreach( \*x, do { my $y = *y; \$y }, sub { my $z = *z; \$z }->(), ) { $oref = \*$_; $aref = $bref = undef; eval q{ use Lexical::Var '*foo' => $oref; $aref = \*foo; $bref = \*foo; }; is $@, ""; ok $aref == $oref; ok $bref == $oref; } 1; Lexical-Var-0.010/t/glob_scope.t000444001750001750 323014407273365 16466 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 18; BEGIN { $^H |= 0x20000 if "$]" < 5.008; } $SIG{__WARN__} = sub { return if $_[0] =~ /\AAttempt to free unreferenced scalar[ :]/ && "$]" < 5.008004; die "WARNING: $_[0]"; }; $main::one = 1; $main::one = 1; $main::two = 2; $main::two = 2; our @values; @values = (); eval q{ push @values, ${*foo{SCALAR}}; }; is $@, ""; is_deeply \@values, [ undef ]; @values = (); eval q{ use Lexical::Var '*foo' => \*one; push @values, ${*foo{SCALAR}}; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Var '*foo' => \*one; use Lexical::Var '*foo' => \*two; push @values, ${*foo{SCALAR}}; }; is $@, ""; is_deeply \@values, [ 2 ]; @values = (); eval q{ use Lexical::Var '*foo' => \*one; { push @values, ${*foo{SCALAR}}; } }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Var '*foo' => \*one; { ; } push @values, ${*foo{SCALAR}}; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ { use Lexical::Var '*foo' => \*one; } push @values, ${*foo{SCALAR}}; }; is $@, ""; is_deeply \@values, [ undef ]; @values = (); eval q{ use Lexical::Var '*foo' => \*one; { use Lexical::Var '*foo' => \*two; push @values, ${*foo{SCALAR}}; } }; is $@, ""; is_deeply \@values, [ 2 ]; @values = (); eval q{ use Lexical::Var '*foo' => \*one; { use Lexical::Var '*foo' => \*two; } push @values, ${*foo{SCALAR}}; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Var '*foo' => \*one; { use Lexical::Var '*foo' => \*two; push @values, ${*foo{SCALAR}}; } push @values, ${*foo{SCALAR}}; }; is $@, ""; is_deeply \@values, [ 2, 1 ]; 1; Lexical-Var-0.010/t/glob_type.t000444001750001750 234714407273365 16346 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 18; BEGIN { $^H |= 0x20000 if "$]" < 5.008; } $SIG{__WARN__} = sub { die "WARNING: $_[0]" }; eval q{use Lexical::Var '*foo' => \undef;}; isnt $@, ""; eval q{use Lexical::Var '*foo' => \1;}; isnt $@, ""; eval q{use Lexical::Var '*foo' => \1.5;}; isnt $@, ""; eval q{use Lexical::Var '*foo' => \[];}; isnt $@, ""; eval q{use Lexical::Var '*foo' => \"abc";}; isnt $@, ""; eval q{use Lexical::Var '*foo' => bless(\(my$x="abc"));}; isnt $@, ""; eval q{use Lexical::Var '*foo' => \*main::wibble;}; is $@, ""; eval q{use Lexical::Var '*foo' => bless(\*main::wibble);}; is $@, ""; eval q{use Lexical::Var '*foo' => qr/xyz/;}; isnt $@, ""; eval q{use Lexical::Var '*foo' => bless(qr/xyz/);}; isnt $@, ""; eval q{use Lexical::Var '*foo' => [];}; isnt $@, ""; eval q{use Lexical::Var '*foo' => bless([]);}; isnt $@, ""; eval q{use Lexical::Var '*foo' => {};}; isnt $@, ""; eval q{use Lexical::Var '*foo' => bless({});}; isnt $@, ""; eval q{use Lexical::Var '*foo' => sub{};}; isnt $@, ""; eval q{use Lexical::Var '*foo' => bless(sub{});}; isnt $@, ""; eval q{use Lexical::Var '*foo' => \*main::wibble; *foo if 0;}; is $@, ""; eval q{use Lexical::Var '*foo' => bless(\*main::wibble); *foo if 0;}; is $@, ""; 1; Lexical-Var-0.010/t/glob_write.t000444001750001750 54114407273365 16471 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 6; BEGIN { $SIG{__WARN__} = sub { die "WARNING: $_[0]" }; } my($x, $y); our @wibble; use Lexical::Var '*foo' => \*main::wibble; ok *foo{SCALAR} != \$x; ok *foo{SCALAR} != \$y; *foo = \$x; ok *foo{SCALAR} == \$x; ok *foo{SCALAR} != \$y; *foo = \$y; ok *foo{SCALAR} != \$x; ok *foo{SCALAR} == \$y; 1; Lexical-Var-0.010/t/hash_ident.t000444001750001750 65014407273365 16443 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 3*3; BEGIN { $^H |= 0x20000 if "$]" < 5.008; } $SIG{__WARN__} = sub { die "WARNING: $_[0]" }; our %x; our($oref, $aref, $bref); foreach( \%x, do { my %x; \%x }, sub { my %x; \%x }->(), ) { $oref = $_; $aref = $bref = undef; eval q{ use Lexical::Var '%foo' => $oref; $aref = \%foo; $bref = \%foo; }; is $@, ""; ok $aref == $oref; ok $bref == $oref; } 1; Lexical-Var-0.010/t/hash_ops.t000444001750001750 273514407273365 16167 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 12; BEGIN { $^H |= 0x20000 if "$]" < 5.008; } $SIG{__WARN__} = sub { return if $_[0] =~ /\AVariable \"\%foo\" is not imported /; return if $_[0] =~ /\AAttempt to free unreferenced scalar[ :]/ && "$]" < 5.008004; die "WARNING: $_[0]"; }; %main::foo = (a=>undef); %main::foo = (a=>undef); our @values; @values = (); eval q{ use strict; use Lexical::Var '%foo' => { qw(a A b B c C) }; push @values, $foo{b}; }; is $@, ""; is_deeply \@values, [ "B" ]; @values = (); eval q{ use strict; use Lexical::Var '%foo' => { qw(a A b B c C) }; my $i = "b"; push @values, $foo{$i}; }; is $@, ""; is_deeply \@values, [ "B" ]; @values = (); eval q{ use strict; use Lexical::Var '%foo' => { qw(a A b B c C) }; push @values, @foo{qw(b c a)}; }; is $@, ""; is_deeply \@values, [ qw(B C A) ]; @values = (); eval q{ use strict; use Lexical::Var '%foo' => { qw(a A b B c C) }; my @i = qw(b c a); push @values, @foo{@i}; }; is $@, ""; is_deeply \@values, [ qw(B C A) ]; SKIP: { skip "key/value hash slicing not available on this Perl", 4 unless "$]" >= 5.019004; @values = (); eval q{ use strict; use Lexical::Var '%foo' => { qw(a A b B c C) }; push @values, %foo{qw(b c a)}; }; is $@, ""; is_deeply \@values, [ qw(b B c C a A) ]; @values = (); eval q{ use strict; use Lexical::Var '%foo' => { qw(a A b B c C) }; my @i = qw(b c a); push @values, %foo{@i}; }; is $@, ""; is_deeply \@values, [ qw(b B c C a A) ]; } 1; Lexical-Var-0.010/t/hash_scope.t000444001750001750 374314407273365 16477 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 22; BEGIN { $^H |= 0x20000 if "$]" < 5.008; } $SIG{__WARN__} = sub { return if $_[0] =~ /\AVariable \"\%foo\" is not imported /; return if $_[0] =~ /\AAttempt to free unreferenced scalar[ :]/ && "$]" < 5.008004; die "WARNING: $_[0]"; }; %main::foo = (a=>undef); %main::foo = (a=>undef); our @values; @values = (); eval q{ use strict; push @values, %foo; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ no strict; push @values, %foo; }; is $@, ""; is_deeply \@values, [ a=>undef ]; @values = (); eval q{ use strict; use Lexical::Var '%foo' => {a=>1}; push @values, %foo; }; is $@, ""; is_deeply \@values, [ a=>1 ]; @values = (); eval q{ use strict; use Lexical::Var '%foo' => {a=>1}; use Lexical::Var '%foo' => {a=>2}; push @values, %foo; }; is $@, ""; is_deeply \@values, [ a=>2 ]; @values = (); eval q{ use strict; use Lexical::Var '%foo' => {a=>1}; { push @values, %foo; } }; is $@, ""; is_deeply \@values, [ a=>1 ]; @values = (); eval q{ use strict; use Lexical::Var '%foo' => {a=>1}; { ; } push @values, %foo; }; is $@, ""; is_deeply \@values, [ a=>1 ]; @values = (); eval q{ use strict; { use Lexical::Var '%foo' => {a=>1}; } push @values, %foo; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ no strict; { use Lexical::Var '%foo' => {a=>1}; } push @values, %foo; }; is $@, ""; is_deeply \@values, [ a=>undef ]; @values = (); eval q{ use strict; use Lexical::Var '%foo' => {a=>1}; { use Lexical::Var '%foo' => {a=>2}; push @values, %foo; } }; is $@, ""; is_deeply \@values, [ a=>2 ]; @values = (); eval q{ use strict; use Lexical::Var '%foo' => {a=>1}; { use Lexical::Var '%foo' => {a=>2}; } push @values, %foo; }; is $@, ""; is_deeply \@values, [ a=>1 ]; @values = (); eval q{ use strict; use Lexical::Var '%foo' => {a=>1}; { use Lexical::Var '%foo' => {a=>2}; push @values, %foo; } push @values, %foo; }; is $@, ""; is_deeply \@values, [ a=>2, a=>1 ]; 1; Lexical-Var-0.010/t/hash_type.t000444001750001750 231714407273365 16343 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 18; BEGIN { $^H |= 0x20000 if "$]" < 5.008; } $SIG{__WARN__} = sub { die "WARNING: $_[0]" }; eval q{use Lexical::Var '%foo' => \undef;}; isnt $@, ""; eval q{use Lexical::Var '%foo' => \1;}; isnt $@, ""; eval q{use Lexical::Var '%foo' => \1.5;}; isnt $@, ""; eval q{use Lexical::Var '%foo' => \[];}; isnt $@, ""; eval q{use Lexical::Var '%foo' => \"abc";}; isnt $@, ""; eval q{use Lexical::Var '%foo' => bless(\(my$x="abc"));}; isnt $@, ""; eval q{use Lexical::Var '%foo' => \*main::wibble;}; isnt $@, ""; eval q{use Lexical::Var '%foo' => bless(\*main::wibble);}; isnt $@, ""; eval q{use Lexical::Var '%foo' => qr/xyz/;}; isnt $@, ""; eval q{use Lexical::Var '%foo' => bless(qr/xyz/);}; isnt $@, ""; eval q{use Lexical::Var '%foo' => [];}; isnt $@, ""; eval q{use Lexical::Var '%foo' => bless([]);}; isnt $@, ""; eval q{use Lexical::Var '%foo' => {};}; is $@, ""; eval q{use Lexical::Var '%foo' => bless({});}; is $@, ""; eval q{use Lexical::Var '%foo' => sub{};}; isnt $@, ""; eval q{use Lexical::Var '%foo' => bless(sub{});}; isnt $@, ""; eval q{use Lexical::Var '%foo' => {}; %foo if 0;}; is $@, ""; eval q{use Lexical::Var '%foo' => bless({}); %foo if 0;}; is $@, ""; 1; Lexical-Var-0.010/t/hash_write.t000444001750001750 46514407273365 16476 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 4; BEGIN { $SIG{__WARN__} = sub { die "WARNING: $_[0]" }; } use Lexical::Var '%foo' => {}; is_deeply \%foo, {}; $foo{x} = "a"; is_deeply \%foo, {x=>"a"}; $foo{y} = "b"; is_deeply \%foo, {x=>"a",y=>"b"}; $foo{x} = "A"; is_deeply \%foo, {x=>"A",y=>"b"}; 1; Lexical-Var-0.010/t/import_return.t000444001750001750 327714407273365 17276 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 21; BEGIN { $SIG{__WARN__} = sub { die "WARNING: $_[0]" }; } use Lexical::Var (); my @r = (\*aa, \*bb, \*cc, \*dd, \*ee, \*ff, \*gg, \*hh, \*ii); my @s = (\*aa, \*bb, \*cc, \*dd, \*ee, \*ff, \*gg, \*hh, \*ii); BEGIN { is_deeply [ "Lexical::Var"->import('$foo' => \1) ], []; } BEGIN { is_deeply [ "Lexical::Var"->import('$bar' => \!0, '$baz' => \2) ], []; } BEGIN { is_deeply [ "Lexical::Var"->import('*aa' => \*bb) ], []; } BEGIN { is_deeply [ "Lexical::Var"->import('*cc' => \*dd, '*ee' => \*ff) ], []; } BEGIN { is_deeply [ "Lexical::Var"->unimport('$foo') ], []; } BEGIN { is_deeply [ "Lexical::Var"->unimport('$bar' => \3) ], []; } BEGIN { is_deeply [ "Lexical::Var"->unimport('$bar' => \!0) ], []; } BEGIN { is_deeply [ "Lexical::Var"->unimport('$quux') ], []; } BEGIN { is_deeply [ "Lexical::Var"->unimport('$baz', '$wibble') ], []; } BEGIN { is_deeply [ "Lexical::Var"->unimport('*aa') ], []; } BEGIN { is_deeply [ "Lexical::Var"->unimport('*cc' => \*gg) ], []; } BEGIN { is_deeply [ "Lexical::Var"->unimport('*cc' => \*dd) ], []; } BEGIN { is_deeply [ "Lexical::Var"->unimport('*hh') ], []; } BEGIN { is_deeply [ "Lexical::Var"->unimport('*ee', '*ii') ], []; } BEGIN { is_deeply [ "Lexical::Sub"->import(foo => sub { 1 }) ], []; } BEGIN { is_deeply [ "Lexical::Sub"->import(bar => sub { 2 }, baz => sub { 3 }) ], []; } BEGIN { is_deeply [ "Lexical::Sub"->unimport("foo") ], []; } BEGIN { is_deeply [ "Lexical::Sub"->unimport(bar => sub { 4 }) ], []; } BEGIN { is_deeply [ "Lexical::Sub"->unimport(bar => \&bar) ], []; } BEGIN { is_deeply [ "Lexical::Sub"->unimport("quux") ], []; } BEGIN { is_deeply [ "Lexical::Sub"->unimport("baz", "wibble") ], []; } 1; Lexical-Var-0.010/t/once.t000444001750001750 70714407273365 15264 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 6; BEGIN { $SIG{__WARN__} = sub { die "WARNING: $_[0]" }; } use Lexical::Var '$scalar' => \1; is_deeply $scalar, 1; use Lexical::Var '@array' => []; is_deeply \@array, []; use Lexical::Var '%hash' => {}; is_deeply \%hash, {}; use Lexical::Var '&code' => sub { 1 }; is_deeply &code, 1; use Lexical::Var '*glob' => \*x; is_deeply *glob, *x; use Lexical::Sub sub => sub { 1 }; is_deeply &sub, 1; 1; Lexical-Var-0.010/t/pod_cvg.t000444001750001750 27314407273365 15757 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(); 1; Lexical-Var-0.010/t/pod_syn.t000444001750001750 23614407273365 16010 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-Var-0.010/t/scalar_const.t000444001750001750 336214407273365 17033 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 12; BEGIN { $SIG{__WARN__} = sub { die "WARNING: $_[0]" }; } is eval q{ use Lexical::Var '$foo' => \(my $x=123); $foo; }, 123; # test that non-constant defined $foo is not a const op eval q{ die; use Lexical::Var '$foo' => \(my $x=123); $foo = 456; }; like $@, qr/\ADied /; # test that non-constant defined $foo does not participate in constant folding eval q{ die; use Lexical::Var '$foo' => \(my $x=123); !$foo = 456; }; like $@, qr/\ACan't modify not /; is eval q{ use Lexical::Var '$foo' => \123; $foo; }, 123; # test that constant defined $foo is a const op eval q{ die; use Lexical::Var '$foo' => \123; $foo = 456; }; like $@, qr/\ACan't modify constant item /; # test that constant defined $foo participates in constant folding eval q{ die; use Lexical::Var '$foo' => \123; !$foo = 456; }; like $@, qr/\ACan't modify constant item /; is_deeply scalar(eval q{ use Lexical::Var '$foo' => \(my $x = my $y = undef); [$foo]; }), [undef]; # test that non-constant undef $foo is not a const op eval q{ die; use Lexical::Var '$foo' => \(my $x = my $y = undef); $foo = 456; }; like $@, qr/\ADied /; # test that non-constant undef $foo does not participate in constant folding eval q{ die; use Lexical::Var '$foo' => \(my $x = my $y = undef); !$foo = 456; }; like $@, qr/\ACan't modify not /; is eval q{ use Lexical::Var '$foo' => \undef; $foo; }, undef; # test that constant undef $foo is a const op eval q{ die; use Lexical::Var '$foo' => \undef; $foo = 456; }; like $@, qr/\ACan't modify constant item /; # test that constant undef $foo participates in constant folding eval q{ die; use Lexical::Var '$foo' => \undef; !$foo = 456; }; like $@, qr/\ACan't modify constant item /; 1; Lexical-Var-0.010/t/scalar_ident.t000444001750001750 176614407273365 17016 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 5*6; BEGIN { $^H |= 0x20000 if "$]" < 5.008; } $SIG{__WARN__} = sub { die "WARNING: $_[0]" }; # The \5 test fails unfairly under MAD+threads due to [perl #109746]. my $bug109746 = do { my $a = \123; my $b = \$$a; $a != $b }; our $x = undef; our $y = 1; our($oref, $aref, $bref, $cref, $dref); foreach( \$x, \$y, do { my $x = 6; \$x }, sub { my $x = 7; \$x }->(), $bug109746 ? "skip" : \5, \undef, ) { SKIP: { skip "[perl #109746]", 5 if ref($_) eq "" && $_ eq "skip"; $oref = $_; $aref = $bref = $cref = $dref = undef; eval q{ use Lexical::Var '$foo' => $oref; $aref = \$foo; $bref = \$foo; # A srefgen op applied to a const op will undergo # constant folding. This screws up some test cases. # So we also test with list-type refgen, which won't # be constant-folded. ($cref, undef) = \($foo, 1); ($dref, undef) = \($foo, 2); }; is $@, ""; ok $aref == $oref; ok $bref == $oref; ok $cref == $oref; ok $dref == $oref; } } 1; Lexical-Var-0.010/t/scalar_scope.t000444001750001750 2257514407273365 17045 0ustar00zeframzefram000000000000use warnings; use strict; BEGIN { unshift @INC, "./t/lib"; } use Test::More tests => 96; BEGIN { $^H |= 0x20000 if "$]" < 5.008; } $SIG{__WARN__} = sub { return if $_[0] =~ /\AVariable \"\$foo\" is not imported /; return if $_[0] =~ /\AAttempt to free unreferenced scalar[ :]/ && "$]" < 5.008004; die "WARNING: $_[0]"; }; our @values; @values = (); eval q{ use strict; push @values, $foo; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ no strict; push @values, $foo; }; is $@, ""; is_deeply \@values, [ undef ]; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); push @values, $foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); use Lexical::Var '$foo' => \(my$x=2); push @values, $foo; }; is $@, ""; is_deeply \@values, [ 2 ]; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); { push @values, $foo; } }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); { ; } push @values, $foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use strict; { use Lexical::Var '$foo' => \(my$x=1); } push @values, $foo; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ no strict; { use Lexical::Var '$foo' => \(my$x=1); } push @values, $foo; }; is $@, ""; is_deeply \@values, [ undef ]; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); { use Lexical::Var '$foo' => \(my$x=2); push @values, $foo; } }; is $@, ""; is_deeply \@values, [ 2 ]; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); { use Lexical::Var '$foo' => \(my$x=2); } push @values, $foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); { use Lexical::Var '$foo' => \(my$x=2); push @values, $foo; } push @values, $foo; }; is $@, ""; is_deeply \@values, [ 2, 1 ]; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); package wibble; push @values, $foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use strict; package wibble; use Lexical::Var '$foo' => \(my$x=1); push @values, $foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use strict; package wibble; use Lexical::Var '$foo' => \(my$x=1); package main; push @values, $foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); package wibble; use Lexical::Var '$foo' => \(my$x=2); push @values, $foo; }; is $@, ""; is_deeply \@values, [ 2 ]; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); package wibble; use Lexical::Var '$foo' => \(my$x=2); package main; push @values, $foo; }; is $@, ""; is_deeply \@values, [ 2 ]; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); { no Lexical::Var '$foo'; push @values, $foo; } }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); no Lexical::Var '$bar'; push @values, $foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ no strict; use Lexical::Var '$foo' => \(my$x=1); { no Lexical::Var '$foo'; push @values, $foo; } }; is $@, ""; is_deeply \@values, [ undef ]; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); { no Lexical::Var '$foo'; } push @values, $foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); { no Lexical::Var '$foo' => \$foo; push @values, $foo; } }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ no strict; use Lexical::Var '$foo' => \(my$x=1); { no Lexical::Var '$foo' => \$foo; push @values, $foo; } }; is $@, ""; is_deeply \@values, [ undef ]; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); { no Lexical::Var '$foo' => \$foo; } push @values, $foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); { no Lexical::Var '$foo' => \(my$x=1); push @values, $foo; } }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); { no Lexical::Var '$foo' => \(my$x=1); } push @values, $foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ no strict; our $value_a = "aaa"; use Lexical::Var '$foo' => \$value_a; sub { no Lexical::Var '$foo' => \$value_a; push @values, $foo; }->(); }; is $@, ""; is_deeply \@values, [ undef ]; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); BEGIN { my $x = "foo\x{666}"; $x =~ /foo\p{Alnum}/; } push @values, $foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); use t::scalar_0; push @values, $foo; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ no strict; use Lexical::Var '$foo' => \(my$x=1); use t::scalar_0n; push @values, $foo; }; is $@, ""; is_deeply \@values, [ undef, 1 ]; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); use t::scalar_1; push @values, $foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); use t::scalar_2; push @values, $foo; }; is $@, ""; is_deeply \@values, [ 2, 1 ]; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); use t::scalar_3; push @values, $foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); use t::scalar_4; push @values, $foo; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ no strict; use Lexical::Var '$foo' => \(my$x=1); use t::scalar_4n; push @values, $foo; }; is $@, ""; is_deeply \@values, [ undef, 1 ]; SKIP: { skip "no lexical propagation into string eval", 12 if "$]" < 5.009003; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); eval q{ use strict; push @values, $foo; }; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use strict; eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); }; push @values, $foo; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ no strict; eval q{ no strict; use Lexical::Var '$foo' => \(my$x=1); }; push @values, $foo; }; is $@, ""; is_deeply \@values, [ undef ]; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=2); push @values, $foo; }; }; is $@, ""; is_deeply \@values, [ 2 ]; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=2); }; push @values, $foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=2); push @values, $foo; }; push @values, $foo; }; is $@, ""; is_deeply \@values, [ 2, 1 ]; } @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); push @values, $foo; { my $foo = 2; push @values, $foo; use Lexical::Var '$foo' => \(my$x=3); push @values, $foo; } push @values, $foo; }; is $@, ""; is_deeply \@values, [ 1, 2, 3, 1 ]; @values = (); eval q{ use strict; no warnings "$]" >= 5.027007 ? "shadow" : "misc"; my $foo = 1; push @values, $foo; { use Lexical::Var '$foo' => \(my$x=2); push @values, $foo; my $foo = 3; push @values, $foo; } push @values, $foo; }; is $@, ""; is_deeply \@values, [ 1, 2, 3, 1 ]; @values = (); eval q{ use strict; use Lexical::Var '$foo' => \(my$x=1); push @values, $foo; { our $foo; push @values, $foo; use Lexical::Var '$foo' => \(my$x=3); push @values, $foo; } push @values, $foo; }; is $@, ""; is_deeply \@values, [ 1, undef, 3, 1 ]; @values = (); eval q{ use strict; no warnings "$]" >= 5.027007 ? "shadow" : "misc"; our $foo; push @values, $foo; { use Lexical::Var '$foo' => \(my$x=2); push @values, $foo; our $foo; push @values, $foo; } push @values, $foo; }; is $@, ""; is_deeply \@values, [ undef, 2, undef, undef ]; @values = (); eval q{ use strict; no warnings "$]" >= 5.027007 ? "shadow" : "misc"; use Lexical::Var '$foo' => \(my$x=2); push @values, $foo; our $foo; push @values, $foo; no Lexical::Var '$foo' => \$foo; push @values, $foo; }; is $@, ""; is_deeply \@values, [ 2, undef, undef ]; @values = (); eval q{ use strict; no warnings "$]" >= 5.027007 ? "shadow" : "misc"; use Lexical::Var '$foo' => \(my$x=2); use Lexical::Var '$foo_alias' => \$foo; push @values, $foo; our $foo; push @values, $foo; no Lexical::Var '$foo' => \$foo_alias; push @values, $foo; }; is $@, ""; is_deeply \@values, [ 2, undef, undef ]; SKIP: { skip "\"class\" unavailable", 4 if "$]" < 5.037009; @values = (); eval q{ use feature "class"; no warnings "experimental::class"; class Test0 { field $foo; use Lexical::Var '$foo' => \(my$x=2); push @values, $foo; } }; is $@, ""; is_deeply \@values, [ 2 ]; @values = (); eval q{ use feature "class"; no warnings "experimental::class"; class Test1 { field $foo = 1; method aa { push @values, $foo; use Lexical::Var '$foo' => \(my$x=2); push @values, $foo; use Lexical::Var '$self' => \(my$x=3); push @values, $self; } } Test1->new->aa; }; is $@, ""; is_deeply \@values, [ 1, 2, 3 ]; } 1; Lexical-Var-0.010/t/scalar_type.t000444001750001750 336514407273365 16671 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 26; BEGIN { $^H |= 0x20000 if "$]" < 5.008; } $SIG{__WARN__} = sub { die "WARNING: $_[0]" }; eval q{use Lexical::Var '$foo' => \undef;}; is $@, ""; eval q{use Lexical::Var '$foo' => \1;}; is $@, ""; eval q{use Lexical::Var '$foo' => \1.5;}; is $@, ""; eval q{use Lexical::Var '$foo' => \[];}; is $@, ""; eval q{use Lexical::Var '$foo' => \"abc";}; is $@, ""; eval q{use Lexical::Var '$foo' => bless(\(my$x="abc"));}; is $@, ""; eval q{use Lexical::Var '$foo' => \*main::wibble;}; is $@, ""; eval q{use Lexical::Var '$foo' => bless(\*main::wibble);}; is $@, ""; eval q{use Lexical::Var '$foo' => qr/xyz/;}; is $@, ""; eval q{use Lexical::Var '$foo' => bless(qr/xyz/);}; is $@, ""; eval q{use Lexical::Var '$foo' => [];}; isnt $@, ""; eval q{use Lexical::Var '$foo' => bless([]);}; isnt $@, ""; eval q{use Lexical::Var '$foo' => {};}; isnt $@, ""; eval q{use Lexical::Var '$foo' => bless({});}; isnt $@, ""; eval q{use Lexical::Var '$foo' => sub{};}; isnt $@, ""; eval q{use Lexical::Var '$foo' => bless(sub{});}; isnt $@, ""; eval q{use Lexical::Var '$foo' => \undef; $foo if 0;}; is $@, ""; eval q{use Lexical::Var '$foo' => \1; $foo if 0;}; is $@, ""; eval q{use Lexical::Var '$foo' => \1.5; $foo if 0;}; is $@, ""; eval q{use Lexical::Var '$foo' => \[]; $foo if 0;}; is $@, ""; eval q{use Lexical::Var '$foo' => \"abc"; $foo if 0;}; is $@, ""; eval q{use Lexical::Var '$foo' => bless(\(my$x="abc")); $foo if 0;}; is $@, ""; eval q{use Lexical::Var '$foo' => \*main::wibble; $foo if 0;}; is $@, ""; eval q{use Lexical::Var '$foo' => bless(\*main::wibble); $foo if 0;}; is $@, ""; eval q{use Lexical::Var '$foo' => qr/xyz/; $foo if 0;}; is $@, ""; eval q{use Lexical::Var '$foo' => bless(qr/xyz/); $foo if 0;}; is $@, ""; 1; Lexical-Var-0.010/t/scalar_write.t000444001750001750 30214407273365 17006 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 3; BEGIN { $SIG{__WARN__} = sub { die "WARNING: $_[0]" }; } use Lexical::Var '$foo' => \(my $x=1); is $foo, 1; is ++$foo, 2; is $foo, 2; 1; Lexical-Var-0.010/t/setup_code.t000444001750001750 246214407273365 16512 0ustar00zeframzefram000000000000use warnings; use strict; BEGIN { unshift @INC, "./t/lib"; } use Test::More tests => 12; BEGIN { $SIG{__WARN__} = sub { die "WARNING: $_[0]" }; } require Lexical::Var; sub test_case($) { my $result = eval($_[0]); my $err = $@; if($err eq "") { is $result, 123; } else { like $err, qr/\Acan't set up Lexical::Var lexical /; } } test_case q{ use Lexical::Var '&t1' => sub{123}; &t1; }; test_case q{ BEGIN { "Lexical::Var"->import('&t2' => sub{123}); } &t2; }; test_case q{ BEGIN { require Lexical::Sub; "Lexical::Var"->import('&t3' => sub{123}); } &t3; }; test_case q{ BEGIN { do "t/setup_c_4.pm"; die $@ if $@; } &t4; }; test_case q{ BEGIN { require t::setup_c_5; } &t5; }; test_case q{ use t::setup_c_6; &t6; }; test_case q{ use t::setup_c_7; &t7; }; test_case q{ BEGIN { sub{ "Lexical::Var"->import('&t8' => sub{123}); }->(); } &t8; }; test_case q{ BEGIN { sub { my $n = 123; sub{ "Lexical::Var"->import('&t9' => sub{$n}); }; }->()->(); } &t9; }; sub ts10() { "Lexical::Var"->import('&t10' => sub{123}); } test_case q{ BEGIN { ts10(); } &t10; }; test_case q{ BEGIN { eval q{"x"}; die $@ if $@; "Lexical::Var"->import('&t11' => sub{123}); } &t11; }; test_case q{ BEGIN { eval q{ "Lexical::Var"->import('&t12' => sub{123}); }; die $@ if $@; } &t12; }; 1; Lexical-Var-0.010/t/setup_scalar.t000444001750001750 242214407273365 17041 0ustar00zeframzefram000000000000use warnings; use strict; BEGIN { unshift @INC, "./t/lib"; } use Test::More tests => 12; BEGIN { $SIG{__WARN__} = sub { die "WARNING: $_[0]" }; } require Lexical::Var; sub test_case($) { my $result = eval($_[0]); my $err = $@; if($err eq "") { is $result, 123; } else { like $err, qr/\Acan't set up Lexical::Var lexical /; } } test_case q{ use Lexical::Var '$t1' => \123; $t1; }; test_case q{ BEGIN { "Lexical::Var"->import('$t2' => \123); } $t2; }; test_case q{ BEGIN { require Lexical::Sub; "Lexical::Var"->import('$t3' => \123); } $t3; }; test_case q{ BEGIN { do "t/setup_s_4.pm"; die $@ if $@; } $t4; }; test_case q{ BEGIN { require t::setup_s_5; } $t5; }; test_case q{ use t::setup_s_6; $t6; }; test_case q{ use t::setup_s_7; $t7; }; test_case q{ BEGIN { sub{ "Lexical::Var"->import('$t8' => \123); }->(); } $t8; }; test_case q{ BEGIN { sub { my $n = 123; sub{ "Lexical::Var"->import('$t9' => \$n); }; }->()->(); } $t9; }; sub ts10() { "Lexical::Var"->import('$t10' => \123); } test_case q{ BEGIN { ts10(); } $t10; }; test_case q{ BEGIN { eval q{"x"}; die $@ if $@; "Lexical::Var"->import('$t11' => \123); } $t11; }; test_case q{ BEGIN { eval q{ "Lexical::Var"->import('$t12' => \123); }; die $@ if $@; } $t12; }; 1; Lexical-Var-0.010/t/sub_bare.t000444001750001750 2140114407273365 16154 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More; BEGIN { plan skip_all => "bare subs impossible on this perl" if "$]" < 5.011002; } plan tests => 2*10*6; BEGIN { $^H |= 0x20000 if "$]" < 5.008; } $SIG{__WARN__} = sub { return if $_[0] =~ /\AAttempt to free unreferenced scalar[ :]/ && "$]" < 5.008004; die "WARNING: $_[0]"; }; our @x = (100, 200); our @values; @values = (); eval q{ use Lexical::Sub foo => sub () { rand() < 2 ? 123 : 0 }; push @values, foo; }; is $@, ""; is_deeply \@values, [ 123 ]; @values = (); eval q{ use Lexical::Sub foo => sub () { rand() < 2 ? 123 : 0 }; push @values, foo + 10; }; is $@, ""; is_deeply \@values, [ 133 ]; @values = (); eval q{ use Lexical::Sub foo => sub () { rand() < 2 ? 123 : 0 }; push @values, foo 10; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub () { rand() < 2 ? 123 : 0 }; push @values, foo 10, 20; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub () { rand() < 2 ? 123 : 0 }; push @values, foo @x; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub () { rand() < 2 ? 123 : 0 }; push @values, foo { 10+20; }; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub () { rand() < 2 ? 123 : 0 }; push @values, foo(); }; is $@, ""; is_deeply \@values, [ 123 ]; @values = (); eval q{ use Lexical::Sub foo => sub () { rand() < 2 ? 123 : 0 }; push @values, foo(10); }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub () { rand() < 2 ? 123 : 0 }; push @values, foo(10, 20); }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub () { rand() < 2 ? 123 : 0 }; push @values, foo(@x); }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub () { 123 }; push @values, foo; }; is $@, ""; is_deeply \@values, [ 123 ]; @values = (); eval q{ use Lexical::Sub foo => sub () { 123 }; push @values, foo + 10; }; is $@, ""; is_deeply \@values, [ 133 ]; @values = (); eval q{ use Lexical::Sub foo => sub () { 123 }; push @values, foo 10; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub () { 123 }; push @values, foo 10, 20; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub () { 123 }; push @values, foo @x; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub () { 123 }; push @values, foo { 10+20; }; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub () { 123 }; push @values, foo(); }; is $@, ""; is_deeply \@values, [ 123 ]; @values = (); eval q{ use Lexical::Sub foo => sub () { 123 }; push @values, foo(10); }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub () { 123 }; push @values, foo(10, 20); }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub () { 123 }; push @values, foo(@x); }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub ($) { $_[0]+1 }; push @values, foo; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub ($) { $_[0]+1 }; push @values, foo + 10; }; is $@, ""; is_deeply \@values, [ 11 ]; @values = (); eval q{ use Lexical::Sub foo => sub ($) { $_[0]+1 }; push @values, foo 10; }; is $@, ""; is_deeply \@values, [ 11 ]; @values = (); eval q{ use Lexical::Sub foo => sub ($) { $_[0]+1 }; push @values, foo 10, 20; }; is $@, ""; is_deeply \@values, [ 11, 20 ]; @values = (); eval q{ use Lexical::Sub foo => sub ($) { $_[0]+1 }; push @values, foo @x; }; is $@, ""; is_deeply \@values, [ 3 ]; @values = (); eval q{ use Lexical::Sub foo => sub ($) { $_[0]+1 }; push @values, foo { 10+20; }; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub ($) { $_[0]+1 }; push @values, foo(); }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub ($) { $_[0]+1 }; push @values, foo(10); }; is $@, ""; is_deeply \@values, [ 11 ]; @values = (); eval q{ use Lexical::Sub foo => sub ($) { $_[0]+1 }; push @values, foo(10, 20); }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub ($) { $_[0]+1 }; push @values, foo(@x); }; is $@, ""; is_deeply \@values, [ 3 ]; @values = (); eval q{ use Lexical::Sub foo => sub (@) { "a", map { $_+1 } @_ }; push @values, foo; }; is $@, ""; is_deeply \@values, [ "a" ]; @values = (); eval q{ use Lexical::Sub foo => sub (@) { "a", map { $_+1 } @_ }; push @values, foo + 10; }; is $@, ""; is_deeply \@values, [ "a", 11 ]; @values = (); eval q{ use Lexical::Sub foo => sub (@) { "a", map { $_+1 } @_ }; push @values, foo 10; }; is $@, ""; is_deeply \@values, [ "a", 11 ]; @values = (); eval q{ use Lexical::Sub foo => sub (@) { "a", map { $_+1 } @_ }; push @values, foo 10, 20; }; is $@, ""; is_deeply \@values, [ "a", 11, 21 ]; @values = (); eval q{ use Lexical::Sub foo => sub (@) { "a", map { $_+1 } @_ }; push @values, foo @x; }; is $@, ""; is_deeply \@values, [ "a", 101, 201 ]; @values = (); eval q{ use Lexical::Sub foo => sub (@) { "a", map { $_+1 } @_ }; push @values, foo { 10+20; }; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub (@) { "a", map { $_+1 } @_ }; push @values, foo(); }; is $@, ""; is_deeply \@values, [ "a" ]; @values = (); eval q{ use Lexical::Sub foo => sub (@) { "a", map { $_+1 } @_ }; push @values, foo(10); }; is $@, ""; is_deeply \@values, [ "a", 11 ]; @values = (); eval q{ use Lexical::Sub foo => sub (@) { "a", map { $_+1 } @_ }; push @values, foo(10, 20); }; is $@, ""; is_deeply \@values, [ "a", 11, 21 ]; @values = (); eval q{ use Lexical::Sub foo => sub (@) { "a", map { $_+1 } @_ }; push @values, foo(@x); }; is $@, ""; is_deeply \@values, [ "a", 101, 201 ]; @values = (); eval q{ use Lexical::Sub foo => sub { "b", map { $_+1 } @_ }; push @values, foo; }; is $@, ""; is_deeply \@values, [ "b" ]; @values = (); eval q{ use Lexical::Sub foo => sub { "b", map { $_+1 } @_ }; push @values, foo + 10; }; is $@, ""; is_deeply \@values, [ "b", 11 ]; @values = (); eval q{ use Lexical::Sub foo => sub { "b", map { $_+1 } @_ }; push @values, foo 10; }; is $@, ""; is_deeply \@values, [ "b", 11 ]; @values = (); eval q{ use Lexical::Sub foo => sub { "b", map { $_+1 } @_ }; push @values, foo 10, 20; }; is $@, ""; is_deeply \@values, [ "b", 11, 21 ]; @values = (); eval q{ use Lexical::Sub foo => sub { "b", map { $_+1 } @_ }; push @values, foo @x; }; is $@, ""; is_deeply \@values, [ "b", 101, 201 ]; @values = (); eval q{ use Lexical::Sub foo => sub { "b", map { $_+1 } @_ }; push @values, foo { 10+20; }; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub { "b", map { $_+1 } @_ }; push @values, foo(); }; is $@, ""; is_deeply \@values, [ "b" ]; @values = (); eval q{ use Lexical::Sub foo => sub { "b", map { $_+1 } @_ }; push @values, foo(10); }; is $@, ""; is_deeply \@values, [ "b", 11 ]; @values = (); eval q{ use Lexical::Sub foo => sub { "b", map { $_+1 } @_ }; push @values, foo(10, 20); }; is $@, ""; is_deeply \@values, [ "b", 11, 21 ]; @values = (); eval q{ use Lexical::Sub foo => sub { "b", map { $_+1 } @_ }; push @values, foo(@x); }; is $@, ""; is_deeply \@values, [ "b", 101, 201 ]; @values = (); eval q{ use Lexical::Sub foo => sub (&) { "c", $_[0]->()+1 }; push @values, foo; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub (&) { "c", $_[0]->()+1 }; push @values, foo + 10; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub (&) { "c", $_[0]->()+1 }; push @values, foo 10; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub (&) { "c", $_[0]->()+1 }; push @values, foo 10, 20; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub (&) { "c", $_[0]->()+1 }; push @values, foo @x; }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub (&) { "c", $_[0]->()+1 }; push @values, foo { 10+20; }; }; is $@, ""; is_deeply \@values, [ "c", 31 ]; @values = (); eval q{ use Lexical::Sub foo => sub (&) { "c", $_[0]->()+1 }; push @values, foo(); }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub (&) { "c", $_[0]->()+1 }; push @values, foo(10); }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub (&) { "c", $_[0]->()+1 }; push @values, foo(10, 20); }; isnt $@, ""; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub foo => sub (&) { "c", $_[0]->()+1 }; push @values, foo(@x); }; isnt $@, ""; is_deeply \@values, []; 1; Lexical-Var-0.010/t/sub_bare_no.t000444001750001750 330014407273365 16626 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More; BEGIN { plan skip_all => "bare subs possible on this perl" if "$]" >= 5.011002; } plan tests => 12; BEGIN { $^H |= 0x20000 if "$]" < 5.008; } $SIG{__WARN__} = sub { return if $_[0] =~ /\AAttempt to free unreferenced scalar[ :]/ && "$]" < 5.008004; die "WARNING: $_[0]"; }; sub main::foo { "main" } sub main::bar () { "main" } our @values; { local $TODO = "bareword ref without parens works funny"; @values = (); eval q{ use Lexical::Sub foo => sub () { 1 }; push @values, foo; }; like $@, qr/\Acan't reference Lexical::Var lexical subroutine without \& sigil/; is_deeply \@values, []; } @values = (); eval q{ use Lexical::Sub foo => sub () { 1 }; push @values, foo(); }; like $@, qr/\Acan't reference Lexical::Var lexical subroutine without \& sigil/; is_deeply \@values, []; { local $TODO = "bareword ref without parens works funny"; @values = (); eval q{ use Lexical::Sub foo => sub ($) { 1+$_[0] }; push @values, foo 10; }; like $@, qr/\Acan't reference Lexical::Var lexical subroutine without \& sigil/; is_deeply \@values, []; } @values = (); eval q{ use Lexical::Sub foo => sub ($) { 1+$_[0] }; push @values, foo(10); }; like $@, qr/\Acan't reference Lexical::Var lexical subroutine without \& sigil/; is_deeply \@values, []; { local $TODO = "constant subs work funny"; @values = (); eval q{ use Lexical::Sub bar => sub () { 1 }; push @values, bar; }; like $@, qr/\Acan't reference Lexical::Var lexical subroutine without \& sigil/; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub bar => sub () { 1 }; push @values, bar(); }; like $@, qr/\Acan't reference Lexical::Var lexical subroutine without \& sigil/; is_deeply \@values, []; } 1; Lexical-Var-0.010/t/sub_const.t000444001750001750 204314407273365 16352 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More; BEGIN { plan skip_all => "bare subs impossible on this perl" if "$]" < 5.011002; } plan tests => 6; BEGIN { $SIG{__WARN__} = sub { die "WARNING: $_[0]" }; } is eval q{ use Lexical::Sub foo => sub () { my $x=123 }; foo(); }, 123; # test that non-constant foo() is not a const op eval q{ use Lexical::Sub foo => sub () { my $x=123 }; foo() = 456; die; }; like $@, qr/\ACan't modify non-lvalue subroutine call /; # test that non-constant foo() does not participate in constant folding eval q{ die; use Lexical::Sub foo => sub () { my $x=123 }; !foo() = 456; }; like $@, qr/\ACan't modify not /; is eval q{ use Lexical::Sub foo => sub () { 123 }; foo(); }, 123; # test that constant foo() is a const op eval q{ die; use Lexical::Sub foo => sub () { 123 }; foo() = 456; }; like $@, qr/\ACan't modify constant item /; # test that constant foo() participates in constant folding eval q{ die; use Lexical::Sub foo => sub () { 123 }; !foo() = 456; }; like $@, qr/\ACan't modify constant item /; 1; Lexical-Var-0.010/t/sub_ident.t000444001750001750 63614407273365 16315 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 3*3; BEGIN { $^H |= 0x20000 if "$]" < 5.008; } $SIG{__WARN__} = sub { die "WARNING: $_[0]" }; sub x {} our($oref, $aref, $bref); foreach( \&x, sub{}, sub { my $x; sub{$x} }->(), ) { $oref = $_; $aref = $bref = undef; eval q{ use Lexical::Sub foo => $oref; $aref = \&foo; $bref = \&foo; }; is $@, ""; ok $aref == $oref; ok $bref == $oref; } 1; Lexical-Var-0.010/t/sub_ops.t000444001750001750 214614407273365 16031 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 12; BEGIN { $^H |= 0x20000 if "$]" < 5.008; } $SIG{__WARN__} = sub { return if $_[0] =~ /\AAttempt to free unreferenced scalar[ :]/ && "$]" < 5.008004; die "WARNING: $_[0]"; }; sub main::foo { "main" } sub main::bar () { "main" } our @values; @values = (); eval q{ use Lexical::Sub foo => sub () { 1 }; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Sub foo => sub () { 1 }; push @values, &foo(); }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Sub foo => sub ($) { 1+$_[0] }; push @values, &foo(10); push @values, &foo(20); }; is $@, ""; is_deeply \@values, [ 11, 21 ]; @values = (); eval q{ use Lexical::Sub foo => sub ($) { 1+$_[0] }; my @a = (10, 20); push @values, &foo(@a); }; is $@, ""; is_deeply \@values, [ 11 ]; @values = (); eval q{ use Lexical::Sub bar => sub () { 1 }; push @values, &bar; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Sub bar => sub () { 1 }; push @values, &bar(); }; is $@, ""; is_deeply \@values, [ 1 ]; 1; Lexical-Var-0.010/t/sub_scope.t000444001750001750 2327414407273365 16366 0ustar00zeframzefram000000000000use warnings; use strict; BEGIN { unshift @INC, "./t/lib"; } use Test::More tests => 86; BEGIN { $^H |= 0x20000 if "$]" < 5.008; } $SIG{__WARN__} = sub { return if $_[0] =~ /\AAttempt to free unreferenced scalar[ :]/ && "$]" < 5.008004; die "WARNING: $_[0]"; }; sub main::foo { "main" } sub wibble::foo { "wibble" } our @values; @values = (); eval q{ push @values, &foo; }; is $@, ""; is_deeply \@values, [ "main" ]; @values = (); eval q{ use Lexical::Sub foo => sub { 1 }; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Sub foo => sub { 1 }; use Lexical::Sub foo => sub { 2 }; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 2 ]; @values = (); eval q{ use Lexical::Sub foo => sub { 1 }; { push @values, &foo; } }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Sub foo => sub { 1 }; { ; } push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ { use Lexical::Sub foo => sub { 1 }; } push @values, &foo; }; is $@, ""; is_deeply \@values, [ "main" ]; @values = (); eval q{ use Lexical::Sub foo => sub { 1 }; { use Lexical::Sub foo => sub { 2 }; push @values, &foo; } }; is $@, ""; is_deeply \@values, [ 2 ]; @values = (); eval q{ use Lexical::Sub foo => sub { 1 }; { use Lexical::Sub foo => sub { 2 }; } push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Sub foo => sub { 1 }; { use Lexical::Sub foo => sub { 2 }; push @values, &foo; } push @values, &foo; }; is $@, ""; is_deeply \@values, [ 2, 1 ]; @values = (); eval q{ use Lexical::Sub foo => sub { 1 }; package wibble; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ package wibble; use Lexical::Sub foo => sub { 1 }; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ package wibble; use Lexical::Sub foo => sub { 1 }; package main; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Sub foo => sub { 1 }; package wibble; use Lexical::Sub foo => sub { 2 }; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 2 ]; @values = (); eval q{ use Lexical::Sub foo => sub { 1 }; package wibble; use Lexical::Sub foo => sub { 2 }; package main; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 2 ]; @values = (); eval q{ use Lexical::Sub foo => sub { 1 }; { no Lexical::Sub "foo"; push @values, &foo; } }; is $@, ""; is_deeply \@values, [ "main" ]; @values = (); eval q{ use strict; use Lexical::Sub foo => sub { 1 }; no Lexical::Sub "bar"; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Sub foo => sub { 1 }; { no Lexical::Sub "foo"; } push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Sub foo => sub { 1 }; { no Lexical::Sub foo => \&foo; push @values, &foo; } }; is $@, ""; is_deeply \@values, [ "main" ]; @values = (); eval q{ use Lexical::Sub foo => sub { 1 }; { no Lexical::Sub foo => \&foo; } push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Sub foo => sub { 1 }; { no Lexical::Sub foo => sub { 1 }; push @values, &foo; } }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Sub foo => sub { 1 }; { no Lexical::Sub foo => sub { 1 }; } push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Sub foo => \&wibble::foo; sub { no Lexical::Sub foo => \&wibble::foo; push @values, &foo; }->(); }; is $@, ""; is_deeply \@values, [ "main" ]; @values = (); eval q{ use Lexical::Sub foo => sub { 1 }; BEGIN { my $x = "foo\x{666}"; $x =~ /foo\p{Alnum}/; } push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Sub foo => sub { 1 }; use t::code_0; push @values, &foo; }; is $@, ""; is_deeply \@values, [ "main", 1 ]; @values = (); eval q{ use Lexical::Sub foo => sub { 1 }; use t::code_1; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Sub foo => sub { 1 }; use t::code_2; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 2, 1 ]; @values = (); eval q{ use Lexical::Sub foo => sub { 1 }; use t::code_3; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Sub foo => sub { 1 }; use t::code_4; push @values, &foo; }; is $@, ""; is_deeply \@values, [ "main", 1 ]; SKIP: { skip "no lexical propagation into string eval", 10 if "$]" < 5.009003; @values = (); eval q{ use Lexical::Sub foo => sub { 1 }; eval q{ push @values, &foo; }; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ eval q{ use Lexical::Sub foo => sub { 1 }; }; push @values, &foo; }; is $@, ""; is_deeply \@values, [ "main" ]; @values = (); eval q{ use Lexical::Sub foo => sub { 1 }; eval q{ use Lexical::Sub foo => sub { 2 }; push @values, &foo; }; }; is $@, ""; is_deeply \@values, [ 2 ]; @values = (); eval q{ use Lexical::Sub foo => sub { 1 }; eval q{ use Lexical::Sub foo => sub { 2 }; }; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1 ]; @values = (); eval q{ use Lexical::Sub foo => sub { 1 }; eval q{ use Lexical::Sub foo => sub { 2 }; push @values, &foo; }; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 2, 1 ]; } SKIP: { skip "\"my sub\" unavailable", 18 if "$]" < 5.017004; @values = (); eval q{ no warnings "$]" >= 5.017005 ? "experimental::lexical_subs" : "experimental"; use feature "lexical_subs"; use Lexical::Sub foo => sub { 1 }; push @values, &foo; { push @values, &foo; my sub foo { 2 } push @values, &foo; } push @values, &foo; use Lexical::Sub foo => sub { 3 }; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1, 1, 2, 1, 3 ]; @values = (); eval q{ no warnings "$]" >= 5.017005 ? "experimental::lexical_subs" : "experimental"; use feature "lexical_subs"; BEGIN { my sub foo { 2 } "Lexical::Sub"->import(foo => sub { 1 }); } push @values, &foo; use Lexical::Sub foo => sub { 3 }; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 1, 3 ]; @values = (); eval q{ no warnings "$]" >= 5.017005 ? "experimental::lexical_subs" : "experimental"; use feature "lexical_subs"; use Lexical::Sub foo => sub { 1 }; push @values, &foo; { my sub foo { 2 } push @values, &foo; use Lexical::Sub foo => sub { 3 }; push @values, &foo; } push @values, &foo; }; if("$]" < 5.019001) { like $@, qr/\Acan't shadow core lexical subroutine/; ok 1; } else { is $@, ""; is_deeply \@values, [ 1, 2, 3, 1 ]; } @values = (); eval q{ no warnings "$]" >= 5.017005 ? "experimental::lexical_subs" : "experimental"; use feature "lexical_subs"; no warnings "$]" >= 5.027007 ? "shadow" : "misc"; my sub foo { 1 } push @values, &foo; { use Lexical::Sub foo => sub { 2 }; push @values, &foo; my sub foo { 3 } push @values, &foo; } push @values, &foo; }; if("$]" < 5.019001) { like $@, qr/\Acan't shadow core lexical subroutine/; ok 1; } else { is $@, ""; is_deeply \@values, [ 1, 2, 3, 1 ]; } @values = (); eval q{ no warnings "$]" >= 5.017005 ? "experimental::lexical_subs" : "experimental"; use feature "lexical_subs"; use Lexical::Sub foo => sub { 1 }; push @values, &foo; { our sub foo; push @values, &foo; use Lexical::Sub foo => sub { 3 }; push @values, &foo; } push @values, &foo; }; if("$]" < 5.019001) { like $@, qr/\Acan't shadow core lexical subroutine/; ok 1; } else { is $@, ""; is_deeply \@values, [ 1, "main", 3, 1 ]; } @values = (); eval q{ no warnings "$]" >= 5.017005 ? "experimental::lexical_subs" : "experimental"; use feature "lexical_subs"; no warnings "$]" >= 5.027007 ? "shadow" : "misc"; our sub foo; push @values, &foo; { use Lexical::Sub foo => sub { 2 }; push @values, &foo; our sub foo; push @values, &foo; } push @values, &foo; }; if("$]" < 5.019001) { like $@, qr/\Acan't shadow core lexical subroutine/; ok 1; } else { is $@, ""; is_deeply \@values, [ "main", 2, "main", "main" ]; } @values = (); eval q{ no warnings "$]" >= 5.017005 ? "experimental::lexical_subs" : "experimental"; use feature "lexical_subs"; our sub foo; push @values, &foo; no Lexical::Sub "foo"; push @values, &foo; }; if("$]" < 5.019001) { like $@, qr/\Acan't shadow core lexical subroutine/; ok 1; } else { is $@, ""; is_deeply \@values, [ "main", "main" ]; } @values = (); eval q{ no warnings "$]" >= 5.017005 ? "experimental::lexical_subs" : "experimental"; use feature "lexical_subs"; no warnings "$]" >= 5.027007 ? "shadow" : "misc"; use Lexical::Sub foo => sub { 2 }; push @values, &foo; package wibble; our sub foo; package main; push @values, &foo; no Lexical::Sub foo => \&foo; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 2, "wibble", "wibble" ]; @values = (); eval q{ no warnings "$]" >= 5.017005 ? "experimental::lexical_subs" : "experimental"; use feature "lexical_subs"; no warnings "$]" >= 5.027007 ? "shadow" : "misc"; use Lexical::Sub foo => sub { 2 }; use Lexical::Sub foo_alias => \&foo; push @values, &foo; package wibble; our sub foo; package main; push @values, &foo; no Lexical::Sub foo => \&foo_alias; push @values, &foo; }; is $@, ""; is_deeply \@values, [ 2, "wibble", "wibble" ]; } SKIP: { skip "builtin unavailable", 2 if "$]" < 5.035007; @values = (); eval q{ no if "$]" >= 5.035009, warnings => "experimental::builtin"; no warnings "$]" >= 5.027007 ? "shadow" : "misc"; use Lexical::Sub blessed => sub { 2 }; push @values, &blessed(bless([])); use builtin qw(blessed); push @values, &blessed(bless([])); use Lexical::Sub blessed => sub { 3 }; push @values, &blessed(bless([])); }; is $@, ""; is_deeply \@values, [ 2, "main", 3 ]; } 1; Lexical-Var-0.010/t/sub_type.t000444001750001750 223714407273365 16212 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 18; BEGIN { $^H |= 0x20000 if "$]" < 5.008; } $SIG{__WARN__} = sub { die "WARNING: $_[0]" }; eval q{use Lexical::Sub foo => \undef;}; isnt $@, ""; eval q{use Lexical::Sub foo => \1;}; isnt $@, ""; eval q{use Lexical::Sub foo => \1.5;}; isnt $@, ""; eval q{use Lexical::Sub foo => \[];}; isnt $@, ""; eval q{use Lexical::Sub foo => \"abc";}; isnt $@, ""; eval q{use Lexical::Sub foo => bless(\(my$x="abc"));}; isnt $@, ""; eval q{use Lexical::Sub foo => \*main::wibble;}; isnt $@, ""; eval q{use Lexical::Sub foo => bless(\*main::wibble);}; isnt $@, ""; eval q{use Lexical::Sub foo => qr/xyz/;}; isnt $@, ""; eval q{use Lexical::Sub foo => bless(qr/xyz/);}; isnt $@, ""; eval q{use Lexical::Sub foo => [];}; isnt $@, ""; eval q{use Lexical::Sub foo => bless([]);}; isnt $@, ""; eval q{use Lexical::Sub foo => {};}; isnt $@, ""; eval q{use Lexical::Sub foo => bless({});}; isnt $@, ""; eval q{use Lexical::Sub foo => sub{};}; is $@, ""; eval q{use Lexical::Sub foo => bless(sub{});}; is $@, ""; eval q{use Lexical::Sub foo => sub{}; &foo if 0;}; is $@, ""; eval q{use Lexical::Sub foo => bless(sub{}); &foo if 0;}; is $@, ""; 1; Lexical-Var-0.010/t/threads.t000444001750001750 354214407273365 16012 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 => 5; 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; } sub basic_test { no strict; our @values = (); $foo = $foo = 3; eval q{ push @values, $foo; use Lexical::Var '$foo' => \4; push @values, $foo; no Lexical::Var '$foo'; push @values, $foo; } or die $@; return join(",", @values) eq "3,4,3"; } test_in_thread(\&basic_test) foreach 0..1; ok basic_test(); test_in_thread(\&basic_test); $_->up foreach @exit_sems; $_->join foreach @threads; ok 1; 1; Lexical-Var-0.010/t/uncover_code.t000444001750001750 177114407273365 17035 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 8; our @x = (100, 200); @x = @x; sub foo ($) { $_[0]+1 } our @values; @values = (); eval q{ push @values, foo @x, 20; push @values, foo(@x); }; is $@, ""; is_deeply \@values, [ 3, 20, 3 ]; @values = (); eval q{ no Lexical::Var '&foo'; push @values, foo @x, 20; push @values, foo(@x); }; is $@, ""; is_deeply \@values, [ 3, 20, 3 ]; @values = (); eval q{ use Lexical::Var '&foo' => sub { 1 }; no Lexical::Var '&foo'; push @values, foo @x, 20; push @values, foo(@x); }; is $@, ""; is_deeply \@values, [ 3, 20, 3 ]; SKIP: { skip "\"my sub\" unavailable", 2 if "$]" < 5.017004; @values = (); eval q{ no warnings "$]" >= 5.017005 ? "experimental::lexical_subs" : "experimental"; use feature "lexical_subs"; my sub foo { 1 } no Lexical::Var '&foo'; push @values, foo @x, 20; push @values, foo(@x); }; if("$]" < 5.019001) { like $@, qr/\Acan't shadow core lexical subroutine/; ok 1; } else { is $@, ""; is_deeply \@values, [ 3, 20, 3 ]; } } 1; Lexical-Var-0.010/t/version_synch.t000444001750001750 54414407273365 17230 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 4; BEGIN { require_ok "Lexical::Var"; } my $main_ver = $Lexical::Var::VERSION; ok defined($main_ver), "have main version number"; foreach my $submod (qw(Sub)) { my $mod = "Lexical::$submod"; require_ok $mod; no strict "refs"; is ${"${mod}::VERSION"}, $main_ver, "$mod version number matches"; } 1; Lexical-Var-0.010/t/lib000755001750001750 014407273365 14600 5ustar00zeframzefram000000000000Lexical-Var-0.010/t/lib/t000755001750001750 014407273365 15043 5ustar00zeframzefram000000000000Lexical-Var-0.010/t/lib/t/code_0.pm000444001750001750 3514407273365 16625 0ustar00zeframzefram000000000000push @main::values, &foo; 1; Lexical-Var-0.010/t/lib/t/code_1.pm000444001750001750 5114407273365 16624 0ustar00zeframzefram000000000000use Lexical::Var '&foo' => sub { 2 }; 1; Lexical-Var-0.010/t/lib/t/code_2.pm000444001750001750 10314407273365 16643 0ustar00zeframzefram000000000000use Lexical::Var '&foo' => sub { 2 }; push @main::values, &foo; 1; Lexical-Var-0.010/t/lib/t/code_3.pm000444001750001750 3314407273365 16626 0ustar00zeframzefram000000000000no Lexical::Var '&foo'; 1; Lexical-Var-0.010/t/lib/t/code_4.pm000444001750001750 6514407273365 16634 0ustar00zeframzefram000000000000no Lexical::Var '&foo'; push @main::values, &foo; 1; Lexical-Var-0.010/t/lib/t/scalar_0.pm000444001750001750 5114407273365 17156 0ustar00zeframzefram000000000000use strict; push @main::values, $foo; 1; Lexical-Var-0.010/t/lib/t/scalar_0n.pm000444001750001750 5014407273365 17333 0ustar00zeframzefram000000000000no strict; push @main::values, $foo; 1; Lexical-Var-0.010/t/lib/t/scalar_1.pm000444001750001750 6514407273365 17164 0ustar00zeframzefram000000000000use strict; use Lexical::Var '$foo' => \(my$x=2); 1; Lexical-Var-0.010/t/lib/t/scalar_2.pm000444001750001750 11714407273365 17203 0ustar00zeframzefram000000000000use strict; use Lexical::Var '$foo' => \(my$x=2); push @main::values, $foo; 1; Lexical-Var-0.010/t/lib/t/scalar_3.pm000444001750001750 4714407273365 17166 0ustar00zeframzefram000000000000use strict; no Lexical::Var '$foo'; 1; Lexical-Var-0.010/t/lib/t/scalar_4.pm000444001750001750 10114407273365 17176 0ustar00zeframzefram000000000000use strict; no Lexical::Var '$foo'; push @main::values, $foo; 1; Lexical-Var-0.010/t/lib/t/scalar_4n.pm000444001750001750 10014407273365 17353 0ustar00zeframzefram000000000000no strict; no Lexical::Var '$foo'; push @main::values, $foo; 1; Lexical-Var-0.010/t/lib/t/setup_c_4.pm000444001750001750 5614407273365 17364 0ustar00zeframzefram000000000000"Lexical::Var"->import('&t4' => sub{123}); 1; Lexical-Var-0.010/t/lib/t/setup_c_5.pm000444001750001750 5614407273365 17365 0ustar00zeframzefram000000000000"Lexical::Var"->import('&t5' => sub{123}); 1; Lexical-Var-0.010/t/lib/t/setup_c_6.pm000444001750001750 12314407273365 17401 0ustar00zeframzefram000000000000package t::setup_c_6; "Lexical::Var"->import('&t6' => sub{123}); sub import { } 1; Lexical-Var-0.010/t/lib/t/setup_c_7.pm000444001750001750 12314407273365 17402 0ustar00zeframzefram000000000000package t::setup_c_7; sub import { "Lexical::Var"->import('&t7' => sub{123}); } 1; Lexical-Var-0.010/t/lib/t/setup_s_4.pm000444001750001750 5214407273365 17400 0ustar00zeframzefram000000000000"Lexical::Var"->import('$t4' => \123); 1; Lexical-Var-0.010/t/lib/t/setup_s_5.pm000444001750001750 5214407273365 17401 0ustar00zeframzefram000000000000"Lexical::Var"->import('$t5' => \123); 1; Lexical-Var-0.010/t/lib/t/setup_s_6.pm000444001750001750 11714407273365 17424 0ustar00zeframzefram000000000000package t::setup_s_6; "Lexical::Var"->import('$t6' => \123); sub import { } 1; Lexical-Var-0.010/t/lib/t/setup_s_7.pm000444001750001750 11714407273365 17425 0ustar00zeframzefram000000000000package t::setup_s_7; sub import { "Lexical::Var"->import('$t7' => \123); } 1;