Allow regexp-to-pvlv assignment
[perl.git] / t / op / qr.t
1 #!./perl -w
2
3 use strict;
4
5 BEGIN {
6     chdir 't';
7     require './test.pl';
8 }
9
10 plan(tests => 32);
11
12 sub r {
13     return qr/Good/;
14 }
15
16 my $a = r();
17 object_ok($a, 'Regexp');
18 my $b = r();
19 object_ok($b, 'Regexp');
20
21 my $b1 = $b;
22
23 isnt($a + 0, $b + 0, 'Not the same object');
24
25 bless $b, 'Pie';
26
27 object_ok($b, 'Pie');
28 object_ok($a, 'Regexp');
29 object_ok($b1, 'Pie');
30
31 my $c = r();
32 like("$c", qr/Good/);
33 my $d = r();
34 like("$d", qr/Good/);
35
36 my $d1 = $d;
37
38 isnt($c + 0, $d + 0, 'Not the same object');
39
40 $$d = 'Bad';
41
42 like("$c", qr/Good/);
43 is($$d, 'Bad');
44 is($$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
49 object_ok($d, 'Regexp');
50 like("$d", qr/\ARegexp=SCALAR\(0x[0-9a-f]+\)\z/);
51
52 # As does an explicitly blessed Regexp object.
53
54 my $e = bless qr/Faux Pie/, 'Stew';
55
56 object_ok($e, 'Stew');
57 $$e = 'Fake!';
58
59 is($$e, 'Fake!');
60 object_ok($e, 'Stew');
61 like("$e", qr/\Stew=SCALAR\(0x[0-9a-f]+\)\z/);
62
63 # [perl #96230] qr// should not have the reuse-last-pattern magic
64 "foo" =~ /foo/;
65 like "bar",qr//,'[perl #96230] =~ qr// does not reuse last successful pat';
66 "foo" =~ /foo/;
67 $_ = "bar";
68 $_ =~ s/${qr||}/baz/;
69 is $_, "bazbar", '[perl #96230] s/$qr// does not reuse last pat';
70
71 {
72     my $x = 1.1; $x = ${qr//};
73     pass 'no assertion failure when upgrading NV to regexp';
74 }
75
76 sub TIESCALAR{bless[]}
77 sub STORE { is ref\pop, "REGEXP", "stored regexp" }
78 tie my $t, "";
79 $t = ${qr||};
80 ok tied $t, 'tied var is still tied after regexp assignment';
81
82 bless \my $t2;
83 $t2 = ${qr||};
84 is ref \$t2, 'main', 'regexp assignment is not maledictory';
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 }
99
100 sub {
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});