On Fri Jun 01 19:46:40 2007, rgrjr wrote:
> This is from the "Small tweak to Pmc2c.pm" I posted on 19-May and
> committed as r18646 on 26-May. Note that lib/Parrot/Pmc2c.pm is not
> actually doing anything different now, it's just telling you that none
> of the code for these methods is being used in the generated C file.
> So
> they are certainly not being tested now, and possibly haven't been for
> a
> while.
When the expected behavior of a block of code is to throw warnings, then tests
should be
written to make sure those warnings are, in fact, being thrown. We can do this
in our Perl 5-
based tests by using Parrot::IO::Capture::Mini to capture the warnings, then
using
Test::More::like() to determine if we got the warnings we expected. In r18763
I took this
approach and applied the following patch to t/tools/pmc2cutils/05-gen_c.t.
Should lib/Parrot/Pmc2c.pm be revised to eliminate those warnings, then the
tests I just
wrote will fail and will have to be revised. But that will be a good thing,
because the
warnings will have been cleared up.
Index: t/tools/pmc2cutils/05-gen_c.t
===================================================================
--- t/tools/pmc2cutils/05-gen_c.t (revision 18762)
+++ t/tools/pmc2cutils/05-gen_c.t (working copy)
@@ -19,12 +19,14 @@
}
unshift @INC, qq{$topdir/lib};
}
-use Test::More tests => 68;
+use Test::More tests => 74;
+use Carp;
use File::Basename;
use File::Copy;
use FindBin;
use Data::Dumper;
use_ok('Parrot::Pmc2c::Pmc2cMain');
+use_ok('Parrot::IO::Capture::Mini');
use_ok('Cwd');
use_ok( 'File::Temp', qw| tempdir | );
@@ -35,6 +37,9 @@
my $cwd = cwd();
my @include_orig = ( qq{$main::topdir}, qq{$main::topdir/src/pmc}, );
+my ( $tie, $msg, @lines );
+my $warnpattern =
+
qr/get_bool_keyed_int.*elements_keyed_int.*set_bool_keyed_int.*is_equal_str/s;
# basic test: @args holds default.pmc
{
@@ -71,9 +76,21 @@
ok( $self->dump_pmc(), "dump_pmc succeeded" );
ok( -f qq{$temppmcdir/default.dump}, "default.dump created as expected" );
- $rv = $self->gen_c();
- ok( $rv, "gen_c completed successfully; args: default.pmc" );
+ {
+ $tie = tie *STDERR, "Parrot::IO::Capture::Mini"
+ or croak "Unable to tie";
+ $rv = $self->gen_c();
+ @lines = $tie->READLINE;
+ untie *STDERR or croak "Unable to untie";
+ ok( $rv, "gen_c completed successfully; args: default.pmc" );
+ $msg = join("\n", @lines);
+ like( $msg,
+ $warnpattern,
+ "Warnings from Parrot::Pmc2c re 4 unknown methods have been
captured"
+ );
+ }
+
ok( chdir $cwd, "changed back to original directory" );
}
@@ -113,8 +130,19 @@
ok( -f qq{$temppmcdir/default.dump}, "default.dump created as expected" );
ok( -f qq{$temppmcdir/array.dump}, "array.dump created as expected" );
- $rv = $self->gen_c();
- ok( $rv, "gen_c completed successfully; args: default.pmc and array.pmc"
);
+ {
+ $tie = tie *STDERR, "Parrot::IO::Capture::Mini"
+ or croak "Unable to tie";
+ $rv = $self->gen_c();
+ @lines = $tie->READLINE;
+ untie *STDERR or croak "Unable to untie";
+ ok( $rv, "gen_c completed successfully; args: default.pmc and
array.pmc" );
+ $msg = join("\n", @lines);
+ like( $msg,
+ $warnpattern,
+ "Warnings from Parrot::Pmc2c re 4 unknown methods have been
captured"
+ );
+ }
ok( chdir $cwd, "changed back to original directory" );
}
@@ -155,15 +183,26 @@
ok( $self->dump_pmc(), "dump_pmc succeeded" );
ok( -f qq{$temppmcdir/default.dump}, "default.dump created as expected" );
- my ( $fh, $msg, $rv );
{
- my $currfh = select($fh);
- open( $fh, '>', \$msg ) or die "Unable to open handle: $!";
- $rv = $self->gen_c();
- select($currfh);
+ $tie = tie *STDERR, "Parrot::IO::Capture::Mini"
+ or croak "Unable to tie";
+ my ( $fh, $dmsg, $rv );
+ {
+ my $currfh = select($fh);
+ open( $fh, '>', \$dmsg ) or die "Unable to open handle: $!";
+ $rv = $self->gen_c();
+ select($currfh);
+ }
+ @lines = $tie->READLINE;
+ untie *STDERR or croak "Unable to untie";
+ ok( $rv, "gen_c completed successfully; args: default.pmc" );
+ like( $dmsg, qr{src/pmc/default\.pmc}, "debug option worked" );
+ $msg = join("\n", @lines);
+ like( $msg,
+ $warnpattern,
+ "Warnings from Parrot::Pmc2c re 4 unknown methods have been
captured"
+ );
}
- ok( $rv, "gen_c completed successfully; args: default.pmc" );
- like( $msg, qr{src/pmc/default\.pmc}, "debug option worked" );
ok( chdir $cwd, "changed back to original directory" );
}
@@ -199,33 +238,44 @@
);
isa_ok( $self, q{Parrot::Pmc2c::Pmc2cMain} );
- my ( $fh, $msg, $rv );
+ my ( $fh, $dmsg, $rv );
{
my $currfh = select($fh);
- open( $fh, '>', \$msg ) or die "Unable to open handle: $!";
+ open( $fh, '>', \$dmsg ) or die "Unable to open handle: $!";
$dump_file = $self->dump_vtable("$main::topdir/vtable.tbl");
select($currfh);
}
ok( -e $dump_file, "dump_vtable created vtable.dump" );
- like( $msg, qr{^Writing}, "verbose option worked" );
+ like( $dmsg, qr{^Writing}, "verbose option worked" );
{
my $currfh = select($fh);
- open( $fh, '>', \$msg ) or die "Unable to open handle: $!";
+ open( $fh, '>', \$dmsg ) or die "Unable to open handle: $!";
ok( $self->dump_pmc(), "dump_pmc succeeded" );
select($currfh);
}
ok( -f qq{$temppmcdir/default.dump}, "default.dump created as expected" );
- like( $msg, qr{^Reading}, "verbose option worked" );
+ like( $dmsg, qr{^Reading}, "verbose option worked" );
{
- my $currfh = select($fh);
- open( $fh, '>', \$msg ) or die "Unable to open handle: $!";
- $rv = $self->gen_c();
- select($currfh);
+ $tie = tie *STDERR, "Parrot::IO::Capture::Mini"
+ or croak "Unable to tie";
+ {
+ my $currfh = select($fh);
+ open( $fh, '>', \$dmsg ) or die "Unable to open handle: $!";
+ $rv = $self->gen_c();
+ select($currfh);
+ }
+ @lines = $tie->READLINE;
+ untie *STDERR or croak "Unable to untie";
+ ok( $rv, "gen_c completed successfully; args: default.pmc" );
+ like( $dmsg, qr{src/pmc/default\.pmc}, "debug option worked" );
+ $msg = join("\n", @lines);
+ like( $msg,
+ $warnpattern,
+ "Warnings from Parrot::Pmc2c re 4 unknown methods have been
captured"
+ );
}
- ok( $rv, "gen_c completed successfully; args: default.pmc" );
- like( $msg, qr{src/pmc/default\.pmc}, "debug option worked" );
ok( chdir $cwd, "changed back to original directory" );
}
@@ -310,8 +360,19 @@
ok( -f qq{$temppmcdir/default.dump}, "default.dump created as expected" );
ok( -f qq{$temppmcdir/class.dump}, "class.dump created as expected" );
- $rv = $self->gen_c();
- ok( $rv, "gen_c completed successfully; args: default.pmc and class.pmc"
);
+ {
+ $tie = tie *STDERR, "Parrot::IO::Capture::Mini"
+ or croak "Unable to tie";
+ $rv = $self->gen_c();
+ @lines = $tie->READLINE;
+ untie *STDERR or croak "Unable to untie";
+ ok( $rv, "gen_c completed successfully; args: default.pmc and
class.pmc" );
+ $msg = join("\n", @lines);
+ like( $msg,
+ $warnpattern,
+ "Warnings from Parrot::Pmc2c re 4 unknown methods have been
captured"
+ );
+ }
ok( chdir $cwd, "changed back to original directory" );
}
