Commit | Line | Data |
192b9cd1 |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | @INC = '../lib'; |
6 | require './test.pl'; |
7 | } |
8 | |
9 | # Do a basic test on all the tied methods of Tie::Hash::NamedCapture |
10 | |
1d021cc8 |
11 | plan(tests => 21); |
1e1d4b91 |
12 | |
13 | # PL_curpm->paren_names can be a null pointer. See that this succeeds anyway. |
14 | 'x' =~ /(.)/; |
15 | () = %+; |
16 | pass( 'still alive' ); |
192b9cd1 |
17 | |
18 | "hlagh" =~ / |
19 | (?<a>.) |
20 | (?<b>.) |
21 | (?<a>.) |
22 | .* |
23 | (?<e>$) |
24 | /x; |
25 | |
26 | # FETCH |
27 | is($+{a}, "h", "FETCH"); |
28 | is($+{b}, "l", "FETCH"); |
29 | is($-{a}[0], "h", "FETCH"); |
30 | is($-{a}[1], "a", "FETCH"); |
31 | |
32 | # STORE |
33 | eval { $+{a} = "yon" }; |
34 | ok(index($@, "read-only") != -1, "STORE"); |
35 | |
36 | # DELETE |
37 | eval { delete $+{a} }; |
38 | ok(index($@, "read-only") != -1, "DELETE"); |
39 | |
40 | # CLEAR |
41 | eval { %+ = () }; |
42 | ok(index($@, "read-only") != -1, "CLEAR"); |
43 | |
44 | # EXISTS |
45 | ok(exists $+{e}, "EXISTS"); |
46 | ok(!exists $+{d}, "EXISTS"); |
47 | |
48 | # FIRSTKEY/NEXTKEY |
49 | is(join('|', sort keys %+), "a|b|e", "FIRSTKEY/NEXTKEY"); |
50 | |
51 | # SCALAR |
52 | is(scalar(%+), 3, "SCALAR"); |
53 | is(scalar(%-), 3, "SCALAR"); |
1d021cc8 |
54 | |
55 | # Abuse all methods with undef as the first argument (RT #71828 and then some): |
56 | |
57 | is(Tie::Hash::NamedCapture::FETCH(undef, undef), undef, 'FETCH with undef'); |
58 | eval {Tie::Hash::NamedCapture::STORE(undef, undef, undef)}; |
59 | like($@, qr/Modification of a read-only value attempted/, 'STORE with undef'); |
60 | eval {Tie::Hash::NamedCapture::DELETE(undef, undef)}; |
61 | like($@, , qr/Modification of a read-only value attempted/, |
62 | 'DELETE with undef'); |
63 | eval {Tie::Hash::NamedCapture::CLEAR(undef)}; |
64 | like($@, qr/Modification of a read-only value attempted/, 'CLEAR with undef'); |
65 | is(Tie::Hash::NamedCapture::EXISTS(undef, undef), undef, 'EXISTS with undef'); |
66 | is(Tie::Hash::NamedCapture::FIRSTKEY(undef), undef, 'FIRSTKEY with undef'); |
67 | is(Tie::Hash::NamedCapture::NEXTKEY(undef, undef), undef, 'NEXTKEY with undef'); |
68 | is(Tie::Hash::NamedCapture::SCALAR(undef), undef, 'SCALAR with undef'); |