9 use Devel::SelfStubber;
11 my $runperl = "$^X \"-I../lib\"";
13 # ensure correct output ordering for system() calls
15 select STDERR; $| = 1; select STDOUT; $| = 1;
22 foreach my $file (reverse @cleanup) {
23 unlink $file or warn "unlink $file failed: $!" while -f $file;
24 rmdir $file or warn "rmdir $file failed: $!" if -d $file;
29 mkdir $inlib, 0777 or die $!;
30 push @cleanup, $inlib;
33 if (/^\#{16,}\s+(.*)/) {
34 my $file = "$inlib/$1";
36 open FH, ">$file" or die $!;
46 open FH, ">$file" or die $!;
48 Devel::SelfStubber->stub('Child', $inlib);
53 open FH, $file or die $!;
56 if (@A == 1 && $A[0] =~ /^\s*sub\s+Child::foo\s*;\s*$/) {
60 print "# $_" foreach (@A);
67 open FH, ">$file" or die $!;
69 Devel::SelfStubber->stub('Proto', $inlib);
71 print "ok 3\n"; # Checking that we did not die horribly.
74 open FH, $file or die $!;
77 if (@B == 1 && $B[0] =~ /^\s*sub\s+Proto::bar\s*\(\$\$\);\s*$/) {
81 print "# $_" foreach (@B);
90 open FH, ">$file" or die $!;
92 Devel::SelfStubber->stub('Attribs', $inlib);
94 print "ok 5\n"; # Checking that we did not die horribly.
97 open FH, $file or die $!;
100 if (@C == 2 && $C[0] =~ /^\s*sub\s+Attribs::baz\s+:\s*locked\s*;\s*$/
101 && $C[1] =~ /^\s*sub\s+Attribs::lv\s+:\s*lvalue\s*:\s*method\s*;\s*$/) {
105 print "# $_" foreach (@C);
111 # "wrong" and "right" may change if SelfLoader is changed.
112 my %wrong = ( Parent => 'Parent', Child => 'Parent' );
113 my %right = ( Parent => 'Parent', Child => 'Child' );
115 # extra line feeds for MBX IPC
116 %wrong = ( Parent => "Parent\n", Child => "Parent\n" );
117 %right = ( Parent => "Parent\n", Child => "Child\n" );
119 my @module = qw(Parent Child)
122 my ($left, $right) = @_;
123 while (my ($key, $val) = each %$left) {
124 # warn "$key $val $$right{$key}";
126 unless $val eq $$right{$key};
132 my ($expect, $got) = @_;
133 foreach (sort keys %$expect) {
134 print "# $_ expect '$$expect{$_}' got '$$got{$_}'\n";
138 # Now test that the module tree behaves "wrongly" as expected
140 foreach my $module (@module) {
141 my $file = "$module--$$";
142 push @cleanup, $file;
143 open FH, ">$file" or die $!;
144 print FH "use $module;
145 print ${module}->foo;
152 foreach my $module (@module) {
153 print "# $runperl \"-I$inlib\" $module--$$\n";
154 ($output{$module} = `$runperl "-I$inlib" $module--$$`)
158 if (&fail (\%wrong, \%output)) {
159 print "not ok 7\n", &faildump (\%wrong, \%output);
166 mkdir $lib, 0777 or die $!;
168 $Devel::SelfStubber::JUST_STUBS=0;
171 foreach my $module (@module, 'Data', 'End') {
172 my $file = "$lib/$module.pm";
173 open FH, "$inlib/$module.pm" or die $!;
176 push @cleanup, $file;
177 open FH, ">$file" or die $!;
179 if ($contents =~ /__DATA__/) {
180 # This will die for any module with no __DATA__
181 Devel::SelfStubber->stub($module, $inlib);
192 foreach my $module (@module) {
193 print "# $runperl \"-I$lib\" $module--$$\n";
194 ($output{$module} = `$runperl "-I$lib" $module--$$`)
198 if (&fail (\%right, \%output)) {
199 print "not ok 9\n", &faildump (\%right, \%output);
205 # Check that the DATA handle stays open
206 system "$runperl -w \"-I$lib\" \"-MData\" -e \"Data::ok\"";
208 # Possibly a pointless test as this doesn't really verify that it's been
210 system "$runperl -w \"-I$lib\" \"-MEnd\" -e \"End::lime\"";
212 # But check that the documentation after the __END__ survived.
213 open FH, "$lib/End.pm" or die $!;
217 if (/Did the documentation here survive\?/) {
220 print "not ok 12 # information after an __END__ token seems to be lost\n";
224 ################ Parent.pm
232 ################ Child.pm
244 ################ Proto.pm
252 ################ Attribs.pm
260 sub lv : lvalue : method {
264 ################ Data.pm
275 ################ End.pm
285 Did the documentation here survive?