# New Ticket Created by  James Keenan 
# Please include the string:  [perl #42072]
# in the subject line of all future correspondence about this issue. 
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=42072 >


Fellow Parrot hackers:

1.  Back in November and December, when I was refactoring tools/build/ 
pmc2c.pl into lib/Parrot/Pmc2c/Utils.pm, I tried to write tests for  
everyone of the command-line options documented in the POD.  I  
experienced problems writing a test for the 'no-body' option, made a  
mental note to get back to it, but never did.  Consequently, code in  
Utils.pm which depends on the 'no-body' option is not completely  
covered by the test suite.

This weakness is now having an impact on other lines of code which  
have been added as tewk, jonathan and others work on  
Parrot::Pmc2c::PCCMETHOD and other modules.  So I'm trying to find  
out how to use the 'no-body' option ... and also trying to find out  
whether anyone ever uses this option.

2.  Here is how the 'no-body' option is documented in the POD (which  
I carried over almost verbatim from earlier versions of tools/build/ 
pmc2c.pl):

     =item C<--no-body>

     Emit an empty body in the dump. This may be useful for debugging.

That's it.  Since it's meant for debugging, it quite logically never  
appears in any of the 169+ calls to pmc2c.pl invoked by 'make'.

3.  Calling 'no-body' on the command-line internally sets $opt 
{nobody}.  This variable is used exactly once inside lib/Parrot/Pmc2c/ 
Utils.pm, deep inside parse_pmc():

             $methodblock = "" if $opt->{nobody};  # line 672

