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

This is a re-submission of the new files and patches originally  
submitted in http://rt.perl.org/rt3/Ticket/Display.html?id=41608.  
(Yesterday I twice tried submitting mail with individual file  
attachments, but it never showed up.   So I'm trying again with just  
a single patch ops2c.pl.refactored.svn.diff.txt.)

New files:
lib/Parrot/IO/Capture/Mini.pm                               [devel]
lib/Parrot/Ops2c/Auxiliary.pm                               [devel]
lib/Parrot/Ops2c/Utils.pm                                   [devel]
t/tools/ops2cutils/01-new.t                                 []
t/tools/ops2cutils/02-usage.t                               []
t/tools/ops2cutils/03-print_c_header_file.t                 []
t/tools/ops2cutils/04-print_c_source_top.t                  []
t/tools/ops2cutils/05-print_c_source_bottom.t               []
t/tools/ops2cutils/06-dynamic.t                             []
t/tools/ops2cutils/07-make_incdir.t                         []
t/tools/ops2cutils/08-nolines.t                             []
t/tools/ops2cutils/09-dynamic_nolines.t                     []
t/tools/ops2cutils/testlib/GenerateCore.pm                  []

Patches to:
config/gen/makefiles/root.in
MANIFEST
tools/build/ops2c.pl

These files constitute a refactoring of Parrot build tool tools/build/
ops2c.pl.  The refactoring was conducted along the same lines as my
recent refactoring of tools/build/ops2pm.pl and tools/build/
pmc2c.pl.  In each case, the interface to the build tool (i.e., what
is invoked by make) was left untouched, but the code within the
script was refactored into two Perl packages:  one dubbed Utils.pm,
holding most of the functionality in methods; and another one dubbed
Auxiliary.pm, holding miscellaneous subroutines.

This refactoring was suggested by particle for the purpose of more
thoroughly testing Parrot's build tools, being able to demonstrate
the soundness of that refactoring and the thoroughness of the testing
via coverage analysis, and thereby setting a firm foundation for any
refactorings needed in the future.

The test suite in t/tools/ops2cutils/ is component-focused.  It is
intended to be run after you have run Configure.pl but before you
have invoked make.  Some of the tests are designed to fail if run
after make.  Hence, these tests are not meant to be part of make
test's targets.  Instead, once you have run Configure.pl you can run
them via:  make buildtools_tests

This refactoring has been conducted largely in the 'buildtools'
branch of the repository, but has passed 'make' and 'make test' in
a fresh checkout of HEAD from trunk.

You can see the coverage analysis here:  http://thenceforward.net/
parrot/coverage/ops2c/.

I have tested this on Darwin ('make' and 'make test') and on Debian
Linux ('make' and 'make test'); particle has tested then on Win32.

So I will apply these files to trunk after the March release unless I  
hear of test failures on other OSes.

Thank you very much.

kid51

[ ops2c.pl.refactored.svn.diff.txt 99K ]
Index: tools/build/ops2c.pl
===================================================================
--- tools/build/ops2c.pl        (revision 17419)
+++ tools/build/ops2c.pl        (working copy)
@@ -1,7 +1,42 @@
 #! perl
 # Copyright (C) 2001-2006, The Perl Foundation.
 # $Id$
+use warnings;
+use strict;
+use lib 'lib';
+use Parrot::Ops2c::Auxiliary qw( Usage getoptions );
+use Parrot::Ops2c::Utils;

+my $flagref = getoptions();
+if (
+        (not defined $flagref) or
+        $flagref->{help} or
+        (not @ARGV)
+    ) {
+        Usage();
+        exit 1;
+}
+
+my $self = Parrot::Ops2c::Utils->new( {
+    argv    => [ @ARGV ],
+    flag    => $flagref,
+    script  => $0,
+} );
+if (not defined $self) {
+    Usage();
+    exit 1;
+}
+
+$self->print_c_header_file();
+
+my $SOURCE = $self->print_c_source_top();
+
+my $c_source_final = $self->print_c_source_bottom($SOURCE);
+
+exit 0;
+
+#################### DOCUMENTATION ####################
+
 =head1 NAME

 tools/build/ops2c.pl - Parser for .ops files
@@ -78,6 +113,30 @@

 =back

+=head1 NOTE
+
+Most of the functionality in F<tools/build/ops2c.pl> has been extracted into
+methods and subroutines found in Parrot::Ops2c::Utils and
+Parrot::Ops2c::Auxiliary.  This refactoring facilitates unit testing and
+coverage analysis of that functionality.  A test suite has been provided in
+F<t/tools/ops2cutils/>.  It is recommended that future refactoring of this
+functionality proceed in a test-driven manner, I<i.e.,> tests should be
+written reflecting any changes to interface or functionality; the code should
+be written which implements the revisions; the code should be tested; and
+coverage analysis should be performed with Devel::Cover to measure the extent
+to which the tests exercise the code.
+
+=head1 AUTHORS
+
+Based on the commit logs, the following members of the Parrot project have
+contributed to this program:
+
+    ambs bernhard boemmels brentdax chip
+    coke dan gregor grunblatt jgoff
+    jkeenan jonathan josh jrieks leo
+    mikescott mrjoltcola nicholas particle paultcochrane
+    petdance rgrjr robert simon
+
 =head1 SEE ALSO

 =over 4
@@ -102,662 +161,18 @@

 =item C<Parrot::OpTrans::CPrederef>

+=item C<Parrot::Ops2c::Utils>
+
+=item C<Parrot::Ops2c::Auxiliary>
+
 =back

 =cut

