9 use Devel::SelfStubber;
10 use File::Spec::Functions;
12 my $runperl = "$^X \"-I../lib\"";
13 $runperl =~ s|../lib|::lib:| if $^O eq 'MacOS';
15 # ensure correct output ordering for system() calls
17 select STDERR; $| = 1; select STDOUT; $| = 1;
24 foreach my $file (reverse @cleanup) {
25 unlink $file or warn "unlink $file failed: $!" while -f $file;
26 rmdir $file or warn "rmdir $file failed: $!" if -d $file;
31 mkdir $inlib, 0777 or die $!;
32 push @cleanup, $inlib;
35 if (/^\#{16,}\s+(.*)/) {
37 my $file = catfile(curdir(),$inlib,$f);
39 open FH, ">$file" or die $!;
49 open FH, ">$file" or die $!;
51 Devel::SelfStubber->stub('Child', $inlib);
56 open FH, $file or die $!;
59 if (@A == 1 && $A[0] =~ /^\s*sub\s+Child::foo\s*;\s*$/) {
63 print "# $_" foreach (@A);
70 open FH, ">$file" or die $!;
72 Devel::SelfStubber->stub('Proto', $inlib);
74 print "ok 3\n"; # Checking that we did not die horribly.
77 open FH, $file or die $!;
80 if (@B == 1 && $B[0] =~ /^\s*sub\s+Proto::bar\s*\(\$\$\);\s*$/) {
84 print "# $_" foreach (@B);
93 open FH, ">$file" or die $!;
95 Devel::SelfStubber->stub('Attribs', $inlib);
97 print "ok 5\n"; # Checking that we did not die horribly.
100 open FH, $file or die $!;
103 if (@C == 2 && $C[0] =~ /^\s*sub\s+Attribs::baz\s+:\s*locked\s*;\s*$/
104 && $C[1] =~ /^\s*sub\s+Attribs::lv\s+:\s*lvalue\s*:\s*method\s*;\s*$/) {
108 print "# $_" foreach (@C);
114 # "wrong" and "right" may change if SelfLoader is changed.
115 my %wrong = ( Parent => 'Parent', Child => 'Parent' );
116 my %right = ( Parent => 'Parent', Child => 'Child' );
118 # extra line feeds for MBX IPC
119 %wrong = ( Parent => "Parent\n", Child => "Parent\n" );
120 %right = ( Parent => "Parent\n", Child => "Child\n" );
122 my @module = qw(Parent Child)
125 my ($left, $right) = @_;
126 while (my ($key, $val) = each %$left) {
127 # warn "$key $val $$right{$key}";
129 unless $val eq $$right{$key};
135 my ($expect, $got) = @_;
136 foreach (sort keys %$expect) {
137 print "# $_ expect '$$expect{$_}' got '$$got{$_}'\n";
141 # Now test that the module tree behaves "wrongly" as expected
143 foreach my $module (@module) {
144 my $file = "$module--$$";
145 push @cleanup, $file;
146 open FH, ">$file" or die $!;
147 print FH "use $module;
148 print ${module}->foo;
155 foreach my $module (@module) {
156 print "# $runperl \"-I$inlib\" $module--$$\n";
157 ($output{$module} = `$runperl "-I$inlib" $module--$$`)
161 if (&fail (\%wrong, \%output)) {
162 print "not ok 7\n", &faildump (\%wrong, \%output);
169 mkdir $lib, 0777 or die $!;
171 $Devel::SelfStubber::JUST_STUBS=0;
174 foreach my $module (@module, 'Data', 'End') {
175 my $file = catfile(curdir(),$lib,"$module.pm");
176 my $fileo = catfile(curdir(),$inlib,"$module.pm");
177 open FH, $fileo or die "Can't open $fileo: $!";
180 push @cleanup, $file;
181 open FH, ">$file" or die $!;
183 if ($contents =~ /__DATA__/) {
184 # This will die for any module with no __DATA__
185 Devel::SelfStubber->stub($module, $inlib);
196 foreach my $module (@module) {
197 print "# $runperl \"-I$lib\" $module--$$\n";
198 ($output{$module} = `$runperl "-I$lib" $module--$$`)
202 if (&fail (\%right, \%output)) {
203 print "not ok 9\n", &faildump (\%right, \%output);
209 # Check that the DATA handle stays open
210 system "$runperl -w \"-I$lib\" \"-MData\" -e \"Data::ok\"";
212 # Possibly a pointless test as this doesn't really verify that it's been
214 system "$runperl -w \"-I$lib\" \"-MEnd\" -e \"End::lime\"";
216 # But check that the documentation after the __END__ survived.
217 open FH, catfile(curdir(),$lib,"End.pm") or die $!;
221 if (/Did the documentation here survive\?/) {
224 print "not ok 12 # information after an __END__ token seems to be lost\n";
228 ################ Parent.pm
236 ################ Child.pm
248 ################ Proto.pm
256 ################ Attribs.pm
264 sub lv : lvalue : method {
268 ################ Data.pm
279 ################ End.pm
289 Did the documentation here survive?