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 => 18);
  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/);