File: 10-basics.t

package info (click to toggle)
libconst-fast-perl 0.014-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, sid, trixie
  • size: 120 kB
  • sloc: perl: 198; makefile: 2
file content (94 lines) | stat: -rw-r--r-- 3,211 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
#!perl

# 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';

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

lives_ok { const my @array => (1, 2, 3, 4) } 'Create array';

throws_readonly { const my @array => (1, 2, 3, 4); $array[2] = 3 } 'Modify array';

lives_ok { const my %hash => (key1 => "value", key2 => "value2") } 'Create hash (list)';

my ($file, $line) = (__FILE__, __LINE__ + 1);
throws_ok { const my %hash => (key1 => "value", "key2") } qr/\AOdd number of elements in hash assignment at \Q$file\E line $line.?\Z/i, 'Odd number of values';

throws_readonly { const my %hash => (key1 => "value", key2 => "value2"); $hash{key1} = "value" } 'Modify hash';

my %computed_values = qw/a A b B c C d D/;
lives_ok { const my %a2 => %computed_values } 'Hash, computed values';

use Data::Dumper;
my (%foo, %recur);
$foo{bar} = \%foo;
lives_ok { const %recur => ( baz => \%foo ) } 'recursive structures are handles properly';

throws_readonly { $recur{baz} = 'foo' };
throws_readonly { $recur{baz}{bar} = 'foo' };
throws_readonly { $recur{baz}{bar}{bar} = 'foo' };

const my $scalar => 'a scalar value';
const my @array => 'an', 'array', 'value';
const my %hash => (a => 'hash', of => 'things');

# Reassign scalar
throws_reassign { const $scalar => "a second scalar value" } 'Scalar reassign die';
is $scalar => 'a scalar value', 'const reassign no effect';

# Reassign array
throws_reassign { const @array => "another", "array" } 'Array reassign die';
ok eq_array(\@array, [qw[an array value]]) => 'const reassign no effect';

# Reassign hash
throws_reassign { const %hash => "another", "hash" } 'Hash reassign die';
ok eq_hash(\%hash, {a => 'hash', of => 'things'}) => 'Const reassign no effect';

# Test for RT#61726
const my $rx => qr/foo/;
isa_ok $rx, 'Regexp';

const my %rx => ( foo => qr/foo/ );
isa_ok $rx{foo}, 'Regexp' or diag( Dumper( \%rx ) ); # fails

throws_ok { &const(1, 1) } qr/^Invalid first argument, need an reference at/, 'First argument must be a reference after prototypes';

my $a = \{}; 
lives_ok { const($a => $a) };

done_testing;