Author: tewk
Date: Fri Jun 8 10:55:46 2007
New Revision: 18882
Added:
branches/pmc2c/t/tools/pmc2cutils/08-pmc.pm.t
Removed:
branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/
Modified:
branches/pmc2c/MANIFEST
branches/pmc2c/MANIFEST.SKIP
branches/pmc2c/lib/Parrot/Pmc2c/Library.pm
branches/pmc2c/lib/Parrot/Pmc2c/Method.pm
branches/pmc2c/lib/Parrot/Pmc2c/MethodEmitter.pm
branches/pmc2c/lib/Parrot/Pmc2c/PMC/delegate.pm
branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter.pm
branches/pmc2c/lib/Parrot/Pmc2c/Pmc2cMain.pm
branches/pmc2c/lib/Parrot/Pmc2c/UtilFunctions.pm
branches/pmc2c/lib/Parrot/Pmc2c/VTable.pm
branches/pmc2c/t/tools/pmc2cutils/01-pmc2cutils.t
branches/pmc2c/t/tools/pmc2cutils/03-dump_vtable.t
branches/pmc2c/t/tools/pmc2cutils/04-dump_pmc.t
branches/pmc2c/t/tools/pmc2cutils/05-gen_c.t
branches/pmc2c/t/tools/pmc2cutils/06-print_tree.t
branches/pmc2c/t/tools/pmc2cutils/07-open_file.t
branches/pmc2c/tools/build/pmc2c.pl
Log:
[Pmc2c] Branch checkpoint, passes all perl Configure --test
Modified: branches/pmc2c/MANIFEST
==============================================================================
--- branches/pmc2c/MANIFEST (original)
+++ branches/pmc2c/MANIFEST Fri Jun 8 10:55:46 2007
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Wed Jun 6 18:11:24 2007 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Fri Jun 8 17:38:56 2007 UT
#
# See tools/dev/install_files.pl for documentation on the
# format of this file.
@@ -354,11 +354,13 @@
docs/dev/dod.pod [devel]doc
docs/dev/events.pod [devel]doc
docs/dev/fhs.pod [devel]doc
+docs/dev/headerizer.pod [main]doc
docs/dev/infant.pod [devel]doc
docs/dev/jit_i386.pod [main]doc
docs/dev/longopt.pod [main]doc
docs/dev/nanoparrot.c [main]doc
docs/dev/optimizer.pod [main]doc
+docs/dev/parrot_api.pod [main]doc
docs/dev/pccmethods.pod [main]doc
docs/dev/pmc_freeze.pod [devel]doc
docs/dev/pmc_object_design_meeting_notes.pod [main]doc
@@ -2312,14 +2314,7 @@
lib/Parrot/Pmc2c/PMC/deleg_pmc.pm [devel]
lib/Parrot/Pmc2c/PMC/delegate.pm [devel]
lib/Parrot/Pmc2c/PMCEmitter.pm [devel]
-lib/Parrot/Pmc2c/PMCEmitter/Null.pm [devel]
-lib/Parrot/Pmc2c/PMCEmitter/Ref.pm [devel]
-lib/Parrot/Pmc2c/PMCEmitter/SharedRef.pm [devel]
lib/Parrot/Pmc2c/PMCEmitter/Standard.pm [devel]
-lib/Parrot/Pmc2c/PMCEmitter/StmRef.pm [devel]
-lib/Parrot/Pmc2c/PMCEmitter/default.pm [devel]
-lib/Parrot/Pmc2c/PMCEmitter/deleg_pmc.pm [devel]
-lib/Parrot/Pmc2c/PMCEmitter/delegate.pm [devel]
lib/Parrot/Pmc2c/Parser.pm [devel]
lib/Parrot/Pmc2c/Pmc2cMain.pm [devel]
lib/Parrot/Pmc2c/UtilFunctions.pm [devel]
@@ -3138,6 +3133,7 @@
t/tools/pmc2cutils/05-gen_c.t []
t/tools/pmc2cutils/06-print_tree.t []
t/tools/pmc2cutils/07-open_file.t []
+t/tools/pmc2cutils/08-pmc.pm.t []
t/tools/pmc2cutils/README []
t/tools/smartlinks.t []
tools/build/addopstags.pl []
Modified: branches/pmc2c/MANIFEST.SKIP
==============================================================================
--- branches/pmc2c/MANIFEST.SKIP (original)
+++ branches/pmc2c/MANIFEST.SKIP Fri Jun 8 10:55:46 2007
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
-# generated by tools/dev/mk_manifest_and_skip.pl Wed Jun 6 18:11:24 2007 UT
-
+# generated by tools/dev/mk_manifest_and_skip.pl Fri Jun 8 17:38:56 2007 UT
+#
# This file should contain a transcript of the svn:ignore properties
# of the directories in the Parrot subversion repository. (Needed for
# distributions or in general when svn is not available).
@@ -14,11 +14,16 @@
# debian/ should not go into release tarballs
^debian$
^debian/
-# generated from svn:ignore of 'languages/pheme/'
-^languages/pheme/.*\.pbc$
-^languages/pheme/.*\.pbc/
-^languages/pheme/Makefile$
-^languages/pheme/Makefile/
+# generated from svn:ignore of '
+languages/pheme/'
+^
+languages/pheme/.*\.pbc$
+^
+languages/pheme/.*\.pbc/
+^
+languages/pheme/Makefile$
+^
+languages/pheme/Makefile/
# generated from svn:ignore of './'
^.*\.core$
^.*\.core/
Modified: branches/pmc2c/lib/Parrot/Pmc2c/Library.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/Library.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/Library.pm Fri Jun 8 10:55:46 2007
@@ -62,17 +62,11 @@
my ( $self, $library_name ) = @_;
my $h_name = "$library_name.h";
my $c_name = "$library_name.c";
- my $debug = $self->{opt}->{debug};
- my $verbose = $self->{opt}->{verbose};
my $cout = $self->gen_c;
- print $cout if $debug;
- print "Writing $h_name\n" if $verbose;
spew($c_name, $cout);
my $hout = $self->gen_h;
- print $hout if $debug;
- print "Writing $h_name\n" if $verbose;
spew($h_name, $hout);
}
Modified: branches/pmc2c/lib/Parrot/Pmc2c/Method.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/Method.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/Method.pm Fri Jun 8 10:55:46 2007
@@ -11,8 +11,6 @@
use Carp;
use Parrot::Pmc2c::UtilFunctions qw(count_newlines);
-$SIG{'__WARN__'} = sub { warn $_[0]; use Carp; print Carp::longmess; };
-
sub new {
my ( $class, $self_hash ) = @_;
my $self = {(
Modified: branches/pmc2c/lib/Parrot/Pmc2c/MethodEmitter.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/MethodEmitter.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/MethodEmitter.pm Fri Jun 8 10:55:46 2007
@@ -30,8 +30,6 @@
use Text::Balanced 'extract_bracketed';
use Parrot::Pmc2c::PCCMETHOD;
-$SIG{'__WARN__'} = sub { use Carp; warn $_[0]; Carp::confess; };
-
=item C<body($method, $line, $out_name)>
Returns the C code for the method body. C<$line> is used to accumulate
Modified: branches/pmc2c/lib/Parrot/Pmc2c/PMC/delegate.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/PMC/delegate.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PMC/delegate.pm Fri Jun 8 10:55:46 2007
@@ -17,12 +17,19 @@
=cut
+our $ok = {
+ 'get_bool' =>1,
+ 'get_string' =>1,
+ 'push_string' =>1,
+};
+
sub pre_method_gen {
my ( $self ) = @_;
# vtable methods
foreach my $method ( @{ $self->vtable->methods } ) {
my $vt_method_name = $method->name;
+ next unless exists $ok->{$vt_method_name};
next unless $self->normal_unimplemented_vtable($vt_method_name);
my $new_default_method = $method->clone();
my ( $func_ret, $ret_suffix, $args, $sig ) = $self->signature($method);
@@ -34,8 +41,8 @@
STRING *meth = CONST_STRING(interp, "$vt_method_name");
PMC *sub = Parrot_find_vtable_meth(interp, pmc, meth);
if (PMC_IS_NULL(sub))
- return SUPER($super_args);
- /* vtable_meth_not_found(interp, pmc, "$vt_method_name"); */
+ /* return SUPER($super_args); */
+ vtable_meth_not_found(interp, pmc, "$vt_method_name");
${func_ret}Parrot_run_meth_fromc_args$ret_suffix(interp, sub, pmc, meth,
"$sig"$args);
EOC
$new_default_method->type(Parrot::Pmc2c::Method::VTABLE);
Modified: branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter.pm Fri Jun 8 10:55:46 2007
@@ -570,6 +570,8 @@
$cout .= <<"EOC";
/* setup MRO and _namespace */
Parrot_create_mro(interp, entry);
+ /* create PMC Proxy object */
+ Parrot_create_pmc_proxy(interp, entry);
EOC
# declare each nci method for this class
Modified: branches/pmc2c/lib/Parrot/Pmc2c/Pmc2cMain.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/Pmc2cMain.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/Pmc2cMain.pm Fri Jun 8 10:55:46 2007
@@ -23,7 +23,7 @@
use File::Basename;
use Carp;
-$SIG{'__WARN__'} = sub { use Carp; warn $_[0]; Carp::confess; };
+#$SIG{'__WARN__'} = sub { use Carp; warn $_[0]; Carp::confess; };
=head1 NAME
@@ -93,7 +93,7 @@
unshift @{ $allargsref->{include} },
( ".", "$FindBin::Bin/../..", "$FindBin::Bin/../../src/pmc/" );
- foreach my $opt qw(nolines debug verbose) {
+ foreach my $opt qw(nolines) {
if ( !defined $allargsref->{opt}{$opt} ) {
$allargsref->{opt}{$opt} = 0;
}
@@ -125,8 +125,7 @@
sub dump_vtable {
my ( $self, $file ) = @_;
- Parrot::Pmc2c::VTable->new( $file )->dump;
- return 1;
+ return Parrot::Pmc2c::VTable->new( $file )->dump;
}
=head3 C<dump_pmc()>
@@ -208,7 +207,7 @@
for my $f (@files) {
my $class = $self->read_dump($f);
print " " x $depth, $class->{name}, "\n";
- for my $k ( keys %{ $class->{flags}{extends} } ) {
+ for my $k ( @{ $class->parents } ) {
$self->print_tree(
{
depth => $depth + 1,
@@ -248,7 +247,7 @@
$filename = $self->find_file( filename($filename, '.dump'), 1 );
my $class;
- eval do { slurp($filename, $self->{opt}{verbose}); };
+ eval do { slurp($filename); };
die $@ if $@;
return $class;
Modified: branches/pmc2c/lib/Parrot/Pmc2c/UtilFunctions.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/UtilFunctions.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/UtilFunctions.pm Fri Jun 8 10:55:46 2007
@@ -169,7 +169,7 @@
=head3 C<open_file()>
- $fh = open_file( "<", $file, $verbose);
+ $fh = open_file( "<", $file );
B<Purpose:> Utility subroutine.
@@ -186,12 +186,6 @@
String holding name of file to be opened.
-=item * verbose
-
-Optional. True value if verbose output is desired. That output will be the
-action followed by the filename.
-In most cases, the third argument will be C<$self->{opt}{verbose}>.
-
=back
B<Return Values:> Filehandle to file so opened.
@@ -201,35 +195,36 @@
=cut
sub open_file {
- my ( $direction, $filename, $verbose ) = @_;
+ my ( $direction, $filename ) = @_;
+ my $verbose = 0;
my $actions_descriptions = { '<' => 'Reading', '>>' => "Appending", '>' =>
"Writing" };
my $action = $actions_descriptions->{$direction} || "Unknown";
-
print "$action $filename\n" if $verbose;
+
open my $fh, $direction, $filename or die "$action $filename: $!\n";
return $fh;
}
sub slurp {
- my ( $filename, $verbose ) = @_;
- my $fh = open_file( '<', $filename, $verbose );
+ my ( $filename ) = @_;
+ my $fh = open_file( '<', $filename );
my $data = do { local $/; <$fh> };
close $fh;
return $data;
}
sub spew {
- my ( $filename, $data, $verbose ) = @_;
- my $fh = open_file( '>', $filename, $verbose );
+ my ( $filename, $data ) = @_;
+ my $fh = open_file( '>', $filename );
print $fh $data;
close $fh;
}
sub splat {
- my ( $filename, $data, $verbose ) = @_;
- my $fh = open_file( '>>', $filename, $verbose );
+ my ( $filename, $data ) = @_;
+ my $fh = open_file( '>>', $filename );
print $fh $data;
close $fh;
}
Modified: branches/pmc2c/lib/Parrot/Pmc2c/VTable.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/VTable.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/VTable.pm Fri Jun 8 10:55:46 2007
@@ -76,6 +76,7 @@
my $Dumper = Data::Dumper->new( [$self], ['class'] );
$Dumper->Indent(3);
spew($dump_filename, $Dumper->Dump);
+ return $dump_filename;
}
sub has_method {
Modified: branches/pmc2c/t/tools/pmc2cutils/01-pmc2cutils.t
==============================================================================
--- branches/pmc2c/t/tools/pmc2cutils/01-pmc2cutils.t (original)
+++ branches/pmc2c/t/tools/pmc2cutils/01-pmc2cutils.t Fri Jun 8 10:55:46 2007
@@ -19,7 +19,7 @@
}
unshift @INC, qq{$topdir/lib};
}
-use Test::More tests => 25;
+use Test::More tests => 21;
use_ok('Parrot::Pmc2c::Pmc2cMain');
@@ -43,11 +43,6 @@
can_ok( 'Parrot::Pmc2c::UtilFunctions', q{open_file} );
-can_ok( 'Parrot::Pmc2c::Dumper', q{inherit_attrs} );
-can_ok( 'Parrot::Pmc2c::Dumper', q{gen_parent_lookup_info} );
-can_ok( 'Parrot::Pmc2c::Dumper', q{gen_parent_reverse_lookup_info} );
-can_ok( 'Parrot::Pmc2c::Dumper', q{dump_is_newer} );
-
can_ok( 'Parrot::Pmc2c::Parser', q{parse_pmc} );
can_ok( 'Parrot::Pmc2c::Parser', q{parse_flags} );
can_ok( 'Parrot::Pmc2c::Parser', q{parse_method_attrs} );
Modified: branches/pmc2c/t/tools/pmc2cutils/03-dump_vtable.t
==============================================================================
--- branches/pmc2c/t/tools/pmc2cutils/03-dump_vtable.t (original)
+++ branches/pmc2c/t/tools/pmc2cutils/03-dump_vtable.t Fri Jun 8 10:55:46 2007
@@ -19,7 +19,7 @@
}
unshift @INC, qq{$topdir/lib};
}
-use Test::More tests => 12;
+use Test::More tests => 8;
use_ok('Parrot::Pmc2c::Pmc2cMain');
use_ok('File::Basename');
use_ok( 'File::Temp', qw| tempdir | );
@@ -51,33 +51,6 @@
ok( chdir $cwd, "changed back to original directory" );
}
-# test verbose option
-{
- $cwd = cwd();
- my $tdir2 = tempdir( CLEANUP => 1 );
- ok( chdir $tdir2, 'changed to temp directory for testing' );
-
- %opt = ( verbose => 1 );
- $self = Parrot::Pmc2c::Pmc2cMain->new(
- {
- include => [EMAIL PROTECTED],
- opt => \%opt,
- args => [EMAIL PROTECTED],
- }
- );
- my ( $fh, $msg );
- {
- my $currfh = select($fh);
- open( $fh, '>', \$msg ) or die "Unable to open handle: $!";
- $dump_file = $self->dump_vtable("$main::topdir/vtable.tbl");
- select($currfh);
- }
- ok( -e $dump_file, "dump_vtable created dump file" );
- like( $msg, qr/^Writing/, "verbose output is as expected" );
-
- ok( chdir $cwd, "changed back to original directory" );
-}
-
pass("Completed all tests in $0");
################### DOCUMENTATION ###################
Modified: branches/pmc2c/t/tools/pmc2cutils/04-dump_pmc.t
==============================================================================
--- branches/pmc2c/t/tools/pmc2cutils/04-dump_pmc.t (original)
+++ branches/pmc2c/t/tools/pmc2cutils/04-dump_pmc.t Fri Jun 8 10:55:46 2007
@@ -19,7 +19,7 @@
}
unshift @INC, qq{$topdir/lib};
}
-use Test::More tests => 117;
+use Test::More tests => 106;
use File::Basename;
use File::Copy;
use FindBin;
@@ -303,62 +303,6 @@
ok( chdir $cwd, "changed back to original directory" );
}
-# test with verbose option
-{
- my $tdir = tempdir( CLEANUP => 1 );
- ok( chdir $tdir, 'changed to temp directory for testing' );
- my $pmcdir = q{src/pmc};
- ok( ( mkdir qq{$tdir/src} ), "created src/ under tempdir" );
- my $temppmcdir = qq{$tdir/src/pmc};
- ok( ( mkdir $temppmcdir ), "created src/pmc/ under tempdir" );
-
- my @pmcfiles = ( "$main::topdir/src/pmc/default.pmc",
"$main::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;
- }
- is( $copycount, $pmcfilecount, "all src/pmc/*.pmc files copied to tempdir"
);
- my @include = ( $tdir, $temppmcdir, @include_orig );
-
- @args = ( qq{$temppmcdir/default.pmc}, );
- $self = Parrot::Pmc2c::Pmc2cMain->new(
- {
- include => [EMAIL PROTECTED],
- opt => { verbose => 1 },
- args => [EMAIL PROTECTED],
- }
- );
- isa_ok( $self, q{Parrot::Pmc2c::Pmc2cMain} );
-
- my ( $fh, $currfh, $msg );
- {
- $currfh = select($fh);
- open( $fh, '>', \$msg ) or die "Unable to open handle: $!";
- $dump_file = $self->dump_vtable("$main::topdir/vtable.tbl");
- close $fh or die "Unable to close handle: $!";
- select($currfh);
- }
- ok( -e $dump_file, "dump_vtable created vtable.dump" );
- like( $msg, qr/^Writing.*?vtable\.dump/s,
- "dump_pmc() returned expected message in verbose mode" );
-
- {
- $currfh = select($fh);
- open( $fh, '>', \$msg ) or die "Unable to open handle: $!";
- ok( $self->dump_pmc(), "dump_pmc succeeded" );
- close $fh or die "Unable to close handle: $!";
- select($currfh);
- }
- ok( -f qq{$temppmcdir/default.dump}, "default.dump created as expected" );
- like( $msg, qr/^Reading.*?vtable\.dump/s,
- "dump_pmc() returned expected message in verbose mode" );
-
- ok( chdir $cwd, "changed back to original directory" );
-}
-
# @args globs 'src/pmc/*.pmc'
{
my $tdir = tempdir( CLEANUP => 1 );
Modified: branches/pmc2c/t/tools/pmc2cutils/05-gen_c.t
==============================================================================
--- branches/pmc2c/t/tools/pmc2cutils/05-gen_c.t (original)
+++ branches/pmc2c/t/tools/pmc2cutils/05-gen_c.t Fri Jun 8 10:55:46 2007
@@ -19,7 +19,7 @@
}
unshift @INC, qq{$topdir/lib};
}
-use Test::More tests => 74;
+use Test::More tests => 45;
use Carp;
use File::Basename;
use File::Copy;
@@ -38,8 +38,6 @@
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
{
@@ -76,20 +74,8 @@
ok( $self->dump_pmc(), "dump_pmc succeeded" );
ok( -f qq{$temppmcdir/default.dump}, "default.dump created as expected" );
- {
- $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"
- );
- }
-
+ $rv = $self->gen_c();
+ ok( $rv, "gen_c completed successfully; args: default.pmc" );
ok( chdir $cwd, "changed back to original directory" );
}
@@ -130,152 +116,8 @@
ok( -f qq{$temppmcdir/default.dump}, "default.dump created as expected" );
ok( -f qq{$temppmcdir/array.dump}, "array.dump created as expected" );
- {
- $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" );
-}
-
-# debug option
-{
- my $tdir = tempdir( CLEANUP => 1 );
- ok( chdir $tdir, 'changed to temp directory for testing' );
- my $pmcdir = q{src/pmc};
- ok( ( mkdir qq{$tdir/src} ), "created src/ under tempdir" );
- my $temppmcdir = qq{$tdir/src/pmc};
- ok( ( mkdir $temppmcdir ), "created src/pmc/ under tempdir" );
-
- my @pmcfiles = ( "$main::topdir/src/pmc/default.pmc",
"$main::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;
- }
- is( $copycount, $pmcfilecount, "all src/pmc/*.pmc files copied to tempdir"
);
- my @include = ( $tdir, $temppmcdir, @include_orig );
-
- @args = ( qq{$temppmcdir/default.pmc}, );
- my %opt = ( debug => 1 );
- $self = Parrot::Pmc2c::Pmc2cMain->new(
- {
- include => [EMAIL PROTECTED],
- opt => \%opt,
- args => [EMAIL PROTECTED],
- }
- );
- isa_ok( $self, q{Parrot::Pmc2c::Pmc2cMain} );
- $dump_file = $self->dump_vtable("$main::topdir/vtable.tbl");
- ok( -e $dump_file, "dump_vtable created vtable.dump" );
-
- ok( $self->dump_pmc(), "dump_pmc succeeded" );
- ok( -f qq{$temppmcdir/default.dump}, "default.dump created as expected" );
-
- {
- $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( chdir $cwd, "changed back to original directory" );
-}
-
-# debug and verbose options
-{
- my $tdir = tempdir( CLEANUP => 1 );
- ok( chdir $tdir, 'changed to temp directory for testing' );
- my $pmcdir = q{src/pmc};
- ok( ( mkdir qq{$tdir/src} ), "created src/ under tempdir" );
- my $temppmcdir = qq{$tdir/src/pmc};
- ok( ( mkdir $temppmcdir ), "created src/pmc/ under tempdir" );
-
- my @pmcfiles = ( "$main::topdir/src/pmc/default.pmc",
"$main::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;
- }
- is( $copycount, $pmcfilecount, "all src/pmc/*.pmc files copied to tempdir"
);
- my @include = ( $tdir, $temppmcdir, @include_orig );
-
- @args = ( qq{$temppmcdir/default.pmc}, );
- my %opt = ( debug => 2, verbose => 1 );
- $self = Parrot::Pmc2c::Pmc2cMain->new(
- {
- include => [EMAIL PROTECTED],
- opt => \%opt,
- args => [EMAIL PROTECTED],
- }
- );
- isa_ok( $self, q{Parrot::Pmc2c::Pmc2cMain} );
-
- my ( $fh, $dmsg, $rv );
- {
- my $currfh = select($fh);
- 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( $dmsg, qr{^Writing}, "verbose option worked" );
-
- {
- my $currfh = select($fh);
- 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( $dmsg, qr{^Reading}, "verbose option worked" );
-
- {
- $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"
- );
- }
+ $rv = $self->gen_c();
+ ok( $rv, "gen_c completed successfully; args: default.pmc and array.pmc"
);
ok( chdir $cwd, "changed back to original directory" );
}
@@ -361,17 +203,8 @@
ok( -f qq{$temppmcdir/class.dump}, "class.dump created as expected" );
{
- $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" );
Modified: branches/pmc2c/t/tools/pmc2cutils/06-print_tree.t
==============================================================================
--- branches/pmc2c/t/tools/pmc2cutils/06-print_tree.t (original)
+++ branches/pmc2c/t/tools/pmc2cutils/06-print_tree.t Fri Jun 8 10:55:46 2007
@@ -131,6 +131,7 @@
select($currfh);
}
ok( $rv, "tree printed for default.dump and array.dump" );
+ print "$msg\n";
like(
$msg,
qr/^default\nArray\n\s{4}default$/s,
Modified: branches/pmc2c/t/tools/pmc2cutils/07-open_file.t
==============================================================================
--- branches/pmc2c/t/tools/pmc2cutils/07-open_file.t (original)
+++ branches/pmc2c/t/tools/pmc2cutils/07-open_file.t Fri Jun 8 10:55:46 2007
@@ -19,7 +19,7 @@
}
unshift @INC, qq{$topdir/lib};
}
-use Test::More tests => 23;
+use Test::More tests => 13;
use File::Basename;
use File::Copy;
use FindBin;
@@ -35,7 +35,7 @@
my $cwd = cwd();
my $file = q{sample.txt};
-my ( $direction, $verbose );
+my ( $direction );
my $fh;
{
@@ -45,68 +45,23 @@
ok( create_test_file($file), "test file created" );
$direction = '<';
- ok( $fh = Parrot::Pmc2c::UtilFunctions::open_file( $direction, $file,
$verbose ),
+ ok( $fh = Parrot::Pmc2c::UtilFunctions::open_file( $direction, $file ),
"file opened for reading" );
close $fh or die "Unable to close handle to test file";
$direction = '>';
- ok( $fh = Parrot::Pmc2c::UtilFunctions::open_file( $direction, $file,
$verbose ),
+ ok( $fh = Parrot::Pmc2c::UtilFunctions::open_file( $direction, $file ),
"file opened for writing" );
close $fh or die "Unable to close handle to test file";
$direction = '>>';
- ok( $fh = Parrot::Pmc2c::UtilFunctions::open_file( $direction, $file,
$verbose ),
+ ok( $fh = Parrot::Pmc2c::UtilFunctions::open_file( $direction, $file ),
"file opened for appending" );
close $fh or die "Unable to close handle to test file";
ok( chdir $cwd, "changed back to original directory" );
}
-{
- my $tdir = tempdir( CLEANUP => 1 );
- ok( chdir $tdir, 'changed to temp directory for testing' );
-
- ok( create_test_file($file), "test file created" );
-
- $verbose = 1;
- my ( $currfh, $msg, $msgfh );
-
- $direction = '<';
- {
- $currfh = select($msgfh);
- open( $msgfh, '>', \$msg ) or die "Unable to open handle: $!";
- $fh = Parrot::Pmc2c::UtilFunctions::open_file( $direction, $file,
$verbose );
- ok( $fh, "file opened for reading" );
- close $fh or die "Unable to close handle: $!";
- select($currfh);
- }
- like( $msg, qr/^Reading/, "verbose option reports Reading" );
-
- $direction = '>';
- {
- $currfh = select($msgfh);
- open( $msgfh, '>', \$msg ) or die "Unable to open handle: $!";
- $fh = Parrot::Pmc2c::UtilFunctions::open_file( $direction, $file,
$verbose );
- ok( $fh, "file opened for writing" );
- close $fh or die "Unable to close handle: $!";
- select($currfh);
- }
- like( $msg, qr/^Writing/, "verbose option reports Writing" );
-
- $direction = '>>';
- {
- $currfh = select($msgfh);
- open( $msgfh, '>', \$msg ) or die "Unable to open handle: $!";
- $fh = Parrot::Pmc2c::UtilFunctions::open_file( $direction, $file,
$verbose );
- ok( $fh, "file opened for appending" );
- close $fh or die "Unable to close handle: $!";
- select($currfh);
- }
- like( $msg, qr/^Appending/, "verbose option reports Appending" );
-
- ok( chdir $cwd, "changed back to original directory" );
-}
-
# failure case: nonexistent file
{
my $tdir = tempdir( CLEANUP => 1 );
@@ -115,14 +70,8 @@
my ( $currfh, $msg, $msgfh );
$direction = '<';
- {
- $currfh = select($msgfh);
- open( $msgfh, '>', \$msg ) or die "Unable to open handle: $!";
- eval { $fh = Parrot::Pmc2c::UtilFunctions::open_file( $direction,
$file, $verbose ); };
- select($currfh);
- }
+ eval { $fh = Parrot::Pmc2c::UtilFunctions::open_file( $direction, $file );
};
like( $@, qr/^Reading sample.txt/, "correctly failed to read nonexistent
file" );
- like( $msg, qr/^Reading sample.txt/, "correct message upon trying to read
nonexistent file" );
ok( chdir $cwd, "changed back to original directory" );
}
Added: branches/pmc2c/t/tools/pmc2cutils/08-pmc.pm.t
==============================================================================
--- (empty file)
+++ branches/pmc2c/t/tools/pmc2cutils/08-pmc.pm.t Fri Jun 8 10:55:46 2007
@@ -0,0 +1,64 @@
+#! perl
+# Copyright (C) 2006-2007, The Perl Foundation.
+# $Id: 01-pmc2cutils.t 18696 2007-05-30 22:16:09Z tewk $
+# 01-pmc2cutils.t
+
+use strict;
+use warnings;
+
+BEGIN {
+ use FindBin qw($Bin);
+ use Cwd qw(cwd realpath);
+ realpath($Bin) =~ m{^(.*\/parrot)\/[^/]*\/[^/]*\/[^/]*$};
+ our $topdir = $1;
+ if ( defined $topdir ) {
+ print "\nOK: Parrot top directory located\n";
+ }
+ else {
+ $topdir = realpath($Bin) . "/../../..";
+ }
+ unshift @INC, qq{$topdir/lib};
+}
+use Test::More tests => 5;
+
+use_ok('Parrot::Pmc2c::PMC');
+
+my ( %opt, @include, @args );
+my $self;
+
+$self = Parrot::Pmc2c::PMC->new();
+
+isa_ok( $self, q{Parrot::Pmc2c::PMC} );
+
+can_ok( 'Parrot::Pmc2c::PMC', q{inherit_attrs} );
+#can_ok( 'Parrot::Pmc2c::PMC', q{gen_parent_lookup_info} );
+#can_ok( 'Parrot::Pmc2c::PMC', q{gen_parent_reverse_lookup_info} );
+can_ok( 'Parrot::Pmc2c::PMC', q{dump_is_current} );
+
+
+pass("Completed all tests in $0");
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+08-pmc.pm.t - test Parrot::Pmc2c::Pmc basic functionality
+
+=head1 SYNOPSIS
+
+ % prove t/tools/pmc2cutils/08-pmc.pm.t
+
+=head1 DESCRIPTION
+
+=head1 AUTHOR
+
+Kevin Tew
+
+=cut
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Modified: branches/pmc2c/tools/build/pmc2c.pl
==============================================================================
--- branches/pmc2c/tools/build/pmc2c.pl (original)
+++ branches/pmc2c/tools/build/pmc2c.pl Fri Jun 8 10:55:46 2007
@@ -22,8 +22,6 @@
"tree" => \$action{tree},
#command line options
"no-lines" => \$options{nolines},
- "debug+" => \$options{debug},
- "verbose+" => \$options{verbose},
"library=s" => \$options{library},
"testing" => \$options{testing},
) or exit 1;
@@ -104,19 +102,10 @@
=over 4
-=item C<--debug>
-
-Increase debug level
-
-=item C<--verbose>
-
-Increase verbose level
-
=item C<--no-lines>
Omit source line info
-
=item C<--include=/path/to/pmc>
Specify include path where to find PMCs.
