1#!./perl -w
2
3use strict;
4use Devel::SelfStubber;
5use File::Spec::Functions;
6
7my $runperl = $^X;
8
9# ensure correct output ordering for system() calls
10
11select STDERR; $| = 1; select STDOUT; $| = 1;
12
13print "1..12\n";
14
15my @cleanup;
16
17END {
18  foreach my $file (reverse @cleanup) {
19    unlink $file or warn "unlink $file failed: $!" while -f $file;
20    rmdir $file or warn "rmdir $file failed: $!" if -d $file;
21  }
22}
23
24my $inlib = "SSI-$$";
25mkdir $inlib, 0777 or die $!;
26push @cleanup, $inlib;
27
28while (<DATA>) {
29  if (/^\#{16,}\s+(.*)/) {
30    my $f = $1;
31    my $file = catfile(curdir(),$inlib,$f);
32    push @cleanup, $file;
33    open FH, '>', $file or die $!;
34  } else {
35    print FH;
36  }
37}
38close FH;
39
40{
41  my $file = "A-$$";
42  push @cleanup, $file;
43  open FH, '>', $file or die $!;
44  select FH;
45  Devel::SelfStubber->stub('xChild', $inlib);
46  select STDOUT;
47  print "ok 1\n";
48  close FH or die $!;
49
50  open FH, '<', $file or die $!;
51  my @A = <FH>;
52
53  if (@A == 1 && $A[0] =~ /^\s*sub\s+xChild::foo\s*;\s*$/) {
54    print "ok 2\n";
55  } else {
56    print "not ok 2\n";
57    print "# $_" foreach (@A);
58  }
59}
60
61{
62  my $file = "B-$$";
63  push @cleanup, $file;
64  open FH, '>', $file or die $!;
65  select FH;
66  Devel::SelfStubber->stub('Proto', $inlib);
67  select STDOUT;
68  print "ok 3\n"; # Checking that we did not die horribly.
69  close FH or die $!;
70
71  open FH, '<', $file or die $!;
72  my @B = <FH>;
73
74  if (@B == 1 && $B[0] =~ /^\s*sub\s+Proto::bar\s*\(\$\$\);\s*$/) {
75    print "ok 4\n";
76  } else {
77    print "not ok 4\n";
78    print "# $_" foreach (@B);
79  }
80
81  close FH or die $!;
82}
83
84{
85  my $file = "C-$$";
86  push @cleanup, $file;
87  open FH, '>', $file or die $!;
88  select FH;
89  Devel::SelfStubber->stub('Attribs', $inlib);
90  select STDOUT;
91  print "ok 5\n"; # Checking that we did not die horribly.
92  close FH or die $!;
93
94  open FH, '<', $file or die $!;
95  my @C = <FH>;
96
97  if (@C == 2 && $C[0] =~ /^\s*sub\s+Attribs::baz\s+:\s*locked\s*;\s*$/
98      && $C[1] =~ /^\s*sub\s+Attribs::lv\s+:\s*lvalue\s*:\s*method\s*;\s*$/) {
99    print "ok 6\n";
100  } else {
101    print "not ok 6\n";
102    print "# $_" foreach (@C);
103  }
104
105  close FH or die $!;
106}
107
108# "wrong" and "right" may change if SelfLoader is changed.
109my %wrong = ( xParent => 'xParent', xChild => 'xParent' );
110my %right = ( xParent => 'xParent', xChild => 'xChild' );
111if ($^O eq 'VMS') {
112    # extra line feeds for MBX IPC
113    %wrong = ( xParent => "xParent\n", xChild => "xParent\n" );
114    %right = ( xParent => "xParent\n", xChild => "xChild\n" );
115}
116my @module = qw(xParent xChild)
117;
118sub fail {
119  my ($left, $right) = @_;
120  while (my ($key, $val) = each %$left) {
121    # warn "$key $val $$right{$key}";
122    return 1
123      unless $val eq $$right{$key};
124  }
125  return;
126}
127
128sub faildump {
129  my ($expect, $got) = @_;
130  foreach (sort keys %$expect) {
131    print "# $_ expect '$$expect{$_}' got '$$got{$_}'\n";
132  }
133}
134
135# Now test that the module tree behaves "wrongly" as expected
136
137foreach my $module (@module) {
138  my $file = "$module--$$";
139  push @cleanup, $file;
140  open FH, '>', $file or die $!;
141  print FH "use $module;
142print ${module}->foo;
143";
144  close FH or die $!;
145}
146
147{
148  my %output;
149  foreach my $module (@module) {
150    print "# $runperl \"-I$inlib\" $module--$$\n";
151    ($output{$module} = `$runperl "-I$inlib" $module--$$`)
152      =~ s/\'s foo//;
153  }
154
155  if (&fail (\%wrong, \%output)) {
156    print "not ok 7\n", &faildump (\%wrong, \%output);
157  } else {
158    print "ok 7\n";
159  }
160}
161
162my $lib="SSO-$$";
163mkdir $lib, 0777 or die $!;
164push @cleanup, $lib;
165$Devel::SelfStubber::JUST_STUBS=0;
166
167undef $/;
168foreach my $module (@module, 'Data', 'End') {
169  my $file = catfile(curdir(),$lib,"$module.pm");
170  my $fileo = catfile(curdir(),$inlib,"$module.pm");
171  open FH, '<', $fileo or die "Can't open $fileo: $!";
172  my $contents = <FH>;
173  close FH or die $!;
174  push @cleanup, $file;
175  open FH, '>', $file or die $!;
176  select FH;
177  if ($contents =~ /__DATA__/) {
178    # This will die for any module with no  __DATA__
179    Devel::SelfStubber->stub($module, $inlib);
180  } else {
181    print $contents;
182  }
183  select STDOUT;
184  close FH or die $!;
185}
186print "ok 8\n";
187
188{
189  my %output;
190  foreach my $module (@module) {
191    print "# $runperl \"-I$lib\" $module--$$\n";
192    ($output{$module} = `$runperl "-I$lib" $module--$$`)
193      =~ s/\'s foo//;
194  }
195
196  if (&fail (\%right, \%output)) {
197    print "not ok 9\n", &faildump (\%right, \%output);
198  } else {
199    print "ok 9\n";
200  }
201}
202
203# Check that the DATA handle stays open
204system "$runperl -w \"-I$lib\" \"-MData\" -e \"Data::ok\"";
205
206# Possibly a pointless test as this doesn't really verify that it's been
207# stubbed.
208system "$runperl -w \"-I$lib\" \"-MEnd\" -e \"End::lime\"";
209
210# But check that the documentation after the __END__ survived.
211open FH, '<', catfile(curdir(),$lib,"End.pm") or die $!;
212$_ = <FH>;
213close FH or die $!;
214
215if (/Did the documentation here survive\?/) {
216  print "ok 12\n";
217} else {
218  print "not ok 12 # information after an __END__ token seems to be lost\n";
219}
220
221__DATA__
222################ xParent.pm
223package xParent;
224
225sub foo {
226  return __PACKAGE__;
227}
2281;
229__END__
230################ xChild.pm
231package xChild;
232require xParent;
233@ISA = 'xParent';
234use SelfLoader;
235
2361;
237__DATA__
238sub foo {
239  return __PACKAGE__;
240}
241__END__
242################ Proto.pm
243package Proto;
244use SelfLoader;
245
2461;
247__DATA__
248sub bar ($$) {
249}
250################ Attribs.pm
251package Attribs;
252use SelfLoader;
253
2541;
255__DATA__
256sub baz : locked {
257}
258sub lv : lvalue : method {
259  my $a;
260  \$a;
261}
262################ Data.pm
263package Data;
264use SelfLoader;
265
2661;
267__DATA__
268sub ok {
269  print <DATA>;
270}
271__END__ DATA
272ok 10
273################ End.pm
274package End;
275use SelfLoader;
276
2771;
278__DATA__
279sub lime {
280  print "ok 11\n";
281}
282__END__
283Did the documentation here survive?
284