13 is(pos($x), 2, "matching, pos() leaves off at offset 2");
16 is(pos($x), 2, "not matching, pos() remains at offset 2");
18 sub f { my $p=$_[0]; return $p }
21 is(f(pos($x)), 4, "matching again, pos() next leaves off at offset 4");
23 # Is pos() set inside //g? (bug id 19990615.008 (#874))
24 $x = "test string?"; $x =~ s/\w/pos($x)/eg;
25 is($x, "0123 5678910?", "pos() set inside //g");
27 $x = "123 56"; $x =~ / /g;
28 is(pos($x), 4, "matching, pos() leaves off at offset 4");
30 is(pos($x), 4, "value of pos() unaffected by intermediate localization");
32 # Explicit test that triggers the utf8_mg_len_cache_update() code path in
37 is(pos $x, 3, "utf8_mg_len_cache_update() test");
39 is(scalar pos $x, 3, "rvalue pos() utf8 test");
43 { package Class; DESTROY { ++$destroyed; } }
49 $x = bless({}, 'Class');
51 is($destroyed, 1, 'Timely scalar destruction with lvalue pos');
54 like $@, qr/^Can't modify array dereference in match position at /,
55 'pos refuses @arrays';
57 like $@, qr/^Can't modify hash dereference in match position at /,
58 'pos refuses %hashes';
60 is eval 'pos *a', 1, 'pos *glob works';
62 # Test that UTF8-ness of $1 changing does not confuse pos
63 "f" =~ /(f)/; "$1"; # first make sure UTF8-ness is off
64 "\x{100}a" =~ /(..)/; # give PL_curpm a UTF8 string; $1 does not know yet
65 pos($1) = 2; # set pos; was ignoring UTF8-ness
66 "$1"; # turn on UTF8 flag
67 is pos($1), 2, 'pos is not confused about changing UTF8-ness';
72 is pos $h{k}, 3, 'defelems can propagate pos assignment';
74 is pos $h{k}, 4, 'defelems can propagate implicit pos (via //g)';
75 $_[0] =~ /oentuhoetn/g;
76 is pos $h{k}, undef, 'failed //g sets pos through defelem';
79 is pos $_[1], 3, 'reading pos through a defelem';
82 is "$1", 'o', '//g can read pos through a defelem';
85 is pos $h{m}, 4, '//gc in list cx can set pos through a defelem';
88 s<e><is pos($h{n}), 1, 's///g setting pos through a defelem'>egg;
90 $_[3] =~ /e(?{ is pos $h{n},2, 're-evals set pos through defelems' })/;
92 ok $_[3] =~ /\Ge/, '\G works with defelem scalars';
93 }->($h{k}, $h{l}, $h{m}, $h{n});
95 $x = bless [], chr 256;
98 is pos($x), 1, 'pos is not affected by reference stringification changing';
101 local $SIG{__WARN__} = sub { $w .= shift };
102 $x = bless [], chr 256;
104 bless $x, "\x{1000}";
106 'pos unchanged after increasing size of chars in stringification';
107 is $w, undef, 'and no malformed utf8 warning';
109 $x = bless [], chr 256;
112 is pos($x), 1, 'pos unaffected by ref str changing (in re-eval)';
116 local $SIG{__WARN__} = sub { $w .= shift };
117 $x = bless [], chr(256);
119 bless $x, "\x{1000}";
121 'pos unchanged in re-eval after increasing size of chars in str';
123 is $w, undef, 'and no malformed utf8 warning';
126 for my $one(pos $x) {
127 for my $two(pos $x) {
131 'no assertion failure when getting pos clobbers ref with undef';
137 my $x = "\N{U+10000}abc";
139 chars => { length => 4, pos => 2 },
140 bytes => { length => 7, pos => 5 },
143 $observed{chars}{length} = length($x);
145 $observed{chars}{pos} = pos($x);
149 $observed{bytes}{length} = length($x);
150 $observed{bytes}{pos} = pos($x);
153 is( $observed{chars}{length}, $expected{chars}{length},
154 "Got expected length in chars");
155 is( $observed{chars}{pos}, $expected{chars}{pos},
156 "Got expected pos in chars");
157 is( $observed{bytes}{length}, $expected{bytes}{length},
158 "Got expected length in bytes");
159 is( $observed{bytes}{pos}, $expected{bytes}{pos},
160 "Got expected pos in bytes");