t/op/qr.t

   1 #!./perl -w
   2
   3 use strict;
   4
   5 require './test.pl';
   6
   7 plan(tests => 18);
   8
   9 sub r {
  10     return qr/Good/;
  11 }
  12
  13 my $a = r();
  14 isa_ok($a, 'Regexp');
  15 my $b = r();
  16 isa_ok($b, 'Regexp');
  17
  18 my $b1 = $b;
  19
  20 isnt($a + 0, $b + 0, 'Not the same object');
  21
  22 bless $b, 'Pie';
  23
  24 isa_ok($b, 'Pie');
  25 isa_ok($a, 'Regexp');
  26 isa_ok($b1, 'Pie');
  27
  28 my $c = r();
  29 like("$c", qr/Good/);
  30 my $d = r();
  31 like("$d", qr/Good/);
  32
  33 my $d1 = $d;
  34
  35 isnt($c + 0, $d + 0, 'Not the same object');
  36
  37 $$d = 'Bad';
  38
  39 like("$c", qr/Good/);
  40 is($$d, 'Bad');
  41 is($$d1, 'Bad');
  42
  43 # Assignment to an implicitly blessed Regexp object retains the class
  44 # (No different from direct value assignment to any other blessed SV
  45
  46 isa_ok($d, 'Regexp');
  47 like("$d", qr/\ARegexp=SCALAR\(0x[0-9a-f]+\)\z/);
  48
  49 # As does an explicitly blessed Regexp object.
  50
  51 my $e = bless qr/Faux Pie/, 'Stew';
  52
  53 isa_ok($e, 'Stew');
  54 $$e = 'Fake!';
  55
  56 is($$e, 'Fake!');
  57 isa_ok($e, 'Stew');
  58 like("$e", qr/\Stew=SCALAR\(0x[0-9a-f]+\)\z/);