Commit | Line | Data |
---|---|---|
c2123ae3 NC |
1 | #!./perl -w |
2 | ||
3 | use strict; | |
4 | ||
ab1d0753 FC |
5 | BEGIN { |
6 | chdir 't'; | |
7 | require './test.pl'; | |
8 | } | |
c2123ae3 | 9 | |
8d919b0a | 10 | plan(tests => 32); |
c2123ae3 NC |
11 | |
12 | sub r { | |
13 | return qr/Good/; | |
14 | } | |
15 | ||
16 | my $a = r(); | |
bbce3ca6 | 17 | object_ok($a, 'Regexp'); |
c2123ae3 | 18 | my $b = r(); |
bbce3ca6 | 19 | object_ok($b, 'Regexp'); |
c2123ae3 NC |
20 | |
21 | my $b1 = $b; | |
22 | ||
23 | isnt($a + 0, $b + 0, 'Not the same object'); | |
24 | ||
25 | bless $b, 'Pie'; | |
26 | ||
bbce3ca6 MS |
27 | object_ok($b, 'Pie'); |
28 | object_ok($a, 'Regexp'); | |
29 | object_ok($b1, 'Pie'); | |
c2123ae3 NC |
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/); | |
b9ad13ac NC |
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 | ||
bbce3ca6 | 49 | object_ok($d, 'Regexp'); |
b9ad13ac NC |
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 | ||
bbce3ca6 | 56 | object_ok($e, 'Stew'); |
b9ad13ac NC |
57 | $$e = 'Fake!'; |
58 | ||
59 | is($$e, 'Fake!'); | |
bbce3ca6 | 60 | object_ok($e, 'Stew'); |
b9ad13ac | 61 | like("$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/; | |
65 | like "bar",qr//,'[perl #96230] =~ qr// does not reuse last successful pat'; | |
6a97c51d FC |
66 | "foo" =~ /foo/; |
67 | $_ = "bar"; | |
68 | $_ =~ s/${qr||}/baz/; | |
69 | is $_, "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 | |
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'; | |
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 | |
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}); |