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
|
#!./perl
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
require './test.pl';
}
plan tests => 12;
$x='banana';
$x=~/.a/g;
is(pos($x), 2);
$x=~/.z/gc;
is(pos($x), 2);
sub f { my $p=$_[0]; return $p }
$x=~/.a/g;
is(f(pos($x)), 4);
# Is pos() set inside //g? (bug id 19990615.008)
$x = "test string?"; $x =~ s/\w/pos($x)/eg;
is($x, "0123 5678910?");
$x = "123 56"; $x =~ / /g;
is(pos($x), 4);
{ local $x }
is(pos($x), 4);
# Explicit test that triggers the utf8_mg_len_cache_update() code path in
# Perl_sv_pos_b2u().
$x = "\x{100}BC";
$x =~ m/.*/g;
is(pos $x, 3);
my $destroyed;
{ package Class; DESTROY { ++$destroyed; } }
$destroyed = 0;
{
my $x = '';
pos($x) = 0;
$x = bless({}, 'Class');
}
is($destroyed, 1, 'Timely scalar destruction with lvalue pos');
eval 'pos @a = 1';
like $@, qr/^Can't modify array dereference in match position at /,
'pos refuses @arrays';
eval 'pos %a = 1';
like $@, qr/^Can't modify hash dereference in match position at /,
'pos refuses %hashes';
eval 'pos *a = 1';
is eval 'pos *a', 1, 'pos *glob works';
# Test that UTF8-ness of $1 changing does not confuse pos
"f" =~ /(f)/; "$1"; # first make sure UTF8-ness is off
"\x{100}a" =~ /(..)/; # give PL_curpm a UTF8 string; $1 does not know yet
pos($1) = 2; # set pos; was ignoring UTF8-ness
"$1"; # turn on UTF8 flag
is pos($1), 2, 'pos is not confused about changing UTF8-ness';
|