Since I never wrote a test for this option, the case where $opt-> 
{nobody} was true and where, therefore, $methodblock evaluated to  
false was never covered by the test suite.  (See http:// 
thenceforward.net/parrot/coverage/pmc2c/lib-Parrot-Pmc2c-Utils- 
pm.html and http://thenceforward.net/parrot/coverage/pmc2c/lib-Parrot- 
Pmc2c-Utils-pm--branch.html#L672.)

4.  I lived with this lack of coverage for several months, but new  
code has been added to Parrot::Pmc2c::Utils which asks whether  
$methodblock is true or false:

         if ( $methodblock and $methodblock =~ /PCCINVOKE/ ) {  #  
line 689
             $flags_ref->{need_fia_header} = 1;
         }

Now I have an uncovered condition as well as an uncovered branch.   
(See http://thenceforward.net/parrot/coverage/pmc2c/lib-Parrot-Pmc2c- 
Utils-pm--condition.html#L689.)

5.  "Alright," you're thinking, "why don't you go ahead and actually  
call the no-body option and see what happens?"  I did so.  I first  
wrote a test which was similar to those found in t/tools/pmc2cutils/ 
05-gen_c.t.  It is attached as 08-nobody.t.  An excerpt of its output  
when run with 'prove -v' is attached as output-08- 
nobody.excerpt.txt.  The relevant output is the following:

     substr outside of string at /Users/jimk/work/parrot/lib/Parrot/ 
Pmc2c.pm line 534.
     Use of uninitialized value in substitution (s///) at /Users/jimk/ 
work/parrot/lib/Parrot/Pmc2c.pm line 536.
     Use of uninitialized value in concatenation (.) or string at / 
Users/jimk/work/parrot/lib/Parrot/Pmc2c.pm line 578.

... which occurs a total of 45 times.  The fact that I am getting  
warnings causes the final test in 08-nobody.t to fail.

It's always a PITA when a bug in your code manifests itself as a  
series of warnings from some other code which you have not modified  
in the least.

6.  Here are the relevant sections of lib/Parrot/Pmc2c.pm:

     my $total_body;   # <-- line 523
     if ( $method->{loc} eq 'vtable' ) {
         $total_body = rewrite_vtable_method( $classname, $meth,  
$super, $self->{super}, $body );
     }
     else {
         $total_body = rewrite_nci_method( $classname, $meth, $body );
     }
     Parrot::Pmc2c::PCCMETHOD::rewrite_pccinvoke( $method, \ 
$total_body );

     # now split into MMD if necessary:
     my $additional_bodies = '';
     $total_body = substr $total_body, 1, -1;      # <-- line 534
     my $standard_body = $total_body;
     while ( $total_body =~ s/\bMMD_(\w+):\s*// ) {     # # <-- line 536
         my $right_type = $1;
         my $body_part = extract_bracketed( $total_body, '{' );
         die "Empty MMD body near '$total_body'" if ( !$body_part );
         $body_part = substr( $body_part, 1, -1 );
         $body_part =~ s/\n(\s*)$//s;

[snip approx. 20 lines]

     }
     $cout .= $self->decl( $classname, $method, 0 );
     if ( exists $method->{pre_block} ) {
         $cout .= $method->{pre_block};
         # This is the part that comes from the PMC file.
         $cout .= $self->line_directive( $method->{line}, $self-> 
{file} );
         $cout .= $standard_body;
         $cout .= $method->{post_block};
         $cout .= "\n}\n";
     }
     else {
         # This is the part that comes from the PMC file.
         $cout .= $self->line_directive( $method->{line}, $self-> 
{file} );
         $cout .= "{$standard_body\n}\n";    # <-- line 578
     }

So when the 'no-body' option is set in tools/build/pmc2c.pl, variable  
$total_body in lib/Parrot/Pmc2c.pm, not surprisingly, is  
uninitialized and messy warnings are thrown.

7.  08-nobody.t, like all the tests in t/tools/pmc2cutils/, creates  
all its test files in temporary directories and cleans up after  
itself.  I created a Perl script parallel to this test file without  
all the tempdirs so that I could look at the files produced.  That  
script is attached as 'nobody.pl'.  If you run it, you will see that  
when called with --no-body, it throws the same warnings as 08-nobody.t.

8.  Which leaves me with these questions:

a.  If an option intended for debugging throws a lot of warnings when  
run, what use is it for debugging?

b.  Is anybody using the --no-body option in Parrot development?  If  
not, should I eliminate it?

c.  If someone *is* using the --no-body option, how do you deal with  
all the warnings?

kid51


Attachment: 08-nobody.t
Description: Binary data

[parrot] 506 $ prove -v t/tools/pmc2cutils/08-nobody.t 
t/tools/pmc2cutils/08-nobody....
OK:  Parrot top directory located
ok 1 - use Parrot::Pmc2c::Utils;
ok 2 - use Cwd;
ok 3 - use File::Temp;
ok 4 - changed to temp directory for testing
ok 5 - created src/ under tempdir
ok 6 - created src/pmc/ under tempdir
ok 7 - all src/pmc/*.pmc files copied to tempdir
ok 8 - The object isa Parrot::Pmc2c::Utils
ok 9 - dump_vtable created vtable.dump
ok 10 - dump_pmc succeeded
ok 11 - default.dump created as expected
substr outside of string at /Users/jimk/work/parrot/lib/Parrot/Pmc2c.pm line 
534.
Use of uninitialized value in substitution (s///) at 
/Users/jimk/work/parrot/lib/Parrot/Pmc2c.pm line 536.
Use of uninitialized value in concatenation (.) or string at 
/Users/jimk/work/parrot/lib/Parrot/Pmc2c.pm line 578.

[3 error messages above repeat a total of 45 times.]

not ok 13 - no-body option worked

#     Failed test (t/tools/pmc2cutils/08-nobody.t at line 84)
#                   undef
#     doesn't match '(?-xism:src/pmc/default\.pmc)'
ok 14 - changed back to original directory
ok 15 - Completed all tests in t/tools/pmc2cutils/08-nobody.t
1..15
# Looks like you failed 1 test of 15.
dubious
        Test returned status 1 (wstat 256, 0x100)
DIED. FAILED test 13
        Failed 1/15 tests, 93.33% okay
Failed Test                    Stat Wstat Total Fail  List of Failed
-------------------------------------------------------------------------------
t/tools/pmc2cutils/08-nobody.t    1   256    15    1  13
Failed 1/1 test scripts. 1/15 subtests failed.
Files=1, Tests=15,  3 wallclock secs ( 0.84 cusr +  0.28 csys =  1.12 CPU)
Failed 1/1 test programs. 1/15 subtests failed.
#! perl
# Copyright (C) 2006, The Perl Foundation.
# nobody.pl

use strict;
use warnings;

use File::Basename;
use File::Copy;
use Data::Dumper;
use Carp;
use Cwd;
use Getopt::Long;

my ($topdir, $tdir, $nobody, $usage);
GetOptions(
    "topdir=s"  => \$topdir,
    "tdir=s"    => \$tdir,
    "no-body"   => \$nobody,
    "help"      => \$usage,
);

Usage() if $usage;

croak "Must supply path to top directory in your sandbox"
    unless -d $topdir;

croak "Must supply path to a temporary directory"
    unless -d $tdir;

my $libdir = qq{$topdir/lib};
unshift @INC, $libdir;
require Parrot::Pmc2c::Utils;

my ( %opt, @include, @args );
my $dump_file;
my $self;
my $cwd = cwd();

my @include_orig = ( qq{$topdir}, qq{$topdir/src/pmc}, );

chdir $tdir;
mkdir qq{$tdir/src} unless -d qq{$tdir/src};
my $temppmcdir = qq{$tdir/src/pmc};
mkdir $temppmcdir unless -d $temppmcdir;
croak "Failed to create $temppmcdir" unless -d $temppmcdir;

my @pmcfiles = ( "$topdir/src/pmc/default.pmc", "$topdir/src/pmc/array.pmc", );
my $pmcfilecount = scalar(@pmcfiles);
my $copycount;
foreach my $pmcfile (@pmcfiles) {
    my $basename = basename($pmcfile);
    my $rv = copy( $pmcfile, qq{$temppmcdir/$basename} );
    $copycount++ if $rv;
}
@include = ( $tdir, $temppmcdir, @include_orig );

@args = ( qq{$temppmcdir/default.pmc}, );
if ($nobody) {
    %opt = ( nobody => 1 );
}
$self = Parrot::Pmc2c::Utils->new(
    {
        include => [EMAIL PROTECTED],
        opt     => \%opt,
        args    => [EMAIL PROTECTED],
    }
);
$dump_file = $self->dump_vtable("$topdir/vtable.tbl");
croak "Unable to create vtable.dump" unless -e $dump_file;

$self->dump_pmc();
croak "Unable to create default.dump" unless -f qq{$temppmcdir/default.dump};

my ( $fh, $msg, $rv );
{
    my $currfh = select($fh);
    open( $fh, '>', \$msg ) or die "Unable to open handle: $!";
    $rv = $self->gen_c();
    select($currfh);
}
croak "gen_c failed" unless $rv;
if (defined $msg) {
    print STDERR "This is the message:\n", $msg, "\n";
}

chdir $cwd;

sub Usage {
    print "Usage:\n";
    print "  perl $0 --topdir=/path/to/sandbox --tdir=/path/to/tempdir [--no-body]\n\n";
    exit 0;
}


Reply via email to