require './test.pl';
set_up_inc('../lib');
require Config; import Config;
+ require constant;
+ constant->import(constcow => *Config::{NAME});
require './charset_tools.pl';
require './loc_tools.pl';
}
-plan( tests => 267 );
+plan( tests => 274 );
$_ = 'david';
$a = s/david/rules/r;
$a = "david" =~ s/david/rules/r;
ok( $a eq 'rules', 's///r with constant' );
+#[perl #127635] failed with -DPERL_NO_COW perl build (George smoker uses flag)
+#Modification of a read-only value attempted at ../t/re/subst.t line 23.
+$a = constcow =~ s/Config/David/r;
+ok( $a eq 'David::', 's///r with COW constant' );
+
$a = "david" =~ s/david/"is"."great"/er;
ok( $a eq 'isgreat', 's///er' );
ok( $_ eq 'abcdefghijklmnopqrstuvwxyz0123456789' );
SKIP: {
- skip("not ASCII",1) unless (ord("+") == ord(",") - 1
- && ord(",") == ord("-") - 1
- && ord("a") == ord("b") - 1
- && ord("b") == ord("c") - 1);
+ skip("ASCII-centric test",1) unless (ord("+") == ord(",") - 1
+ && ord(",") == ord("-") - 1
+ && ord("a") == ord("b") - 1
+ && ord("b") == ord("c") - 1);
$_ = '+,-';
tr/+--/a-c/;
ok( $_ eq 'abc' );
substr($pv2,0,1) = "\x{100}";
is($pv1, $pv2);
-SKIP: {
- skip("EBCDIC", 3) if ord("A") == 193;
-
+{
{
# Gregor Chrupala <gregor.chrupala@star-group.net>
use utf8;
/e;
};
is $locker{key}, '3', 'locking target in $hash{key} =~ s//.../e';
- like $@, qr/^Modification of a read-only value/, 'err msg';
+ like $@, qr/^Modification of a read-only value/, 'err msg' . ($@ ? ": $@" : "");
}
delete $::{does_not_exist}; # just in case
eval { no warnings; $::{does_not_exist}=~s/(?:)/*{"does_not_exist"}; 4/e };
$s1 =~ s/.?/$s1++/ge;
is($s1, "01","RT #123954 s1");
}
+{
+ # RT #126602 double free if the value being modified is freed in the replacement
+ fresh_perl_is('s//*_=0;s|0||;00.y0/e; print qq(ok\n)', "ok\n", { stderr => 1 },
+ "[perl #126602] s//*_=0;s|0||/e crashes");
+}
+
+{
+ #RT 126260 gofs is in chars, not bytes
+
+ # in something like /..\G/, the engine should start matching two
+ # chars before pos(). At one point it was matching two bytes before.
+
+ my $s = "\x{121}\x{122}\x{123}";
+ pos($s) = 2;
+ $s =~ s/..\G//g;
+ is($s, "\x{123}", "#RT 126260 gofs");
+}
+
+SKIP: {
+ if (! locales_enabled('LC_CTYPE')) {
+ skip "Can't test locale", 1;
+ }
+
+ # To cause breakeage, we need a locale in which \xff matches whatever
+ # POSIX class is used in the pattern. Easiest is C, with \W.
+ fresh_perl_is(' use POSIX qw(locale_h);
+ setlocale(&POSIX::LC_CTYPE, "C");
+ my $s = "\xff";
+ $s =~ s/\W//l;
+ print qq(ok$s\n)',
+ "ok\n",
+ {stderr => 1 },
+ '[perl #129038 ] s/\xff//l no longer crashes');
+}
+
+ SKIP: {
+ skip("no Tie::Hash::NamedCapture under miniperl", 3) if is_miniperl;
+
+ # RT #23624 scoping of @+/@- when used with tie()
+ #! /usr/bin/perl -w
+
+ package Tie::Prematch;
+ sub TIEHASH { bless \my $dummy => __PACKAGE__ }
+ sub FETCH { return substr $_[1], 0, $-[0] }
+
+ package main;
+
+ eval <<'__EOF__';
+ tie my %pre, 'Tie::Prematch';
+ my $foo = 'foobar';
+ $foo =~ s/.ob/$pre{ $foo }/;
+ is($foo, 'ffar', 'RT #23624');
+
+ $foo = 'foobar';
+ $foo =~ s/.ob/tied(%pre)->FETCH($foo)/e;
+ is($foo, 'ffar', 'RT #23624');
+
+ tie %-, 'Tie::Prematch';
+ $foo = 'foobar';
+ $foo =~ s/.ob/$-{$foo}/;
+ is($foo, 'ffar', 'RT #23624');
+
+ undef *Tie::Prematch::TIEHASH;
+ undef *Tie::Prematch::FETCH;
+__EOF__
+}