view release on metacpan or  search on metacpan

lib/Const/Fast.pm  view on Meta::CPAN

}

use 5.008;
use strict;
use warnings FATAL => 'all';

use Scalar::Util qw/reftype blessed/;
use Carp qw/croak/;
use Sub::Exporter::Progressive 0.001007 -setup => { exports => [qw/const/], groups => { default => [qw/const/] } };

sub _dclone($) {
	require Storable;
	no warnings 'redefine';
	*_dclone = \&Storable::dclone;
	goto &Storable::dclone;
}

## no critic (RequireArgUnpacking, ProhibitAmpersandSigils)
# The use of $_[0] is deliberate and essential, to be able to use it as an lvalue and to keep the refcount down.

my %skip = map { $_ => 1 } qw/CODE GLOB/;

lib/Const/Fast.pm  view on Meta::CPAN

		elsif ($reftype eq 'HASH') {
			&Internals::hv_clear_placeholders($_[0]);
			_make_readonly($_) for values %{ $_[0] };
		}
	}
	Internals::SvREADONLY($_[0], 1);
	return;
}

## no critic (ProhibitSubroutinePrototypes, ManyArgs)
sub const(\[$@%]@) {
	my (undef, @args) = @_;
	croak 'Invalid first argument, need an reference' if not defined reftype($_[0]);
	croak 'Attempt to reassign a readonly variable' if &Internals::SvREADONLY($_[0]);
	if (reftype $_[0] eq 'SCALAR' or reftype $_[0] eq 'REF') {
		croak 'No value for readonly variable' if @args == 0;
		croak 'Too many arguments in readonly assignment' if @args > 1;
		${ $_[0] } = $args[0];
	}
	elsif (reftype $_[0] eq 'ARRAY') {
		@{ $_[0] } = @args;

t/10-basics.t  view on Meta::CPAN

# Test the Const function

use strict;
use warnings FATAL => 'all';
use Test::More 0.88;
use Test::Fatal qw(exception lives_ok);

use Const::Fast;

sub throws_readonly(&@) {
	my ($sub, $desc) = @_;
	my ($file, $line) = (caller)[1,2];
	my $error = qr/\AModification of a read-only value attempted at \Q$file\E line $line\.\Z/;
	local $Test::Builder::Level = $Test::Builder::Level + 1;
	like(exception { $sub->() }, $error, $desc);
}

sub throws_reassign(&@) {
	my ($sub, $desc) = @_;
	my ($file, $line) = (caller)[1,2];
	my $error = qr/\AAttempt to reassign a readonly \w+ at \Q$file\E line $line\.?\Z/;
	local $Test::Builder::Level = $Test::Builder::Level + 1;
	like(exception { $sub->() }, $error, $desc);
}

sub throws_ok(&@) {
	my ($sub, $error, $desc) = @_;
	local $Test::Builder::Level = $Test::Builder::Level + 1;
	like(exception { $sub->() }, $error, $desc);
}

lives_ok { const my $scalar => 45 } 'Create scalar';

throws_readonly { const my $scalar => 45; $scalar = 45 } 'Modify scalar';

throws_readonly { const my $ref => \do{45}; $$ref = 45 } 'Modify ref to scalar';