t/lib/selfstubber.t

   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
  11 my $runperl = "$^X \"-I../lib\"";
  12
  13 print "1..12\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 {
  84   my $file = "C-$$";
  85   push @cleanup, $file;
  86   open FH, ">$file" or die $!;
  87   select FH;
  88   Devel::SelfStubber->stub('Attribs', $inlib);
  89   select STDOUT;
  90   print "ok 5\n"; # Checking that we did not die horribly.
  91   close FH or die $!;
  92
  93   open FH, $file or die $!;
  94   my @C = <FH>;
  95
  96   if (@C == 2 && $C[0] =~ /^\s*sub\s+Attribs::baz\s+:\s*locked\s*;\s*$/
  97       && $C[1] =~ /^\s*sub\s+Attribs::lv\s+:\s*lvalue\s*:\s*method\s*;\s*$/) {
  98     print "ok 6\n";
  99   } else {
 100     print "not ok 6\n";
 101     print "# $_" foreach (@C);
 102   }
 103
 104   close FH or die $!;
 105 }
 106
 107 # "wrong" and "right" may change if SelfLoader is changed.
 108 my %wrong = ( Parent => 'Parent', Child => 'Parent' );
 109 my %right = ( Parent => 'Parent', Child => 'Child' );
 110 my @module = qw(Parent Child)
 111 ;
 112 sub fail {
 113   my ($left, $right) = @_;
 114   while (my ($key, $val) = each %$left) {
 115     # warn "$key $val $$right{$key}";
 116     return 1
 117       unless $val eq $$right{$key};
 118   }
 119   return;
 120 }
 121
 122 sub faildump {
 123   my ($expect, $got) = @_;
 124   foreach (sort keys %$expect) {
 125     print "# $_ expect '$$expect{$_}' got '$$got{$_}'\n";
 126   }
 127 }
 128
 129 # Now test that the module tree behaves "wrongly" as expected
 130
 131 foreach my $module (@module) {
 132   my $file = "$module--$$";
 133   push @cleanup, $file;
 134   open FH, ">$file" or die $!;
 135   print FH "use $module;
 136 print ${module}->foo;
 137 ";
 138   close FH or die $!;
 139 }
 140
 141 {
 142   my %output;
 143   foreach my $module (@module) {
 144     print "# $runperl \"-I$inlib\" $module--$$\n";
 145     ($output{$module} = `$runperl "-I$inlib" $module--$$`)
 146       =~ s/\'s foo//;
 147   }
 148
 149   if (&fail (\%wrong, \%output)) {
 150     print "not ok 7\n", &faildump (\%wrong, \%output);
 151   } else {
 152     print "ok 7\n";
 153   }
 154 }
 155
 156 my $lib="SSO-$$";
 157 mkdir $lib, 0777 or die $!;
 158 push @cleanup, $lib;
 159 $Devel::SelfStubber::JUST_STUBS=0;
 160
 161 undef $/;
 162 foreach my $module (@module, 'Data', 'End') {
 163   my $file = "$lib/$module.pm";
 164   open FH, "$inlib/$module.pm" or die $!;
 165   my $contents = <FH>;
 166   close FH or die $!;
 167   push @cleanup, $file;
 168   open FH, ">$file" or die $!;
 169   select FH;
 170   if ($contents =~ /__DATA__/) {
 171     # This will die for any module with no  __DATA__
 172     Devel::SelfStubber->stub($module, $inlib);
 173   } else {
 174     print $contents;
 175   }
 176   select STDOUT;
 177   close FH or die $!;
 178 }
 179 print "ok 8\n";
 180
 181 {
 182   my %output;
 183   foreach my $module (@module) {
 184     print "# $runperl \"-I$lib\" $module--$$\n";
 185     ($output{$module} = `$runperl "-I$lib" $module--$$`)
 186       =~ s/\'s foo//;
 187   }
 188
 189   if (&fail (\%right, \%output)) {
 190     print "not ok 9\n", &faildump (\%right, \%output);
 191   } else {
 192     print "ok 9\n";
 193   }
 194 }
 195
 196 # Check that the DATA handle stays open
 197 system "$runperl -w \"-I$lib\" -MData -e Data::ok";
 198
 199 # Possibly a pointless test as this doesn't really verify that it's been
 200 # stubbed.
 201 system "$runperl -w \"-I$lib\" -MEnd -e End::lime";
 202
 203 # But check that the documentation after the __END__ survived.
 204 open FH, "$lib/End.pm" or die $!;
 205 $_ = <FH>;
 206 close FH or die $!;
 207
 208 if (/Did the documentation here survive\?/) {
 209   print "ok 12\n";
 210 } else {
 211   print "not ok 12 # information after an __END__ token seems to be lost\n";
 212 }
 213
 214 __DATA__
 215 ################ Parent.pm
 216 package Parent;
 217
 218 sub foo {
 219   return __PACKAGE__;
 220 }
 221 1;
 222 __END__
 223 ################ Child.pm
 224 package Child;
 225 require Parent;
 226 @ISA = 'Parent';
 227 use SelfLoader;
 228
 229 1;
 230 __DATA__
 231 sub foo {
 232   return __PACKAGE__;
 233 }
 234 __END__
 235 ################ Proto.pm
 236 package Proto;
 237 use SelfLoader;
 238
 239 1;
 240 __DATA__
 241 sub bar ($$) {
 242 }
 243 ################ Attribs.pm
 244 package Attribs;
 245 use SelfLoader;
 246
 247 1;
 248 __DATA__
 249 sub baz : locked {
 250 }
 251 sub lv : lvalue : method {
 252   my $a;
 253   \$a;
 254 }
 255 ################ Data.pm
 256 package Data;
 257 use SelfLoader;
 258
 259 1;
 260 __DATA__
 261 sub ok {
 262   print <DATA>;
 263 }
 264 __END__ DATA
 265 ok 10
 266 ################ End.pm
 267 package End;
 268 use SelfLoader;
 269
 270 1;
 271 __DATA__
 272 sub lime {
 273   print "ok 11\n";
 274 }
 275 __END__
 276 Did the documentation here survive?