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" ); }