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, qr/numeric/, 'produces non-numeric warning';
  93     undef $w;
  94     $_ = 1;
  95     $_ = ${qr//};
  96     is 0+$_, 0, 'int upgraded to regexp';
  97     like $w, qr/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});