This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Allow regexp-to-pvlv assignment
[perl5.git] / t / op / qr.t
CommitLineData
c2123ae3
NC
1#!./perl -w
2
3use strict;
4
ab1d0753
FC
5BEGIN {
6 chdir 't';
7 require './test.pl';
8}
c2123ae3 9
8d919b0a 10plan(tests => 32);
c2123ae3
NC
11
12sub r {
13 return qr/Good/;
14}
15
16my $a = r();
bbce3ca6 17object_ok($a, 'Regexp');
c2123ae3 18my $b = r();
bbce3ca6 19object_ok($b, 'Regexp');
c2123ae3
NC
20
21my $b1 = $b;
22
23isnt($a + 0, $b + 0, 'Not the same object');
24
25bless $b, 'Pie';
26
bbce3ca6
MS
27object_ok($b, 'Pie');
28object_ok($a, 'Regexp');
29object_ok($b1, 'Pie');
c2123ae3
NC
30
31my $c = r();
32like("$c", qr/Good/);
33my $d = r();
34like("$d", qr/Good/);
35
36my $d1 = $d;
37
38isnt($c + 0, $d + 0, 'Not the same object');
39
40$$d = 'Bad';
41
42like("$c", qr/Good/);
b9ad13ac
NC
43is($$d, 'Bad');
44is($$d1, 'Bad');
45
46# Assignment to an implicitly blessed Regexp object retains the class
47# (No different from direct value assignment to any other blessed SV
48
bbce3ca6 49object_ok($d, 'Regexp');
b9ad13ac
NC
50like("$d", qr/\ARegexp=SCALAR\(0x[0-9a-f]+\)\z/);
51
52# As does an explicitly blessed Regexp object.
53
54my $e = bless qr/Faux Pie/, 'Stew';
55
bbce3ca6 56object_ok($e, 'Stew');
b9ad13ac
NC
57$$e = 'Fake!';
58
59is($$e, 'Fake!');
bbce3ca6 60object_ok($e, 'Stew');
b9ad13ac 61like("$e", qr/\Stew=SCALAR\(0x[0-9a-f]+\)\z/);
7e313637
FC
62
63# [perl #96230] qr// should not have the reuse-last-pattern magic
64"foo" =~ /foo/;
65like "bar",qr//,'[perl #96230] =~ qr// does not reuse last successful pat';
6a97c51d
FC
66"foo" =~ /foo/;
67$_ = "bar";
68$_ =~ s/${qr||}/baz/;
69is $_, "bazbar", '[perl #96230] s/$qr// does not reuse last pat';
12c45b25
FC
70
71{
72 my $x = 1.1; $x = ${qr//};
73 pass 'no assertion failure when upgrading NV to regexp';
74}
78a84e43
FC
75
76sub TIESCALAR{bless[]}
77sub STORE { is ref\pop, "REGEXP", "stored regexp" }
78tie my $t, "";
79$t = ${qr||};
80ok tied $t, 'tied var is still tied after regexp assignment';
81
82bless \my $t2;
83$t2 = ${qr||};
84is ref \$t2, 'main', 'regexp assignment is not maledictory';
62f099ef
FC
85
86{
87 my $w;
88 local $SIG{__WARN__}=sub{$w=$_[0]};
89 $_ = 1.1;
90 $_ = ${qr//};
91 is 0+$_, 0, 'double upgraded to regexp';
92 like $w, 'numeric', 'produces non-numeric warning';
93 undef $w;
94 $_ = 1;
95 $_ = ${qr//};
96 is 0+$_, 0, 'int upgraded to regexp';
97 like $w, 'numeric', 'likewise produces non-numeric warning';
98}
8d919b0a
FC
99
100sub {
101 $_[0] = ${qr=crumpets=};
102 is ref\$_[0], 'REGEXP', 'PVLVs';
103 # Don’t use like() here, as we would no longer be testing a PVLV.
104 ok " crumpets " =~ $_[0], 'using a regexpvlv as regexp';
105 my $x = $_[0];
106 is ref\$x, 'REGEXP', 'copying a regexpvlv';
107 $_[0] = ${qr//};
108 my $str = "".qr//;
109 $_[0] .= " ";
110 is $_[0], "$str ", 'stringifying regexpvlv in place';
111}
112 ->((\my%hash)->{key});