Commit | Line | Data |
---|---|---|
02c45c47 GS |
1 | #!./perl |
2 | ||
ee8ba353 SP |
3 | BEGIN { |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
6 | require './test.pl'; | |
7 | } | |
8 | ||
57e30c7a | 9 | plan tests => 12; |
02c45c47 GS |
10 | |
11 | $x='banana'; | |
12 | $x=~/.a/g; | |
e58f9f94 | 13 | is(pos($x), 2, "matching, pos() leaves off at offset 2"); |
02c45c47 GS |
14 | |
15 | $x=~/.z/gc; | |
e58f9f94 | 16 | is(pos($x), 2, "not matching, pos() remains at offset 2"); |
02c45c47 GS |
17 | |
18 | sub f { my $p=$_[0]; return $p } | |
19 | ||
20 | $x=~/.a/g; | |
e58f9f94 | 21 | is(f(pos($x)), 4, "matching again, pos() next leaves off at offset 4"); |
02c45c47 | 22 | |
084916e3 JH |
23 | # Is pos() set inside //g? (bug id 19990615.008) |
24 | $x = "test string?"; $x =~ s/\w/pos($x)/eg; | |
e58f9f94 | 25 | is($x, "0123 5678910?", "pos() set inside //g"); |
ee8ba353 | 26 | |
e7cbf6c6 | 27 | $x = "123 56"; $x =~ / /g; |
e58f9f94 | 28 | is(pos($x), 4, "matching, pos() leaves off at offset 4"); |
e7cbf6c6 | 29 | { local $x } |
e58f9f94 | 30 | is(pos($x), 4, "value of pos() unaffected by intermediate localization"); |
0d7caf4c | 31 | |
93f09d7b | 32 | # Explicit test that triggers the utf8_mg_len_cache_update() code path in |
0d7caf4c NC |
33 | # Perl_sv_pos_b2u(). |
34 | ||
35 | $x = "\x{100}BC"; | |
36 | $x =~ m/.*/g; | |
e58f9f94 | 37 | is(pos $x, 3, "utf8_mg_len_cache_update() test"); |
0d7caf4c | 38 | |
0607bed5 EB |
39 | |
40 | my $destroyed; | |
41 | { package Class; DESTROY { ++$destroyed; } } | |
42 | ||
43 | $destroyed = 0; | |
44 | { | |
45 | my $x = ''; | |
46 | pos($x) = 0; | |
47 | $x = bless({}, 'Class'); | |
48 | } | |
2154eca7 | 49 | is($destroyed, 1, 'Timely scalar destruction with lvalue pos'); |
32a60974 FC |
50 | |
51 | eval 'pos @a = 1'; | |
52 | like $@, qr/^Can't modify array dereference in match position at /, | |
53 | 'pos refuses @arrays'; | |
54 | eval 'pos %a = 1'; | |
55 | like $@, qr/^Can't modify hash dereference in match position at /, | |
56 | 'pos refuses %hashes'; | |
57 | eval 'pos *a = 1'; | |
58 | is eval 'pos *a', 1, 'pos *glob works'; | |
57e30c7a FC |
59 | |
60 | # Test that UTF8-ness of $1 changing does not confuse pos | |
61 | "f" =~ /(f)/; "$1"; # first make sure UTF8-ness is off | |
62 | "\x{100}a" =~ /(..)/; # give PL_curpm a UTF8 string; $1 does not know yet | |
63 | pos($1) = 2; # set pos; was ignoring UTF8-ness | |
64 | "$1"; # turn on UTF8 flag | |
65 | is pos($1), 2, 'pos is not confused about changing UTF8-ness'; |