From: Nicholas Clark Date: Thu, 26 Apr 2001 00:00:54 +0000 (+0100) Subject: test for Devel::SelfStubber X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7f4f6dafffd5d5d35d318217d91a454a993e6d94;p=p5sagit%2Fp5-mst-13.2.git test for Devel::SelfStubber Message-ID: <20010426000054.D89026@plum.flirble.org> p4raw-id: //depot/perl@9845 --- diff --git a/MANIFEST b/MANIFEST index 834b025..33e69eb 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1580,6 +1580,7 @@ t/lib/sdbm.t See if SDBM_File works t/lib/searchdict.t See if Search::Dict works t/lib/selectsaver.t See if SelectSaver works t/lib/selfloader.t See if SelfLoader works +t/lib/selfstubber.t See if Devel::SelfStubber works t/lib/sigaction.t See if POSIX::sigaction works t/lib/socket.t See if Socket works t/lib/soundex.t See if Soundex works diff --git a/lib/Devel/SelfStubber.pm b/lib/Devel/SelfStubber.pm index 8a3a76e..ba833ff 100644 --- a/lib/Devel/SelfStubber.pm +++ b/lib/Devel/SelfStubber.pm @@ -3,7 +3,7 @@ require SelfLoader; @ISA = qw(SelfLoader); @EXPORT = 'AUTOLOAD'; $JUST_STUBS = 1; -$VERSION = '1.02'; +$VERSION = 1.03; sub Version {$VERSION} # Use as @@ -34,13 +34,17 @@ sub stub { $mod_file = "$lib/$mod_file.pm"; $fh = "${module}::DATA"; + my (@BEFORE_DATA, @AFTER_DATA); + @DATA = @STUBS = (); open($fh,$mod_file) || die "Unable to open $mod_file"; + local $/ = "\n"; while(defined ($line = <$fh>) and $line !~ m/^__DATA__/) { push(@BEFORE_DATA,$line); $line =~ /use\s+SelfLoader/ && $found_selfloader++; } - $line =~ m/^__DATA__/ || die "$mod_file doesn't contain a __DATA__ token"; + (defined ($line) && $line =~ m/^__DATA__/) + || die "$mod_file doesn't contain a __DATA__ token"; $found_selfloader || print 'die "\'use SelfLoader;\' statement NOT FOUND!!\n"',"\n"; $self->_load_stubs($module); diff --git a/t/lib/1_compile.t b/t/lib/1_compile.t index f188ea2..8e54650 100644 --- a/t/lib/1_compile.t +++ b/t/lib/1_compile.t @@ -127,6 +127,7 @@ DB_File Data::Dumper Devel::DProf Devel::Peek +Devel::SelfStubber Digest Digest::MD5 DirHandle diff --git a/t/lib/selfstubber.t b/t/lib/selfstubber.t new file mode 100644 index 0000000..8e8502a --- /dev/null +++ b/t/lib/selfstubber.t @@ -0,0 +1,198 @@ +#!./perl -w + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +use strict; +use Devel::SelfStubber; + +my $runperl = './perl'; + +print "1..7\n"; + +my @cleanup; + +END { + foreach my $file (reverse @cleanup) { + unlink $file or warn "unlink $file failed: $!" while -f $file; + rmdir $file or warn "rmdir $file failed: $!" if -d $file; + } +} + +my $inlib = "SSI-$$"; +mkdir $inlib, 0777 or die $!; +push @cleanup, $inlib; + +while () { + if (/^\#{16,}\s+(.*)/) { + my $file = "$inlib/$1"; + push @cleanup, $file; + open FH, ">$file" or die $!; + } else { + print FH; + } +} +close FH; + +{ + my $file = "A-$$"; + push @cleanup, $file; + open FH, ">$file" or die $!; + select FH; + Devel::SelfStubber->stub('Child', $inlib); + select STDOUT; + print "ok 1\n"; + close FH or die $!; + + open FH, $file or die $!; + my @A = ; + + if (@A == 1 && $A[0] =~ /^\s*sub\s+Child::foo\s*;\s*$/) { + print "ok 2\n"; + } else { + print "not ok 2\n"; + print "# $_" foreach (@A); + } +} + +{ + my $file = "B-$$"; + push @cleanup, $file; + open FH, ">$file" or die $!; + select FH; + Devel::SelfStubber->stub('Proto', $inlib); + select STDOUT; + print "ok 3\n"; # Checking that we did not die horribly. + close FH or die $!; + + open FH, $file or die $!; + my @B = ; + + if (@B == 1 && $B[0] =~ /^\s*sub\s+Proto::bar\s*\(\$\$\);\s*$/) { + print "ok 4\n"; + } else { + print "not ok 4\n"; + print "# $_" foreach (@B); + } + + 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' ); +my @module = qw(Parent Child) +; +sub fail { + my ($left, $right) = @_; + while (my ($key, $val) = each %$left) { + # warn "$key $val $$right{$key}"; + return 1 + unless $val eq $$right{$key}; + } + return; +} + +sub faildump { + my ($expect, $got) = @_; + foreach (sort keys %$expect) { + print "# $_ expect '$$expect{$_}' got '$$got{$_}'\n"; + } +} + +# Now test that the module tree behaves "wrongly" as expected + +foreach my $module (@module) { + my $file = "$module--$$"; + push @cleanup, $file; + open FH, ">$file" or die $!; + print FH "use $module; +print ${module}->foo; +"; + close FH or die $!; +} + +{ + my %output; + foreach my $module (@module) { + ($output{$module} = `$runperl -I $inlib $module--$$`) + =~ s/\'s foo//; + } + + if (&fail (\%wrong, \%output)) { + print "not ok 5\n", &faildump (\%wrong, \%output); + } else { + print "ok 5\n"; + } +} + +my $lib="SSO-$$"; +mkdir $lib, 0777 or die $!; +push @cleanup, $lib; +$Devel::SelfStubber::JUST_STUBS=0; + +undef $/; +foreach my $module (@module) { + my $file = "$lib/$module.pm"; + open FH, "$inlib/$module.pm" or die $!; + my $contents = ; + close FH or die $!; + push @cleanup, $file; + open FH, ">$file" or die $!; + select FH; + if ($contents =~ /__DATA__/) { + # This will die for any module with no __DATA__ + Devel::SelfStubber->stub($module, $inlib); + } else { + print $contents; + } + select STDOUT; + close FH or die $!; +} +print "ok 6\n"; + +{ + my %output; + foreach my $module (@module) { + ($output{$module} = `$runperl -I $lib $module--$$`) + =~ s/\'s foo//; + } + + if (&fail (\%right, \%output)) { + print "not ok 7\n", &faildump (\%right, \%output); + } else { + print "ok 7\n"; + } +} + +__DATA__ +################ Parent.pm +package Parent; + +sub foo { + return __PACKAGE__; +} +1; +__END__ +################ Child.pm +package Child; +require Parent; +@ISA = 'Parent'; +use SelfLoader; + +1; +__DATA__ +sub foo { + return __PACKAGE__; +} +__END__ +################ Proto.pm +package Proto; +use SelfLoader; + +1; +__DATA__ +sub bar ($$) { +}