Author: jkeenan
Date: Thu Feb 14 19:01:20 2008
New Revision: 25723
Added:
branches/tcif/lib/Parrot/Configure/Parallel/Trace.pm
- copied, changed from r25672,
/branches/reconfigure/t/steps/testlib/Auxiliary.pm
Modified:
branches/tcif/MANIFEST
Log:
Add first draft of lib/Parrot/Configure/Parallel/Trace.pm.
Modified: branches/tcif/MANIFEST
==============================================================================
--- branches/tcif/MANIFEST (original)
+++ branches/tcif/MANIFEST Thu Feb 14 19:01:20 2008
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Thu Feb 14 23:47:46 2008 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Fri Feb 15 02:17:22 2008 UT
#
# See tools/dev/install_files.pl for documentation on the
# format of this file.
@@ -2427,6 +2427,7 @@
lib/Parrot/Configure/Options/Reconf.pm [devel]
lib/Parrot/Configure/Options/Test.pm [devel]
lib/Parrot/Configure/Parallel.pm [devel]
+lib/Parrot/Configure/Parallel/Trace.pm [devel]
lib/Parrot/Configure/Step.pm [devel]
lib/Parrot/Configure/Step/List.pm [devel]
lib/Parrot/Configure/Step/Methods.pm [devel]
Copied: branches/tcif/lib/Parrot/Configure/Parallel/Trace.pm (from r25672,
/branches/reconfigure/t/steps/testlib/Auxiliary.pm)
==============================================================================
--- /branches/reconfigure/t/steps/testlib/Auxiliary.pm (original)
+++ branches/tcif/lib/Parrot/Configure/Parallel/Trace.pm Thu Feb 14
19:01:20 2008
@@ -1,23 +1,11 @@
# Copyright (C) 2007, The Perl Foundation.
# $Id$
-
-package Auxiliary;
+package Parrot::Configure::Parallel::Trace;
use strict;
use warnings;
-our (@ISA, @EXPORT_OK);
[EMAIL PROTECTED] = qw( Exporter );
[EMAIL PROTECTED] = qw(
- get_step_name
- get_step_position
- retrieve_state
- dump_state
- get_previous_state
- store_this_step_pure
- update_state
-);
use Carp;
use Data::Dumper;
-$Data::Dumper::Indent = 1;
+local $Data::Dumper::Indent = 1;
use File::Basename;
use Storable qw( nstore retrieve );
use lib qw( lib );
@@ -27,45 +15,61 @@
our $sto = q{.configure_parallel.sto};
-our %steps_position;
-my @steps_list = get_steps_list();
-for (my $i=0; $i<=$#steps_list; $i++) {
- $steps_position{$steps_list[$i]} = $i+1;
-}
-
-sub get_step_name {
+sub new {
+ my $class = shift;
+ croak "Need to provide name of test script as argument to
Parrot::Configure::Parallel::Trace::new()"
+ unless $_[0];
my $script = shift;
+ my %args;
+ $args{sto} = $sto;
+
+ my @steps_list = get_steps_list();
+ my %steps_position;
+ for (my $i=0; $i<=$#steps_list; $i++) {
+ $steps_position{$steps_list[$i]} = $i+1;
+ }
+ $args{position} = \%steps_position;
+
my $base = basename($script);
- my ($type, $class);
+ my ($type, $stepclass);
if ($base =~ m/^(init|inter|auto|gen)_(.*?)\-/o) {
- ($type, $class) = ($1, $2);
+ ($type, $stepclass) = ($1, $2);
} else {
croak "Cannot parse test file name $base to get step: $!";
}
- return $type . q{::} . $class;
+ $args{step} = $type . q{::} . $stepclass;
+
+ return bless \%args, $class;
+}
+
+sub get_step_name {
+ my $self = shift;
+ return $self->{step};
}
sub get_step_position {
- my $step = shift;
- return $steps_position{$step};
+ my $self = shift;
+ return $self->{position}->{$self->{step}};
}
sub retrieve_state {
+ my $self = shift;
my $state = [];
local $Storable::Eval = 1;
- $state = retrieve($sto) if -e $sto;
+ $state = retrieve($self->{sto}) if -e $self->{sto};
return $state;
}
sub dump_state {
- my $state = retrieve_state();
+ my $self = shift;
+ my $state = $self->retrieve_state();
print Dumper $state;
}
sub get_previous_state {
- my $pkg = shift;
- my $state = shift || retrieve_state();
- my $step_position = get_step_position($pkg);
+ my $self = shift;
+ my $step_position = $self->get_step_position($self->{step});
+ my $state = shift || $self->retrieve_state();
if ( (defined($state->[$step_position - 1]))
and
(ref($state->[$step_position - 1]) =~ /Parrot::Configure/)
@@ -76,19 +80,31 @@
}
}
+sub update_state {
+ my $self = shift;
+ my $argsref = shift;
+ push @{ $argsref->{state} }, $argsref->{conf};
+ {
+ local $Storable::Deparse = 1;
+ nstore( $argsref->{state}, $self->{sto} );
+ }
+ return 1;
+}
+
sub store_this_step_pure {
- my $pkg = shift;
- my $state = retrieve_state();
- my $step_position = get_step_position($pkg);
- return 2 if $state->[$step_position];
+ my $self = shift;
+ my $pkg = $self->{step};
+ my $step_position = $self->get_step_position($pkg);
+ my $state = $self->retrieve_state();
+ return 2 if $state->[ $step_position ];
+
my $args = process_options( {
argv => [q{--silent}],
mode => q{configure},
} );
my $conf = Parrot::Configure::Parallel->new;
-# my $pv = get_previous_state($pkg,$state);
- $conf->refresh(get_previous_state($pkg,$state));
+ $conf->refresh($self->get_previous_state($pkg,$state));
$conf->add_steps($pkg);
$conf->options->set( %{$args} );
@@ -97,12 +113,10 @@
my $step = $step_name->new();
my $ret = $step->runstep($conf);
if (defined $ret) {
- update_state(
+ $self->update_state(
{
state => $state,
-# step_name => $step_name,
conf => $conf,
- sto => $sto,
}
);
} else {
@@ -112,29 +126,37 @@
return 1;
}
-sub update_state {
- my $argsref = shift;
-# if (! defined $argsref->{state}->[0]) {
-# $argsref->{state}->[0] = [];
-# }
-# push @{ $argsref->{state}->[0] }, $argsref->{step_name};
- push @{ $argsref->{state} }, $argsref->{conf};
- {
- local $Storable::Deparse = 1;
- nstore( $argsref->{state}, $argsref->{sto} );
- }
- return 1;
-}
-
1;
+#################### DOCUMENTATION ####################
+
=head1 NAME
-t/steps/testlib/Auxiliary.pm - Subroutines used in F<t/steps/*.t>.
+Parrot::Configure::Parallel::Trace - Manipulate a Parrot::Configure::Parallel
object during testing of configuration step classes.
=head1 SYNOPSIS
-Use only in test scripts.
+ $trace =
+ Parrot::Configure::Parallel::Trace->new('current_test_script');
+
+ $step_name = $trace->get_step_name();
+
+ $step_position = $trace->get_step_position($step_name);
+
+ $state = $self->retrieve_state();
+
+ $self->dump_state();
+
+ $self->get_previous_state($step_name);
+
+ $self->update_state( {
+ state => $state,
+ conf => $conf,
+ } );
+
+ $self->store_this_step_pure($step_name);
+
+Used only in configuration step tests found in F<t/steps/>.
=head1 AUTHOR
