Author: jkeenan
Date: Sun Feb 11 18:58:14 2007
New Revision: 16946
Added:
branches/buildtools/t/tools/ops2cutils/testlib/GenerateCore.pm
Modified:
branches/buildtools/t/tools/ops2cutils/01-new.t
Log:
Parrot::Ops2c::Utils has as a prerequisite Parrot::OpLib::core. But that
package doesn't yet exist at the "post-Configure, pre-make" state when the
build tools tests are called, because it is created by the operation of
tools/build/ops2pm.pl at the outset of the make process. So we have to have a
way of simulating the existence of the prerequisite by creating it in a
temporary directory. Added functionality to 01-new.t to do all work in a
temporary directory. Then created t/tools/ops2cutils/testlib/GenerateCore.pm,
which exports a single function, generate_core(), that creates all the
temporary directories needed and invokes Parrot::Ops2pm::Utils methods to
create a temporary version of Parrot::OpLib::core.
Modified: branches/buildtools/t/tools/ops2cutils/01-new.t
==============================================================================
--- branches/buildtools/t/tools/ops2cutils/01-new.t (original)
+++ branches/buildtools/t/tools/ops2cutils/01-new.t Sun Feb 11 18:58:14 2007
@@ -20,96 +20,106 @@
use Test::More qw(no_plan); # tests => 30;
use Carp;
use Cwd;
-use_ok( 'Parrot::Ops2c::Utils' );
+use File::Copy;
+use File::Temp (qw| tempdir |);
+use_ok( 'Parrot::Ops2pm::Utils' );
use lib ("$main::topdir/t/tools/ops2cutils/testlib");
use_ok( "Capture" );
+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);
{
- 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");
-}
+ my $tdir = tempdir( CLEANUP => 1 );
+ ok(chdir $tdir, 'changed to temp directory for testing');
-{
- 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");
-}
+ my $tlib = generate_core(
+ $cwd, $tdir, [EMAIL PROTECTED], $num, $skip);
-{
- 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");
+ ok(-d $tlib, "lib directory created under tempdir");
+ unshift @INC, $tlib;
+ require Parrot::Ops2c::Utils;
+
+ {
+ 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 => { core => 1 },
+ } );
+ ok(defined $self,
+ "Constructor correctly returned when provided 1 argument");
+ }
+
+ {
+ 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 );
+ $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");
+ }
+
+ ok(chdir($cwd), "returned to starting directory");
}
-{
- 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");
@@ -144,3 +154,19 @@
=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';
Added: branches/buildtools/t/tools/ops2cutils/testlib/GenerateCore.pm
==============================================================================
--- (empty file)
+++ branches/buildtools/t/tools/ops2cutils/testlib/GenerateCore.pm Sun Feb
11 18:58:14 2007
@@ -0,0 +1,62 @@
+# Copyright (C) 2006, The Perl Foundation.
+# $Id: GenerateCore.pm 16816 2007-01-27 06:16:23Z jkeenan $
+package GenerateCore;
+use strict;
+our (@ISA, @EXPORT_OK);
[EMAIL PROTECTED] = qw(Exporter);
[EMAIL PROTECTED] = 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;
