unconstant-0.09/0000755000175000017500000000000013564573015014037 5ustar ecarrollecarrollunconstant-0.09/Changes0000644000175000017500000000111513564572772015341 0ustar ecarrollecarrollRevision history for unconstant 0.09 2019-11-14 Blocked installs pre 5.20, was failing tests 0.07 2019-11-14 Fixed pacakaging and removed one of the two prototype tests 0.05 2019-11-14 Updated tests to not fail if you don't have namespace::autoclean 0.04 2019-11-14 Updated to work with namespace::autoclean. 0.03 2019-11-13 Updated to work with list constants 0.02 2019-11-08 Refactor so you can do `no unconstant`. Added tests. 0.01 2019-11-07 First version, released on an unsuspecting world. unconstant-0.09/t/0000755000175000017500000000000013564573015014302 5ustar ecarrollecarrollunconstant-0.09/t/03_list.t0000644000175000017500000000147313563120722015741 0ustar ecarrollecarrolluse Test::More tests => 6; package Foo1 { use constant BAR => (1,2,3,4); sub baz { BAR } } BEGIN { no warnings 'redefine'; is( Foo1::baz, 4, 'Constant length set right initially' ); *Foo1::BAR = sub { 42 }; is( Foo1::baz, 4, 'Constants are inlined' ); } package Foo2 { use unconstant; use constant BAR => (1,2,3); sub baz { BAR } } BEGIN { no warnings 'redefine'; is( Foo2::baz, 3, 'Constant length set right initially' ); *Foo2::BAR = sub { 1,2,3,4,5,6; }; is( Foo2::baz, 6, 'Constant not inlined' ); } package Foo3 { use unconstant; no unconstant; use constant BAR => (1,2,3,4,5); sub baz { BAR } } BEGIN { no warnings 'redefine'; is( Foo3::baz, 5, 'Constant length set right initially' ); *Foo3::BAR = sub { 42 }; is( Foo3::baz, 5, 'Constant are inlined again after use of [no constant]' ); } 1; unconstant-0.09/t/manifest.t0000644000175000017500000000047013560452237016274 0ustar ecarrollecarroll#!perl -T use 5.006; use strict; use warnings; use Test::More; unless ( $ENV{RELEASE_TESTING} ) { plan( skip_all => "Author tests not required for installation" ); } my $min_tcm = 0.9; eval "use Test::CheckManifest $min_tcm"; plan skip_all => "Test::CheckManifest $min_tcm required" if $@; ok_manifest(); unconstant-0.09/t/00-load.t0000644000175000017500000000032113560452237015615 0ustar ecarrollecarroll#!perl -T use 5.006; use strict; use warnings; use Test::More; plan tests => 1; BEGIN { use_ok( 'unconstant' ) || print "Bail out!\n"; } diag( "Testing unconstant $unconstant::VERSION, Perl $], $^X" ); unconstant-0.09/t/pod-coverage.t0000644000175000017500000000125013560452237017036 0ustar ecarrollecarroll#!perl -T use 5.006; use strict; use warnings; use Test::More; unless ( $ENV{RELEASE_TESTING} ) { plan( skip_all => "Author tests not required for installation" ); } # Ensure a recent version of Test::Pod::Coverage my $min_tpc = 1.08; eval "use Test::Pod::Coverage $min_tpc"; plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" if $@; # Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, # but older versions don't recognize some common documentation styles my $min_pc = 0.18; eval "use Pod::Coverage $min_pc"; plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" if $@; all_pod_coverage_ok(); unconstant-0.09/t/pod.t0000644000175000017500000000053613560452237015253 0ustar ecarrollecarroll#!perl -T use 5.006; use strict; use warnings; use Test::More; unless ( $ENV{RELEASE_TESTING} ) { plan( skip_all => "Author tests not required for installation" ); } # Ensure a recent version of Test::Pod my $min_tp = 1.22; eval "use Test::Pod $min_tp"; plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; all_pod_files_ok(); unconstant-0.09/t/05_prototype.t0000644000175000017500000000043513563322745017043 0ustar ecarrollecarrolluse strict; use warnings; use Test::More; use constant BEFORE => 10; use unconstant; use constant AFTER => 10; my $before = BEFORE + 10; is( $before, 20, 'constants parsed as expected' ); my $after = AFTER + 10; is( $after, 20, 'unconstants parsed as expected' ); done_testing; unconstant-0.09/t/02_import_unimport.t0000644000175000017500000000140513561304721020230 0ustar ecarrollecarrolluse Test::More tests => 6; package Foo1 { use constant BAR => 7; sub baz { BAR } } BEGIN { no warnings 'redefine'; is( Foo1::baz, 7, 'Constant set right initially' ); *Foo1::BAR = sub { 42 }; is( Foo1::baz, 7, 'Constants are inlined' ); } package Foo2 { use unconstant; use constant BAR => 7; sub baz { BAR } } BEGIN { no warnings 'redefine'; is( Foo2::baz, 7, 'Constant set right initially' ); *Foo2::BAR = sub { 42 }; is( Foo2::baz, 42, 'Constant not inlined' ); } package Foo3 { use unconstant; no unconstant; use constant BAR => 7; sub baz { BAR } } BEGIN { no warnings 'redefine'; is( Foo3::baz, 7, 'Constant set right initially' ); *Foo3::BAR = sub { 42 }; is( Foo3::baz, 7, 'Constant are inlined again after use of [no constant]' ); } 1; unconstant-0.09/t/01_no_inline_redefine.t0000644000175000017500000000116413561131373020576 0ustar ecarrollecarrolluse unconstant; use Test::More tests => 5; package Foo { use constant BAR => 7; sub baz { BAR } } BEGIN { is( Foo::baz, 7, 'Constant set right initially' ); } BEGIN { *Foo::BAR = sub { 42 }; is( Foo::baz, 42, 'Constant override: sub assign to glob wo/ prototype' ); } BEGIN { no warnings 'redefine'; *Foo::BAR = sub () { 0 }; is( Foo::baz, 0, 'Constant override: sub assign to glob w/ prototype' ); } BEGIN { use constant "Foo::BAR" => 9; is( Foo::baz, 9, 'Constant override: use constant ' ); } BEGIN { use constant *Foo::BAR => 11; is( Foo::baz, 11, 'Constant override: use constant ' ); } 1; unconstant-0.09/t/04_autoclean.t0000644000175000017500000000061513563544103016742 0ustar ecarrollecarrolluse Test::More tests => 2; SKIP: { eval { require namespace::autoclean }; skip "namespace::autoclean not installed", 2 if $@; package Foo { use unconstant; use constant FOO => 42; } package Bar { namespace::autoclean->import(); use unconstant; use constant FOO => 42; } is ( Foo::FOO, 42, "Without namespace::autoclean" ); is ( Bar::FOO, 42, "With namespace::autoclean" ); } unconstant-0.09/README0000644000175000017500000000144313561131751014713 0ustar ecarrollecarrollunconstant INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc unconstant You can also look for information at: RT, CPAN's request tracker (report bugs here) https://rt.cpan.org/NoAuth/Bugs.html?Dist=unconstant AnnoCPAN, Annotated CPAN documentation http://annocpan.org/dist/unconstant CPAN Ratings https://cpanratings.perl.org/d/unconstant Search CPAN https://metacpan.org/release/unconstant LICENSE AND COPYRIGHT This software is Copyright (c) 2019 by Evan Carroll. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) unconstant-0.09/META.yml0000644000175000017500000000125313564573015015311 0ustar ecarrollecarroll--- abstract: "sometimes you need to un- em'." author: - 'Evan Carroll ' build_requires: ExtUtils::MakeMaker: '0' Test::More: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010' license: artistic_2 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: unconstant no_index: directory: - t - inc requires: Sub::Util: '0' constant: '0' perl: '5.020' resources: repository: https://github.com/EvanCarroll/unconstant.git version: '0.09' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' unconstant-0.09/lib/0000755000175000017500000000000013564573015014605 5ustar ecarrollecarrollunconstant-0.09/lib/unconstant.pm0000644000175000017500000001336713564571652017356 0ustar ecarrollecarrollpackage unconstant; use Sub::Util (); use warnings; use constant (); my $constant_import; my $installed; BEGIN { $constant_import = \&constant::import }; use 5.020; use strict; use warnings; our $VERSION = '0.09'; our %declared; #======================================================================= # Some names are evil choices. my %keywords = map +($_, 1), qw{ BEGIN INIT CHECK END DESTROY AUTOLOAD UNITCHECK }; my %forced_into_main = map +($_, 1), qw{ STDIN STDOUT STDERR ARGV ARGVOUT ENV INC SIG }; my %forbidden = (%keywords, %forced_into_main); my $normal_constant_name = qr/^_?[^\W_0-9]\w*\z/; my $tolerable = qr/^[A-Za-z_]\w*\z/; my $boolean = qr/^[01]?\z/; sub unconstant_import { return if $installed; *constant::import = *constant_import; $installed = 1; } sub unconstant_unimport { return unless $installed; no warnings 'redefine'; *constant::import = $constant_import; $installed = 0; } sub constant_import { my $caller = caller(); my $package = shift; my $flush_mro; return unless @_; my $multiple = ref $_[0]; my $constants; if ( $multiple ) { if ($multiple ne 'HASH') { require Carp; Carp::croak("Invalid reference type '".ref(shift)."' not 'HASH'"); } $constants = shift; } else { unless (defined $_[0]) { require Carp; Carp::croak("Can't use undef as constant name"); } $constants->{+shift} = undef; } my $symtab; { no strict 'refs'; $symtab = \%{$caller . "::"}; } foreach my $name ( keys %$constants ) { my $pkg = $caller; my $symtab = $symtab; my $orig_name = $name; if ($name =~ s/(.*)(?:::|')(?=.)//s) { $pkg = $1; if ($pkg ne $caller) { no strict 'refs'; $symtab = \%{$pkg . '::'}; } } # Normal constant name if ($name =~ $normal_constant_name and !$forbidden{$name}) { # Everything is okay } # Name forced into main, but we're not in main. Fatal. elsif ($forced_into_main{$name} and $pkg ne 'main') { require Carp; Carp::croak("Constant name '$name' is forced into main::"); } # Starts with double underscore. Fatal. elsif ($name =~ /^__/) { require Carp; Carp::croak("Constant name '$name' begins with '__'"); } # Maybe the name is tolerable elsif ($name =~ $tolerable) { # Then we'll warn only if you've asked for warnings if (warnings::enabled()) { if ($keywords{$name}) { warnings::warn("Constant name '$name' is a Perl keyword"); } elsif ($forced_into_main{$name}) { warnings::warn("Constant name '$name' is " . "forced into package main::"); } } } # Looks like a boolean # use constant FRED == fred; elsif ($name =~ $boolean) { require Carp; if (@_) { Carp::croak("Constant name '$name' is invalid"); } else { Carp::croak("Constant name looks like boolean value"); } } else { # Must have bad characters require Carp; Carp::croak("Constant name '$name' has invalid characters"); } no strict 'refs'; my $full_name = "${pkg}::$name"; # This is required to fool namespace::autoclean my $const_name = "constant::$name"; $declared{$full_name}++; if ($multiple || @_ == 1) { my $scalar = $multiple ? $constants->{$orig_name} : $_[0]; #$symtab->{$name} = sub () { $scalar }; { no warnings; *$full_name = Sub::Util::set_prototype( '', Sub::Util::set_subname("constant::$name", sub { $scalar } ) ); } ++$flush_mro->{$pkg}; } elsif (@_) { my @list = @_; { no warnings; *$full_name = Sub::Util::set_prototype( '', Sub::Util::set_subname("constant::$name", sub { @list } ) ); } $flush_mro->{$pkg}++; } else { die 'should never hit this'; } } # Flush the cache exactly once if we make any direct symbol table changes. if ($flush_mro) { mro::method_changed_in($_) for keys %$flush_mro; } } { no warnings; *import = \&unconstant_import; *unimport = \&unconstant_unimport; } 1; __END__ =head1 NAME unconstant - sometimes you need to un- em'. =head1 DESCRIPTION This module provides an alternative implementation of L. This implementation stops perl from inlining the constant, stops constant folding, and stops dead code removal. This is supremely useful for testing where a package internally declares and uses a constant that you want to change. This is common when wanting to test modules that make use of constants. B stop `use` from hoisting the statement to the top.> =head1 SYNOPSIS # Disable constant optimizations in my_test perl -Munconstant ./my_test.pl package MyTest { use constant BAR => 7; sub baz { BAR } } # All of these will change the return of `MyTest::baz()` package main { use constant *MyTest::BAR => 42; use constant "MyTest::BAR" => 42; *MyTest::BAR = sub { 42 }; *MyTest::BAR = sub () { 42 }; } =head1 AUTHOR Evan Carroll, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc unconstant You can also look for information at: =over 4 =item * RT: CPAN's request tracker (report bugs here) L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =back =head1 LICENSE AND COPYRIGHT This software is Copyright (c) 2019 by Evan Carroll. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) =cut 1; # End of unconstant unconstant-0.09/META.json0000644000175000017500000000242113564573015015457 0ustar ecarrollecarroll{ "abstract" : "sometimes you need to un- em'.", "author" : [ "Evan Carroll " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010", "license" : [ "artistic_2" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "unconstant", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Sub::Util" : "0", "constant" : "0", "perl" : "5.020" } }, "test" : { "requires" : { "Test::More" : "0" } } }, "release_status" : "stable", "resources" : { "repository" : { "type" : "git", "url" : "https://github.com/EvanCarroll/unconstant.git", "web" : "https://github.com/EvanCarroll/unconstant" } }, "version" : "0.09", "x_serialization_backend" : "JSON::PP version 2.97001" } unconstant-0.09/MANIFEST0000644000175000017500000000062513564573015015173 0ustar ecarrollecarrollChanges lib/unconstant.pm Makefile.PL MANIFEST This list of files README t/00-load.t t/01_no_inline_redefine.t t/02_import_unimport.t t/03_list.t t/04_autoclean.t t/05_prototype.t t/manifest.t t/pod-coverage.t t/pod.t xt/boilerplate.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) unconstant-0.09/xt/0000755000175000017500000000000013564573015014472 5ustar ecarrollecarrollunconstant-0.09/xt/boilerplate.t0000644000175000017500000000246513560452237017166 0ustar ecarrollecarroll#!perl -T use 5.006; use strict; use warnings; use Test::More; plan tests => 3; sub not_in_file_ok { my ($filename, %regex) = @_; open( my $fh, '<', $filename ) or die "couldn't open $filename for reading: $!"; my %violated; while (my $line = <$fh>) { while (my ($desc, $regex) = each %regex) { if ($line =~ $regex) { push @{$violated{$desc}||=[]}, $.; } } } if (%violated) { fail("$filename contains boilerplate text"); diag "$_ appears on lines @{$violated{$_}}" for keys %violated; } else { pass("$filename contains no boilerplate text"); } } sub module_boilerplate_ok { my ($module) = @_; not_in_file_ok($module => 'the great new $MODULENAME' => qr/ - The great new /, 'boilerplate description' => qr/Quick summary of what the module/, 'stub function definition' => qr/function[12]/, ); } TODO: { local $TODO = "Need to replace the boilerplate text"; not_in_file_ok(README => "The README is used..." => qr/The README is used/, "'version information here'" => qr/to provide version information/, ); not_in_file_ok(Changes => "placeholder date/time" => qr(Date/time) ); module_boilerplate_ok('lib/unconstant.pm'); } unconstant-0.09/Makefile.PL0000644000175000017500000000334313564571473016022 0ustar ecarrollecarrolluse 5.006; use strict; use warnings; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( NAME => 'unconstant', AUTHOR => q{Evan Carroll }, VERSION_FROM => 'lib/unconstant.pm', ABSTRACT_FROM => 'lib/unconstant.pm', LICENSE => 'artistic_2', MIN_PERL_VERSION => '5.020', CONFIGURE_REQUIRES => { 'ExtUtils::MakeMaker' => '0', }, TEST_REQUIRES => { 'Test::More' => '0', }, PREREQ_PM => { 'Sub::Util' => '0', 'constant' => '0' }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'unconstant-*' }, META_MERGE => { "meta-spec" => { version => 2 }, resources => { repository => { type => 'git', url => 'https://github.com/EvanCarroll/unconstant.git', web => 'https://github.com/EvanCarroll/unconstant', }, }, }, ); # Compatibility with old versions of ExtUtils::MakeMaker unless (eval { ExtUtils::MakeMaker->VERSION('6.64'); 1 }) { my $test_requires = delete $WriteMakefileArgs{TEST_REQUIRES} || {}; @{$WriteMakefileArgs{PREREQ_PM}}{keys %$test_requires} = values %$test_requires; } unless (eval { ExtUtils::MakeMaker->VERSION('6.55_03'); 1 }) { my $build_requires = delete $WriteMakefileArgs{BUILD_REQUIRES} || {}; @{$WriteMakefileArgs{PREREQ_PM}}{keys %$build_requires} = values %$build_requires; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION('6.52'); 1 }; delete $WriteMakefileArgs{MIN_PERL_VERSION} unless eval { ExtUtils::MakeMaker->VERSION('6.48'); 1 }; delete $WriteMakefileArgs{LICENSE} unless eval { ExtUtils::MakeMaker->VERSION('6.31'); 1 }; WriteMakefile(%WriteMakefileArgs);