-use warnings;
-use strict;
-use lib 'lib';
-
-use Pod::Usage;
-use Getopt::Long qw(:config permute);
-
-use Parrot::OpsFile;
-use Parrot::OpLib::core;
-use Parrot::Config;
-
-my %arg_dir_mapping = (
-    ''   => 'PARROT_ARGDIR_IGNORED',
-    'i'  => 'PARROT_ARGDIR_IN',
-    'o'  => 'PARROT_ARGDIR_OUT',
-    'io' => 'PARROT_ARGDIR_INOUT'
-);
-
-#
-# Look at the command line options
-#
-sub Usage {
-    return pod2usage( -exitval => 1, -verbose => 0, -output => \*STDERR );
-}
-
-my ( $nolines_flag, $help_flag, $dynamic_flag, $core_flag );
-GetOptions(
-    "no-lines"  => \$nolines_flag,
-    "help"      => \$help_flag,
-    "dynamic|d" => \$dynamic_flag,
-    "core"      => \$core_flag,
-) || Usage();
-
-Usage() if $help_flag;
-Usage() unless @ARGV;
-
-my $class_name = shift @ARGV;
-my %is_allowed = map { $_ => 1 } qw(C CGoto CGP CSwitch CPrederef);
-Usage() unless $is_allowed{$class_name};
-my $trans_class = "Parrot::OpTrans::" . $class_name;
-
-eval "require $trans_class";
-
-my $trans = $trans_class->new();
-
-# Not used
-my $prefix = $trans->prefix();
-my $suffix = $trans->suffix();
-
-# Used as ${defines}
-my $defines      = $trans->defines();
-my $opsarraytype = $trans->opsarraytype();
-my $core_type    = $trans->core_type();
-
-my $file = $core_flag ? 'core.ops' : shift @ARGV;
-
-my $base = $file;
-$base =~ s/\.ops$//;
-
-my $incdir  = "include/parrot/oplib";
-my $include = "parrot/oplib/${base}_ops${suffix}.h";
-my $header  = "include/$include";
-
-# SOURCE is closed and reread, which confuses make -j
-# create a temp file and rename it
-my $source = "src/ops/${base}_ops${suffix}.c.temp";
-
-if ( $base =~ m!^src/dynoplibs/! || $dynamic_flag ) {
-    $source =~ s!src/ops/!!;
-    $header = "${base}_ops${suffix}.h";
-    $base =~ s!^.*[/\\]!!;
-    $include      = "${base}_ops${suffix}.h";
-    $dynamic_flag = 1;
-}
-
-my $sym_export = $dynamic_flag ? 'PARROT_DYNEXT_EXPORT' : 'PARROT_API';
-
-my %hashed_ops;
-
-#
-# Read the input files:
-#
-
-my $ops;
-if ($core_flag) {
-    $ops = Parrot::OpsFile->new( ["src/ops/$file"], $nolines_flag );
-    $ops->{OPS}      = $Parrot::OpLib::core::ops;
-    $ops->{PREAMBLE} = $Parrot::OpLib::core::preamble;
-}
-else {
-    my %opsfiles;
-    my @opsfiles;
-
-    foreach my $opsfile ( $file, @ARGV ) {
-        if ( $opsfiles{$opsfile} ) {
-            print STDERR "$0: Ops file '$opsfile' mentioned more than once!\n";
-            next;
-        }
-
-        $opsfiles{$opsfile} = 1;
-        push @opsfiles, $opsfile;
-
-        die "$0: Could not read ops file '$opsfile'!\n" unless -r $opsfile;
-    }
-
-    $ops = Parrot::OpsFile->new( \@opsfiles, $nolines_flag );
-
-    my $cur_code = 0;
-    for ( @{ $ops->{OPS} } ) {
-        $_->{CODE} = $cur_code++;
-    }
-}
-
-my $version       = $ops->version;
-my $major_version = $ops->major_version;
-my $minor_version = $ops->minor_version;
-my $patch_version = $ops->patch_version;
-my $num_ops       = scalar $ops->ops;
-my $num_entries   = $num_ops + 1;          # For trailing NULL
-
-#
-# Open the output files:
-#
-
-if ( !$dynamic_flag && !-d $incdir ) {
-    mkdir( $incdir, 0755 ) or die "ops2c.pl: Could not mkdir $incdir $!!\n";
-}
-
-open my $HEADER, '>', $header
-    or die "ops2c.pl: Cannot open header file '$header' for writing: $!!\n";
-
-open my $SOURCE, '>', $source
-    or die "ops2c.pl: Cannot open source file '$source' for writing: $!!\n";
-
-#
-# Print the preamble for the HEADER and SOURCE files:
-#
-
-my $preamble = <<END_C;
-/* ex: set ro:
- * !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
- *
- * This file is generated automatically from '$file' (and possibly other
- * .ops files). by $0.
- *
- * Any changes made here will be lost!
- *
- */
-
-END_C
-
-my $mmp_v     = "${major_version}_${minor_version}_${patch_version}";
-my $init_func = "Parrot_DynOp_${base}${suffix}_$mmp_v";
-
-print $HEADER $preamble;
-if ($dynamic_flag) {
-    print $HEADER "#define PARROT_IN_EXTENSION\n";
-}
-print $HEADER <<END_C;
-#include "parrot/parrot.h"
-#include "parrot/oplib.h"
-
-$sym_export extern op_lib_t *$init_func(long init);
-
-END_C
-my $cg_func = $trans->core_prefix . $base;
-
-if ( $trans->can("run_core_func_decl") ) {
-    my $run_core_func = $trans->run_core_func_decl($base);
-    print $HEADER "$run_core_func;\n";
-}
-my $bs = "${base}${suffix}_";
-
-# append the C code coda
-print $HEADER <<END_C;
-
-/*
- * Local variables:
- *   c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
-END_C
-
-print $SOURCE $preamble;
-print $SOURCE <<END_C;
-#include "$include"
-
-${defines}
-static op_lib_t ${bs}op_lib;
-
-END_C
-
-my $text = $ops->preamble($trans);
-$text =~ s/\bops_addr\b/${bs}ops_addr/g;
-print $SOURCE $text;
-
-if ( $trans->can("ops_addr_decl") ) {
-    print $SOURCE $trans->ops_addr_decl($bs);
-}
-if ( $trans->can("run_core_func_decl") ) {
-    print $SOURCE $trans->run_core_func_decl($base);
-    print $SOURCE "\n{\n";
-    print $SOURCE $trans->run_core_func_start;
-}
-
-#
-# Iterate over the ops, appending HEADER and SOURCE fragments:
-#
-
-my @op_funcs;
-my @op_func_table;
-my @cg_jump_table;
-my $index = 0;
-my ( $prev_src, $prev_index );
-
-$prev_src = '';
-foreach my $op ( $ops->ops ) {
-    my $func_name = $op->func_name($trans);
-    my $arg_types = "$opsarraytype *, Interp *";
-    my $prototype = "$sym_export $opsarraytype * $func_name ($arg_types)";
-    my $args      = "$opsarraytype *cur_opcode, Interp *interp";
-    my $definition;
-    my $comment = '';
-    my $one_op  = "";
-
-    if ( $suffix =~ /cg/ ) {
-        $definition = "PC_$index:";
-        $comment    = "/* " . $op->full_name() . " */";
-    }
-    elsif ( $suffix =~ /switch/ ) {
-        $definition = "case $index:";
-        $comment    = "/* " . $op->full_name() . " */";
-    }
-    else {
-        $definition = "$prototype;\n$opsarraytype *\n$func_name ($args)";
-    }
-
-    my $src = $op->source($trans);
-    $src =~ s/\bop_lib\b/${bs}op_lib/g;
-    $src =~ s/\bops_addr\b/${bs}ops_addr/g;
-
-    if ( $suffix =~ /cg/ ) {
-        if ( $prev_src eq $src ) {
-            push @cg_jump_table, "        &&PC_$prev_index,\n";
-        }
-        else {
-            push @cg_jump_table, "        &&PC_$index,\n";
-        }
-    }
-    elsif ( $suffix eq '' ) {
-        push @op_func_table, sprintf( "  %-50s /* %6ld */\n", "$func_name,", $index );
-    }
-    if ( $prev_src eq $src ) {
-        push @op_funcs, "$comment\n";
-    }
-    else {
-        $one_op .= "$definition $comment {\n$src}\n\n";
-        push @op_funcs, $one_op;
-        $prev_src = $src if ( $suffix eq '_cgp' || $suffix eq '_switch' );
-        $prev_index = $index;
-    }
-    $index++;
-}
-
-if ( $suffix =~ /cg/ ) {
-    print $SOURCE @cg_jump_table;
-    print $SOURCE <<END_C;
-        NULL
-    };
-END_C
-    print $SOURCE $trans->run_core_after_addr_table($bs);
-}
-
-if ( $suffix =~ /cgp/ ) {
-    print $SOURCE <<END_C;
-#ifdef __GNUC__
-# ifdef I386
-    else if (cur_opcode == (void **) 1)
-    asm ("jmp *4(%ebp)");  /* jump to ret addr, used by JIT */
-# endif
-#endif
-    _reg_base = (char*)interp->ctx.bp.regs_i;
-    goto **cur_opcode;
-
-END_C
-}
-elsif ( $suffix =~ /cg/ ) {
-    print $SOURCE <<END_C;
-goto *${bs}ops_addr[*cur_opcode];
-
-END_C
-}
-
-print $SOURCE <<END_C;
-/*
-** Op Function Definitions:
-*/
-
-END_C
-
-#
-# Finish the SOURCE file's array initializer:
-#
-my $CORE_SPLIT = 300;
-for ( my $i = 0 ; $i < @op_funcs ; $i++ ) {
-    if ( $i && $i % $CORE_SPLIT == 0 && $trans->can("run_core_split") ) {
-        print $SOURCE $trans->run_core_split($base);
-    }
-    print $SOURCE $op_funcs[$i];
-}
-
-if ( $trans->can("run_core_finish") ) {
-    print $SOURCE $trans->run_core_finish($base);
-}
-
-#
-# reset #line in the SOURCE file.
-#
-
-close($SOURCE);
-open( $SOURCE, '<', $source ) || die "Error re-reading $source: $!\n";
-my $line = 0;
-while (<$SOURCE>) { $line++; }
-$line += 2;
-close($SOURCE);
-open( $SOURCE, '>>', $source ) || die "Error appending to $source: $!\n";
-unless ($nolines_flag) {
-    my $source_escaped = $source;
-    $source_escaped =~ s|\.temp||;
-    $source_escaped =~ s|(\\)|$1$1|g;    # escape backslashes
-    print $SOURCE qq{#line $line "$source_escaped"\n};
-}
-
-#
-# write op_func_func
-#
-
-my ( $op_info, $op_func, $getop );
-$op_info = $op_func = 'NULL';
-$getop = '( int (*)(const char *, int) )NULL';
-
-if ( $suffix eq '' ) {
-    $op_func = "${bs}op_func_table";
-    print $SOURCE <<END_C;
-
-INTVAL ${bs}numops${suffix} = $num_ops;
-
-/*
-** Op Function Table:
-*/
-
-static op_func${suffix}_t ${op_func}\[$num_entries] = {
-END_C
-
-    print $SOURCE @op_func_table;
-
-    print $SOURCE <<END_C;
-  (op_func${suffix}_t)0  /* NULL function pointer */
-};
-
-
-END_C
-}
-
-my ( %names, $tot );
-if ( $suffix eq '' ) {
-    $op_info = "${bs}op_info_table";
-
-    #
-    # Op Info Table:
-    #
-    print $SOURCE <<END_C;
-
-/*
-** Op Info Table:
-*/
-
-static op_info_t $op_info\[$num_entries] = {
-END_C
-
-    $index = 0;
-
-    foreach my $op ( $ops->ops ) {
-        my $type = sprintf( "PARROT_%s_OP", uc $op->type );
-        my $name = $op->name;
-        $names{$name} = 1;
-        my $full_name = $op->full_name;
-        my $func_name = $op->func_name($trans);
-        my $body      = $op->body;
-        my $jump      = $op->jump || 0;
-        my $arg_count = $op->size;
-
-        ## 0 inserted if arrays are empty to prevent msvc compiler errors
-        my $arg_types = "{ "
-            . join( ", ",
-            scalar $op->arg_types
-            ? map { sprintf( "PARROT_ARG_%s", uc $_ ) } $op->arg_types
-            : 0 )
-            . " }";
-        my $arg_dirs = "{ "
-            . join(
-            ", ", scalar $op->arg_dirs
-            ? map { $arg_dir_mapping{$_} } $op->arg_dirs
-            : 0
-            ) . " }";
-        my $labels = "{ "
-            . join(
-            ", ", scalar $op->labels
-            ? $op->labels
-            : 0
-            ) . " }";
-        my $flags = 0;
-
-        print $SOURCE <<END_C;
-  { /* $index */
-    /* type $type, */
-    "$name",
-    "$full_name",
-    "$func_name",
-    /* "",  body */
-    $jump,
-    $arg_count,
-    $arg_types,
-    $arg_dirs,
-    $labels,
-    $flags
-  },
-END_C
-
-        $index++;
-    }
-    print $SOURCE <<END_C;
-};
-
-END_C
-}
-
-if ( $suffix eq '' && !$dynamic_flag ) {
-    $getop = 'get_op';
-    my $hash_size = 3041;
-    $tot = $index + scalar keys(%names);
-    if ( $hash_size < $tot * 1.2 ) {
-        print STDERR "please increase hash_size ($hash_size) in tools/build/ops2c.pl "
-            . "to a prime number > ", $tot * 1.2, "\n";
-    }
-    print $SOURCE <<END_C;
-
-/*
-** Op lookup function:
-*/
-
-#define NUM_OPS $num_ops
-
-#define OP_HASH_SIZE $hash_size
-
-/* we could calculate a prime somewhat bigger than
- * n of fullnames + n of names
- * for now this should be ok
- *
- * look up an op_code: at first call to op_code() a hash
- * of short and full opcode names is created
- * hash functions are from imcc, thanks to Melvin.
- */
-
-
-typedef struct hop {
-    op_info_t * info;
-    struct hop *next;
-} HOP;
-static HOP **hop;
-
-static void hop_init(void);
-static size_t hash_str(const char * str);
-static void store_op(op_info_t *info, int full);
-
-/* XXX on changing interpreters, this should be called,
-   through a hook */
-
-static void hop_deinit(void);
-
-/*
- * find a short or full opcode
- * usage:
- *
- * interp->op_lib->op_code("set", 0)
- * interp->op_lib->op_code("set_i_i", 1)
- *
- * returns >= 0 (found idx into info_table), -1 if not
- */
-
-static int get_op(const char * name, int full);
-
-static size_t hash_str(const char * str) {
-    size_t key = 0;
-    const char * s;
-    for(s=str; *s; s++)
-        key = key * 65599 + *s;
-    return key;
-}
-
-static void store_op(op_info_t *info, int full) {
-    HOP * const p = mem_sys_allocate(sizeof(HOP));
-    const size_t hidx =
-        hash_str(full ? info->full_name : info->name) % OP_HASH_SIZE;
-    p->info = info;
-    p->next = hop[hidx];
-    hop[hidx] = p;
-}
-static int get_op(const char * name, int full) {
-    HOP * p;
-    const size_t hidx = hash_str(name) % OP_HASH_SIZE;
-    if (!hop) {
-        hop = mem_sys_allocate_zeroed(OP_HASH_SIZE * sizeof(HOP*));
-        hop_init();
-    }
-    for (p = hop[hidx]; p; p = p->next) {
-        if(!strcmp(name, full ? p->info->full_name : p->info->name))
-            return p->info - ${bs}op_lib.op_info_table;
-    }
-    return -1;
-}
-static void hop_init() {
-    size_t i;
-    op_info_t * info = ${bs}op_lib.op_info_table;
-    /* store full names */
-    for (i = 0; i < ${bs}op_lib.op_count; i++)
-        store_op(info + i, 1);
-    /* plus one short name */
-    for (i = 0; i < ${bs}op_lib.op_count; i++)
-        if (get_op(info[i].name, 0) == -1)
-            store_op(info + i, 0);
-}
-static void hop_deinit(void)
-{
-    HOP *p, *next;
-    if (hop) {
-        size_t i;
-        for (i = 0; i < OP_HASH_SIZE; i++)
-            for (p = hop[i]; p; ) {
-                next = p->next;
-                free(p);
-                p = next;
-        }
-        free(hop);
-    }
-    hop = 0;
-}
-
-END_C
-
-}
-else {
-    print $SOURCE <<END_C;
-static void hop_deinit(void) {}
-END_C
-}
-
-print $SOURCE <<END_C;
-
-/*
-** op lib descriptor:
-*/
-
-static op_lib_t ${bs}op_lib = {
-  "$base",              /* name */
-  "$suffix",            /* suffix */
-  $core_type,           /* core_type = PARROT_XX_CORE */
-  0,                    /* flags */
-  $major_version,       /* major_version */
-  $minor_version,       /* minor_version */
-  $patch_version,       /* patch_version */
-  $num_ops,             /* op_count */
-  $op_info,             /* op_info_table */
-  $op_func,             /* op_func_table */
-  $getop                /* op_code() */
-};
-
-END_C
-
-# generate initfunc
-my $init1_code = "";
-if ( $trans->can("init_func_init1") ) {
-    $init1_code = $trans->init_func_init1($base);
-}
-
-my $init_set_dispatch = "";
-if ( $trans->can("init_set_dispatch") ) {
-    $init_set_dispatch = $trans->init_set_dispatch($bs);
-}
-
-print $SOURCE <<END_C;
-op_lib_t *
-$init_func(long init) {
-    /* initialize and return op_lib ptr */
-    if (init == 1) {
-$init1_code
-    return &${bs}op_lib;
-    }
-    /* set op_lib to the passed ptr (in init) */
-    else if (init) {
-$init_set_dispatch
-    }
-    /* deinit - free resources */
-    else {
-    hop_deinit();
-    }
-    return NULL;
-}
-
-END_C
-
-if ($dynamic_flag) {
-    my $load_func = "Parrot_lib_${base}_ops${suffix}_load";
-    print $SOURCE <<END_C;
-/*
- * dynamic lib load function - called once
- */
-
-$sym_export PMC*
-$load_func(Parrot_Interp interp)
-{
-    PMC *lib = pmc_new(interp, enum_class_ParrotLibrary);
-    PMC_struct_val(lib) = (void *) $init_func;
-    dynop_register(interp, lib);
-    return lib;
-}
-END_C
-
-}
-
-# append the C code coda
-print $SOURCE <<END_C;
-
-/*
- * Local variables:
- *   c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
-END_C
-
-close $SOURCE;
-my $final = $source;
-$final =~ s/\.temp//;
-rename $source, $final;
-
-exit 0;
-
 # Local Variables:
 #   mode: cperl
 #   cperl-indent-level: 4
 #   fill-column: 100
 # End:
 # vim: expandtab shiftwidth=4:
+
Index: MANIFEST
===================================================================
--- MANIFEST    (revision 17419)
+++ MANIFEST    (working copy)
@@ -2229,6 +2229,7 @@
 lib/Parrot/Docs/Section/Perl.pm                             [devel]
 lib/Parrot/Docs/Section/Tests.pm                            [devel]
 lib/Parrot/Docs/Section/Tools.pm                            [devel]
+lib/Parrot/IO/Capture/Mini.pm                               [devel]
 lib/Parrot/IO/Directory.pm                                  [devel]
 lib/Parrot/IO/File.pm                                       [devel]
 lib/Parrot/IO/Path.pm                                       [devel]
@@ -2240,6 +2241,8 @@
 lib/Parrot/OpTrans/CPrederef.pm                             [devel]
 lib/Parrot/OpTrans/CSwitch.pm                               [devel]
 lib/Parrot/OpTrans/Compiled.pm                              [devel]
+lib/Parrot/Ops2c/Auxiliary.pm                               [devel]
+lib/Parrot/Ops2c/Utils.pm                                   [devel]
 lib/Parrot/Ops2pm/Auxiliary.pm                              [devel]
 lib/Parrot/Ops2pm/Utils.pm                                  [devel]
 lib/Parrot/OpsFile.pm                                       [devel]
@@ -2957,6 +2960,16 @@
 t/stm/queue.t                                               []
 t/stm/runtime.t                                             []
 t/stress/gc.t                                               []
+t/tools/ops2cutils/01-new.t                                 []
+t/tools/ops2cutils/02-usage.t                               []
+t/tools/ops2cutils/03-print_c_header_file.t                 []
+t/tools/ops2cutils/04-print_c_source_top.t                  []
+t/tools/ops2cutils/05-print_c_source_bottom.t               []
+t/tools/ops2cutils/06-dynamic.t                             []
+t/tools/ops2cutils/07-make_incdir.t                         []
+t/tools/ops2cutils/08-nolines.t                             []
+t/tools/ops2cutils/09-dynamic_nolines.t                     []
+t/tools/ops2cutils/testlib/GenerateCore.pm                  []
 t/tools/ops2pmutils/00-qualify.t                            []
 t/tools/ops2pmutils/01-ops2pmutils.t                        []
 t/tools/ops2pmutils/02-usage.t                              []
Index: lib/Parrot/Ops2c/Auxiliary.pm
===================================================================
--- lib/Parrot/Ops2c/Auxiliary.pm       (revision 0)
+++ lib/Parrot/Ops2c/Auxiliary.pm       (revision 0)
@@ -0,0 +1,133 @@
+# Copyright (C) 2007, The Perl Foundation.
+# $Id: Auxiliary.pm 17373 2007-03-07 00:58:56Z jkeenan $
+package Parrot::Ops2c::Auxiliary;
+use strict;
+use warnings;
+use vars qw(@ISA @EXPORT_OK);
+@ISA = qw( Exporter );
+@EXPORT_OK = qw( Usage getoptions );
+use Getopt::Long qw(:config permute);
+
+sub Usage {
+    my $usage_msg = <<USAGE;
+    % perl tools/build/ops2c.pl trans [--help] [--no-lines] [--dynamic]
+                                      [--core | input.ops [input2.ops ...]]
+       trans := C | CGoto | CGP | CSwitch | CPrederef
+
+For example:
+
+    % perl tools/build/ops2c.pl C --core
+
+    % perl tools/build/ops2c.pl C --dynamic myops.ops
+
+USAGE
+    print STDERR $usage_msg;
+    return 1;
+}
+
+sub getoptions {
+    my %flags;
+    GetOptions(
+        "no-lines"  => \$flags{nolines},
+        "help"      => \$flags{help},
+        "dynamic|d" => \$flags{dynamic},
+        "core"      => \$flags{core},
+    );
+    return \%flags;
+}
+
+1;
+
+#################### DOCUMENTATION ####################
+
+=head1 NAME
+
+Parrot::Ops2c::Auxiliary - Non-method subroutines holding functionality for
+F<tools/build/ops2c.pl>.
+
+=head1 SYNOPSIS
+
+    use Parrot::Ops2c::Auxiliary qw( Usage getoptions );
+    
+    Usage();
+
+    $flagref = getoptions();
+
+=cut
+
+=head1 DESCRIPTION
+
+Parrot::Ops2c::Auxiliary provides subroutines called by F<tools/build/ops2c.pl>, a
+program which is called at various points in the Parrot F<make> process.
+This package is intended to hold subroutines used by that program I<other
+than> the object-oriented methods provided by Parrot::Ops2c::Utils.
+
+Extraction of the subroutines exported by this package from
+F<tools/build/ops2c.pl> facilitates the testing of their functionality by the
+tests in F<t/tools/ops2cutils/*.t>.
+
+=head1 SUBROUTINES
+
+=head2 C<Usage()>
+
+=over 4
+
+=item * Purpose
+
+Display a short description of how to use F<tools/build/ops2c.pl> on
+standard output.
+
+    usage: tools/build/ops2pm.pl [--help] [--no-lines] input.ops [input2.ops ...]
+
+=item * Arguments
+
+None.
+
+=item * Return Value
+
+Implicitly returns true upon successful printing.
+
+=back
+
+=head2 C<getoptions>
+
+=over 4
+
+=item * Purpose
+
+Process arguments provided on command-line to F<tools/build/ops2c.pl>.
+
+=item * Arguments
+
+None.
+
+=item * Return Value
+
+Hash reference where any of the following keys may or may not be defined.
+
+   no-lines
+   help
+   renum
+
+=item * Comment
+
+A wrapper around Getopt::Long::GetOptions() designed to assure testability.
+
+=back
+
+=head1 AUTHOR
+
+Jim Keenan (refactoring code originally found in F<tools/build/ops2c.pl>).
+
+=head1 SEE ALSO
+
+=over 4
+
+=item * Parrot::Ops2c::Utils.
+
+=item * F<tools/build/ops2c.pl>.
+
+=back
+
+=cut
+
Index: lib/Parrot/Ops2c/Utils.pm
===================================================================
--- lib/Parrot/Ops2c/Utils.pm   (revision 0)
+++ lib/Parrot/Ops2c/Utils.pm   (revision 0)
@@ -0,0 +1,1024 @@
+# Copyright (C) 2007, The Perl Foundation.
+# $Id: Utils.pm 17373 2007-03-07 00:58:56Z jkeenan $
+package Parrot::Ops2c::Utils;
+use strict;
+use lib ("lib/");
+use Parrot::OpLib::core;
+use Parrot::OpsFile;
+
+=head1 NAME
+
+Parrot::Ops2c::Utils - Methods holding functionality for F<tools/build/ops2c.pl>.
+
+=head1 SYNOPSIS
+
+    $self = Parrot::Ops2c::Utils->new( {
+        argv    => [ @ARGV ],
+        flag    => Parrot::Ops2c::Auxiliary::getoptions(),
+        script  => $0,
+    } );
+
+    $c_header = $self->print_c_header_file();
+
+    $SOURCE = $self->print_c_source_top();
+
+    $c_source = $self->print_c_source_bottom($SOURCE);
+
+=head1 DESCRIPTION
+
+Parrot::Ops2c::Utils provides methods called by F<tools/build/ops2c.pl>, a
+program which is called at various points in the Parrot F<make> process.
+The program's function is to create a pair of C header (F<*.h>) and
+implementation (F<*.c>) files from the operation definitions found in
+one or more F<*.ops> files.
+
+The functionality originally found in F<tools/build/ops2c.pl> has been
+extracted into this package's methods in order to support component-focused
+testing and future refactoring.
+
+=head1 METHODS
+
+=head2 C<new()>
+
+=over 4
+
+=item * Purpose
+
+Process command-line arguments provided to F<tools/build/ops2c.pl>; construct
+and initialize a Parrot::Ops2c::Utils object.
+
+=item * Arguments
+
+Hash reference with the following elements:
+
+    argv        :   reference to @ARGV
+    flag        :   hash reference which is the return value of
+                    Parrot::Ops2c::Utils::getoptions();
+                    hash will have keys such as 'core', 'dynamic' or 'nolines'
+    script      :   name of the script to be executed by 'make'
+                    (generally, $0 or tools/build/ops2c.pl)
+
+=item * Return Value
+
+Parrot::Ops2c::Utils object.  At this point, the caller is ready to open a
+handle to the C-header file and write to it.
+
+=item * Comment
+
+Arguments for the constructor have been selected so as to provide
+subsequent methods with all information needed to execute properly and to be
+testable.
+
+=back
+
+=cut
+
+sub new {
+    my ($class, $argsref) = @_;
+    unless (defined $argsref->{flag}) {
+        print STDERR "Parrot::Ops2c::Utils::new() requires reference to hash of command-line options: $!";
+        return;
+    }
+    my $flagref = $argsref->{flag};
+    my @argv = @{$argsref->{argv}};
+    $argsref->{script} ||= "tools/build/ops2c.pl";
+    unless (@argv) {
+        print STDERR "Parrot::Ops2c::Utils::new() requires 'trans' options: $!";
+        return;
+    };
+    my $class_name = shift @argv;
+    my %is_allowed = map { $_ => 1 } qw(C CGoto CGP CSwitch CPrederef);
+    unless ($is_allowed{$class_name}) {
+        print STDERR "Parrot::Ops2c::Utils::new() requires C, CGoto, CGP, CSwitch and/or  CPrederef: $!";
+        return;
+    };
+
+    my $trans_class = "Parrot::OpTrans::" . $class_name;
+    eval "require $trans_class";
+    my $trans   = $trans_class->new();
+    # Don't yet know how to test the following.
+    unless (defined $trans) {
+        print STDERR "Unable to construct $trans object: $!";
+        return;
+    };
+
+    my $suffix  = $trans->suffix();     # Invoked (sometimes) as ${suffix}
+
+    my $file = $flagref->{core} ? 'core.ops' : shift @argv;
+    my $base = $file;   # Invoked (sometimes) as ${base}
+    $base =~ s/\.ops$//;
+    my $base_ops_stub = $base . q{_ops} . $suffix;
+    my $base_ops_h    = $base_ops_stub . q{.h};
+
+    my $incdir  = "include/parrot/oplib";
+    my $include = "parrot/oplib/$base_ops_h";
+    my $header  = "include/$include";
+
+    # SOURCE is closed and reread, which confuses make -j
+    # create a temp file and rename it
+    my $source = "src/ops/$base_ops_stub.c.temp";
+
+    if ( $flagref->{dynamic} ) {
+        $source             =~ s!src/ops/!!;
+        $header             = $base_ops_h;
+        $base               =~ s!^.*[/\\]!!;
+        $include            = $base_ops_h;
+        $flagref->{dynamic} = 1;
+    }
+
+    my $sym_export = $flagref->{dynamic}
+        ? 'PARROT_DYNEXT_EXPORT'
+        : 'PARROT_API';
+
+    my $ops;
+    if ($flagref->{core}) {
+        $ops = _prepare_core( {
+            file        => $file,
+            flag        => $flagref,
+        } );
+    }
+    else {
+        $ops = _prepare_non_core( {
+            file        => $file,
+            argv        => [ @argv ],
+            flag        => $flagref,
+            script      => $argsref->{script},
+        } );
+    }
+
+    my %versions = (
+        major => $ops->major_version,
+        minor => $ops->minor_version,
+        patch => $ops->patch_version,
+    );
+    my $num_ops       = scalar $ops->ops;
+    my $num_entries   = $num_ops + 1;          # For trailing NULL
+
+    if ( ! $flagref->{dynamic} && ! -d $incdir ) {
+        mkdir( $incdir, 0755 )
+            or die "ops2c.pl: Could not mkdir $incdir $!!\n";
+    }
+
+    my $preamble = _compose_preamble($file, $argsref->{script});
+
+    my $init_func = join q{_}, (
+        q{Parrot},
+        q{DynOp},
+        $base . $suffix,
+        @versions{ qw(major minor patch) },
+    );
+
+    ##### Populate the object #####
+    $argsref->{argv} = \@argv;
+    $argsref->{trans} = $trans;
+    $argsref->{suffix} = $suffix;
+
+    $argsref->{file} = $file;
+    $argsref->{base} = $base;
+    $argsref->{incdir} = $incdir;
+    $argsref->{include} = $include;
+    $argsref->{header} = $header;
+    $argsref->{source} = $source;
+    $argsref->{sym_export} = $sym_export;
+
+    $argsref->{ops} = $ops;
+    $argsref->{versions} = \%versions;
+    $argsref->{num_ops} = $num_ops;
+    $argsref->{num_entries} = $num_entries;
+
+    $argsref->{preamble} = $preamble;
+    $argsref->{init_func} = $init_func;
+
+    $argsref->{flag} = $flagref;
+    return bless $argsref, $class;
+}
+
+sub _prepare_core {
+    my $argsref = shift;
+    my $ops = Parrot::OpsFile->new(
+        [ qq|src/ops/$argsref->{file}| ],
+        $argsref->{flag}->{nolines},
+    );
+    $ops->{OPS}      = $Parrot::OpLib::core::ops;
+    $ops->{PREAMBLE} = $Parrot::OpLib::core::preamble;
+    return $ops;
+}
+
+sub _prepare_non_core {
+    my $argsref = shift;
+    my %opsfiles;
+    my @opsfiles;
+
+    foreach my $f ( $argsref->{file}, @{$argsref->{argv}} ) {
+        if ( $opsfiles{$f} ) {
+            print STDERR "$argsref->{script}: Ops file '$f' mentioned more than once!\n";
+            next;
+        }
+
+        $opsfiles{$f} = 1;
+        push @opsfiles, $f;
+
+        die "$argsref->{script}: Could not read ops file '$f'!\n" unless -r $f;
+    }
+
+    my $ops = Parrot::OpsFile->new( \@opsfiles, $argsref->{flag}->{nolines} );
+
+    my $cur_code = 0;
+    for my $el ( @{ $ops->{OPS} } ) {
+        $el->{CODE} = $cur_code++;
+    }
+    return $ops;
+}
+
+sub _compose_preamble {
+    my ($file, $script) = @_;
+    my $preamble = <<END_C;
+/* ex: set ro:
+ * !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
+ *
+ * This file is generated automatically from '$file' (and possibly other
+ * .ops files). by $script.
+ *
+ * Any changes made here will be lost!
+ *
+ */
+
+END_C
+    return $preamble;
+}
+
+=head2 C<print_header_file()>
+
+=over 4
+
+=item * Purpose
+
+Creates a C-header file corresponding to a particular op.  Such files will
+have names like these:
+
+    include/parrot/oplib/core_ops.h
+    include/parrot/oplib/myops_ops_switch.h
+
+=item * Arguments
+
+None.  (All data needed is already in the object.)
+
+=item * Return Value
+
+Returns the name of the C-header file created.  You do not need to capture or
+make use of this return value during production, but it has proven useful in
+testing.
+
+=item * Comment
+
+=back
+
+=cut
+
+sub print_c_header_file {
+    my $self = shift;
+
+    open my $HEADER, '>', $self->{header}
+        or die "ops2c.pl: Cannot open header file '$self->{header}' for writing: $!!\n";
+
+    $self->_print_preamble_header($HEADER);
+
+    $self->_print_run_core_func_decl_header($HEADER);
+
+    _print_coda($HEADER);
+
+    close $HEADER or die "Unable to close handle to $self->{header}: $!";
+    (-e $self->{header}) or die "$self->{header} not created: $!";
+    (-s $self->{header}) or die "$self->{header} has 0 size: $!";
+    return $self->{header};
+}
+
+sub _print_preamble_header {
+    my ($self, $fh) = @_;
+
+    print $fh $self->{preamble};
+    if ($self->{flag}->{dynamic}) {
+        print $fh "#define PARROT_IN_EXTENSION\n";
+    }
+    print $fh <<END_C;
+#include "parrot/parrot.h"
+#include "parrot/oplib.h"
+
+$self->{sym_export} extern op_lib_t *$self->{init_func}(long init);
+
+END_C
+}
+
+sub _print_run_core_func_decl_header {
+    my ($self, $fh) = @_;
+
+    if ( $self->{trans}->can("run_core_func_decl") ) {
+        my $run_core_func =
+            $self->{trans}->run_core_func_decl($self->{base});
+        print $fh "$run_core_func;\n";
+    } else {
+        return;
+    }
+}
+
+sub _print_coda {
+    my $fh = shift;
+    print $fh <<END_C;
+
+/*
+ * Local variables:
+ *   c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
+END_C
+}
+
+=head2 C<print_c_source_top()>
+
+=over 4
+
+=item * Purpose
+
+Writes the top half of a C-source file corresponding to a particular op.  
+Such files will have names like these:
+
+    src/ops/core_ops.c
+    src/ops/myops_ops_switch.c
+
+=item * Arguments
+
+None.  (All data needed is already in the object.)
+
+=item * Return Value
+
+Returns a still-open filehandle to the C-source file.
+
+=item * Comment
+
+B<Q:>  Why does this method write only the top-half of the C-source file
+rather than the whole thing?
+
+B<A:>  Mainly for convenience in maintenance and testing.
+Internally, a handle is opened to the file, the file is written to, and the
+handle is closed and returned.  That same handle is then re-opened, a line
+count on the file so far is taken, the handle is closed, then opened again for
+writing the bottom half of the source file.  There are quite a few private
+methods implementing the first and last of these steps.  It made sense to
+group these private methods into two public methods corresponding to the two
+points where the filehandle is opened and the C-source file is written to.
+
+B<Q:>  Why return a filehandle?
+
+B<A:>  It is re-used as an argument to the next method.
+
+=back
+
+=cut
+
+sub print_c_source_top {
+    my $self = shift;
+    $self->{defines} = $self->{trans}->defines();    # Invoked as:  ${defines}
+    $self->{bs} = "$self->{base}$self->{suffix}_";   # Also invoked as ${bs}
+    $self->{opsarraytype} = $self->{trans}->opsarraytype();
+
+    ##### BEGIN printing to $SOURCE #####
+    open my $SOURCE, '>', $self->{source}
+        or die "ops2c.pl: Cannot open source file '$self->{source}' for writing: $!!\n";
+
+    $self->_print_preamble_source($SOURCE);
+
+    $self->_print_ops_addr_decl($SOURCE);
+
+    $self->_print_run_core_func_decl_source($SOURCE);
+
+    # Iterate over the ops, appending HEADER and SOURCE fragments:
+    $self->_iterate_over_ops();
+
+    $self->_print_cg_jump_table($SOURCE);
+
+    $self->_print_goto_opcode($SOURCE);
+
+    $self->_print_op_function_definitions($SOURCE);
+
+    return $SOURCE;
+}
+
+sub _print_preamble_source {
+    my ($self, $fh) = @_;
+
+    print $fh $self->{preamble};
+    print $fh <<END_C;
+#include "$self->{include}"
+
+$self->{defines}
+static op_lib_t $self->{bs}op_lib;
+
+END_C
+
+    my $text = $self->{ops}->preamble($self->{trans});
+    $text =~ s/\bops_addr\b/$self->{bs}ops_addr/g;
+    print $fh $text;
+}
+
+sub _print_ops_addr_decl {
+    my ($self, $fh) = @_;
+
+    if ( $self->{trans}->can("ops_addr_decl") ) {
+        print $fh $self->{trans}->ops_addr_decl($self->{bs});
+    } else {
+        return;
+    }
+}
+
+sub _print_run_core_func_decl_source {
+    my ($self, $fh) = @_;
+
+    if ( $self->{trans}->can("run_core_func_decl") ) {
+        print $fh $self->{trans}->run_core_func_decl($self->{base});
+        print $fh "\n{\n";
+        print $fh $self->{trans}->run_core_func_start;
+    } else {
+        return;
+    }
+}
+
+sub _iterate_over_ops {
+    my $self = shift;
+    my @op_funcs;
+    my @op_func_table;
+    my @cg_jump_table;
+    my $index = 0;
+    my ( $prev_src, $prev_index );
+
+    $prev_src = '';
+    foreach my $op ( $self->{ops}->ops ) {
+        my $func_name = $op->func_name($self->{trans});
+        my $arg_types = "$self->{opsarraytype} *, Interp *";
+        my $prototype = "$self->{sym_export} $self->{opsarraytype} * $func_name ($arg_types)";
+        my $args      = "$self->{opsarraytype} *cur_opcode, Interp *interp";
+        my $definition;
+        my $comment = '';
+        my $one_op  = "";
+
+        if ( $self->{suffix} =~ /cg/ ) {
+            $definition = "PC_$index:";
+            $comment    = "/* " . $op->full_name() . " */";
+        }
+        elsif ( $self->{suffix} =~ /switch/ ) {
+            $definition = "case $index:";
+            $comment    = "/* " . $op->full_name() . " */";
+        }
+        else {
+            $definition = "$prototype;\n$self->{opsarraytype} *\n$func_name ($args)";
+        }
+
+        my $src = $op->source($self->{trans});
+        $src =~ s/\bop_lib\b/$self->{bs}op_lib/g;
+        $src =~ s/\bops_addr\b/$self->{bs}ops_addr/g;
+
+        if ( $self->{suffix} =~ /cg/ ) {
+            if ( $prev_src eq $src ) {
+                push @cg_jump_table, "        &&PC_$prev_index,\n";
+            }
+            else {
+                push @cg_jump_table, "        &&PC_$index,\n";
+            }
+        }
+        elsif ( $self->{suffix} eq '' ) {
+            push @op_func_table, sprintf( "  %-50s /* %6ld */\n", "$func_name,", $index );
+        }
+        if ( $prev_src eq $src ) {
+            push @op_funcs, "$comment\n";
+        }
+        else {
+            $one_op .= "$definition $comment {\n$src}\n\n";
+            push @op_funcs, $one_op;
+            $prev_src = $src if ( $self->{suffix} eq '_cgp' || $self->{suffix} eq '_switch' );
+            $prev_index = $index;
+        }
+        $index++;
+    }
+    $self->{index} =  $index;
+    $self->{op_funcs} = \@op_funcs;
+    $self->{op_func_table} = \@op_func_table;
+    $self->{cg_jump_table} = \@cg_jump_table;
+}
+
+sub _print_cg_jump_table {
+    my ($self, $fh) = @_;
+
+    my @cg_jump_table = @{$self->{cg_jump_table}};
+
+    if ( $self->{suffix} =~ /cg/ ) {
+        print $fh @cg_jump_table;
+        print $fh <<END_C;
+        NULL
+    };
+END_C
+        print $fh $self->{trans}->run_core_after_addr_table($self->{bs});
+    }
+}
+
+sub _print_goto_opcode {
+    my ($self, $fh) = @_;
+
+    if ( $self->{suffix} =~ /cgp/ ) {
+        print $fh <<END_C;
+#ifdef __GNUC__
+# ifdef I386
+    else if (cur_opcode == (void **) 1)
+    asm ("jmp *4(%ebp)");  /* jump to ret addr, used by JIT */
+# endif
+#endif
+    _reg_base = (char*)interp->ctx.bp.regs_i;
+    goto **cur_opcode;
+
+END_C
+    }
+    elsif ( $self->{suffix} =~ /cg/ ) {
+        print $fh <<END_C;
+goto *$self->{bs}ops_addr[*cur_opcode];
+
+END_C
+    }
+    return 1;
+}
+
+sub _print_op_function_definitions {
+    my ($self, $fh) = @_;
+
+    my @op_funcs = @{$self->{op_funcs}};
+    print $fh <<END_C;
+/*
+** Op Function Definitions:
+*/
+
+END_C
+
+    # Finish the SOURCE file's array initializer:
+    my $CORE_SPLIT = 300;
+    for ( my $i = 0 ; $i < @op_funcs ; $i++ ) {
+        if ( $i &&
+            $i % $CORE_SPLIT == 0 &&
+            $self->{trans}->can("run_core_split") )
+        {
+            print $fh $self->{trans}->run_core_split($self->{base});
+        }
+        print $fh $op_funcs[$i];
+    }
+
+    if ( $self->{trans}->can("run_core_finish") ) {
+        print $fh $self->{trans}->run_core_finish($self->{base});
+    }
+    close($fh) || die "Unable to close after writing: $!";
+}
+
+=head2 C<print_c_source_bottom()>
+
+=over 4
+
+=item * Purpose
+
+Writes the bottom half of a C-source file corresponding to a particular op.  
+
+=item * Arguments
+
+One argument:  the filehandle returned by C<print_c_source_top()>.
+
+=item * Return Value
+
+Returns the name of the C-source file created.  You do not need to capture or
+make use of this return value during production, but it has proven useful in
+testing.
+
+=item * Comment
+
+=back
+
+=cut
+
+sub print_c_source_bottom {
+    my ($self, $SOURCE) = @_;
+    my @op_func_table = @{$self->{op_func_table}};
+    my $bs = $self->{bs};
+    my $index = $self->{index};
+
+    $SOURCE = $self->_reset_line_number($SOURCE);
+    
+    $self->_op_func_table($SOURCE);
+    
+    $self->{names} = {};
+    $self->_op_info_table($SOURCE);
+
+    $self->_op_lookup($SOURCE);
+    
+    $self->_print_op_lib_descriptor($SOURCE);
+    
+    $self->_generate_init_func($SOURCE);
+    
+    $self->_print_dynamic_lib_load($SOURCE);
+    
+    _print_coda($SOURCE);
+    
+    close $SOURCE or die "Unable to close handle to $self->{source}: $!";
+    
+    my $c_source_final = $self->_rename_source();
+    return $c_source_final;
+}
+    
+sub _reset_line_number {
+    my ($self, $fh) = @_;
+
+    my $source = $self->{source};
+    my $line = 0;
+    open( $fh, '<', $source ) || die "Error re-reading $source: $!\n";
+    while (<$fh>) { $line++; }
+    $line += 2;
+    close($fh) || die "Error closing $source:  $!";
+    open( $fh, '>>', $source ) || die "Error appending to $source: $!\n";
+    unless ($self->{flag}->{nolines}) {
+        my $source_escaped = $source;
+        $source_escaped =~ s|\.temp||;
+        $source_escaped =~ s|(\\)|$1$1|g;    # escape backslashes
+        print $fh qq{#line $line "$source_escaped"\n};
+    }
+    return $fh;  # filehandle remains open
+}
+
+sub _op_func_table {
+    my ($self, $fh) = @_;
+
+    my ( $op_info, $op_func, $getop );
+    $op_info = $op_func = 'NULL';
+    $getop = '( int (*)(const char *, int) )NULL';
+    
+    if ( $self->{suffix} eq '' ) {
+        $op_func = $self->{bs} . q{op_func_table};
+        print $fh <<END_C;
+
+INTVAL $self->{bs}numops$self->{suffix} = $self->{num_ops};
+
+/*
+** Op Function Table:
+*/
+
+static op_func$self->{suffix}_t ${op_func}\[$self->{num_entries}] = {
+END_C
+
+        print $fh @{$self->{op_func_table}};
+
+        print $fh <<END_C;
+  (op_func$self->{suffix}_t)0  /* NULL function pointer */
+};
+
+
+END_C
+    }
+    $self->{op_info} = $op_info;
+    $self->{op_func} = $op_func;
+    $self->{getop} = $getop;
+}
+
+sub _op_info_table {
+    my ($self, $fh) = @_;
+
+    my %names = %{$self->{names}};
+    my %arg_dir_mapping = (
+        ''   => 'PARROT_ARGDIR_IGNORED',
+        'i'  => 'PARROT_ARGDIR_IN',
+        'o'  => 'PARROT_ARGDIR_OUT',
+        'io' => 'PARROT_ARGDIR_INOUT'
+    );
+
+    if ( $self->{suffix} eq '' ) {
+        $self->{op_info} = "$self->{bs}op_info_table";
+    
+        #
+        # Op Info Table:
+        #
+        print $fh <<END_C;
+
+/*
+** Op Info Table:
+*/
+
+static op_info_t $self->{op_info}\[$self->{num_entries}] = {
+END_C
+
+        $self->{index} = 0;
+    
+        foreach my $op ( $self->{ops}->ops ) {
+            my $type = sprintf( "PARROT_%s_OP", uc $op->type );
+            my $name = $op->name;
+            $names{$name} = 1;
+            my $full_name = $op->full_name;
+            my $func_name = $op->func_name($self->{trans});
+            my $body      = $op->body;
+            my $jump      = $op->jump || 0;
+            my $arg_count = $op->size;
+    
+            ## 0 inserted if arrays are empty to prevent msvc compiler errors
+            my $arg_types = "{ "
+                . join( ", ",
+                scalar $op->arg_types
+                ? map { sprintf( "PARROT_ARG_%s", uc $_ ) } $op->arg_types
+                : 0 )
+                . " }";
+            my $arg_dirs = "{ "
+                . join(
+                ", ", scalar $op->arg_dirs
+                ? map { $arg_dir_mapping{$_} } $op->arg_dirs
+                : 0
+                ) . " }";
+            my $labels = "{ "
+                . join(
+                ", ", scalar $op->labels
+                ? $op->labels
+                : 0
+                ) . " }";
+            my $flags = 0;
+    
+            print $fh <<END_C;
+  { /* $self->{index} */
+    /* type $type, */
+    "$name",
+    "$full_name",
+    "$func_name",
+    /* "",  body */
+    $jump,
+    $arg_count,
+    $arg_types,
+    $arg_dirs,
+    $labels,
+    $flags
+  },
+END_C
+
+            $self->{index}++;
+        }
+        print $fh <<END_C;
+};
+
+END_C
+    }
+}
+
+sub _op_lookup {
+    my ($self, $fh) = @_;
+
+    if ( $self->{suffix} eq '' && !$self->{flag}->{dynamic} ) {
+        $self->{getop} = 'get_op';
+        my $hash_size = 3041;
+        my $tot = $self->{index} + scalar keys(%{$self->{names}});
+        if ( $hash_size < $tot * 1.2 ) {
+            print STDERR "please increase hash_size ($hash_size) in lib/Parrot/Ops2c/Utils.pm "
+                . "to a prime number > ", $tot * 1.2, "\n";
+        }
+        print $fh <<END_C;
+
+/*
+** Op lookup function:
+*/
+
+#define NUM_OPS $self->{num_ops}
+
+#define OP_HASH_SIZE $hash_size
+
+/* we could calculate a prime somewhat bigger than
+ * n of fullnames + n of names
+ * for now this should be ok
+ *
+ * look up an op_code: at first call to op_code() a hash
+ * of short and full opcode names is created
+ * hash functions are from imcc, thanks to Melvin.
+ */
+
+
+typedef struct hop {
+    op_info_t * info;
+    struct hop *next;
+} HOP;
+static HOP **hop;
+
+static void hop_init(void);
+static size_t hash_str(const char * str);
+static void store_op(op_info_t *info, int full);
+
+/* XXX on changing interpreters, this should be called,
+   through a hook */
+
+static void hop_deinit(void);
+
+/*
+ * find a short or full opcode
+ * usage:
+ *
+ * interp->op_lib->op_code("set", 0)
+ * interp->op_lib->op_code("set_i_i", 1)
+ *
+ * returns >= 0 (found idx into info_table), -1 if not
+ */
+
+static int get_op(const char * name, int full);
+
+static size_t hash_str(const char * str) {
+    size_t key = 0;
+    const char * s;
+    for(s=str; *s; s++)
+        key = key * 65599 + *s;
+    return key;
+}
+
+static void store_op(op_info_t *info, int full) {
+    HOP * const p = mem_sys_allocate(sizeof(HOP));
+    const size_t hidx =
+        hash_str(full ? info->full_name : info->name) % OP_HASH_SIZE;
+    p->info = info;
+    p->next = hop[hidx];
+    hop[hidx] = p;
+}
+static int get_op(const char * name, int full) {
+    HOP * p;
+    const size_t hidx = hash_str(name) % OP_HASH_SIZE;
+    if (!hop) {
+        hop = mem_sys_allocate_zeroed(OP_HASH_SIZE * sizeof(HOP*));
+        hop_init();
+    }
+    for (p = hop[hidx]; p; p = p->next) {
+        if(!strcmp(name, full ? p->info->full_name : p->info->name))
+            return p->info - $self->{bs}op_lib.op_info_table;
+    }
+    return -1;
+}
+static void hop_init() {
+    size_t i;
+    op_info_t * info = $self->{bs}op_lib.op_info_table;
+    /* store full names */
+    for (i = 0; i < $self->{bs}op_lib.op_count; i++)
+        store_op(info + i, 1);
+    /* plus one short name */
+    for (i = 0; i < $self->{bs}op_lib.op_count; i++)
+        if (get_op(info[i].name, 0) == -1)
+            store_op(info + i, 0);
+}
+static void hop_deinit(void)
+{
+    HOP *p, *next;
+    if (hop) {
+        size_t i;
+        for (i = 0; i < OP_HASH_SIZE; i++)
+            for (p = hop[i]; p; ) {
+                next = p->next;
+                free(p);
+                p = next;
+        }
+        free(hop);
+    }
+    hop = 0;
+}
+
+END_C
+    } else {
+        print $fh <<END_C;
+static void hop_deinit(void) {}
+END_C
+    }
+}
+
+sub _print_op_lib_descriptor {
+    my ($self, $fh) = @_;
+
+    my $core_type = $self->{trans}->core_type();
+    print $fh <<END_C;
+
+/*
+** op lib descriptor:
+*/
+
+static op_lib_t $self->{bs}op_lib = {
+  "$self->{base}",               /* name */
+  "$self->{suffix}",             /* suffix */
+  $core_type,                       /* core_type = PARROT_XX_CORE */
+  0,                                /* flags */
+  $self->{versions}->{major},    /* major_version */
+  $self->{versions}->{minor},    /* minor_version */
+  $self->{versions}->{patch},    /* patch_version */
+  $self->{num_ops},              /* op_count */
+  $self->{op_info},              /* op_info_table */
+  $self->{op_func},              /* op_func_table */
+  $self->{getop}                 /* op_code() */
+};
+
+END_C
+}
+
+sub _generate_init_func {
+    my ($self, $fh) = @_;
+
+    my $init1_code = "";
+    if ( $self->{trans}->can("init_func_init1") ) {
+        $init1_code = $self->{trans}->init_func_init1($self->{base});
+    }
+    
+    my $init_set_dispatch = "";
+    if ( $self->{trans}->can("init_set_dispatch") ) {
+        $init_set_dispatch
+            = $self->{trans}->init_set_dispatch($self->{bs});
+    }
+    
+    print $fh <<END_C;
+op_lib_t *
+$self->{init_func}(long init) {
+    /* initialize and return op_lib ptr */
+    if (init == 1) {
+$init1_code
+    return &$self->{bs}op_lib;
+    }
+    /* set op_lib to the passed ptr (in init) */
+    else if (init) {
+$init_set_dispatch
+    }
+    /* deinit - free resources */
+    else {
+    hop_deinit();
+    }
+    return NULL;
+}
+
+END_C
+}
+
+sub _print_dynamic_lib_load {
+    my ($self, $fh) = @_;
+
+    if ($self->{flag}->{dynamic}) {
+        my $load_func = join q{_}, (
+            q{Parrot},
+            q{lib},
+            $self->{base},
+            (q{ops} . $self->{suffix}),
+            q{load},
+        );
+        print $fh <<END_C;
+/*
+ * dynamic lib load function - called once
+ */
+
+$self->{sym_export} PMC*
+$load_func(Parrot_Interp interp)
+{
+    PMC *lib = pmc_new(interp, enum_class_ParrotLibrary);
+    PMC_struct_val(lib) = (void *) $self->{init_func};
+    dynop_register(interp, lib);
+    return lib;
+}
+END_C
+    }
+}
+
+sub _rename_source {
+    my $self = shift;
+
+    my $final = $self->{source};
+    $final =~ s/\.temp//;
+    rename $self->{source}, $final
+        or die "Unable to rename $self->{source} to $final: $!";
+    return $final;
+}
+
+1;
+
+=head1 DEPENDENCIES
+
+=over 4
+
+=item * Parrot::OpsFile
+
+=item * Parrot::OpLib::core
+
+This package is not part of the Parrot distribution.  It is created during
+Parrot's F<make> process before the first invocation of F<tools/build/ops2c.pl>.
+
+=back
+
+=head1 AUTHOR
+
+See F<tools/build/ops2c.pl> for a list of the Parrot hackers who, over a
+period of several years, developed the functionality now found in the methods
+of Parrot::Ops2c::Utils.  Jim Keenan extracted that functionality and placed
+it in this package's methods.
+
+=head1 SEE ALSO
+
+=over 4
+
+=item * F<tools/build/ops2c.pl>
+
+=item * Parrot::OpsFile
+
+=item * Parrot::Ops2c::Auxiliary
+
+=back
+
+=cut
Index: lib/Parrot/IO/Capture/Mini.pm
===================================================================
--- lib/Parrot/IO/Capture/Mini.pm       (revision 0)
+++ lib/Parrot/IO/Capture/Mini.pm       (revision 0)
@@ -0,0 +1,70 @@
+# Copyright (C) 2007, The Perl Foundation.
+# $Id: Mini.pm 17373 2007-03-07 00:58:56Z jkeenan $
+package Parrot::IO::Capture::Mini;
+use strict;
+
+sub TIEHANDLE {
+    my $class = shift;
+    bless [], $class;
+}
+
+sub PRINT {
+     my $self = shift;
+     push @$self, join '',@_;
+}
+
+sub READLINE {
+    my $self = shift;
+    return wantarray ? @$self : shift @$self;
+}
+
+1;
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+Parrot::IO::Capture::Mini - capture messages printed to STDOUT or STDERR during Parrot testing
+
+=head1 SYNOPSIS
+
+    use Parrot::IO::Capture::Mini;
+
+Tie C<STDOUT> or C<STDERR>.
+
+    $tie = tie *STDERR, "Parrot::IO::Capture::Mini" or croak "Unable to tie";
+
+Call a function which is likely to generate a warning or error message.
+
+    $self = Parrot::Ops2c::Utils->new( {
+        argv            => [ qw( CSwitch  dan.ops dan.ops ) ],
+        flag            => { dynamic => 1 },
+    } );
+
+Store what was captured in a variable, then C<untie>.
+
+    $msg = $tie->READLINE;
+    untie *STDERR or croak "Unable to untie";
+
+Use that variable in a test.
+
+    like($msg,
+        qr/Ops file 'dan\.ops' mentioned more than once!/,
+        "Got expected error message about mentioning same file twice");
+
+=head1 DESCRIPTION
+
+This package provides the bare minimum level of functionality needed to
+capture messages printed to C<STDOUT> or C<STDERR> by Parrot build tools
+written in Perl 5.
+
+=head1 AUTHOR
+
+Adapted by Jim Keenan from CPAN module IO::Capture::Tie_STDx.  Thanks as
+always to the authors of IO::Capture, Mark Reynolds and Jon Morgan!
+
+=head1 SEE ALSO
+
+IO::Capture (L<http://search.cpan.org/dist/IO-Capture/>).
+
+=cut
Index: t/tools/ops2cutils/04-print_c_source_top.t
===================================================================
--- t/tools/ops2cutils/04-print_c_source_top.t  (revision 0)
+++ t/tools/ops2cutils/04-print_c_source_top.t  (revision 0)
@@ -0,0 +1,117 @@
+#! perl
+# Copyright (C) 2007, The Perl Foundation.
+# $Id: 04-print_c_source_top.t 17373 2007-03-07 00:58:56Z jkeenan $
+# 04-print_c_source_top.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 =>  27;
+use Carp;
+use Cwd;
+use File::Copy;
+use File::Temp (qw| tempdir |);
+use_ok( 'Parrot::Ops2pm::Utils' );
+use lib ("$main::topdir/t/tools/ops2cutils/testlib");
+use_ok( "GenerateCore", qw| generate_core | );
+
+my @srcopsfiles = qw( src/ops/core.ops src/ops/bit.ops src/ops/cmp.ops
+src/ops/debug.ops src/ops/experimental.ops src/ops/io.ops src/ops/math.ops
+src/ops/object.ops src/ops/pic.ops src/ops/pmc.ops src/ops/set.ops
+src/ops/stack.ops src/ops/stm.ops src/ops/string.ops src/ops/sys.ops
+src/ops/var.ops );
+my $num = "src/ops/ops.num";
+my $skip = "src/ops/ops.skip";
+
+ok(chdir $main::topdir, "Positioned at top-level Parrot directory");
+my $cwd = cwd();
+
+{
+    my $tdir = tempdir( CLEANUP => 1 );
+    ok(chdir $tdir, 'changed to temp directory for testing');
+
+    my $tlib = generate_core(
+        $cwd, $tdir, \@srcopsfiles, $num, $skip);
+
+    ok(-d $tlib, "lib directory created under tempdir");
+    unshift @INC, $tlib;
+    require Parrot::Ops2c::Utils;
+
+    test_print_c_source_top( [ qw( C ) ] );
+    test_print_c_source_top( [ qw( CGoto ) ] );
+    test_print_c_source_top( [ qw( CGP ) ] );
+    test_print_c_source_top( [ qw( CSwitch ) ] );
+    test_print_c_source_top( [ qw( C CGoto CGP CSwitch CPrederef ) ] );
+
+    ok(chdir($cwd), "returned to starting directory");
+}
+
+sub test_print_c_source_top {
+    my $local_argv_ref = shift;
+    {
+        my $self = Parrot::Ops2c::Utils->new( {
+            argv            => $local_argv_ref,
+            flag            => { core => 1 },
+        } );
+        ok(defined $self,
+            "Constructor correctly returned when provided with argument(s): @{$local_argv_ref}");
+
+        my $c_header_file = $self->print_c_header_file();
+        ok(-e $c_header_file, "$c_header_file created");
+        ok(-s $c_header_file, "$c_header_file has non-zero size");
+
+        my $SOURCE = $self->print_c_source_top();
+        is(ref($SOURCE), q{GLOB}, "Argument type is filehandle (typeglob)");
+    }
+}
+
+pass("Completed all tests in $0");
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+04-print_c_source_top.t - test C<Parrot::Ops2c::Utils::print_c_source_top()>
+
+=head1 SYNOPSIS
+
+    % prove t/tools/ops2cutils/04-print_c_source_top.t
+
+=head1 DESCRIPTION
+
+The files in this directory test the publicly callable subroutines of
+F<lib/Parrot/Ops2c/Utils.pm> and F<lib/Parrot/Ops2c/Auxiliary.pm>.  
+By doing so, they test the functionality of the F<ops2c.pl> utility.  
+That functionality has largely been extracted
+into the methods of F<Utils.pm>.
+
+All the files in this directory are intended to be run B<after>
+F<Configure.pl> has been run but before F<make> has been called.  Hence, they
+are B<not> part of the test suite run by F<make test>.   Once you have run
+F<Configure.pl>, however, you may run these tests as part of F<make
+buildtools_tests>.
+
+F<04-print_c_source_top.t> tests whether
+C<Parrot::Ops2c::Utils::print_c_source_top()> work properly.
+
+=head1 AUTHOR
+
+James E Keenan
+
+=head1 SEE ALSO
+
+Parrot::Ops2c::Auxiliary, F<ops2c.pl>.
+
+=cut
+
Index: t/tools/ops2cutils/09-dynamic_nolines.t
===================================================================
--- t/tools/ops2cutils/09-dynamic_nolines.t     (revision 0)
+++ t/tools/ops2cutils/09-dynamic_nolines.t     (revision 0)
@@ -0,0 +1,134 @@
+#! perl
+# Copyright (C) 2007, The Perl Foundation.
+# $Id: 09-dynamic_nolines.t 17373 2007-03-07 00:58:56Z jkeenan $
+# 09-dynamic_nolines.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 =>  63;
+use Carp;
+use Cwd;
+use File::Copy;
+use File::Temp (qw| tempdir |);
+use_ok( 'Parrot::Ops2pm::Utils' );
+use lib ("$main::topdir/t/tools/ops2cutils/testlib");
+use_ok( "GenerateCore", qw| generate_core | );
+
+my @srcopsfiles = qw( src/ops/core.ops src/ops/bit.ops src/ops/cmp.ops
+src/ops/debug.ops src/ops/experimental.ops src/ops/io.ops src/ops/math.ops
+src/ops/object.ops src/ops/pic.ops src/ops/pmc.ops src/ops/set.ops
+src/ops/stack.ops src/ops/stm.ops src/ops/string.ops src/ops/sys.ops
+src/ops/var.ops );
+my $num = "src/ops/ops.num";
+my $skip = "src/ops/ops.skip";
+my @dynopsfiles = qw( src/dynoplibs/dan.ops src/dynoplibs/myops.ops );
+
+
+ok(chdir $main::topdir, "Positioned at top-level Parrot directory");
+my $cwd = cwd();
+
+{
+    my $tdir = tempdir( CLEANUP => 1 );
+    ok(chdir $tdir, 'changed to temp directory for testing');
+
+    my $tlib = generate_core(
+        $cwd, $tdir, \@srcopsfiles, $num, $skip);
+
+    ok(-d $tlib, "lib directory created under tempdir");
+    unshift @INC, $tlib;
+    require Parrot::Ops2c::Utils;
+
+    foreach my $f (@dynopsfiles) {
+        copy (qq{$cwd/$f}, qq{$tdir/$f});
+    }
+    chdir "src/dynoplibs" or croak "Unable to change to src/dynoplibs: $!";
+
+    test_dynops_nolines( [ qw( CGoto    myops.ops ) ] );
+    test_dynops_nolines( [ qw( CGP      myops.ops ) ] );
+    test_dynops_nolines( [ qw( C        myops.ops ) ] );
+    test_dynops_nolines( [ qw( CSwitch  myops.ops ) ] );
+    test_dynops_nolines( [ qw( CGoto    dan.ops ) ] );
+    test_dynops_nolines( [ qw( CGP      dan.ops ) ] );
+    test_dynops_nolines( [ qw( C        dan.ops ) ] );
+    test_dynops_nolines( [ qw( CSwitch  dan.ops ) ] );
+
+    ok(chdir($cwd), "returned to starting directory");
+}
+
+pass("Completed all tests in $0");
+
+sub test_dynops_nolines {
+    my $local_argv_ref = shift;
+    {
+        my $self = Parrot::Ops2c::Utils->new( {
+            argv            => $local_argv_ref,
+            flag            => { dynamic => 1, nolines => 1 },
+        } );
+        ok(defined $self,
+            "Constructor correctly returned when provided >= 1 arguments");
+
+        my $c_header_file = $self->print_c_header_file();
+        ok(-e $c_header_file, "$c_header_file created");
+        ok(-s $c_header_file, "$c_header_file has non-zero size");
+
+        my $SOURCE = $self->print_c_source_top();
+        is(ref($SOURCE), q{GLOB}, "Argument type is filehandle (typeglob)");
+
+        my $c_source_final;
+        ok($c_source_final = $self->print_c_source_bottom($SOURCE),
+            "print_c_source_bottom() returned successfully");
+        ok(-e $c_source_final, "$c_source_final created");
+        ok(-s $c_source_final, "$c_source_final has non-zero size");
+    }
+}
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+09-dynamic_nolines.t - test C<--nolines> option to F<tools/build/ops2c.pl>.
+
+=head1 SYNOPSIS
+
+    % prove t/tools/ops2cutils/09-dynamic_nolines.t
+
+=head1 DESCRIPTION
+
+The files in this directory test the publicly callable subroutines of
+F<lib/Parrot/Ops2c/Utils.pm> and F<lib/Parrot/Ops2c/Auxiliary.pm>.  
+By doing so, they test the functionality of the F<ops2c.pl> utility.  
+That functionality has largely been extracted
+into the methods of F<Utils.pm>.
+
+All the files in this directory are intended to be run B<after>
+F<Configure.pl> has been run but before F<make> has been called.  Hence, they
+are B<not> part of the test suite run by F<make test>.   Once you have run
+F<Configure.pl>, however, you may run these tests as part of F<make
+buildtools_tests>.
+
+F<09-dynamic_nolines.t> tests whether
+C<Parrot::Ops2c::Utils::new()> work properly when the C<--nolines> and
+C<--dynamic> options are passed to F<tools/build/ops2c.pl>.
+
+=head1 AUTHOR
+
+James E Keenan
+
+=head1 SEE ALSO
+
+Parrot::Ops2c::Auxiliary, F<ops2c.pl>.
+
+=cut
+
Index: t/tools/ops2cutils/02-usage.t
===================================================================
--- t/tools/ops2cutils/02-usage.t       (revision 0)
+++ t/tools/ops2cutils/02-usage.t       (revision 0)
@@ -0,0 +1,138 @@
+#! perl
+# Copyright (C) 2007, The Perl Foundation.
+# $Id: 02-usage.t 17373 2007-03-07 00:58:56Z jkeenan $
+# 02-usage.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 =>  30;
+use Carp;
+use Cwd;
+use_ok( "Parrot::IO::Capture::Mini" );
+use_ok( 'Parrot::Ops2c::Auxiliary', qw| Usage getoptions | );
+
+ok(chdir $main::topdir, "Positioned at top-level Parrot directory");
+my $cwd = cwd();
+my ($msg, $tie, @lines);
+{
+    $tie = tie *STDERR, "Parrot::IO::Capture::Mini"
+        or croak "Unable to tie";
+    my $rv = Usage();
+    $msg = $tie->READLINE;
+    untie *STDERR or croak "Unable to untie";
+    is($rv, 1, "Usage() returned");
+    like($msg,
+        qr|^
+            \s*%\sperl\stools\/build\/ops2c\.pl\strans.*
+            trans\s:=.*
+            For\sexample.*
+            core.*
+            dynamic.*
+            |msx,
+        "Got expected usage message");
+}
+
+{
+    local @ARGV = qw( --no-lines );
+    my $flagsref = getoptions();
+    ok($flagsref->{nolines}, "no-lines option detected");
+    ok(! defined $flagsref->{help}, "help option not defined");
+    ok(! defined $flagsref->{dynamic}, "dynamic option not defined");
+    ok(! defined $flagsref->{core}, "core option not defined");
+}
+
+{
+    local @ARGV = ();
+    my $flagsref = getoptions();
+    ok(! defined $flagsref->{nolines}, "no-lines option not defined");
+    ok(! defined $flagsref->{help}, "help option not defined");
+    ok(! defined $flagsref->{dynamic}, "dynamic option not defined");
+    ok(! defined $flagsref->{core}, "core option not defined");
+}
+
+{
+    local @ARGV = qw( --no-lines --help --core );
+    my $flagsref = getoptions();
+    ok($flagsref->{nolines}, "no-lines option detected");
+    ok($flagsref->{help}, "help option detected");
+    ok(! defined $flagsref->{dynamic}, "dynamic option not defined");
+    ok($flagsref->{core}, "core option detected");
+}
+
+{
+    local @ARGV = qw( --dynamic );
+    my $flagsref = getoptions();
+    ok(! defined $flagsref->{nolines}, "no-lines option not defined");
+    ok(! defined $flagsref->{help}, "help option not defined");
+    ok(defined $flagsref->{dynamic}, "dynamic option defined");
+    ok(! defined $flagsref->{core}, "core option not defined");
+}
+
+{
+    local @ARGV = qw( --d );
+    my $flagsref = getoptions();
+    ok(! defined $flagsref->{nolines}, "no-lines option not defined");
+    ok(! defined $flagsref->{help}, "help option not defined");
+    ok(defined $flagsref->{dynamic}, "dynamic option defined");
+    ok(! defined $flagsref->{core}, "core option not defined");
+}
+
+{
+    local @ARGV = qw( --no-lines --help --core --d );
+    my $flagsref = getoptions();
+    ok($flagsref->{nolines}, "no-lines option detected");
+    ok($flagsref->{help}, "help option detected");
+    ok(defined $flagsref->{dynamic}, "dynamic option defined");
+    ok($flagsref->{core}, "core option detected");
+}
+
+pass("Completed all tests in $0");
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+02-usage.t - test C<Parrot::Ops2c::Auxiliary::Usage()> and <getoptions()>
+
+=head1 SYNOPSIS
+
+    % prove t/tools/ops2cutils/02-usage.t
+
+=head1 DESCRIPTION
+
+The files in this directory test the publicly callable subroutines of
+F<lib/Parrot/Ops2c/Utils.pm> and F<lib/Parrot/Ops2c/Auxiliary.pm>.  
+By doing so, they test the functionality of the F<ops2c.pl> utility.  
+That functionality has largely been extracted
+into the methods of F<Utils.pm>.
+
+All the files in this directory are intended to be run B<after>
+F<Configure.pl> has been run but before F<make> has been called.  Hence, they
+are B<not> part of the test suite run by F<make test>.   Once you have run
+F<Configure.pl>, however, you may run these tests as part of F<make
+buildtools_tests>.
+
+F<02-usage.t> tests whether C<Parrot::Ops2c::Auxiliary::Usage()>
+and F<getoptions()> work properly.
+
+=head1 AUTHOR
+
+James E Keenan
+
+=head1 SEE ALSO
+
+Parrot::Ops2c::Auxiliary, F<ops2c.pl>.
+
+=cut
Index: t/tools/ops2cutils/testlib/GenerateCore.pm
===================================================================
--- t/tools/ops2cutils/testlib/GenerateCore.pm  (revision 0)
+++ t/tools/ops2cutils/testlib/GenerateCore.pm  (revision 0)
@@ -0,0 +1,170 @@
+# Copyright (C) 2007, The Perl Foundation.
+# $Id: GenerateCore.pm 17373 2007-03-07 00:58:56Z jkeenan $
+package GenerateCore;
+use strict;
+our (@ISA, @EXPORT_OK);
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(
+    generate_core
+);
+use Carp;
+use File::Copy;
+use lib ( "./lib" );
+use Parrot::Ops2pm::Utils;
+
+my @srcopsfiles = qw( src/ops/core.ops src/ops/bit.ops src/ops/cmp.ops
+src/ops/debug.ops src/ops/experimental.ops src/ops/io.ops src/ops/math.ops
+src/ops/object.ops src/ops/pic.ops src/ops/pmc.ops src/ops/set.ops
+src/ops/stack.ops src/ops/stm.ops src/ops/string.ops src/ops/sys.ops
+src/ops/var.ops );
+my $num = "src/ops/ops.num";
+my $skip = "src/ops/ops.skip";
+
+sub generate_core {
+    my ($cwd, $tdir, $srcopsref, $num_file, $skip_file) = @_;
+    my @srcopsfiles = @$srcopsref;
+    mkdir qq{$tdir/src};
+    mkdir qq{$tdir/src/ops};
+    mkdir qq{$tdir/src/dynoplibs};
+
+    foreach my $f (@srcopsfiles) {
+        copy(qq{$cwd/$f}, qq{$tdir/$f});
+    }
+    copy(qq{$cwd/$num}, qq{$tdir/$num});
+    copy(qq{$cwd/$skip}, qq{$tdir/$skip});
+    my @opsfiles = glob("./src/ops/*.ops");
+    
+    mkdir qq{$tdir/lib};
+    mkdir qq{$tdir/lib/Parrot};
+    mkdir qq{$tdir/lib/Parrot/Ops2c};
+    mkdir qq{$tdir/include};
+    mkdir qq{$tdir/include/parrot};
+    mkdir qq{$tdir/include/parrot/oplib};
+    
+    my $o2p = Parrot::Ops2pm::Utils->new( {
+        argv            => [ @opsfiles ],
+        script          => "tools/build/ops2pm.pl",
+        moddir          => "lib/Parrot/OpLib",
+        module          => "core.pm",
+    } );
+    
+    $o2p->prepare_ops();
+    $o2p->load_op_map_files();
+    $o2p->sort_ops();
+    $o2p->prepare_real_ops();
+    $o2p->print_module();
+
+    croak "Temporary core.pm file not written"
+        unless (-f qq|$tdir/$o2p->{moddir}/$o2p->{module}|);
+    return qq{$tdir/lib};
+}
+
+1;
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+GenerateCore - functionality used in testing Parrot::Ops2c::Utils
+
+=head1 SYNOPSIS
+
+    use lib ("t/tools/ops2cutils/testlib");
+    use GenerateCore qw| generate_core |;
+
+    @srcopsfiles = qw(
+        src/ops/core.ops src/ops/bit.ops src/ops/cmp.ops
+        src/ops/debug.ops src/ops/experimental.ops src/ops/io.ops
+        src/ops/math.ops src/ops/object.ops src/ops/pic.ops
+        src/ops/pmc.ops src/ops/set.ops src/ops/stack.ops
+        src/ops/stm.ops src/ops/string.ops src/ops/sys.ops
+        src/ops/var.ops
+    );
+
+    $num = "src/ops/ops.num";
+    $skip = "src/ops/ops.skip";
+
+    $cwd = cwd();
+    $tdir = tempdir( CLEANUP => 1 );
+
+    $tlib = generate_core(
+        $cwd, $tdir, \@srcopsfiles, $num, $skip);
+
+=head1 DESCRIPTION
+
+=head2 Purpose
+
+The test suite found in F<t/tools/ops2cutils/> tests the methods of
+Parrot::Ops2c::Utils.  Those methods are invoked by Parrot build tool
+F<tools/build/ops2c.pl>, which in turn is invoked several times by F<make>.
+Parrot::Ops2c::Utils has as a prerequisite Parrot::OpLib::core.  But
+Parrot::OpLib::core is not part of the Parrot distribution, nor does it exist
+at the point F<make> is called.  Rather, it is created
+during the Parrot build process prior to the first call to F<ops2c.pl>.
+
+To test Parrot::Ops2c::Utils therefore requires a module which does not exist
+'pre-F<make>'.  The tests in this suite, however, are designed to be run when
+your filesystem is in a 'post-F<Configure.pl>, pre-F<make>' state.  The
+solution to this conundrum is to create a copy of Parrot::OpLib::core which
+exists only for the duration of a single test file.
+
+This package, GenerateCore, exports upon request a single subroutine,
+C<generate_core>, which (a) creates subdirectories needed underneath a
+temporary directory created solely for testing purposes; then
+(b) creates a temporary copy of Parrot::OpLib::core such that
+C<Parrot::Ops2c::Utils::new()> can successfully execute.
+
+=head2 C<generate_core()>
+
+=over 4
+
+=item *  B<Purpose:>  (See above.)
+
+=item *  B<Arguments:>  Five scalar arguments, in this order:
+
+  cwd           :   String with full path of directory from which
+                    tests are invoked (generally, the top-level
+                    Parrot directory).
+  tdir          :   String holding full path of temporary
+                    directory into which you have changed for
+                    testing.
+  \@srcopsfiles :   Reference to an array of F<.ops> files
+                    (generally, the list of arguments to ops2c.pl
+                    as invoked by make).
+  $num          :   Path to ops.num file.
+  $skip         :   Path to ops.skip file.
+
+=item *  B<Return Value:>  String holding full path to a directory F<lib/>
+found one level underneath the temporary directory denoted by F<tdir> above.
+(This is the directory underneath which the temporary copy of
+Parrot::OpLib::core is created.)  The return value may be used in testing as a
+marker for the creation of all the needed temporary subdirectories and the
+temporary copy of Parrot::OpLib::core.
+
+=back
+
+=head1 DEPENDENCIES
+
+=over 4
+
+=item *  File::Copy
+
+=item *  Parrot::Ops2c::Utils
+
+=back
+
+=head1 AUTHOR
+
+James E Keenan (jkee...@cpan.org).
+
+=head1 SEE ALSO
+
+=over 4
+
+=item *  Parrot::Ops2c::Utils
+
+=item *  F<tools/build/ops2c.pl>
+
+=back
+
+=cut
Index: t/tools/ops2cutils/05-print_c_source_bottom.t
===================================================================
--- t/tools/ops2cutils/05-print_c_source_bottom.t       (revision 0)
+++ t/tools/ops2cutils/05-print_c_source_bottom.t       (revision 0)
@@ -0,0 +1,126 @@
+#! perl
+# Copyright (C) 2007, The Perl Foundation.
+# $Id: 05-print_c_source_bottom.t 17373 2007-03-07 00:58:56Z jkeenan $
+# 05-print_c_source_bottom.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 =>  42;
+use Carp;
+use Cwd;
+use File::Copy;
+use File::Temp (qw| tempdir |);
+use_ok( 'Parrot::Ops2pm::Utils' );
+use lib ("$main::topdir/t/tools/ops2cutils/testlib");
+use_ok( "GenerateCore", qw| generate_core | );
+
+my @srcopsfiles = qw( src/ops/core.ops src/ops/bit.ops src/ops/cmp.ops
+src/ops/debug.ops src/ops/experimental.ops src/ops/io.ops src/ops/math.ops
+src/ops/object.ops src/ops/pic.ops src/ops/pmc.ops src/ops/set.ops
+src/ops/stack.ops src/ops/stm.ops src/ops/string.ops src/ops/sys.ops
+src/ops/var.ops );
+my $num = "src/ops/ops.num";
+my $skip = "src/ops/ops.skip";
+
+ok(chdir $main::topdir, "Positioned at top-level Parrot directory");
+my $cwd = cwd();
+my ($msg, $tie);
+
+{
+    my $tdir = tempdir( CLEANUP => 1 );
+    ok(chdir $tdir, 'changed to temp directory for testing');
+
+    my $tlib = generate_core(
+        $cwd, $tdir, \@srcopsfiles, $num, $skip);
+
+    ok(-d $tlib, "lib directory created under tempdir");
+    unshift @INC, $tlib;
+    require Parrot::Ops2c::Utils;
+
+    test_print_c_source_bottom( [ qw( C ) ] );
+    test_print_c_source_bottom( [ qw( CGoto ) ] );
+    test_print_c_source_bottom( [ qw( CGP ) ] );
+    test_print_c_source_bottom( [ qw( CSwitch ) ] );
+    test_print_c_source_bottom( [ qw( C CGoto CGP CSwitch CPrederef ) ] );
+
+    ok(chdir($cwd), "returned to starting directory");
+}
+
+
+pass("Completed all tests in $0");
+
+sub test_print_c_source_bottom {
+    my $local_argv_ref = shift;
+    {
+        my $self = Parrot::Ops2c::Utils->new( {
+            argv            => $local_argv_ref,
+            flag            => { core => 1 },
+        } );
+        ok(defined $self,
+            "Constructor correctly returned when provided with argument(s): @{$local_argv_ref}");
+
+        my $c_header_file = $self->print_c_header_file();
+        ok(-e $c_header_file, "$c_header_file created");
+        ok(-s $c_header_file, "$c_header_file has non-zero size");
+
+        my $SOURCE = $self->print_c_source_top();
+        is(ref($SOURCE), q{GLOB}, "Argument type is filehandle (typeglob)");
+
+        my $c_source_final;
+        ok($c_source_final = $self->print_c_source_bottom($SOURCE),
+            "print_c_source_bottom() returned successfully");
+        ok(-e $c_source_final, "$c_source_final created");
+        ok(-s $c_source_final, "$c_source_final has non-zero size");
+    }
+}
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+05-print_c_source_bottom.t - test
+C<Parrot::Ops2c::Utils::print_c_source_bottom()>
+
+=head1 SYNOPSIS
+
+    % prove t/tools/ops2cutils/05-print_c_source_bottom.t
+
+=head1 DESCRIPTION
+
+The files in this directory test the publicly callable subroutines of
+F<lib/Parrot/Ops2c/Utils.pm> and F<lib/Parrot/Ops2c/Auxiliary.pm>.  
+By doing so, they test the functionality of the F<ops2c.pl> utility.  
+That functionality has largely been extracted
+into the methods of F<Utils.pm>.
+
+All the files in this directory are intended to be run B<after>
+F<Configure.pl> has been run but before F<make> has been called.  Hence, they
+are B<not> part of the test suite run by F<make test>.   Once you have run
+F<Configure.pl>, however, you may run these tests as part of F<make
+buildtools_tests>.
+
+F<05-print_c_source_bottom.t> tests whether
+C<Parrot::Ops2c::Utils::print_c_source_bottom()> work properly.
+
+=head1 AUTHOR
+
+James E Keenan
+
+=head1 SEE ALSO
+
+Parrot::Ops2c::Auxiliary, F<ops2c.pl>.
+
+=cut
+
Index: t/tools/ops2cutils/03-print_c_header_file.t
===================================================================
--- t/tools/ops2cutils/03-print_c_header_file.t (revision 0)
+++ t/tools/ops2cutils/03-print_c_header_file.t (revision 0)
@@ -0,0 +1,130 @@
+#! perl
+# Copyright (C) 2007, The Perl Foundation.
+# $Id: 03-print_c_header_file.t 17373 2007-03-07 00:58:56Z jkeenan $
+# 03-print_c_header_file.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 =>  25;
+use Carp;
+use Cwd;
+use File::Copy;
+use File::Temp (qw| tempdir |);
+use_ok( 'Parrot::Ops2pm::Utils' );
+use lib ("$main::topdir/t/tools/ops2cutils/testlib");
+use_ok( "GenerateCore", qw| generate_core | );
+
+my @srcopsfiles = qw( src/ops/core.ops src/ops/bit.ops src/ops/cmp.ops
+src/ops/debug.ops src/ops/experimental.ops src/ops/io.ops src/ops/math.ops
+src/ops/object.ops src/ops/pic.ops src/ops/pmc.ops src/ops/set.ops
+src/ops/stack.ops src/ops/stm.ops src/ops/string.ops src/ops/sys.ops
+src/ops/var.ops );
+my $num = "src/ops/ops.num";
+my $skip = "src/ops/ops.skip";
+
+ok(chdir $main::topdir, "Positioned at top-level Parrot directory");
+my $cwd = cwd();
+
+{
+    my $tdir = tempdir( CLEANUP => 1 );
+    ok(chdir $tdir, 'changed to temp directory for testing');
+
+    my $tlib = generate_core(
+        $cwd, $tdir, \@srcopsfiles, $num, $skip);
+
+    ok(-d $tlib, "lib directory created under tempdir");
+    unshift @INC, $tlib;
+    require Parrot::Ops2c::Utils;
+
+    
+    test_single_trans_and_header(q{C});
+    test_single_trans_and_header(q{CGoto});
+    test_single_trans_and_header(q{CGP});
+    test_single_trans_and_header(q{CSwitch});
+    test_single_trans_and_header(q{CPrederef});
+
+    {
+        local @ARGV = qw( C CGoto CGP CSwitch CPrederef );
+        my $self = Parrot::Ops2c::Utils->new( {
+            argv            => [ @ARGV ],
+            flag            => { core => 1 },
+        } );
+        ok(defined $self,
+            "Constructor correctly returned when provided >= 1 arguments");
+        my $c_header_file = $self->print_c_header_file();
+        ok(-e $c_header_file, "$c_header_file created");
+        ok(-s $c_header_file, "$c_header_file has non-zero size");
+    }
+
+    ok(chdir($cwd), "returned to starting directory");
+}
+
+
+pass("Completed all tests in $0");
+
+sub test_single_trans_and_header {
+    my $trans = shift;
+    my %available = map {$_, 1} qw( C CGoto CGP CSwitch CPrederef );
+    croak "Bad argument $trans to test_single_trans()"
+        unless $available{$trans};
+
+    my $self = Parrot::Ops2c::Utils->new( {
+            argv            => [ $trans ],
+            flag            => { core => 1 },
+        } );
+    ok(defined $self,
+        "Constructor correct when provided with single argument $trans");
+
+    my $c_header_file = $self->print_c_header_file();
+    ok(-e $c_header_file, "$c_header_file created");
+    ok(-s $c_header_file, "$c_header_file has non-zero size");
+}
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+03-print_c_header_file.t - test C<Parrot::Ops2c::Utils::new()>
+
+=head1 SYNOPSIS
+
+    % prove t/tools/ops2cutils/03-print_c_header_file.t
+
+=head1 DESCRIPTION
+
+The files in this directory test the publicly callable subroutines of
+F<lib/Parrot/Ops2c/Utils.pm> and F<lib/Parrot/Ops2c/Auxiliary.pm>.  
+By doing so, they test the functionality of the F<ops2c.pl> utility.  
+That functionality has largely been extracted
+into the methods of F<Utils.pm>.
+
+All the files in this directory are intended to be run B<after>
+F<Configure.pl> has been run but before F<make> has been called.  Hence, they
+are B<not> part of the test suite run by F<make test>.   Once you have run
+F<Configure.pl>, however, you may run these tests as part of F<make
+buildtools_tests>.
+
+F<03-print_c_header_file.t> tests whether
+C<Parrot::Ops2c::Utils::print_c_header_file()> works properly.
+
+=head1 AUTHOR
+
+James E Keenan
+
+=head1 SEE ALSO
+
+Parrot::Ops2c::Auxiliary, F<ops2c.pl>.
+
+=cut
Index: t/tools/ops2cutils/01-new.t
===================================================================
--- t/tools/ops2cutils/01-new.t (revision 0)
+++ t/tools/ops2cutils/01-new.t (revision 0)
@@ -0,0 +1,201 @@
+#! perl
+# Copyright (C) 2007, The Perl Foundation.
+# $Id: 01-new.t 17373 2007-03-07 00:58:56Z jkeenan $
+# 01-new.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 =>  21;
+use Carp;
+use Cwd;
+use File::Copy;
+use File::Temp (qw| tempdir |);
+use_ok( 'Parrot::Ops2pm::Utils' );
+use lib ("$main::topdir/t/tools/ops2cutils/testlib");
+use_ok( "Parrot::IO::Capture::Mini" );
+use_ok( "GenerateCore", qw| generate_core | );
+
+my @srcopsfiles = qw( src/ops/core.ops src/ops/bit.ops src/ops/cmp.ops
+src/ops/debug.ops src/ops/experimental.ops src/ops/io.ops src/ops/math.ops
+src/ops/object.ops src/ops/pic.ops src/ops/pmc.ops src/ops/set.ops
+src/ops/stack.ops src/ops/stm.ops src/ops/string.ops src/ops/sys.ops
+src/ops/var.ops );
+my $num = "src/ops/ops.num";
+my $skip = "src/ops/ops.skip";
+
+ok(chdir $main::topdir, "Positioned at top-level Parrot directory");
+my $cwd = cwd();
+my ($msg, $tie);
+
+{
+    my $tdir = tempdir( CLEANUP => 1 );
+    ok(chdir $tdir, 'changed to temp directory for testing');
+
+    my $tlib = generate_core(
+        $cwd, $tdir, \@srcopsfiles, $num, $skip);
+
+    ok(-d $tlib, "lib directory created under tempdir");
+    unshift @INC, $tlib;
+    require Parrot::Ops2c::Utils;
+
+    {
+        local @ARGV = qw();
+        $tie = tie *STDERR, "Parrot::IO::Capture::Mini"
+            or croak "Unable to tie";
+        my $self = Parrot::Ops2c::Utils->new( {
+            argv            => [ @ARGV ],
+            flag            => {},
+        } );
+        $msg = $tie->READLINE;
+        untie *STDERR or croak "Unable to untie";
+        ok(! defined $self,
+            "Constructor correctly returned undef due to lack of command-line arguments");
+        like($msg,
+            qr/^Parrot::Ops2c::Utils::new\(\) requires 'trans' options/,
+            "Error message is correct");
+    }
+    
+    {
+        local @ARGV = qw( gobbledygook );
+        $tie = tie *STDERR, "Parrot::IO::Capture::Mini"
+            or croak "Unable to tie";
+        my $self = Parrot::Ops2c::Utils->new( {
+            argv            => [ @ARGV ],
+            flag            => {},
+        } );
+        $msg = $tie->READLINE;
+        untie *STDERR or croak "Unable to untie";
+        ok(! defined $self,
+            "Constructor correctly returned undef due to bad class name command-line argument");
+        like($msg,
+            qr/Parrot::Ops2c::Utils::new\(\) requires C, CGoto, CGP, CSwitch and\/or  CPrederef/,
+            "Got correct error message");
+    }
+    
+    test_single_trans(q{C});
+    test_single_trans(q{CGoto});
+    test_single_trans(q{CGP});
+    test_single_trans(q{CSwitch});
+    test_single_trans(q{CPrederef});
+
+    {
+        local @ARGV = qw( C CGoto CGP CSwitch CPrederef );
+        my $self = Parrot::Ops2c::Utils->new( {
+            argv            => [ @ARGV ],
+            flag            => { core => 1 },
+        } );
+        ok(defined $self,
+            "Constructor correctly returned when provided >= 1 arguments");
+    }
+
+    {
+        local @ARGV = qw( C CGoto CGP CSwitch CPrederef );
+        my $self = Parrot::Ops2c::Utils->new( {
+            argv            => [ @ARGV ],
+            flag            => { core => 1 },
+            script          => "tools/build/ops2c.pl",
+        } );
+        ok(defined $self,
+            "Constructor correctly returned when provided with explicit 'script' argument");
+    }
+
+    {
+        local @ARGV = qw( C );
+        $tie = tie *STDERR, "Parrot::IO::Capture::Mini"
+            or croak "Unable to tie";
+        my $self = Parrot::Ops2c::Utils->new( {
+            argv            => [ @ARGV ],
+        } );
+        $msg = $tie->READLINE;
+        untie *STDERR or croak "Unable to untie";
+        ok(! defined $self,
+            "Constructor correctly returned undef when lacking reference to options");
+        like($msg,
+            qr/^Parrot::Ops2c::Utils::new\(\) requires reference to hash of command-line options/,
+            "Error message correctly returned");
+    }
+    
+    ok(chdir($cwd), "returned to starting directory");
+}
+
+pass("Completed all tests in $0");
+
+sub test_single_trans {
+    my $trans = shift;
+    my %available = map {$_, 1} qw( C CGoto CGP CSwitch CPrederef );
+    croak "Bad argument $trans to test_single_trans()"
+        unless $available{$trans};
+
+    my $self = Parrot::Ops2c::Utils->new( {
+            argv            => [ $trans ],
+            flag            => { core => 1 },
+        } );
+    ok(defined $self,
+        "Constructor correct when provided with single argument $trans");
+}
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+01-new.t - test C<Parrot::Ops2c::Utils::new()>
+
+=head1 SYNOPSIS
+
+    % prove t/tools/ops2cutils/01-new.t
+
+=head1 DESCRIPTION
+
+The files in this directory test the publicly callable subroutines of
+F<lib/Parrot/Ops2c/Utils.pm> and F<lib/Parrot/Ops2c/Auxiliary.pm>.  
+By doing so, they test the functionality of the F<ops2c.pl> utility.  
+That functionality has largely been extracted
+into the methods of F<Utils.pm>.
+
+All the files in this directory are intended to be run B<after>
+F<Configure.pl> has been run but before F<make> has been called.  Hence, they
+are B<not> part of the test suite run by F<make test>.   Once you have run
+F<Configure.pl>, however, you may run these tests as part of F<make
+buildtools_tests>.
+
+F<01-new.t> tests whether C<Parrot::Ops2c::Utils::new()>
+works properly.
+
+=head1 AUTHOR
+
+James E Keenan
+
+=head1 SEE ALSO
+
+Parrot::Ops2c::Auxiliary, F<ops2c.pl>.
+
+=cut
+
+__END__
+
+#$VAR1 = [];
+#$VAR2 = bless( {
+#                 'split_count' => 0
+#               }, 'Parrot::OpTrans::CSwitch' );
+#$VAR3 = '_switch';
+#/usr/local/bin/perl tools/build/vtable_extend.pl
+#/usr/local/bin/perl tools/build/ops2c.pl CGoto --core
+#$VAR1 = [];
+#$VAR2 = bless( {}, 'Parrot::OpTrans::CGoto' );
+#$VAR3 = '_cg';
+#/usr/local/bin/perl tools/build/ops2c.pl CGP --core
+#$VAR1 = [];
+#$VAR2 = bless( {}, 'Parrot::OpTrans::CGP' );
+#$VAR3 = '_cgp';
Index: t/tools/ops2cutils/06-dynamic.t
===================================================================
--- t/tools/ops2cutils/06-dynamic.t     (revision 0)
+++ t/tools/ops2cutils/06-dynamic.t     (revision 0)
@@ -0,0 +1,165 @@
+#! perl
+# Copyright (C) 2007, The Perl Foundation.
+# $Id: 06-dynamic.t 17373 2007-03-07 00:58:56Z jkeenan $
+# 06-dynamic.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 =>  72;
+use Carp;
+use Cwd;
+use File::Copy;
+use File::Temp (qw| tempdir |);
+use_ok( 'Parrot::Ops2pm::Utils' );
+use_ok( 'Parrot::IO::Capture::Mini' );
+use lib ("$main::topdir/t/tools/ops2cutils/testlib");
+use_ok( "GenerateCore", qw| generate_core | );
+
+my @srcopsfiles = qw( src/ops/core.ops src/ops/bit.ops src/ops/cmp.ops
+src/ops/debug.ops src/ops/experimental.ops src/ops/io.ops src/ops/math.ops
+src/ops/object.ops src/ops/pic.ops src/ops/pmc.ops src/ops/set.ops
+src/ops/stack.ops src/ops/stm.ops src/ops/string.ops src/ops/sys.ops
+src/ops/var.ops );
+my $num = "src/ops/ops.num";
+my $skip = "src/ops/ops.skip";
+my @dynopsfiles = qw( src/dynoplibs/dan.ops src/dynoplibs/myops.ops );
+
+
+ok(chdir $main::topdir, "Positioned at top-level Parrot directory");
+my $cwd = cwd();
+my ($msg, $tie);
+
+{
+    my $tdir = tempdir( CLEANUP => 1 );
+    ok(chdir $tdir, 'changed to temp directory for testing');
+
+    my $tlib = generate_core(
+        $cwd, $tdir, \@srcopsfiles, $num, $skip);
+
+    ok(-d $tlib, "lib directory created under tempdir");
+    unshift @INC, $tlib;
+    require Parrot::Ops2c::Utils;
+
+    foreach my $f (@dynopsfiles) {
+        copy (qq{$cwd/$f}, qq{$tdir/$f});
+    }
+    chdir "src/dynoplibs" or croak "Unable to change to src/dynoplibs: $!";
+
+    test_dynops( [ qw( CGoto    myops.ops ) ] );
+    test_dynops( [ qw( CGP      myops.ops ) ] );
+    test_dynops( [ qw( C        myops.ops ) ] );
+    test_dynops( [ qw( CSwitch  myops.ops ) ] );
+    test_dynops( [ qw( CGoto    dan.ops ) ] );
+    test_dynops( [ qw( CGP      dan.ops ) ] );
+    test_dynops( [ qw( C        dan.ops ) ] );
+    test_dynops( [ qw( CSwitch  dan.ops ) ] );
+
+    {
+        $tie = tie *STDERR, "Parrot::IO::Capture::Mini"
+            or croak "Unable to tie";
+        my $self = Parrot::Ops2c::Utils->new( {
+            argv            => [ qw( CSwitch  dan.ops dan.ops ) ],
+            flag            => { dynamic => 1 },
+        } );
+        $msg = $tie->READLINE;
+        untie *STDERR or croak "Unable to untie";
+        ok(defined $self,
+            "Constructor correctly returned when provided >= 1 arguments");
+        like($msg,
+            qr/Ops file 'dan\.ops' mentioned more than once!/,
+            "Error message is correct");
+
+        my $c_header_file = $self->print_c_header_file();
+        ok(-e $c_header_file, "$c_header_file created");
+        ok(-s $c_header_file, "$c_header_file has non-zero size");
+
+        my $SOURCE = $self->print_c_source_top();
+        is(ref($SOURCE), q{GLOB}, "Argument type is filehandle (typeglob)");
+
+        my $c_source_final;
+        ok($c_source_final = $self->print_c_source_bottom($SOURCE),
+            "print_c_source_bottom() returned successfully");
+        ok(-e $c_source_final, "$c_source_final created");
+        ok(-s $c_source_final, "$c_source_final has non-zero size");
+    }
+
+    ok(chdir($cwd), "returned to starting directory");
+}
+
+sub test_dynops {
+    my $local_argv_ref = shift;
+    {
+        my $self = Parrot::Ops2c::Utils->new( {
+            argv            => $local_argv_ref,
+            flag            => { dynamic => 1 },
+        } );
+        ok(defined $self,
+            "Constructor correctly returned when provided >= 1 arguments");
+
+        my $c_header_file = $self->print_c_header_file();
+        ok(-e $c_header_file, "$c_header_file created");
+        ok(-s $c_header_file, "$c_header_file has non-zero size");
+
+        my $SOURCE = $self->print_c_source_top();
+        is(ref($SOURCE), q{GLOB}, "Argument type is filehandle (typeglob)");
+
+        my $c_source_final;
+        ok($c_source_final = $self->print_c_source_bottom($SOURCE),
+            "print_c_source_bottom() returned successfully");
+        ok(-e $c_source_final, "$c_source_final created");
+        ok(-s $c_source_final, "$c_source_final has non-zero size");
+    }
+}
+
+pass("Completed all tests in $0");
+
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+06-dynamic.t - test C<--dynamic> flag to F<tools/build/ops2c.pl>
+
+=head1 SYNOPSIS
+
+    % prove t/tools/ops2cutils/06-dynamic.t
+
+=head1 DESCRIPTION
+
+The files in this directory test the publicly callable subroutines of
+F<lib/Parrot/Ops2c/Utils.pm> and F<lib/Parrot/Ops2c/Auxiliary.pm>.  
+By doing so, they test the functionality of the F<ops2c.pl> utility.  
+That functionality has largely been extracted
+into the methods of F<Utils.pm>.
+
+All the files in this directory are intended to be run B<after>
+F<Configure.pl> has been run but before F<make> has been called.  Hence, they
+are B<not> part of the test suite run by F<make test>.   Once you have run
+F<Configure.pl>, however, you may run these tests as part of F<make
+buildtools_tests>.
+
+F<06-dynamic.t> tests how well
+C<Parrot::Ops2c::Utils()> works when the C<--dynamic> flag is passed to
+F<tools/build/ops2c.pl>.
+
+=head1 AUTHOR
+
+James E Keenan
+
+=head1 SEE ALSO
+
+Parrot::Ops2c::Auxiliary, F<ops2c.pl>.
+
+=cut
Index: t/tools/ops2cutils/07-make_incdir.t
===================================================================
--- t/tools/ops2cutils/07-make_incdir.t (revision 0)
+++ t/tools/ops2cutils/07-make_incdir.t (revision 0)
@@ -0,0 +1,146 @@
+#! perl
+# Copyright (C) 2007, The Perl Foundation.
+# $Id: 07-make_incdir.t 17373 2007-03-07 00:58:56Z jkeenan $
+# 07-make_incdir.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 =>   7;
+use Carp;
+use Cwd;
+use File::Copy;
+use File::Temp (qw| tempdir |);
+use_ok( 'Parrot::Ops2pm::Utils' );
+use lib ("$main::topdir/t/tools/ops2cutils/testlib", "./lib");
+use_ok( "GenerateCore", qw| generate_core | );
+
+my @srcopsfiles = qw( src/ops/core.ops src/ops/bit.ops src/ops/cmp.ops
+src/ops/debug.ops src/ops/experimental.ops src/ops/io.ops src/ops/math.ops
+src/ops/object.ops src/ops/pic.ops src/ops/pmc.ops src/ops/set.ops
+src/ops/stack.ops src/ops/stm.ops src/ops/string.ops src/ops/sys.ops
+src/ops/var.ops );
+my $num = "src/ops/ops.num";
+my $skip = "src/ops/ops.skip";
+
+ok(chdir $main::topdir, "Positioned at top-level Parrot directory");
+my $cwd = cwd();
+
+{
+    my $tdir = tempdir( CLEANUP => 1 );
+    ok(chdir $tdir, 'changed to temp directory for testing');
+
+    mkdir qq{$tdir/src};
+    mkdir qq{$tdir/src/ops};
+    mkdir qq{$tdir/src/dynoplibs};
+
+    foreach my $f (@srcopsfiles) {
+        copy(qq{$cwd/$f}, qq{$tdir/$f});
+    }
+    copy(qq{$cwd/$num}, qq{$tdir/$num});
+    copy(qq{$cwd/$skip}, qq{$tdir/$skip});
+    my @opsfiles = glob("./src/ops/*.ops");
+    
+    mkdir qq{$tdir/lib};
+    mkdir qq{$tdir/lib/Parrot};
+    mkdir qq{$tdir/lib/Parrot/Ops2c};
+    mkdir qq{$tdir/include};
+    mkdir qq{$tdir/include/parrot};
+#    mkdir qq{$tdir/include/parrot/oplib};
+    
+    my $o2p = Parrot::Ops2pm::Utils->new( {
+        argv            => [ @opsfiles ],
+        script          => "tools/build/ops2pm.pl",
+        moddir          => "lib/Parrot/OpLib",
+        module          => "core.pm",
+    } );
+    
+    $o2p->prepare_ops();
+    $o2p->load_op_map_files();
+    $o2p->sort_ops();
+    $o2p->prepare_real_ops();
+    $o2p->print_module();
+
+    croak "Temporary core.pm file not written"
+        unless (-f qq|$tdir/$o2p->{moddir}/$o2p->{module}|);
+
+    my $tlib = qq{$tdir/lib};
+    ok(-d $tlib, "lib directory created under tempdir");
+    unshift @INC, $tlib;
+    require Parrot::Ops2c::Utils;
+
+    {
+        local @ARGV = qw( C CGoto CGP CSwitch CPrederef );
+        my $self = Parrot::Ops2c::Utils->new( {
+            argv            => [ @ARGV ],
+            flag            => { core => 1 },
+        } );
+        ok(defined $self,
+            "Constructor correctly returned even though include/parrot/oplib had to be created");
+    }
+}
+
+pass("Completed all tests in $0");
+
+sub test_single_trans {
+    my $trans = shift;
+    my %available = map {$_, 1} qw( C CGoto CGP CSwitch CPrederef );
+    croak "Bad argument $trans to test_single_trans()"
+        unless $available{$trans};
+
+    my $self = Parrot::Ops2c::Utils->new( {
+            argv            => [ $trans ],
+            flag            => { core => 1 },
+        } );
+    ok(defined $self,
+        "Constructor correct when provided with single argument $trans");
+}
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+07-make_incdir.t - test C<Parrot::Ops2c::Utils::new()>
+
+=head1 SYNOPSIS
+
+    % prove t/tools/ops2cutils/07-make_incdir.t
+
+=head1 DESCRIPTION
+
+The files in this directory test the publicly callable subroutines of
+F<lib/Parrot/Ops2c/Utils.pm> and F<lib/Parrot/Ops2c/Auxiliary.pm>.  
+By doing so, they test the functionality of the F<ops2c.pl> utility.  
+That functionality has largely been extracted
+into the methods of F<Utils.pm>.
+
+All the files in this directory are intended to be run B<after>
+F<Configure.pl> has been run but before F<make> has been called.  Hence, they
+are B<not> part of the test suite run by F<make test>.   Once you have run
+F<Configure.pl>, however, you may run these tests as part of F<make
+buildtools_tests>.
+
+F<07-make_incdir.t> tests whether C<Parrot::Ops2c::Utils::new()>
+works properly when F<include/parrot/oplib> was not previously created..
+
+=head1 AUTHOR
+
+James E Keenan
+
+=head1 SEE ALSO
+
+Parrot::Ops2c::Auxiliary, F<ops2c.pl>.
+
+=cut
+
Index: t/tools/ops2cutils/08-nolines.t
===================================================================
--- t/tools/ops2cutils/08-nolines.t     (revision 0)
+++ t/tools/ops2cutils/08-nolines.t     (revision 0)
@@ -0,0 +1,116 @@
+#! perl
+# Copyright (C) 2007, The Perl Foundation.
+# $Id: 08-nolines.t 17373 2007-03-07 00:58:56Z jkeenan $
+# 08-nolines.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 =>  14;
+use Carp;
+use Cwd;
+use File::Copy;
+use File::Temp (qw| tempdir |);
+use_ok( 'Parrot::Ops2pm::Utils' );
+use lib ("$main::topdir/t/tools/ops2cutils/testlib");
+use_ok( "GenerateCore", qw| generate_core | );
+
+my @srcopsfiles = qw( src/ops/core.ops src/ops/bit.ops src/ops/cmp.ops
+src/ops/debug.ops src/ops/experimental.ops src/ops/io.ops src/ops/math.ops
+src/ops/object.ops src/ops/pic.ops src/ops/pmc.ops src/ops/set.ops
+src/ops/stack.ops src/ops/stm.ops src/ops/string.ops src/ops/sys.ops
+src/ops/var.ops );
+my $num = "src/ops/ops.num";
+my $skip = "src/ops/ops.skip";
+
+ok(chdir $main::topdir, "Positioned at top-level Parrot directory");
+my $cwd = cwd();
+
+{
+    my $tdir = tempdir( CLEANUP => 1 );
+    ok(chdir $tdir, 'changed to temp directory for testing');
+
+    my $tlib = generate_core(
+        $cwd, $tdir, \@srcopsfiles, $num, $skip);
+
+    ok(-d $tlib, "lib directory created under tempdir");
+    unshift @INC, $tlib;
+    require Parrot::Ops2c::Utils;
+
+    {
+        local @ARGV = qw( C CGoto CGP CSwitch CPrederef );
+        my $self = Parrot::Ops2c::Utils->new( {
+            argv            => [ @ARGV ],
+            flag            => { core => 1, nolines => 1 },
+        } );
+        ok(defined $self,
+            "Constructor correctly returned when provided >= 1 arguments");
+
+        my $c_header_file = $self->print_c_header_file();
+        ok(-e $c_header_file, "$c_header_file created");
+        ok(-s $c_header_file, "$c_header_file has non-zero size");
+
+        my $SOURCE = $self->print_c_source_top();
+        is(ref($SOURCE), q{GLOB}, "Argument type is filehandle (typeglob)");
+
+        my $c_source_final;
+        ok($c_source_final = $self->print_c_source_bottom($SOURCE),
+            "print_c_source_bottom() returned successfully");
+        ok(-e $c_source_final, "$c_source_final created");
+        ok(-s $c_source_final, "$c_source_final has non-zero size");
+    }
+
+    ok(chdir($cwd), "returned to starting directory");
+}
+
+pass("Completed all tests in $0");
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+08-nolines.t - test C<--nolines> option to F<tools/build/ops2c.pl>.
+
+=head1 SYNOPSIS
+
+    % prove t/tools/ops2cutils/08-nolines.t
+
+=head1 DESCRIPTION
+
+The files in this directory test the publicly callable subroutines of
+F<lib/Parrot/Ops2c/Utils.pm> and F<lib/Parrot/Ops2c/Auxiliary.pm>.  
+By doing so, they test the functionality of the F<ops2c.pl> utility.  
+That functionality has largely been extracted
+into the methods of F<Utils.pm>.
+
+All the files in this directory are intended to be run B<after>
+F<Configure.pl> has been run but before F<make> has been called.  Hence, they
+are B<not> part of the test suite run by F<make test>.   Once you have run
+F<Configure.pl>, however, ...

read more »