[svn:parrot] r42251 - in branches/configtests: . lib/Parrot/Configure/Options/Test lib/Parrot/Configure/Step t/steps/init
jkeenan at svn.parrot.org
jkeenan at svn.parrot.org
Wed Nov 4 03:39:29 UTC 2009
Author: jkeenan
Date: Wed Nov 4 03:39:22 2009
New Revision: 42251
URL: https://trac.parrot.org/parrot/changeset/42251
Log:
Begin work on transforming tests of step classes to use results of configuration. Create Parrot::Configure::Step::Test.
Added:
branches/configtests/lib/Parrot/Configure/Step/Test.pm (contents, props changed)
- copied, changed from r42247, branches/configtests/lib/Parrot/Configure.pm
Modified:
branches/configtests/MANIFEST
branches/configtests/lib/Parrot/Configure/Options/Test/Prepare.pm
branches/configtests/t/steps/init/hints-01.t
Modified: branches/configtests/MANIFEST
==============================================================================
--- branches/configtests/MANIFEST Tue Nov 3 22:35:44 2009 (r42250)
+++ branches/configtests/MANIFEST Wed Nov 4 03:39:22 2009 (r42251)
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Wed Oct 28 00:57:35 2009 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Tue Nov 3 22:14:38 2009 UT
#
# See below for documentation on the format of this file.
#
@@ -1029,6 +1029,7 @@
lib/Parrot/Configure/Step.pm [devel]lib
lib/Parrot/Configure/Step/List.pm [devel]lib
lib/Parrot/Configure/Step/Methods.pm [devel]lib
+lib/Parrot/Configure/Step/Test.pm [devel]lib
lib/Parrot/Configure/Test.pm [devel]lib
lib/Parrot/Configure/Trace.pm [devel]lib
lib/Parrot/Configure/Utils.pm [devel]lib
Modified: branches/configtests/lib/Parrot/Configure/Options/Test/Prepare.pm
==============================================================================
--- branches/configtests/lib/Parrot/Configure/Options/Test/Prepare.pm Tue Nov 3 22:35:44 2009 (r42250)
+++ branches/configtests/lib/Parrot/Configure/Options/Test/Prepare.pm Wed Nov 4 03:39:22 2009 (r42251)
@@ -29,11 +29,13 @@
);
sub get_preconfiguration_tests {
- return ( @framework_tests, @steps_tests );
+# return ( @framework_tests, @steps_tests );
+ return ( @framework_tests );
};
sub get_postconfiguration_tests {
my @postconfiguration_tests = (
+ @steps_tests,
glob("t/postconfigure/*.t"),
glob("t/tools/pmc2cutils/*.t"),
glob("t/tools/ops2cutils/*.t"),
Copied and modified: branches/configtests/lib/Parrot/Configure/Step/Test.pm (from r42247, branches/configtests/lib/Parrot/Configure.pm)
==============================================================================
--- branches/configtests/lib/Parrot/Configure.pm Tue Nov 3 20:24:16 2009 (r42247, copy source)
+++ branches/configtests/lib/Parrot/Configure/Step/Test.pm Wed Nov 4 03:39:22 2009 (r42251)
@@ -1,574 +1,154 @@
# Copyright (C) 2001-2009, Parrot Foundation.
# $Id$
-package Parrot::Configure;
+package Parrot::Configure::Step::Test;
use strict;
use warnings;
+use lib qw( lib );
+our @ISA = qw( Parrot::Configure );
+use Parrot::Config;
+use Parrot::Configure::Data;
=head1 NAME
-Parrot::Configure - Conducts the execution of Configuration Steps
+Parrot::Configure::Step::Test - Populate Parrot::Configure object with results of configuration
=head1 SYNOPSIS
- use Parrot::Configure;
-
- my $conf = Parrot::Configure->new;
- my $data = $conf->data;
- my $options = $conf->options;
- my @steps = $conf->steps;
+ use Parrot::Configure::Step::Test;
- $conf->add_steps(@steps);
- $conf->runsteps;
+ $conf = Parrot::Configure::Step::Test->new;
+ $conf->include_config_results( $args );
+ $conf->add_steps( 'some_package' );
+ $serialized = $conf->pcfreeze();
+ $conf->options->set( %options );
+ $conf->runsteps();
+ $conf->replenish($serialized);
=head1 DESCRIPTION
-This module provides a means for registering, executing, and
-coordinating one or more configuration steps. Please see
-F<docs/configuration.pod> for further details about the configuration
-framework.
-
-=head1 USAGE
-
-=head2 Import Parameters
-
-This module accepts no arguments to its C<import> method and exports no
-I<symbols>.
-
-=cut
-
-use lib qw(config);
-use Carp qw(carp);
-use Storable qw(2.12 nstore retrieve nfreeze thaw);
-use Parrot::Configure::Data;
-use base qw(Parrot::Configure::Compiler);
-
-use Class::Struct;
+This module is a wrapper around Parrot::Configure to be used for testing of
+individual configuration steps once F<Configure.pl> has run. It inherits
+C<Parrot::Configure::new()> -- the Parrot::Configure constructor -- and all
+Parrot::Configure methods. It adds just one method:
+C<Parrot::Configure::Step::Test::include_config_results()>. This method
+populates the C<data> section of the Parrot::Configure object's data structure
+with the results of Parrot configuration, I<i.e.,> C<%PConfig> from
+Parrot::Config (F<lib/Parrot/Config.pm>).
-struct(
- 'Parrot::Configure::Task' => {
- step => '$',
- object => 'Parrot::Configure::Step',
- },
-);
+=head2 Rationale
-=head2 Methods
-
-=head3 Constructor
+Consider these questions:
=over 4
-=item * C<new()>
+=item 1
-Basic constructor.
+Why test a Parrot configuration step after that step has already been run by
+F<Configure.pl>?
-Accepts no arguments and returns a Parrot::Configure object.
+=item 2
-=cut
+If F<Configure.pl> has completed successfully, doesn't that, in some sense,
+I<prove> that the code in the configuration step class was correct? If so,
+why bother to test it at all?
-my $singleton;
+=item 3
-BEGIN {
- $singleton = {
- steps => [],
- data => Parrot::Configure::Data->new,
- options => Parrot::Configure::Data->new,
- };
- bless $singleton, 'Parrot::Configure';
-}
-
-sub new {
- my $class = shift;
- return $singleton;
-}
+Conversely, wouldn't it make more sense to test a configuration step I<before>
+that step has been run by F<Configure.pl>?
=back
-=head3 Object Methods
+Parrot developers have debated these questions for years. Between mid-2007
+and late-2009, the position reflected in our testing practices was that found
+in Question 3 above. We included tests of the configuration steps in the set
+of I<preconfiguration tests> run when you called:
+
+ perl Configure.pl --test=configure
+
+The primary reason for taking this approach was the conviction that the
+B<building blocks> of the Parrot configuration process ought to be tested
+before that whole process is executed.
+
+It should be noted that at the point in time when this approach was
+implemented, there was B<no testing of the configuration step classes
+whatsoever>. Previously, it was just assumed that if F<Configure.pl> completed
+successfully, the code in the various configuration step classes did not need
+more fine-grained testing.
+
+So, B<some> testing of the Parrot configuration steps was clearly an
+improvement over B<no> testing of those steps.
+
+Nonetheless, there were limits to how well we could apply standard testing
+practices to the Parrot configuration step classes. The following factors
+delimited what we could do:
=over 4
-=item * C<data()>
-
-Provides access to a Parrot::Configure::Data object intended to contain
-initial and discovered configuration data.
-
-Accepts no arguments and returns a Parrot::Configure::Data object.
-
-=cut
-
-sub data {
- my $conf = shift;
-
- return $conf->{data};
-}
-
-=item * C<options()>
-
-Provides access to a Parrot::Configure::Data object intended to contain CLI
-option data.
-
-Accepts no arguments and returns a Parrot::Configure::Data object.
-
-=cut
-
-sub options {
- my $conf = shift;
-
- return $conf->{options};
-}
-
-=item * C<steps()>
-
-Provides a list of registered steps, where each step is represented by an
-Parrot::Configure::Task object. Steps are returned in the order in which
-they were registered.
+=item *
-Accepts no arguments and returns a list in list context or an arrayref in
-scalar context.
-
-=cut
-
-sub steps {
- my $conf = shift;
-
- return wantarray ? @{ $conf->{steps} } : $conf->{steps};
-}
-
-=item * C<get_list_of_steps()>
-
-Provides a list of the B<names> of registered steps.
-
-C<steps()>, in contrast, provides a list of registered step B<objects>, of
-which the B<step name> is just a small part. Step names are returned in the
-order in which their corresponding step objects were registered.
-
-Accepts no arguments and returns a list in list context or an arrayref in
-scalar context.
-
-B<Note:> The list of step names returned by C<get_list_of_steps()> will be the
-same as that in the second argument returned by
-C<Parrot::Configure::Options::process_options()> B<provided> that you have not
-used C<add_step()> or C<add_steps()> to add any configuration steps.
-
-=cut
-
-sub get_list_of_steps {
- my $conf = shift;
- die 'list_of_steps not available until steps have been added'
- unless defined $conf->{list_of_steps};
- return wantarray ? @{ $conf->{list_of_steps} } : $conf->{list_of_steps};
-}
+TK
-=item * C<add_step()>
-
-Registers a new step and any parameters that should be passed to it. The
-first parameter passed is the class name of the step being registered. All
-other parameters are saved and passed to the registered class's C<runstep()>
-method.
-
-Accepts a list and modifies the data structure within the
-Parrot::Configure object.
-
-=cut
-
-sub add_step {
- my ( $conf, $step ) = @_;
-
- push @{ $conf->{steps} },
- Parrot::Configure::Task->new(
- step => $step,
- );
-
- return 1;
-}
-
-=item * C<add_steps()>
-
-Registers new steps to be run at the end of the execution queue.
-
-Accepts a list of new steps and modifies the data structure within the
-Parrot::Configure object.
-
-=cut
-
-sub add_steps {
- my ( $conf, @new_steps ) = @_;
-
- for ( my $i = 0 ; $i <= $#new_steps ; $i++ ) {
- $conf->add_step( $new_steps[$i] );
- push @{ $conf->{list_of_steps} }, $new_steps[$i];
- $conf->{hash_of_steps}->{ $new_steps[$i] } = $i + 1;
- }
-
- return 1;
-}
-
-=item * C<runsteps()>
+=back
-Sequentially executes steps in the order they were registered. The invoking
-Parrot::Configure object is passed as the first argument to each step's
-C<runstep()> method, followed by any parameters that were registered for that
-step.
+=head1 METHODS
-Accepts no arguments and modifies the data structure within the
-Parrot::Configure object.
+=head2 C<new()>
-=cut
+Constructor. Inherited from Parrot::Configure. See
+F<lib/Parrot/Configure.pm>.
-sub runsteps {
- my $conf = shift;
-
- my $n = 0; # step number
- my ( $silent, $verbose, $verbose_step_str, $fatal, $fatal_step_str, $ask );
- $silent = $conf->options->get(qw( silent ));
- unless ($silent) {
- ( $verbose, $verbose_step_str, $fatal, $fatal_step_str, $ask ) =
- $conf->options->get(qw( verbose verbose-step fatal fatal-step ask ));
- }
+=head2 C<include_config_results()>
- $conf->{log} = [];
- my %steps_to_die_for = ();
- # If the --fatal option is true, then all config steps are mapped into
- # %steps_to_die_for and there is no consideration of --fatal-step.
- if ($fatal) {
- %steps_to_die_for = map { ($_,1) } @{ $conf->{list_of_steps} };
- }
- # We make certain that argument to --fatal-step is a comma-delimited
- # string of configuration steps, each of which is a string delimited by
- # two colons, the first half of which is one of init|inter|auto|gen
- elsif ( defined ( $fatal_step_str ) ) {
- %steps_to_die_for = _handle_fatal_step_option( $fatal_step_str );
- }
- else {
- # No action needed; this is the default case where no step is fatal
- }
+B<Purpose:>
- my %verbose_steps;
- if (defined $verbose_step_str) {
- %verbose_steps = _handle_verbose_step_option( $verbose_step_str );
- }
- foreach my $task ( $conf->steps ) {
- my ($red_flag, $this_step_is_verbose);
- my $step_name = $task->step;
- if ( scalar keys %steps_to_die_for ) {
- if ( $steps_to_die_for{$step_name} ) {
- $red_flag++;
- }
- }
- if ( scalar keys %verbose_steps ) {
- $this_step_is_verbose = $verbose_steps{$step_name}
- ? $step_name
- : q{};
- }
-
- $n++;
- my $rv = $conf->_run_this_step(
- {
- task => $task,
- verbose => $verbose,
- verbose_step => $this_step_is_verbose,
- ask => $ask,
- n => $n,
- silent => $silent,
- }
- );
- if ( ! defined $rv ) {
- if ( $red_flag ) {
- return;
- }
- else {
- $conf->{log}->[$n] = {
- step => $step_name,
- };
- }
- }
- }
- return 1;
-}
-
-sub _handle_fatal_step_option {
- my $fatal_step_str = shift;
- my %steps_to_die_for = ();
- my $named_step_pattern = qr/(?:init|inter|auto|gen)::\w+/;
- if ( $fatal_step_str =~ m{^
- $named_step_pattern
- (, $named_step_pattern)*
- $}x
- ) {
- my @fatal_steps = split /,/, $fatal_step_str;
- for my $s (@fatal_steps) {
- $steps_to_die_for{$s}++;
- }
- }
- else {
- die q{Argument to fatal-step option must be comma-delimited string of valid configuration steps};
- }
- return %steps_to_die_for;
-}
-
-sub _handle_verbose_step_option {
- my $verbose_step_str = shift;
- my %verbose_steps = ();
- my $named_step_pattern = qr/(?:init|inter|auto|gen)::\w+/;
- if ( $verbose_step_str =~ m{^
- $named_step_pattern
- (, $named_step_pattern)*
- $}x
- ) {
- my @verbose_steps = split /,/, $verbose_step_str;
- for my $s (@verbose_steps) {
- $verbose_steps{$s}++;
- }
- }
- else {
- die q{Argument to verbose-step option must be comma-delimited string of valid configuration steps};
- }
- return %verbose_steps;
-}
+B<Arguments:>
-=item * C<run_single_step()>
+B<Return Value:>
-The invoking Parrot::Configure object is passed as the first argument to
-each step's C<runstep()> method, followed by any parameters that were
-registered for that step.
-
-Accepts no arguments and modifies the data structure within the
-Parrot::Configure object.
-
-B<Note:> Currently used only in F<tools/dev/reconfigure.pl>; not used in
-F<Configure.pl>.
+B<Comment:>
=cut
-sub run_single_step {
- my $conf = shift;
- my $taskname = shift;
-
- my ( $verbose, $verbose_step, $ask ) =
- $conf->options->get(qw( verbose verbose-step ask ));
-
- my $task = ( $conf->steps() )[0];
- if ( $task->{'Parrot::Configure::Task::step'} eq $taskname ) {
- $conf->_run_this_step(
- {
- task => $task,
- verbose => $verbose,
- verbose_step => $verbose_step,
- ask => $ask,
- n => 1,
- }
- );
- }
- else {
- die 'Mangled task in run_single_step';
- }
-
- return;
-}
-
-sub _run_this_step {
- my $conf = shift;
- my $args = shift;
-
- my $step_name = $args->{task}->step;
-
- eval "use $step_name;"; ## no critic (BuiltinFunctions::ProhibitStringyEval)
- die $@ if $@;
-
- my $conftrace = [];
- my $sto = q{.configure_trace.sto};
- {
- local $Storable::Eval = 1;
- if ( $conf->options->get(q{configure_trace}) and ( -e $sto ) ) {
- $conftrace = retrieve($sto);
- }
- }
- my $step = $step_name->new();
-
- # set per step verbosity
- if ( $args->{verbose_step} ) {
- $conf->options->set( verbose => 2 );
- }
-
- my $stub = qq{$step_name - };
- my $message = $stub .
- (q{ } x (22 - length($stub))) .
- $step->description .
- '...';
- my $length_message = length($message);
- unless ($args->{silent}) {
- # The first newline terminates the report on the *previous* step.
- # (Probably needed to make interactive output work properly.
- # Otherwise, we'd put it in _finish_printing_result().
- print "\n";
- print $message;
- print "\n" if $args->{verbose_step};
- }
-
- my $ret;
- # When successful, a Parrot configuration step now returns 1
- eval { $ret = $step->runstep($conf); };
- if ($@) {
- carp "\nstep $step_name died during execution: $@\n";
- return;
- }
- else {
- # A Parrot configuration step can run successfully, but if it fails to
- # achieve its objective it is supposed to return an undefined status.
- if ( $ret ) {
- # reset verbose value for the next step
- $conf->options->set( verbose => $args->{verbose} );
- unless ($args->{silent}) {
- _finish_printing_result(
- {
- step => $step,
- step_name => $step_name,
- args => $args,
- description => $step->description,
- length_message => $length_message,
- }
- );
- }
- if ($conf->options->get(q{configure_trace}) ) {
- _update_conftrace(
- {
- conftrace => $conftrace,
- step_name => $step_name,
- conf => $conf,
- sto => $sto,
- }
- );
- }
- return 1;
- }
- else {
- _failure_message( $step, $step_name );
- return;
- }
- }
-}
-
-sub _failure_message {
- my ( $step, $step_name ) = @_;
- my $result = $step->result || 'no result returned';
- carp "\nstep $step_name failed: " . $result;
-
- return;
-}
-
-
-sub _finish_printing_result {
- my $argsref = shift;
- my $result = $argsref->{step}->result || 'done';
- my $linelength = 78;
- if ($argsref->{args}->{verbose} or $argsref->{args}->{verbose_step}) {
- # For more readable verbose output, we'll repeat the step description
- print "\n";
- my $spaces = 22;
- print q{ } x $spaces;
- print $argsref->{description};
- print '.' x (
- ( $linelength - $spaces ) -
- ( length($argsref->{description}) + length($result) + 1 )
- );
- }
- else {
- print '.' x (
- $linelength -
- ( $argsref->{length_message} + length($result) + 1 )
- );
- }
- unless ( $argsref->{step_name} =~ m{^inter} && $argsref->{args}->{ask} ) {
- print "$result.";
- }
- return 1;
-}
+my $singleton;
-sub _update_conftrace {
- my $argsref = shift;
- if (! defined $argsref->{conftrace}->[0]) {
- $argsref->{conftrace}->[0] = [];
- }
- push @{ $argsref->{conftrace}->[0] }, $argsref->{step_name};
- my $evolved_data = {
- options => $argsref->{conf}->{options},
- data => $argsref->{conf}->{data},
+BEGIN {
+ $singleton = {
+ steps => [],
+ data => Parrot::Configure::Data->new,
+ options => Parrot::Configure::Data->new,
};
- push @{ $argsref->{conftrace} }, $evolved_data;
- {
- local $Storable::Deparse = 1;
- nstore( $argsref->{conftrace}, $argsref->{sto} );
- }
- return 1;
-}
-
-=item * C<option_or_data($arg)>
-
-Are you tired of this construction all over the place?
-
- my $opt = $conf->options->get( $arg );
- $opt = $conf->data->get( $arg ) unless defined $opt;
-
-It gives you the user-specified option for I<$arg>, and if there
-isn't one, it gets it from the created data. You do it all the
-time, but oh! the wear and tear on your fingers!
-
-Toil no more! Use this simple construction:
-
- my $opt = $conf->option_or_data($arg);
-
-and save your fingers for some real work!
-
-=cut
-
-sub option_or_data {
- my $conf = shift;
- my $arg = shift;
-
- my $opt = $conf->options->get($arg);
- return defined $opt ? $opt : $conf->data->get($arg);
+ bless $singleton, 'Parrot::Configure::Step::Test';
}
-sub pcfreeze {
- my $conf = shift;
- local $Storable::Deparse = 1;
- local $Storable::Eval = 1;
- return nfreeze($conf);
+sub new {
+ my $class = shift;
+ return $singleton;
}
-sub replenish {
- my $conf = shift;
- my $serialized = shift;
- foreach my $k (keys %{$conf}) {
- delete $conf->{$k};
+#sub new {
+# my ($class, $args) = @_;
+# my $self = Parrot::Configure::new( $class, $args );
+# return $self;
+#}
+
+sub include_config_results {
+ my ($conf, $args) = @_;
+ while ( my ($k, $v) = each %PConfig ) {
+ $conf->data->set( $k => $v );
}
- local $Storable::Deparse = 1;
- local $Storable::Eval = 1;
- my %gut = %{ thaw($serialized) };
- while ( my ($k, $v) = each %gut ) {
- $conf->{$k} = $v;
- }
-
- return;
+ $conf->options->set( %{$args} );
}
-=back
-
-=head1 CREDITS
-
-The L</runsteps()> method is largely based on code written by Brent
-Royal-Gordon C<brent at brentdax.com>.
-
=head1 AUTHOR
-Joshua Hoblitt C<jhoblitt at cpan.org>
+James E Keenan C<jkeenan at cpan.org>
=head1 SEE ALSO
-F<docs/configuration.pod>, L<Parrot::Configure::Data>,
-L<Parrot::Configure::Utils>, L<Parrot::Configure::Step>
+L<Parrot::Configure>.
=cut
Modified: branches/configtests/t/steps/init/hints-01.t
==============================================================================
--- branches/configtests/t/steps/init/hints-01.t Tue Nov 3 22:35:44 2009 (r42250)
+++ branches/configtests/t/steps/init/hints-01.t Wed Nov 4 03:39:22 2009 (r42251)
@@ -5,16 +5,17 @@
use strict;
use warnings;
-use Test::More tests => 26;
+use Test::More qw(no_plan); # tests => 26;
use Carp;
use Cwd;
+use Data::Dumper;$Data::Dumper::Indent=1;
use File::Path ();
use File::Spec::Functions qw/catfile/;
use File::Temp qw(tempdir);
use lib qw( lib t/configure/testlib );
-use_ok('config::init::defaults');
+#use_ok('config::init::defaults');
use_ok('config::init::hints');
-use Parrot::Configure;
+use Parrot::Configure::Step::Test;
use Parrot::Configure::Options qw( process_options );
use Parrot::Configure::Test qw(
test_step_thru_runstep
@@ -31,141 +32,145 @@
}
);
-my $conf = Parrot::Configure->new;
+my $conf = Parrot::Configure::Step::Test->new;
-test_step_thru_runstep( $conf, q{init::defaults}, $args );
+#test_step_thru_runstep( $conf, q{init::defaults}, $args );
-my $pkg = q{init::hints};
+$conf->include_config_results( $args );
-$conf->add_steps($pkg);
+#print STDERR Dumper $conf;
-my $serialized = $conf->pcfreeze();
-
-$conf->options->set( %{$args} );
-my $step = test_step_constructor_and_description($conf);
-
-# need to capture the --verbose output, because the fact that it does not end
-# in a newline confuses Test::Harness
-{
- my $rv;
- my $stdout;
- capture ( sub {$rv = $step->runstep($conf)}, \$stdout);
- ok( $stdout, "verbose output: hints were captured" );
- ok( defined $rv, "runstep() returned defined value" );
-}
-
-$conf->replenish($serialized);
-
-########## --verbose; local hints directory ##########
-
-($args, $step_list_ref) = process_options(
- {
- argv => [q{--verbose}],
- mode => q{configure},
- }
-);
-
-$conf->options->set( %{$args} );
-$step = test_step_constructor_and_description($conf);
-
-my $cwd = cwd();
-{
- my $tdir = tempdir( CLEANUP => 1 );
- File::Path::mkpath(qq{$tdir/init/hints})
- or croak "Unable to create directory for local hints";
- my $localhints = qq{$tdir/init/hints/local.pm};
- open my $FH, '>', $localhints
- or croak "Unable to open temp file for writing";
- print $FH <<END;
-package init::hints::local;
-use strict;
-sub runstep {
- return 1;
-}
-1;
-END
- close $FH or croak "Unable to close temp file after writing";
- unshift( @INC, $tdir );
-
- {
- my $rv;
- my $stdout;
- capture ( sub {$rv = $step->runstep($conf)}, \$stdout);
- ok( $stdout, "verbose output: hints were captured" );
- ok( defined $rv, "runstep() returned defined value" );
- }
- unlink $localhints or croak "Unable to delete $localhints";
-}
-
-$conf->replenish($serialized);
-
-########## --verbose; local hints directory; no runstep() in local hints ##########
-
-($args, $step_list_ref) = process_options(
- {
- argv => [q{--verbose}],
- mode => q{configure},
- }
-);
-
-$conf->options->set( %{$args} );
-$step = test_step_constructor_and_description($conf);
-
-$cwd = cwd();
-{
- my $tdir = tempdir( CLEANUP => 1 );
- File::Path::mkpath(qq{$tdir/init/hints})
- or croak "Unable to create directory for local hints";
- my $localhints = qq{$tdir/init/hints/local.pm};
- open my $FH, '>', $localhints
- or croak "Unable to open temp file for writing";
- print $FH <<END;
-package init::hints::local;
-use strict;
-1;
-END
- close $FH or croak "Unable to close temp file after writing";
- unshift( @INC, $tdir );
-
- {
- my $rv;
- my $stdout;
- capture ( sub {$rv = $step->runstep($conf)}, \$stdout);
- ok( $stdout, "verbose output: hints were captured" );
- ok( defined $rv, "runstep() returned defined value" );
- }
- unlink $localhints or croak "Unable to delete $localhints";
-}
-
-$conf->replenish($serialized);
-
-########## --verbose; imaginary OS ##########
-
-($args, $step_list_ref) = process_options(
- {
- argv => [ q{--verbose} ],
- mode => q{configure},
- }
-);
-
-$conf->options->set( %{$args} );
-$step = test_step_constructor_and_description($conf);
-{
- my ($stdout, $stderr, $ret);
- $conf->data->set_p5( OSNAME => q{imaginaryOS} );
- my $osname = lc( $conf->data->get_p5( 'OSNAME' ) );
- my $hints_file = catfile('config', 'init', 'hints', "$osname.pm");
- capture (
- sub { $ret = $step->runstep($conf); },
- \$stdout,
- \$stderr,
- );;
- like(
- $stdout,
- qr/No \Q$hints_file\E found/s,
- "Got expected verbose output when no hints file found"
- );
-}
+#my $pkg = q{init::hints};
+#
+#$conf->add_steps($pkg);
+#
+#my $serialized = $conf->pcfreeze();
+#
+#$conf->options->set( %{$args} );
+#my $step = test_step_constructor_and_description($conf);
+#
+## need to capture the --verbose output, because the fact that it does not end
+## in a newline confuses Test::Harness
+#{
+# my $rv;
+# my $stdout;
+# capture ( sub {$rv = $step->runstep($conf)}, \$stdout);
+# ok( $stdout, "verbose output: hints were captured" );
+# ok( defined $rv, "runstep() returned defined value" );
+#}
+#
+#$conf->replenish($serialized);
+#
+########### --verbose; local hints directory ##########
+#
+#($args, $step_list_ref) = process_options(
+# {
+# argv => [q{--verbose}],
+# mode => q{configure},
+# }
+#);
+#
+#$conf->options->set( %{$args} );
+#$step = test_step_constructor_and_description($conf);
+#
+#my $cwd = cwd();
+#{
+# my $tdir = tempdir( CLEANUP => 1 );
+# File::Path::mkpath(qq{$tdir/init/hints})
+# or croak "Unable to create directory for local hints";
+# my $localhints = qq{$tdir/init/hints/local.pm};
+# open my $FH, '>', $localhints
+# or croak "Unable to open temp file for writing";
+# print $FH <<END;
+#package init::hints::local;
+#use strict;
+#sub runstep {
+# return 1;
+#}
+#1;
+#END
+# close $FH or croak "Unable to close temp file after writing";
+# unshift( @INC, $tdir );
+#
+# {
+# my $rv;
+# my $stdout;
+# capture ( sub {$rv = $step->runstep($conf)}, \$stdout);
+# ok( $stdout, "verbose output: hints were captured" );
+# ok( defined $rv, "runstep() returned defined value" );
+# }
+# unlink $localhints or croak "Unable to delete $localhints";
+#}
+#
+#$conf->replenish($serialized);
+#
+########### --verbose; local hints directory; no runstep() in local hints ##########
+#
+#($args, $step_list_ref) = process_options(
+# {
+# argv => [q{--verbose}],
+# mode => q{configure},
+# }
+#);
+#
+#$conf->options->set( %{$args} );
+#$step = test_step_constructor_and_description($conf);
+#
+#$cwd = cwd();
+#{
+# my $tdir = tempdir( CLEANUP => 1 );
+# File::Path::mkpath(qq{$tdir/init/hints})
+# or croak "Unable to create directory for local hints";
+# my $localhints = qq{$tdir/init/hints/local.pm};
+# open my $FH, '>', $localhints
+# or croak "Unable to open temp file for writing";
+# print $FH <<END;
+#package init::hints::local;
+#use strict;
+#1;
+#END
+# close $FH or croak "Unable to close temp file after writing";
+# unshift( @INC, $tdir );
+#
+# {
+# my $rv;
+# my $stdout;
+# capture ( sub {$rv = $step->runstep($conf)}, \$stdout);
+# ok( $stdout, "verbose output: hints were captured" );
+# ok( defined $rv, "runstep() returned defined value" );
+# }
+# unlink $localhints or croak "Unable to delete $localhints";
+#}
+#
+#$conf->replenish($serialized);
+#
+########### --verbose; imaginary OS ##########
+#
+#($args, $step_list_ref) = process_options(
+# {
+# argv => [ q{--verbose} ],
+# mode => q{configure},
+# }
+#);
+#
+#$conf->options->set( %{$args} );
+#$step = test_step_constructor_and_description($conf);
+#{
+# my ($stdout, $stderr, $ret);
+# $conf->data->set_p5( OSNAME => q{imaginaryOS} );
+# my $osname = lc( $conf->data->get_p5( 'OSNAME' ) );
+# my $hints_file = catfile('config', 'init', 'hints', "$osname.pm");
+# capture (
+# sub { $ret = $step->runstep($conf); },
+# \$stdout,
+# \$stderr,
+# );;
+# like(
+# $stdout,
+# qr/No \Q$hints_file\E found/s,
+# "Got expected verbose output when no hints file found"
+# );
+#}
pass("Completed all tests in $0");
More information about the parrot-commits
mailing list