From: Nicholas Clark <nick@ccl4.org>
Date: Fri, 27 Apr 2001 00:13:52 +0000 (+0100)
Subject: more for Devel::SelfStubber
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=33235a50d090f47e8c1345f546ef4a97abb985d9;p=p5sagit%2Fp5-mst-13.2.git

more for Devel::SelfStubber
Message-ID: <20010427001351.K88186@plum.flirble.org>

p4raw-id: //depot/perl@9872
---

diff --git a/lib/Devel/SelfStubber.pm b/lib/Devel/SelfStubber.pm
index ba833ff..9009d69 100644
--- a/lib/Devel/SelfStubber.pm
+++ b/lib/Devel/SelfStubber.pm
@@ -28,13 +28,13 @@ sub _package_defined {
 
 sub stub {
     my($self,$module,$lib) = @_;
-    my($line,$end,$fh,$mod_file,$found_selfloader);
+    my($line,$end_data,$fh,$mod_file,$found_selfloader);
     $lib ||= '.';
     ($mod_file = $module) =~ s,::,/,g;
     
     $mod_file = "$lib/$mod_file.pm";
     $fh = "${module}::DATA";
-    my (@BEFORE_DATA, @AFTER_DATA);
+    my (@BEFORE_DATA, @AFTER_DATA, @AFTER_END);
     @DATA = @STUBS = ();
 
     open($fh,$mod_file) || die "Unable to open $mod_file";
@@ -47,9 +47,13 @@ sub stub {
       || die "$mod_file doesn't contain a __DATA__ token";
     $found_selfloader || 
 	print 'die "\'use SelfLoader;\' statement NOT FOUND!!\n"',"\n";
-    $self->_load_stubs($module);
+    if ($JUST_STUBS) {
+        $self->_load_stubs($module);
+    } else {
+        $self->_load_stubs($module, \@AFTER_END);
+    }
     if ( fileno($fh) ) {
-	$end = 1;
+	$end_data = 1;
 	while(defined($line = <$fh>)) {
 	    push(@AFTER_DATA,$line);
 	}
@@ -60,7 +64,8 @@ sub stub {
     print @STUBS;
     unless ($JUST_STUBS) {
     	print "1;\n__DATA__\n",@DATA;
-    	if($end) { print "__END__\n",@AFTER_DATA; }
+    	if($end_data) { print "__END__ DATA\n",@AFTER_DATA; }
+    	if(@AFTER_END) { print "__END__\n",@AFTER_END; }
     }
 }
 
diff --git a/lib/SelfLoader.pm b/lib/SelfLoader.pm
index 3b9c52d..51124af 100644
--- a/lib/SelfLoader.pm
+++ b/lib/SelfLoader.pm
@@ -47,7 +47,8 @@ AUTOLOAD {
 sub load_stubs { shift->_load_stubs((caller)[0]) }
 
 sub _load_stubs {
-    my($self, $callpack) = @_;
+    # $endlines is used by Devel::SelfStubber to capture lines after __END__
+    my($self, $callpack, $endlines) = @_;
     my $fh = \*{"${callpack}::DATA"};
     my $currpack = $callpack;
     my($line,$name,@lines, @stubs, $protoype);
@@ -94,7 +95,16 @@ sub _load_stubs {
             push(@lines,$line);
         }
     }
-    close($fh) unless defined($line) && $line =~ /^__END__\s*DATA/;     # __END__
+    if (defined($line) && $line =~ /^__END__/) { # __END__
+        unless ($line =~ /^__END__\s*DATA/) {
+            if ($endlines) {
+                # Devel::SelfStubber would like us to capture the lines after
+                # __END__ so it can write out the entire file
+                @$endlines = <$fh>;
+            }
+            close($fh);
+        }
+    }
     push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
     eval join('', @stubs) if @stubs;
 }
diff --git a/t/lib/selfstubber.t b/t/lib/selfstubber.t
index 4565c79..f545024 100644
--- a/t/lib/selfstubber.t
+++ b/t/lib/selfstubber.t
@@ -10,7 +10,7 @@ use Devel::SelfStubber;
 
 my $runperl = "$^X \"-I../lib\"";
 
-print "1..7\n";
+print "1..12\n";
 
 my @cleanup;
 
@@ -80,6 +80,30 @@ close FH;
   close FH or die $!;
 }
 
+{
+  my $file = "C-$$";
+  push @cleanup, $file;
+  open FH, ">$file" or die $!;
+  select FH;
+  Devel::SelfStubber->stub('Attribs', $inlib);
+  select STDOUT;
+  print "ok 5\n"; # Checking that we did not die horribly.
+  close FH or die $!;
+
+  open FH, $file or die $!;
+  my @C = <FH>;
+
+  if (@C == 2 && $C[0] =~ /^\s*sub\s+Attribs::baz\s+:\s*locked\s*;\s*$/
+      && $C[1] =~ /^\s*sub\s+Attribs::lv\s+:\s*lvalue\s*:\s*method\s*;\s*$/) {
+    print "ok 6\n";
+  } else {
+    print "not ok 6\n";
+    print "# $_" foreach (@C);
+  }
+
+  close FH or die $!;
+}
+
 # "wrong" and "right" may change if SelfLoader is changed.
 my %wrong = ( Parent => 'Parent', Child => 'Parent' );
 my %right = ( Parent => 'Parent', Child => 'Child' );
@@ -123,9 +147,9 @@ print ${module}->foo;
   }
 
   if (&fail (\%wrong, \%output)) {
-    print "not ok 5\n", &faildump (\%wrong, \%output);
+    print "not ok 7\n", &faildump (\%wrong, \%output);
   } else {
-    print "ok 5\n";
+    print "ok 7\n";
   }
 }
 
@@ -135,7 +159,7 @@ push @cleanup, $lib;
 $Devel::SelfStubber::JUST_STUBS=0;
 
 undef $/;
-foreach my $module (@module) {
+foreach my $module (@module, 'Data', 'End') {
   my $file = "$lib/$module.pm";
   open FH, "$inlib/$module.pm" or die $!;
   my $contents = <FH>;
@@ -152,7 +176,7 @@ foreach my $module (@module) {
   select STDOUT;
   close FH or die $!;
 }
-print "ok 6\n";
+print "ok 8\n";
 
 {
   my %output;
@@ -163,12 +187,30 @@ print "ok 6\n";
   }
 
   if (&fail (\%right, \%output)) {
-    print "not ok 7\n", &faildump (\%right, \%output);
+    print "not ok 9\n", &faildump (\%right, \%output);
   } else {
-    print "ok 7\n";
+    print "ok 9\n";
   }
 }
 
+# Check that the DATA handle stays open
+system "$runperl -w \"-I$lib\" -MData -e Data::ok";
+
+# Possibly a pointless test as this doesn't really verify that it's been
+# stubbed.
+system "$runperl -w \"-I$lib\" -MEnd -e End::lime";
+
+# But check that the documentation after the __END__ survived.
+open FH, "$lib/End.pm" or die $!;
+$_ = <FH>;
+close FH or die $!;
+
+if (/Did the documentation here survive\?/) {
+  print "ok 12\n";
+} else {
+  print "not ok 12 # information after an __END__ token seems to be lost\n";
+}
+
 __DATA__
 ################ Parent.pm
 package Parent;
@@ -198,3 +240,37 @@ use SelfLoader;
 __DATA__
 sub bar ($$) {
 }
+################ Attribs.pm
+package Attribs;
+use SelfLoader;
+
+1;
+__DATA__
+sub baz : locked {
+}
+sub lv : lvalue : method {
+  my $a;
+  \$a;
+}
+################ Data.pm
+package Data;
+use SelfLoader;
+
+1;
+__DATA__
+sub ok {
+  print <DATA>;
+}
+__END__ DATA
+ok 10
+################ End.pm
+package End;
+use SelfLoader;
+
+1;
+__DATA__
+sub lime {
+  print "ok 11\n";
+}
+__END__
+Did the documentation here survive?