This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade Filter-Util-Call from version 1.54 to 1.55
[perl5.git] / cpan / Filter-Util-Call / t / rt_54452-rebless.t
1 # RT #54452 check that filter_add does not rebless an already blessed
2 # given object into the callers class.
3
4 if ($] < 5.004_55) {
5   print "1..0\n";
6   exit 0;
7 }
8
9 use strict;
10 use warnings;
11
12 require "./filter-util.pl" ;
13
14 use vars qw( $Inc $Perl) ;
15
16 my $file = "bless.test" ;
17 my $module = "Foo";
18 my $bless1 = "bless1" ;
19
20 writeFile("t/Foo.pm", <<'EOM') ;
21 package Foo;
22 use strict;
23 use warnings;
24 our @ISA = ('Foo::Base');
25
26 package Foo::Base;
27 use Filter::Util::Call;
28 sub import {
29   my ($class) = @_;
30   my $self = bless {}, $class;
31   print "before ", ref $self, "\n";
32   filter_add ($self);
33   print "after ", ref $self, "\n";
34 }
35 sub filter {
36   my ($self) = @_;
37   print "filter ", ref $self, "\n";
38   return 0;
39 }
40
41 1;
42 EOM
43
44 my $fil1 = <<EOM;
45 use lib 't';
46 use Foo;
47 print "this is filtered out\n";
48 EOM
49
50 writeFile($file, $fil1);
51
52 my $a = `$Perl $Inc $file 2>&1` ;
53 print "1..2\n" ;
54
55 ok(1, ($? >> 8) == 0) ;
56 chomp $a;
57 ok(2, $a eq "before Foo
58 after Foo
59 filter Foo", "RT \#54452 " . $a);
60
61 unlink $file or die "Cannot remove $file: $!\n" ;
62 unlink "t/Foo.pm" or die "Cannot remove t/Foo.pm: $!\n" ;