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
|
=pod
=encoding utf-8
=head1 PURPOSE
Test that Type::Tie works with Clone::clone
=head1 AUTHOR
Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
=head1 COPYRIGHT AND LICENCE
This software is copyright (c) 2022-2023 by Toby Inkster.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
use strict;
use warnings;
use Test::More;
use Test::Requires 'Clone';
use Test::Fatal;
use Type::Tie;
use Types::Standard qw( Int );
use Clone qw(clone);
# Hashes
ttie my %hash, Int;
my $ref = \%hash;
my $hashDclone = clone(\%hash);
eval {
$hashDclone->{a} = 1;
};
ok(! $@);
eval {
$hashDclone->{a} = 'a';
};
ok($@);
# Arrays
ttie my @array, Int;
my $arrayDclone = clone(\@array);
eval {
push @$arrayDclone, 1;
};
ok(! $@);
eval {
push @$arrayDclone, 'a';
};
ok($@);
# Scalar
my $scalarContainer = [ '' ];
ttie $scalarContainer->[0], Int;
my $scalarContainerDclone = clone($scalarContainer);
eval {
$scalarContainerDclone->[0] = 1;
};
ok(! $@);
eval {
$scalarContainerDclone->[0] = 'a';
};
ok($@);
done_testing();
|
