File: readonly.t

package info (click to toggle)
libreadonly-tiny-perl 4-3
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 108 kB
  • sloc: perl: 314; makefile: 2
file content (122 lines) | stat: -rw-r--r-- 4,101 bytes parent folder | download
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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
#!/usr/bin/perl

use strict;
use warnings;

use Test::More;
use Test::Exception;
use t::Util;

use Readonly::Tiny;

use File::Spec::Functions   qw/devnull/;

{
    my $x = 1;
    readonly \$x;

    is $x, 1,                       "readonly doesn't affect scalar value";
    ok SvRO(\$x),                   "readonly makes scalars SvRO";
    throws_ok { $x = 2 } $mod,      "readonly makes scalars readonly";
    throws_ok { undef $x } $mod,    "readonly scalar can't be undefined";
}

{
    my $x = 1;
    my $y = \$x;
    readonly \$y;

    is $y, \$x,                     "readonly doesn't affect REF value";
    ok SvRO(\$y),                   "readonly makes REF SvRO";
    throws_ok { $y = 2 } $mod,      "readonly makes REF readonly";
    throws_ok { undef $y } $mod,    "readonly REF can't be undefined";
}

{
    my @x = (1, 2);
    readonly \@x;

    is_deeply \@x, [1, 2],          "readonly doesn't affect array value";
    ok SvRO(\@x),                   "readonly makes array SvRO";
    ok SvRO(\$x[0]),                "readonly makes array elem SvRO";

    throws_ok { $x[0] = 2 } $mod,   "readonly array elem can't be changed";
    throws_ok { push @x, 3 } $mod,  "readonly array can't be extended";
    throws_ok { pop @x } $mod,      "readonly array can't be shortened";
    throws_ok { @x = () } $mod,     "readonly array can't be cleared";
    throws_ok { undef @x } $mod,    "readonly array can't be undefined";
}

{
    my %x = (foo => 1);
    readonly \%x;

    is_deeply \%x, {foo => 1},      "readonly doesn't affect hash value";
    ok SvRO(\%x),                   "readonly makes hashes SvRO";
    ok SvRO(\$x{foo}),              "readonly makes hash elem SvRO";

    throws_ok { $x{foo} = 2 } $mod,     "readonly hash elem can't be changed";
    throws_ok { $x{bar} = 1 } $mod,     "readonly hash can't be extended";
    throws_ok { delete $x{foo} } $mod,  "readonly hash can't be shortened";
    throws_ok { %x = () } $mod,         "readonly hash can't be cleared";
    throws_ok { undef %x } $mod,        "readonly hash can't be undefined";
}

{
    my $x = 1;              *x = \$x;
    my @x = (1, 2);         *x = \@x;
    my %x = (foo => 1);     *x = \%x;
    my $c = sub {1};        *x = $c;
    open *x, "<", devnull;  my $i = *x{IO};
    readonly \*x;

    is *x{SCALAR}, \$x,             "readonly doesn't affect glob SCALAR slot";
    is *x{ARRAY}, \@x,              "readonly doesn't affect glob ARRAY slot";
    is *x{HASH}, \%x,               "readonly doesn't affect glob HASH slot";
    is *x{CODE}, $c,                "readonly doesn't affect glob CODE slot";
    is *x{IO}, $i,                  "readonly doesn't affect glob IO slot";

    ok SvRO(\*x),                   "readonly makes glob SvRO";
    ok SvRO(*x{SCALAR}),            "readonly makes glob SCALAR SvRO";
    ok SvRO(*x{ARRAY}),             "readonly makes glob ARRAY SvRO";
    ok SvRO(*x{HASH}),              "readonly makes glob HASH SvRO";

    ok !SvRO(*x{CODE}),             "readonly doesn't make CODE slot SvRO";
    ok !SvRO(*x{IO}),               "readonly doesn't make IO slot SvRO";

    throws_ok { *x = \1 } $mod,     "readonly SCALAR slot can't be changed";
    throws_ok { *x = [] } $mod,     "readonly ARRAY slot can't be changed";
    throws_ok { *x = {} } $mod,     "readonly HASH slot can't be changed";
    throws_ok { *x = sub {2} } $mod, "readonly CODE slot can't be changed";
    throws_ok { *x = *STDOUT{IO} } $mod,
                                    "readonly IO slot can't be changed";
}

{
    my $x = bless [];
    readonly $x;

    ok !SvRO($x),                   "readonly doesn't affect object";
}
{
    my $x = bless [];
    readonly $x, {peek=>1};

    ok SvRO($x),                    "readonly w/peek affects objects";
}

sub foo { }
readonly \&foo;
ok !SvRO(\&foo),                    "readonly doesn't affect subref";

readonly *STDOUT{IO};
ok !SvRO(*STDOUT{IO}),              "readonly doesn't affect ioref";

{
    my $x = qr/x/;
    readonly $x, {peek => 1};

    ok !SvRO($x),                       "readonly doesn't affect qr//";
}

done_testing;