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
CommitLineData
f686c54e
CBW
1# RT #54452 check that filter_add does not rebless an already blessed
2# given object into the callers class.
3
4if ($] < 5.004_55) {
5 print "1..0\n";
6 exit 0;
7}
8
9use strict;
10use warnings;
11
12require "./filter-util.pl" ;
13
14use vars qw( $Inc $Perl) ;
15
16my $file = "bless.test" ;
17my $module = "Foo";
18my $bless1 = "bless1" ;
19
20writeFile("t/Foo.pm", <<'EOM') ;
21package Foo;
22use strict;
23use warnings;
24our @ISA = ('Foo::Base');
25
26package Foo::Base;
27use Filter::Util::Call;
28sub 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}
35sub filter {
36 my ($self) = @_;
37 print "filter ", ref $self, "\n";
38 return 0;
39}
40
411;
42EOM
43
44my $fil1 = <<EOM;
45use lib 't';
46use Foo;
47print "this is filtered out\n";
48EOM
49
50writeFile($file, $fil1);
51
52my $a = `$Perl $Inc $file 2>&1` ;
53print "1..2\n" ;
54
55ok(1, ($? >> 8) == 0) ;
56chomp $a;
57ok(2, $a eq "before Foo
58after Foo
59filter Foo", "RT \#54452 " . $a);
60
61unlink $file or die "Cannot remove $file: $!\n" ;
62unlink "t/Foo.pm" or die "Cannot remove t/Foo.pm: $!\n" ;