Commit | Line | Data |
7f4f6daf |
1 | #!./perl -w |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | @INC = '../lib'; |
6 | } |
7 | |
8 | use strict; |
9 | use Devel::SelfStubber; |
10 | |
ef61f41f |
11 | my $runperl = "$^X \"-I../lib\""; |
7f4f6daf |
12 | |
13 | print "1..7\n"; |
14 | |
15 | my @cleanup; |
16 | |
17 | END { |
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 | |
24 | my $inlib = "SSI-$$"; |
25 | mkdir $inlib, 0777 or die $!; |
26 | push @cleanup, $inlib; |
27 | |
28 | while (<DATA>) { |
29 | if (/^\#{16,}\s+(.*)/) { |
30 | my $file = "$inlib/$1"; |
31 | push @cleanup, $file; |
32 | open FH, ">$file" or die $!; |
33 | } else { |
34 | print FH; |
35 | } |
36 | } |
37 | close FH; |
38 | |
39 | { |
40 | my $file = "A-$$"; |
41 | push @cleanup, $file; |
42 | open FH, ">$file" or die $!; |
43 | select FH; |
44 | Devel::SelfStubber->stub('Child', $inlib); |
45 | select STDOUT; |
46 | print "ok 1\n"; |
47 | close FH or die $!; |
48 | |
49 | open FH, $file or die $!; |
50 | my @A = <FH>; |
51 | |
52 | if (@A == 1 && $A[0] =~ /^\s*sub\s+Child::foo\s*;\s*$/) { |
53 | print "ok 2\n"; |
54 | } else { |
55 | print "not ok 2\n"; |
56 | print "# $_" foreach (@A); |
57 | } |
58 | } |
59 | |
60 | { |
61 | my $file = "B-$$"; |
62 | push @cleanup, $file; |
63 | open FH, ">$file" or die $!; |
64 | select FH; |
65 | Devel::SelfStubber->stub('Proto', $inlib); |
66 | select STDOUT; |
67 | print "ok 3\n"; # Checking that we did not die horribly. |
68 | close FH or die $!; |
69 | |
70 | open FH, $file or die $!; |
71 | my @B = <FH>; |
72 | |
73 | if (@B == 1 && $B[0] =~ /^\s*sub\s+Proto::bar\s*\(\$\$\);\s*$/) { |
74 | print "ok 4\n"; |
75 | } else { |
76 | print "not ok 4\n"; |
77 | print "# $_" foreach (@B); |
78 | } |
79 | |
80 | close FH or die $!; |
81 | } |
82 | |
83 | # "wrong" and "right" may change if SelfLoader is changed. |
84 | my %wrong = ( Parent => 'Parent', Child => 'Parent' ); |
85 | my %right = ( Parent => 'Parent', Child => 'Child' ); |
86 | my @module = qw(Parent Child) |
87 | ; |
88 | sub fail { |
89 | my ($left, $right) = @_; |
90 | while (my ($key, $val) = each %$left) { |
91 | # warn "$key $val $$right{$key}"; |
92 | return 1 |
93 | unless $val eq $$right{$key}; |
94 | } |
95 | return; |
96 | } |
97 | |
98 | sub faildump { |
99 | my ($expect, $got) = @_; |
100 | foreach (sort keys %$expect) { |
101 | print "# $_ expect '$$expect{$_}' got '$$got{$_}'\n"; |
102 | } |
103 | } |
104 | |
105 | # Now test that the module tree behaves "wrongly" as expected |
106 | |
107 | foreach my $module (@module) { |
108 | my $file = "$module--$$"; |
109 | push @cleanup, $file; |
110 | open FH, ">$file" or die $!; |
111 | print FH "use $module; |
112 | print ${module}->foo; |
113 | "; |
114 | close FH or die $!; |
115 | } |
116 | |
117 | { |
118 | my %output; |
119 | foreach my $module (@module) { |
ef61f41f |
120 | print "# $runperl \"-I$inlib\" $module--$$\n"; |
121 | ($output{$module} = `$runperl "-I$inlib" $module--$$`) |
7f4f6daf |
122 | =~ s/\'s foo//; |
123 | } |
124 | |
125 | if (&fail (\%wrong, \%output)) { |
126 | print "not ok 5\n", &faildump (\%wrong, \%output); |
127 | } else { |
128 | print "ok 5\n"; |
129 | } |
130 | } |
131 | |
132 | my $lib="SSO-$$"; |
133 | mkdir $lib, 0777 or die $!; |
134 | push @cleanup, $lib; |
135 | $Devel::SelfStubber::JUST_STUBS=0; |
136 | |
137 | undef $/; |
138 | foreach my $module (@module) { |
139 | my $file = "$lib/$module.pm"; |
140 | open FH, "$inlib/$module.pm" or die $!; |
141 | my $contents = <FH>; |
142 | close FH or die $!; |
143 | push @cleanup, $file; |
144 | open FH, ">$file" or die $!; |
145 | select FH; |
146 | if ($contents =~ /__DATA__/) { |
147 | # This will die for any module with no __DATA__ |
148 | Devel::SelfStubber->stub($module, $inlib); |
149 | } else { |
150 | print $contents; |
151 | } |
152 | select STDOUT; |
153 | close FH or die $!; |
154 | } |
155 | print "ok 6\n"; |
156 | |
157 | { |
158 | my %output; |
159 | foreach my $module (@module) { |
ef61f41f |
160 | print "# $runperl \"-I$lib\" $module--$$\n"; |
161 | ($output{$module} = `$runperl "-I$lib" $module--$$`) |
7f4f6daf |
162 | =~ s/\'s foo//; |
163 | } |
164 | |
165 | if (&fail (\%right, \%output)) { |
166 | print "not ok 7\n", &faildump (\%right, \%output); |
167 | } else { |
168 | print "ok 7\n"; |
169 | } |
170 | } |
171 | |
172 | __DATA__ |
173 | ################ Parent.pm |
174 | package Parent; |
175 | |
176 | sub foo { |
177 | return __PACKAGE__; |
178 | } |
179 | 1; |
180 | __END__ |
181 | ################ Child.pm |
182 | package Child; |
183 | require Parent; |
184 | @ISA = 'Parent'; |
185 | use SelfLoader; |
186 | |
187 | 1; |
188 | __DATA__ |
189 | sub foo { |
190 | return __PACKAGE__; |
191 | } |
192 | __END__ |
193 | ################ Proto.pm |
194 | package Proto; |
195 | use SelfLoader; |
196 | |
197 | 1; |
198 | __DATA__ |
199 | sub bar ($$) { |
200 | } |