Author: jkeenan
Date: Sun Feb 11 11:11:34 2007
New Revision: 16943
Added:
branches/buildtools/lib/Parrot/Ops2c/Utils.pm
branches/buildtools/t/tools/ops2cutils/01-new.t
Modified:
branches/buildtools/tools/build/ops2c.pl
Log:
1. Created lib/Parrot/Ops2c/Utils.pm. Within that package, created sub
new(); transferred subs _prepare_core() and _prepare_non_core() from
tools/build/ops2c.pl thereto.
2. Having concluded refactoring most of the code within tools/build/ops2c.pl
into internal subroutines, I've begun moving that code out of the script and
into lib/Parrot/Ops2c/Utils.pm. So far most of the initialization has been
moved into that package's new() function. To guarantee that this transferral
is taking place safely, once I return the Utils object, I assign its keys to
the variables which will be needed in the remaining subroutines in ops2c.pl,
then test that 'make' works successfully.
3. Created t/tools/ops2cutils/01-new.t. Some tests in it will currently fail
because I have not yet set up a way to create prerequisite
Parrot::OpLib::core. (This was the last bit of functionality imported into
the constructor. Prior to doing that, all tests in 01-new.t were passing.)
Added: branches/buildtools/lib/Parrot/Ops2c/Utils.pm
==============================================================================
--- (empty file)
+++ branches/buildtools/lib/Parrot/Ops2c/Utils.pm Sun Feb 11 11:11:34 2007
@@ -0,0 +1,153 @@
+# Copyright (C) 2004-2006, The Perl Foundation.
+# $Id: Utils.pm 16894 2007-02-04 22:54:29Z jkeenan $
+package Parrot::Ops2c::Utils;
+use strict;
+#use warnings;
+#use Cwd;
+#use Data::Dumper;
+#use File::Path ();
+#use File::Spec;
+use lib ("lib/");
+use Parrot::OpLib::core;
+use Parrot::OpsFile;
+
+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}};
+ 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 ( $base =~ m!^src/dynoplibs/! || $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 ],
+ argv => [ @argv ],
+ flag => $flagref,
+ } );
+ }
+
+ 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
+
+###############################
+ $argsref->{argv} = [EMAIL PROTECTED];
+ $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->{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 "$0: Ops file '$f' mentioned more than once!\n";
+ next;
+ }
+
+ $opsfiles{$f} = 1;
+ push @opsfiles, $f;
+
+ die "$0: Could not read ops file '$f'!\n" unless -r $f;
+ }
+
+ my $ops = Parrot::OpsFile->new( [EMAIL PROTECTED],
$argsref->{flag}->{nolines} );
+
+ my $cur_code = 0;
+ for my $el ( @{ $ops->{OPS} } ) {
+ $el->{CODE} = $cur_code++;
+ }
+ return $ops;
+}
+
+1;
Added: branches/buildtools/t/tools/ops2cutils/01-new.t
==============================================================================
--- (empty file)
+++ branches/buildtools/t/tools/ops2cutils/01-new.t Sun Feb 11 11:11:34 2007
@@ -0,0 +1,146 @@
+#! perl
+# Copyright (C) 2006, The Perl Foundation.
+# $Id: 01-new.t 16894 2007-02-04 22:54:29Z 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 qw(no_plan); # tests => 30;
+use Carp;
+use Cwd;
+use_ok( 'Parrot::Ops2c::Utils' );
+use lib ("$main::topdir/t/tools/ops2cutils/testlib");
+use_ok( "Capture" );
+
+
+ok(chdir $main::topdir, "Positioned at top-level Parrot directory");
+my $cwd = cwd();
+my ($msg, $tie);
+
+{
+ local @ARGV = qw();
+ $tie = tie *STDERR, "Capture" 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, "Capture" 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");
+}
+
+{
+ local @ARGV = qw( C );
+ my $self = Parrot::Ops2c::Utils->new( {
+ argv => [ @ARGV ],
+ flag => {},
+ } );
+ ok(defined $self,
+ "Constructor correctly returned when provided 1 argument");
+}
+
+{
+ local @ARGV = qw( C );
+ $tie = tie *STDERR, "Capture" 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");
+}
+
+{
+ local @ARGV = qw( C CGoto CGP CSwitch CPrederef);
+ my $self = Parrot::Ops2c::Utils->new( {
+ argv => [ @ARGV ],
+ flag => {},
+ } );
+ ok(defined $self,
+ "Constructor correctly returned when provided >= 1 arguments");
+}
+
+#$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';
+
+pass("Completed all tests in $0");
+
+################### 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>.
+
+F<01-new.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
+
Modified: branches/buildtools/tools/build/ops2c.pl
==============================================================================
--- branches/buildtools/tools/build/ops2c.pl (original)
+++ branches/buildtools/tools/build/ops2c.pl Sun Feb 11 11:11:34 2007
@@ -3,14 +3,13 @@
# $Id$
use warnings;
use strict;
+use Data::Dumper;
use lib 'lib';
-
-use Getopt::Long qw(:config permute);
-
-use Parrot::OpsFile;
-use Parrot::OpLib::core;
+#use Parrot::OpsFile;
+#use Parrot::OpLib::core;
use Parrot::Config;
use Parrot::Ops2c::Auxiliary qw( Usage getoptions );
+use Parrot::Ops2c::Utils;
#
# Look at the command line options
@@ -26,66 +25,112 @@
exit 1;
}
-my $class_name = shift @ARGV;
-my %is_allowed = map { $_ => 1 } qw(C CGoto CGP CSwitch CPrederef);
-unless ($is_allowed{$class_name}) {
+#my $class_name = shift @ARGV;
+#print STDERR Dumper ([EMAIL PROTECTED], $class_name);
+#my %is_allowed = map { $_ => 1 } qw(C CGoto CGP CSwitch CPrederef);
+#unless ($is_allowed{$class_name}) {
+# Usage();
+# exit 1;
+#}
+
+#########################
+my $self = Parrot::Ops2c::Utils->new( {
+ argv => [ @ARGV ],
+ flag => $flagref,
+} );
+if (not defined $self) {
Usage();
exit 1;
}
-
-my $trans_class = "Parrot::OpTrans::" . $class_name;
-eval "require $trans_class";
-my $trans = $trans_class->new();
-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 ( $base =~ m!^src/dynoplibs/! || $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 $trans_class = "Parrot::OpTrans::" . $class_name;
+#eval "require $trans_class";
+#my $trans = $trans_class->new();
+#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 ( $base =~ m!^src/dynoplibs/! || $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';
# Read the input files:
-my $ops;
-if ($flagref->{core}) {
- $ops = _prepare_core( {
- file => $file,
- flag => $flagref,
- } );
-}
-else {
- $ops = _prepare_non_core( {
- file => $file,
- argv => [ @ARGV ],
- flag => $flagref,
- } );
-}
-
-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
-
+#my $ops;
+#if ($flagref->{core}) {
+# $ops = _prepare_core( {
+# file => $file,
+# flag => $flagref,
+# } );
+#}
+#else {
+# $ops = _prepare_non_core( {
+# file => $file,
+# argv => [ @ARGV ],
+# flag => $flagref,
+# } );
+#}
+#
+#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
+
+#########################
+local @ARGV = @{$self->{argv}};
+my $trans = $self->{trans};
+my $suffix = $self->{suffix};
+
+my $file = $self->{file};
+my $base = $self->{base};
+my $incdir = $self->{incdir};
+my $include = $self->{include};
+my $header = $self->{header};
+my $source = $self->{source};
+my $sym_export = $self->{sym_export};
+
+my $ops = $self->{ops};
+my %versions = %{$self->{versions}};
+my $num_ops = $self->{num_ops};
+my $num_entries = $self->{num_entries};
+
+#print STDERR Dumper (
+# [EMAIL PROTECTED],
+# $trans,
+# $suffix,
+# $file,
+# $base,
+# $incdir,
+# $include,
+# $header,
+# $source,
+# $sym_export,
+# $ops,
+# \%versions,
+# $num_ops,
+# $num_entries,
+#);
+#########################
#
# Open the output files:
#
@@ -277,42 +322,42 @@
#################### SUBROUTINES ####################
-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 "$0: Ops file '$f' mentioned more than once!\n";
- next;
- }
-
- $opsfiles{$f} = 1;
- push @opsfiles, $f;
-
- die "$0: Could not read ops file '$f'!\n" unless -r $f;
- }
-
- my $ops = Parrot::OpsFile->new( [EMAIL PROTECTED],
$argsref->{flag}->{nolines} );
-
- my $cur_code = 0;
- for my $el ( @{ $ops->{OPS} } ) {
- $el->{CODE} = $cur_code++;
- }
- return $ops;
-}
+#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 "$0: Ops file '$f' mentioned more than once!\n";
+# next;
+# }
+#
+# $opsfiles{$f} = 1;
+# push @opsfiles, $f;
+#
+# die "$0: Could not read ops file '$f'!\n" unless -r $f;
+# }
+#
+# my $ops = Parrot::OpsFile->new( [EMAIL PROTECTED],
$argsref->{flag}->{nolines} );
+#
+# my $cur_code = 0;
+# for my $el ( @{ $ops->{OPS} } ) {
+# $el->{CODE} = $cur_code++;
+# }
+# return $ops;
+#}
sub _compose_preamble {
my ($file, $script) = @_;
