Lexical-Var-0.009000755001750001750 012206451076 13567 5ustar00zeframzefram000000000000Lexical-Var-0.009/.gitignore000444001750001750 23212206451066 15670 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.009/MANIFEST000444001750001750 177312206451066 15064 0ustar00zeframzefram000000000000.gitignore Build.PL Changes MANIFEST META.json META.yml Makefile.PL 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_0.pm t/code_1.pm t/code_2.pm t/code_3.pm t/code_4.pm 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/once.t t/pod_cvg.t t/pod_syn.t t/scalar_0.pm t/scalar_0n.pm t/scalar_1.pm t/scalar_2.pm t/scalar_3.pm t/scalar_4.pm t/scalar_4n.pm t/scalar_const.t t/scalar_ident.t t/scalar_scope.t t/scalar_type.t t/scalar_write.t t/setup_c_4.pm t/setup_c_5.pm t/setup_c_6.pm t/setup_c_7.pm t/setup_code.t t/setup_s_4.pm t/setup_s_5.pm t/setup_s_6.pm t/setup_s_7.pm 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 SIGNATURE Added here by Module::Build Lexical-Var-0.009/Makefile.PL000444001750001750 230212206451066 15672 0ustar00zeframzefram000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.4007 require 5.006; unless (eval "use Module::Build::Compat 0.02; 1" ) { print "This module requires Module::Build to install itself.\n"; require ExtUtils::MakeMaker; my $yn = ExtUtils::MakeMaker::prompt (' Install Module::Build now from CPAN?', 'y'); unless ($yn =~ /^y/i) { die " *** Cannot install without Module::Build. Exiting ...\n"; } require Cwd; require File::Spec; require CPAN; # Save this 'cause CPAN will chdir all over the place. my $cwd = Cwd::cwd(); CPAN::Shell->install('Module::Build::Compat'); CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate or die "Couldn't install Module::Build, giving up.\n"; chdir $cwd or die "Cannot chdir() back to $cwd: $!"; } eval "use Module::Build::Compat 0.02; 1" or die $@; Module::Build::Compat->run_build_pl(args => \@ARGV); my $build_script = 'Build'; $build_script .= '.com' if $^O eq 'VMS'; exit(0) unless(-e $build_script); # cpantesters convention require Module::Build; Module::Build::Compat->write_makefile(build_class => 'Module::Build'); Lexical-Var-0.009/META.json000444001750001750 307012206451066 15344 0ustar00zeframzefram000000000000{ "abstract" : "static variables without namespace pollution", "author" : [ "Andrew Main (Zefram) " ], "dynamic_config" : 0, "generated_by" : "Module::Build version 0.4007, CPAN::Meta::Converter version 2.120921", "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", "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.006", "XSLoader" : "0", "perl" : "5.006", "strict" : "0", "warnings" : "0" } } }, "provides" : { "Lexical::Sub" : { "file" : "lib/Lexical/Sub.pm", "version" : "0.009" }, "Lexical::Var" : { "file" : "lib/Lexical/Var.pm", "version" : "0.009" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "0.009" } Lexical-Var-0.009/Build.PL000444001750001750 135312206451066 15221 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, "perl" => "5.006", "strict" => 0, "warnings" => 0, }, requires => { "Lexical::SealRequireHints" => "0.006", "XSLoader" => 0, "perl" => "5.006", "strict" => 0, "warnings" => 0, }, conflicts => { "B::Hooks::OP::Check" => "< 0.19", }, dynamic_config => 0, meta_add => { distribution_type => "module" }, create_makefile_pl => "passthrough", sign => 1, )->create_build_script; 1; Lexical-Var-0.009/META.yml000444001750001750 156212206451066 15200 0ustar00zeframzefram000000000000--- abstract: 'static variables without namespace pollution' author: - 'Andrew Main (Zefram) ' build_requires: ExtUtils::CBuilder: 0.15 Module::Build: 0 Test::More: 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.4007, CPAN::Meta::Converter version 2.120921' 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.009 Lexical::Var: file: lib/Lexical/Var.pm version: 0.009 requires: Lexical::SealRequireHints: 0.006 XSLoader: 0 perl: 5.006 strict: 0 warnings: 0 resources: license: http://dev.perl.org/licenses/ version: 0.009 Lexical-Var-0.009/README000444001750001750 546712206451066 14617 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. 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 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.009/Changes000444001750001750 1171612206451066 15244 0ustar00zeframzefram000000000000version 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.009/SIGNATURE000644001750001750 1150212206451076 15231 0ustar00zeframzefram000000000000This file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.73. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 SHA1 adc3bbca9a52e94ff1607402a258fc2724e51556 .gitignore SHA1 8addaffa153b31ee79b66685a0bd4daea5a512d9 Build.PL SHA1 b0e6ffb83e2694aed5110b47fff08b30a4d5e56a Changes SHA1 6505652e6bc6c477ba65b147ed592bba8147b260 MANIFEST SHA1 25fd41fa6c36aec741eb84d7cc523ec31eb90e36 META.json SHA1 70c9bbc1e656954f11a4f4880f27d2696def9bc6 META.yml SHA1 0bfa106a64fc680e40507c47cbf461cea3a8b374 Makefile.PL SHA1 16e549a21f5873dbc766cb7a7bf71bb88cf20e77 README SHA1 d6d227db087b2bdd2c710570c8bb3482c52ef9e7 lib/Lexical/Sub.pm SHA1 f7e78bd8fe2bb6da687fde09fb23d8316ed3c245 lib/Lexical/Var.pm SHA1 e2312189096e37c00cbca5d541f49f689277a811 lib/Lexical/Var.xs SHA1 64e26cf6927950fbdd693740517028d855556cf5 t/array_ident.t SHA1 2bde4d5fec320632bf2bd609746a7d9e37ca54c7 t/array_ops.t SHA1 123cb81bbfaa745b664b4e91e53479843590835a t/array_scope.t SHA1 1bd14737a66c5c928e3623d86df39a8d1e3a7e8d t/array_type.t SHA1 bec91828956addb9760482700b83bcf76721ed7e t/array_write.t SHA1 b77592056c0eb1627a2eadcfd14ec49e6f98609c t/code_0.pm SHA1 fb4de8af68a858176ba2ad1f43ac86f3af383ec0 t/code_1.pm SHA1 53219d481b83de70ef66cac5e21488a731a96420 t/code_2.pm SHA1 716352815b6196af50f29868d8cbdb9e945f697e t/code_3.pm SHA1 31356e0540b696cfbaca328e598e50283e0009fc t/code_4.pm SHA1 5ac5b6044e3d96cb4441f9028b1aaa0812d7af9d t/code_bare.t SHA1 0186e0cb496b2593198991b0640fe58ae0a28ac0 t/code_bare_no.t SHA1 053b49e5b95dcc078642659cccfd03d6b4919fc8 t/code_const.t SHA1 18e88d9ae7442cd50e8f54344a79040822c4cc2f t/code_ident.t SHA1 df56cf4ed4f1d2ec8815704b8255b1d3ac508473 t/code_ops.t SHA1 b0dbd755fe57b68b0f3ed8eda55011613646e17f t/code_scope.t SHA1 0c63e18d595ff20739d5589e300102a432d99ad9 t/code_type.t SHA1 2ee4ff49e19f0c4a47a08c57922c06105d6edeb4 t/error.t SHA1 ae53df4b2a30224eb1a9bb518b2ed0109825695f t/glob_ident.t SHA1 e15cbe5dbdbd9d7db8be4b805fab7d0bbb78a397 t/glob_scope.t SHA1 6cf0ce40972fbf190b5a8b84dc546924707d39cd t/glob_type.t SHA1 45627b7e9ce8ccd77decead65890c374d26e3799 t/glob_write.t SHA1 14647107f7690cc1652ab1b96f5ee0296bcac8b4 t/hash_ident.t SHA1 d586e58d750831e3be0b071d24785da18262e1f3 t/hash_ops.t SHA1 1a032e6cecdef1f608190da88b9c574d5a1e010d t/hash_scope.t SHA1 0c1bb92ef70cb600a14ffd51e126778dae26e33b t/hash_type.t SHA1 e546e3b033fbc3a9ea708fb99a46696bd54d4df3 t/hash_write.t SHA1 494afeb406508632cddd98f2af97e09efcf4b93a t/once.t SHA1 904d9a4f76525e2303e4b0c168c68230f223c8de t/pod_cvg.t SHA1 65c75abdef6f01a5d1588a307f2ddfe2333dc961 t/pod_syn.t SHA1 c683d9b6b1d4f3a207f4cbeff67e4be60c4187e5 t/scalar_0.pm SHA1 9c9ca0731ddb0d4278a9834c36c09548e2d945c8 t/scalar_0n.pm SHA1 b7906d0ece01fe3c61e30c17a6d0adcb8d39f0c3 t/scalar_1.pm SHA1 63baa907ce673f4a3fa116f803ff4e94614c39c3 t/scalar_2.pm SHA1 100db668daa0c393a5ac9dbd2d82396c612e773f t/scalar_3.pm SHA1 768295f751ce394aa9596c1fcb5365beaddfaf30 t/scalar_4.pm SHA1 c1ec53a6228ecbd90700027b0e1e4722699006c6 t/scalar_4n.pm SHA1 fe215249573bb2a05ff10620d53f64523e674856 t/scalar_const.t SHA1 960a624049e01853c386860f2c2c8d273d99ca95 t/scalar_ident.t SHA1 5ae0f031950c25d75d3e58e977fd8f9c8f26f66a t/scalar_scope.t SHA1 f69657000aaa518075c24abdbec073d02c399254 t/scalar_type.t SHA1 7ca93a0e42cb706524a9e21c9eec4bcd36e8c734 t/scalar_write.t SHA1 8ddc45ba416c6df3a7d0e3aca8650e01a7063867 t/setup_c_4.pm SHA1 ed80d2ffb1eb797de2b426a7bf13d86818113d53 t/setup_c_5.pm SHA1 5467748d279c618121b3a053369f5145c61a932a t/setup_c_6.pm SHA1 71ba17e14e105459dbb5b7ee58b92ce90a8d1d7a t/setup_c_7.pm SHA1 8e03d77b77d87f7091d646cec92777aebcc44e6b t/setup_code.t SHA1 fbc2feacfadd5535a8b43bd598a91cbac3d95bc4 t/setup_s_4.pm SHA1 739e4ba1b6fe5b32000325d9161e3a4f42a8d161 t/setup_s_5.pm SHA1 1986a8ff907a30ba2f4c45d9418479c48ae6ee4b t/setup_s_6.pm SHA1 3bc1b399ba8d2c685daf9ecf54c4d853e653a46c t/setup_s_7.pm SHA1 32bf0926e3b16080814b9f2848d2b05ba87fbd56 t/setup_scalar.t SHA1 ddbcd41204c0768c82c737d0b78d34c2de5ea571 t/sub_bare.t SHA1 ab806ade319bd0642d7a42f08d4111a7cdc1678b t/sub_bare_no.t SHA1 0e7727bc9ab76de5ba48193e8b64e1d15dc6cfd2 t/sub_const.t SHA1 964c030d2e3027c34aa2ec5cc2430d37b22d2ad7 t/sub_ident.t SHA1 56612eaff4167f446b632f19f2f850a7870878c7 t/sub_ops.t SHA1 895f36f916e009afdee45f51a1d39e6963c828cb t/sub_scope.t SHA1 aefdb2e8019f6beaa52dc49bbad30fd7d58b0be6 t/sub_type.t -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.12 (GNU/Linux) iEYEARECAAYFAlIaUjYACgkQOV9mt2VyAVF5dQCgqXIVngcUyhGknKz3Bgiwpu9m 2/wAoI2JChYOrr6fsFWGafJMuqudJhCw =qLvX -----END PGP SIGNATURE----- Lexical-Var-0.009/lib000755001750001750 012206451066 14334 5ustar00zeframzefram000000000000Lexical-Var-0.009/lib/Lexical000755001750001750 012206451066 15715 5ustar00zeframzefram000000000000Lexical-Var-0.009/lib/Lexical/Var.xs000444001750001750 5047212206451066 17206 0ustar00zeframzefram000000000000#define PERL_NO_GET_CONTEXT 1 #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #define PERL_VERSION_DECIMAL(r,v,s) (r*1000000 + v*1000 + s) #define PERL_DECIMAL_VERSION \ PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION) #define PERL_VERSION_GE(r,v,s) \ (PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s)) #if !PERL_VERSION_GE(5,9,3) # define SVt_LAST (SVt_PVIO+1) #endif /* <5.9.3 */ #if PERL_VERSION_GE(5,9,4) # define SVt_PADNAME SVt_PVMG #else /* <5.9.4 */ # define SVt_PADNAME SVt_PVGV #endif /* <5.9.4 */ #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 SvPAD_OUR_on # define SvPAD_OUR_on(SV) (SvFLAGS(SV) |= SVpad_OUR) #endif /* !SvPAD_OUR_on */ #ifndef SvOURSTASH_set # ifdef OURSTASH_set # define SvOURSTASH_set(SV, STASH) OURSTASH_set(SV, STASH) # else /* !OURSTASH_set */ # define SvOURSTASH_set(SV, STASH) (GvSTASH(SV) = STASH) # endif /* !OURSTASH_set */ #endif /* !SvOURSTASH_set */ #ifndef PadMAX # define PadlistARRAY(pl) ((PAD**)AvARRAY(pl)) # define PadlistNAMES(pl) (PadlistARRAY(pl)[0]) # define PadMAX(p) AvFILLp(p) typedef AV PADNAMELIST; #endif /* !PadMAX */ #if !PERL_VERSION_GE(5,8,1) typedef AV PADLIST; typedef AV PAD; #endif /* <5.8.1 */ #ifndef COP_SEQ_RANGE_LOW # if 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 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 SvRV_set # define SvRV_set(SV, VAL) (SvRV(SV) = (VAL)) #endif /* !SvRV_set */ #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 SVfARG # define SVfARG(p) ((void *)p) #endif /* !SVfARG */ #ifndef GV_NOTQUAL # define GV_NOTQUAL 0 #endif /* !GV_NOTQUAL */ /* * scalar classification * * Logic borrowed from Params::Classify. */ #define sv_is_glob(sv) (SvTYPE(sv) == SVt_PVGV) #if 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))) /* * gen_const_identity_op() * * 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 *pp_const_via_ref(pTHX) { dSP; SV *reference_sv = cSVOPx_sv(PL_op); SV *referent_sv = SvRV(reference_sv); PUSHs(referent_sv); RETURN; } #endif /* Q_CONST_COPIES */ #define gen_const_identity_op(sv) THX_gen_const_identity_op(aTHX_ sv) static OP *THX_gen_const_identity_op(pTHX_ SV *sv) { #if Q_CONST_COPIES OP *op = newSVOP(OP_CONST, 0, newRV_noinc(sv)); op->op_ppaddr = 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 LEXPADPREFIX "Lexical::Var::" #define LEXPADPREFIXLEN (sizeof(LEXPADPREFIX)-1) #define CHAR_IDSTART 0x01 #define CHAR_IDCONT 0x02 #define CHAR_SIGIL 0x10 #define CHAR_USEPAD 0x20 static U8 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, 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, LEXPADPREFIX, LEXPADPREFIXLEN)) return NULL; p += LEXPADPREFIXLEN; 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 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); } static SV *fake_sv, *fake_av, *fake_hv; #define ck_rv2xv(o, sigil, nxck) THX_ck_rv2xv(aTHX_ o, sigil, nxck) static OP *THX_ck_rv2xv(pTHX_ OP *o, char sigil, OP *(*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, *fake_referent, *newref; OP *newop; U16 type, flags; #if !PERL_VERSION_GE(5,11,2) if(sigil == '&' && (c->op_private & OPpCONST_BARE)) croak("can't reference lexical subroutine " "without & sigil on this perl"); #endif /* <5.11.2 */ if(sigil != 'P' || !PERL_VERSION_GE(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)[LEXPADPREFIXLEN] == '$' && SvREADONLY(referent)) { op_free(o); return gen_const_identity_op(referent); } switch(type) { case OP_RV2SV: fake_referent = fake_sv; break; case OP_RV2AV: fake_referent = fake_av; break; case OP_RV2HV: fake_referent = fake_hv; break; default: fake_referent = referent; break; } newref = newRV_noinc(fake_referent); if(referent != fake_referent) { SvREFCNT_inc(fake_referent); SvREFCNT_inc(newref); } newop = newUNOP(type, flags, newSVOP(OP_CONST, 0, newref)); if(referent != fake_referent) { fake_referent = SvRV(newref); SvREADONLY_off(newref); SvRV_set(newref, referent); SvREADONLY_on(newref); SvREFCNT_dec(fake_referent); SvREFCNT_dec(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)+LEXPADPREFIXLEN+3, SvCUR(ref)-LEXPADPREFIXLEN-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 nxck(aTHX_ o); } static OP *(*nxck_rv2sv)(pTHX_ OP *o); static OP *(*nxck_rv2av)(pTHX_ OP *o); static OP *(*nxck_rv2hv)(pTHX_ OP *o); static OP *(*nxck_rv2cv)(pTHX_ OP *o); static OP *(*nxck_rv2gv)(pTHX_ OP *o); static OP *ck_rv2sv(pTHX_ OP *o) { return ck_rv2xv(o, 'P', nxck_rv2sv); } static OP *ck_rv2av(pTHX_ OP *o) { return ck_rv2xv(o, 'P', nxck_rv2av); } static OP *ck_rv2hv(pTHX_ OP *o) { return ck_rv2xv(o, 'P', nxck_rv2hv); } static OP *ck_rv2cv(pTHX_ OP *o) { return ck_rv2xv(o, '&', nxck_rv2cv); } static OP *ck_rv2gv(pTHX_ OP *o) { return ck_rv2xv(o, '*', nxck_rv2gv); } /* * setting up lexical names */ static HV *stash_lex_sv, *stash_lex_av, *stash_lex_hv; #define pad_max() THX_pad_max(aTHX) static U32 THX_pad_max(pTHX) { #if PERL_VERSION_GE(5,13,10) return U32_MAX; #elif PERL_VERSION_GE(5,9,5) return I32_MAX; #elif PERL_VERSION_GE(5,9,0) return 999999999; #elif 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 */ 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 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 %s outside compilation", vari_word); return compcv; } #define setup_pad(compcv, name) THX_setup_pad(aTHX_ compcv, name) static void THX_setup_pad(pTHX_ CV *compcv, char const *name) { PADLIST *padlist = CvPADLIST(compcv); PADNAMELIST *padname = PadlistNAMES(padlist); PAD *padvar = PadlistARRAY(padlist)[1]; PADOFFSET ouroffset; SV *ourname, *ourvar; HV *stash; ourvar = *av_fetch(padvar, PadMAX(padvar) + 1, 1); SvPADMY_on(ourvar); ouroffset = PadMAX(padvar); ourname = newSV_type(SVt_PADNAME); sv_setpv(ourname, name); SvPAD_OUR_on(ourname); stash = name[0] == '$' ? stash_lex_sv : name[0] == '@' ? stash_lex_av : stash_lex_hv; SvOURSTASH_set(ourname, (HV*)SvREFCNT_inc((SV*)stash)); COP_SEQ_RANGE_LOW_set(ourname, PL_cop_seqmax); COP_SEQ_RANGE_HIGH_set(ourname, pad_max()); PL_cop_seqmax++; av_store(padname, ouroffset, ourname); #ifdef PadnamelistMAXNAMED PadnamelistMAXNAMED(padname) = ouroffset; #endif /* PadnamelistMAXNAMED */ } #define lookup_for_compilation(base_sigil, vari_word, name) \ THX_lookup_for_compilation(aTHX_ base_sigil, vari_word, name) static SV *THX_lookup_for_compilation(pTHX_ char base_sigil, char const *vari_word, SV *name) { SV *key; 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); he = hv_fetch_ent(GvHV(PL_hintgv), key, 0, 0); return he ? SvREFCNT_inc(HeVAL(he)) : &PL_sv_undef; } static int svt_scalar(svtype t) { switch(t) { case SVt_NULL: case SVt_IV: case SVt_NV: #if !PERL_VERSION_GE(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 PERL_VERSION_GE(5,11,0) case SVt_REGEXP: #endif /* >=5.11.0 */ return 1; default: return 0; } } #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; 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); val = newRV_inc(SvRV(ref)); he = hv_store_ent(GvHV(PL_hintgv), key, val, 0); if(he) { val = HeVAL(he); SvSETMAGIC(val); } else { SvREFCNT_dec(val); } if(char_attr[(U8)sigil] & CHAR_USEPAD) setup_pad(compcv, SvPVX(key)+KEYPREFIXLEN); } 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))) { HE *he; SV *cref; i++; he = hv_fetch_ent(GvHV(PL_hintgv), key, 0, 0); cref = he ? HeVAL(he) : &PL_sv_undef; if(SvROK(cref) && SvRV(cref) != SvRV(ref)) continue; } (void) hv_delete_ent(GvHV(PL_hintgv), key, G_DISCARD, 0); if(char_attr[(U8)sigil] & CHAR_USEPAD) setup_pad(compcv, SvPVX(key)+KEYPREFIXLEN); } } MODULE = Lexical::Var PACKAGE = Lexical::Var PROTOTYPES: DISABLE BOOT: fake_sv = &PL_sv_undef; fake_av = (SV*)newAV(); fake_hv = (SV*)newHV(); stash_lex_sv = gv_stashpvs(LEXPADPREFIX"$", 1); stash_lex_av = gv_stashpvs(LEXPADPREFIX"@", 1); stash_lex_hv = gv_stashpvs(LEXPADPREFIX"%", 1); nxck_rv2sv = PL_check[OP_RV2SV]; PL_check[OP_RV2SV] = ck_rv2sv; nxck_rv2av = PL_check[OP_RV2AV]; PL_check[OP_RV2AV] = ck_rv2av; nxck_rv2hv = PL_check[OP_RV2HV]; PL_check[OP_RV2HV] = ck_rv2hv; nxck_rv2cv = PL_check[OP_RV2CV]; PL_check[OP_RV2CV] = ck_rv2cv; nxck_rv2gv = PL_check[OP_RV2GV]; PL_check[OP_RV2GV] = ck_rv2gv; SV * _variable_for_compilation(SV *classname, SV *name) CODE: PERL_UNUSED_VAR(classname); RETVAL = lookup_for_compilation('N', "variable", name); OUTPUT: RETVAL 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 SV * _sub_for_compilation(SV *classname, SV *name) CODE: PERL_UNUSED_VAR(classname); RETVAL = lookup_for_compilation('&', "subroutine", name); OUTPUT: RETVAL 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.009/lib/Lexical/Var.pm000444001750001750 1771312206451066 17171 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. 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.006; use warnings; use strict; our $VERSION = "0.009"; 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 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. 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. =head1 SEE ALSO L, L, L, L =head1 AUTHOR Andrew Main (Zefram) =head1 COPYRIGHT Copyright (C) 2009, 2010, 2011, 2012, 2013 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.009/lib/Lexical/Sub.pm000444001750001750 1305412206451066 17164 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. These lexical definitions propagate into string Cs, on Perl versions that support it (5.9.3 and later). This module is implemented through the mechanism of L. Its distinct name and declaration syntax exist to make lexical subroutine declarations clearer. =cut package Lexical::Sub; { use 5.006; } use warnings; use strict; our $VERSION = "0.009"; 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 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. 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. =head1 SEE ALSO L, L =head1 AUTHOR Andrew Main (Zefram) =head1 COPYRIGHT Copyright (C) 2009, 2010, 2011, 2012, 2013 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.009/t000755001750001750 012206451066 14031 5ustar00zeframzefram000000000000Lexical-Var-0.009/t/scalar_type.t000444001750001750 336512206451066 16670 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.009/t/pod_syn.t000444001750001750 23612206451066 16007 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.009/t/setup_s_4.pm000444001750001750 5212206451066 16366 0ustar00zeframzefram000000000000"Lexical::Var"->import('$t4' => \123); 1; Lexical-Var-0.009/t/glob_scope.t000444001750001750 323012206451066 16465 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.009/t/sub_bare_no.t000444001750001750 316212206451066 16633 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 subroutine without \& sigil/; is_deeply \@values, []; } @values = (); eval q{ use Lexical::Sub foo => sub () { 1 }; push @values, foo(); }; like $@, qr/\Acan't reference 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 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 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 subroutine without \& sigil/; is_deeply \@values, []; @values = (); eval q{ use Lexical::Sub bar => sub () { 1 }; push @values, bar(); }; like $@, qr/\Acan't reference lexical subroutine without \& sigil/; is_deeply \@values, []; } 1; Lexical-Var-0.009/t/setup_s_5.pm000444001750001750 5212206451066 16367 0ustar00zeframzefram000000000000"Lexical::Var"->import('$t5' => \123); 1; Lexical-Var-0.009/t/sub_type.t000444001750001750 223712206451066 16211 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.009/t/code_1.pm000444001750001750 5112206451066 15612 0ustar00zeframzefram000000000000use Lexical::Var '&foo' => sub { 2 }; 1; Lexical-Var-0.009/t/setup_code.t000444001750001750 240212206451066 16503 0ustar00zeframzefram000000000000use warnings; use strict; 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 /; } } 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.009/t/hash_scope.t000444001750001750 374312206451066 16476 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.009/t/scalar_0n.pm000444001750001750 5012206451066 16321 0ustar00zeframzefram000000000000no strict; push @main::values, $foo; 1; Lexical-Var-0.009/t/scalar_write.t000444001750001750 30212206451066 17005 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.009/t/code_ops.t000444001750001750 217012206451066 16146 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.009/t/scalar_4.pm000444001750001750 10112206451066 16164 0ustar00zeframzefram000000000000use strict; no Lexical::Var '$foo'; push @main::values, $foo; 1; Lexical-Var-0.009/t/code_bare_no.t000444001750001750 320412206451066 16751 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 subroutine without \& sigil/; is_deeply \@values, []; } @values = (); eval q{ use Lexical::Var '&foo' => sub () { 1 }; push @values, foo(); }; like $@, qr/\Acan't reference 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 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 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 subroutine without \& sigil/; is_deeply \@values, []; @values = (); eval q{ use Lexical::Var '&foo' => sub () { 1 }; push @values, bar(); }; like $@, qr/\Acan't reference lexical subroutine without \& sigil/; is_deeply \@values, []; } 1; Lexical-Var-0.009/t/code_type.t000444001750001750 232512206451066 16330 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.009/t/array_scope.t000444001750001750 363012206451066 16664 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.009/t/code_4.pm000444001750001750 6512206451066 15622 0ustar00zeframzefram000000000000no Lexical::Var '&foo'; push @main::values, &foo; 1; Lexical-Var-0.009/t/setup_scalar.t000444001750001750 234212206451066 17041 0ustar00zeframzefram000000000000use warnings; use strict; 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 /; } } 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.009/t/scalar_3.pm000444001750001750 4712206451066 16154 0ustar00zeframzefram000000000000use strict; no Lexical::Var '$foo'; 1; Lexical-Var-0.009/t/setup_s_6.pm000444001750001750 11712206451066 16412 0ustar00zeframzefram000000000000package t::setup_s_6; "Lexical::Var"->import('$t6' => \123); sub import { } 1; Lexical-Var-0.009/t/pod_cvg.t000444001750001750 27312206451066 15756 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.009/t/sub_scope.t000444001750001750 1177012206451066 16363 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 62; 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 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 => 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 ]; } 1; Lexical-Var-0.009/t/hash_ops.t000444001750001750 200312206451066 16152 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 8; 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) ]; 1; Lexical-Var-0.009/t/glob_type.t000444001750001750 234712206451066 16345 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.009/t/error.t000444001750001750 1112412206451066 15523 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 variable outside compilation/; eval q{ Lexical::Var->unimport('$foo'); }; like $@, qr/\Acan't set up 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.009/t/hash_write.t000444001750001750 46512206451066 16475 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.009/t/hash_ident.t000444001750001750 65012206451066 16442 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.009/t/sub_ident.t000444001750001750 63612206451066 16314 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.009/t/setup_c_5.pm000444001750001750 5612206451066 16353 0ustar00zeframzefram000000000000"Lexical::Var"->import('&t5' => sub{123}); 1; Lexical-Var-0.009/t/scalar_ident.t000444001750001750 176612206451066 17015 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.009/t/setup_c_6.pm000444001750001750 12312206451066 16367 0ustar00zeframzefram000000000000package t::setup_c_6; "Lexical::Var"->import('&t6' => sub{123}); sub import { } 1; Lexical-Var-0.009/t/scalar_scope.t000444001750001750 1742512206451066 17042 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 84; 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{ 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{ 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; BEGIN { $SIG{__WARN__} = sub {}; } # bogus redefinition warning 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; BEGIN { $SIG{__WARN__} = sub {}; } # bogus redefinition warning 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 ]; 1; Lexical-Var-0.009/t/code_3.pm000444001750001750 3312206451066 15614 0ustar00zeframzefram000000000000no Lexical::Var '&foo'; 1; Lexical-Var-0.009/t/array_ident.t000444001750001750 65012206451066 16635 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.009/t/setup_s_7.pm000444001750001750 11712206451066 16413 0ustar00zeframzefram000000000000package t::setup_s_7; sub import { "Lexical::Var"->import('$t7' => \123); } 1; Lexical-Var-0.009/t/sub_ops.t000444001750001750 214612206451066 16030 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.009/t/code_scope.t000444001750001750 1217312206451066 16502 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 62; 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 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' => 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 ]; } 1; Lexical-Var-0.009/t/scalar_const.t000444001750001750 331412206451066 17027 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 eval q{ use Lexical::Var '$foo' => \(my $x=undef); [$foo]; }, [undef]; # test that non-constant undef $foo is not a const op eval q{ die; use Lexical::Var '$foo' => \(my $x=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=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.009/t/setup_c_4.pm000444001750001750 5612206451066 16352 0ustar00zeframzefram000000000000"Lexical::Var"->import('&t4' => sub{123}); 1; Lexical-Var-0.009/t/sub_const.t000444001750001750 204312206451066 16351 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.009/t/code_const.t000444001750001750 206512206451066 16476 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.009/t/array_type.t000444001750001750 231712206451066 16535 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.009/t/hash_type.t000444001750001750 231712206451066 16342 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.009/t/scalar_4n.pm000444001750001750 10012206451066 16341 0ustar00zeframzefram000000000000no strict; no Lexical::Var '$foo'; push @main::values, $foo; 1; Lexical-Var-0.009/t/array_ops.t000444001750001750 214412206451066 16353 0ustar00zeframzefram000000000000use warnings; use strict; use Test::More tests => 10; 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) ]; 1; Lexical-Var-0.009/t/setup_c_7.pm000444001750001750 12312206451066 16370 0ustar00zeframzefram000000000000package t::setup_c_7; sub import { "Lexical::Var"->import('&t7' => sub{123}); } 1; Lexical-Var-0.009/t/code_ident.t000444001750001750 64112206451066 16431 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.009/t/scalar_1.pm000444001750001750 6512206451066 16152 0ustar00zeframzefram000000000000use strict; use Lexical::Var '$foo' => \(my$x=2); 1; Lexical-Var-0.009/t/code_bare.t000444001750001750 2166512206451066 16310 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.009/t/glob_write.t000444001750001750 54112206451066 16470 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.009/t/once.t000444001750001750 70712206451066 15263 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.009/t/glob_ident.t000444001750001750 67512206451066 16451 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.009/t/code_2.pm000444001750001750 10312206451066 15631 0ustar00zeframzefram000000000000use Lexical::Var '&foo' => sub { 2 }; push @main::values, &foo; 1; Lexical-Var-0.009/t/scalar_0.pm000444001750001750 5112206451066 16144 0ustar00zeframzefram000000000000use strict; push @main::values, $foo; 1; Lexical-Var-0.009/t/array_write.t000444001750001750 47412206451066 16670 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.009/t/scalar_2.pm000444001750001750 11712206451066 16171 0ustar00zeframzefram000000000000use strict; use Lexical::Var '$foo' => \(my$x=2); push @main::values, $foo; 1; Lexical-Var-0.009/t/code_0.pm000444001750001750 3512206451066 15613 0ustar00zeframzefram000000000000push @main::values, &foo; 1; Lexical-Var-0.009/t/sub_bare.t000444001750001750 2140112206451066 16153 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;