[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