On Tue Nov 27 19:53:55 2007, [EMAIL PROTECTED] wrote:
> I should add that I'll probably have to revise doc/configuration.pod a
> bit to impose a rule that Perl 5 %Config may only be 'use-d' in
> init::defaults. I'll also have to revise the documentation for
> Parrot::Configure::Data::keys() to include a caution about avoiding the
> 'p5Config_' elements.
>
> OTOH, perhaps it might be best to stash all those p5Config elements in a
> different part/level of the Parrot::Configure object, so that they can
> not possibly be accessed by methods such as keys(). What do people think?
>
Please see the revised patch attached. In this patch, I implement the
above suggestions as well as the intent of RT 41597.
Besides applying the patch to your sandbox of trunk, you can also
evaluate it by checking out a copy of the 'initp5' branch:
svn co https://svn.perl.org/parrot/branches/initp5/
... which is up-to-date as of r23311. I will apply this patch to trunk
in 2-3 days unless some objects or someone else does it first.
kid51
Index: docs/configuration.pod
===================================================================
--- docs/configuration.pod (revision 23311)
+++ docs/configuration.pod (working copy)
@@ -30,14 +30,12 @@
=head2 Initialization Steps
-I<Initialization steps> are run before any other steps. They do tasks such as
-preparing the configuration system's data structures and checking the
-F<MANIFEST>. These will rarely be added; when they are, it usually means that
-the configuration system is getting significant new capabilities. They're kept
-in the directory F<config/init>.
+I<Initialization steps> are run before any other steps. They do tasks
+such as preparing the configuration system's data structures and
+checking the F<MANIFEST>. New initialization steps will only be added
+when the configuration system is getting significant new capabilities.
+They're kept in the directory F<config/init>.
-Initialization steps usually do not output anything under normal circumstances.
-
=head2 Prompts
Prompts ask the user for some information. These should be used sparingly. A
@@ -47,28 +45,22 @@
Interactive steps often include simple probes to determine good guesses of what
the user will answer. See L</Prompt or Probe?> for more information.
-Interactive steps virtually always output something.
-
Note that, by default, these prompts are turned off. To enable them run
F<Configure.pl> with the C<--ask> option.
=head2 Probes
Probes are automated tests of some feature of the computer. These should be
-used wherever a value will not often need to be modified by the user. A step
+used wherever a value will not need to be modified often by the user. A step
containing probes is an I<automatic step>. Automatic steps should be in the
F<config/auto> folder.
-Automatic steps usually do not output anything under normal circumstances.
-
=head2 Generations
Generations create files needed after configuration has completed, such as
Makefiles and configuration headers. A step containing generations is a
I<generation step>. Generation steps should be in the F<config/gen> folder.
-Generation steps usually do not output anything under normal circumstances.
-
Templates for files to be generated usually have the extension F<.in>. There
are variable substitutes and funny macros like 'CONDITIONED_LINE' and
'INVERSE_CONDITIONED_LINE'.
@@ -80,7 +72,7 @@
change this?>, or conversely, I<Is this something that can be completely
determined without user intervention?> A step figuring out what the compiler's
command is would probably be an interactive step; conversely, a step figuring
-out if that command is connected to a specific compiler (like gcc) would be an
+out if that command is connected to a specific compiler (like F<gcc>) would be
an
automatic step.
=head2 Configuring Configuration
@@ -92,7 +84,7 @@
=head2 Adding New Steps
-New steps should be added in one of the three folders mentioned above.
+New steps should be added in one of the four folders mentioned above.
All steps are really classes; each exists in a unique namespace. The
namespace used depends on the step's relative path in the source tree sans the
@@ -130,14 +122,6 @@
=over 4
-=item F<config/inter/progs.pm>
-
- Okay, I'm going to start by asking you a couple questions about your
- compiler and linker. Default values are in square brackets; you can
- hit ENTER to accept them. If you don't understand a question, the
- default will usually work--they've been intuited from your Perl 5
- configuration.
-
=item F<config/auto/cgoto.pm>
Determining if your compiler supports computed goto...
@@ -315,6 +299,18 @@
=back
+=head2 Accessing Configuration Information via Perl 5 Variables
+
+Parrot configuration is currently jump-started by extracting
+considerable information from variables associated with the instance of
+Perl 5 which the user is using to run F<Configure.pl>. These variables
+are largely looked up in the C<%Config> found in the Perl 5
+F<Config.pm>, but may also be sought in Perl 5 special variables such as
+C<$^O>. All such lookups should be done in configuration step
+C<init::defaults> and B<only> in that step. Special accessors are
+available for working with such variables; see
+F<config/init/defaults.pm> and F<lib/Parrot/Configure/Data.pm>.
+
=head1 HISTORY
The Parrot configuration system was created by Brent Dax and has been heavily
Index: lib/Parrot/Configure/Data.pm
===================================================================
--- lib/Parrot/Configure/Data.pm (revision 23311)
+++ lib/Parrot/Configure/Data.pm (working copy)
@@ -25,16 +25,24 @@
=head1 DESCRIPTION
-This module contains configuration data for use by the other
-L<Parrot::Configure::*> modules.
+This module provides methods by which other Parrot::Configure::* modules
+can access configuration data.
-=head1 USAGE
+The module supplies a constructor for Parrot::Configure::Data objects
+and three kinds of accessors:
-=head2 Import Parameters
+=over 4
-This module accepts no arguments to its C<import> method and exports no
-I<symbols>.
+=item 1 Main configuration data
+=item 2 Triggers
+
+=item 3 Data read from Perl 5's C<%Config> or Perl 5 special variables.
+
+=back
+
+=head1 USAGE
+
=cut
package Parrot::Configure::Data;
@@ -44,18 +52,30 @@
use Data::Dumper;
-=head2 Methods
+=head2 Constructor
-=head3 Constructors
+=over 4
+=item * C<new()>
+
=over 4
-=item C<new()>
+=item * Purpose
Basic object constructor.
-Accepts no arguments and returns a L<Parrot::Configure::Data> object.
+=item * Arguments
+None.
+
+=item * Return Value
+
+Parrot::Configure::Data object.
+
+=back
+
+=back
+
=cut
sub new {
@@ -64,24 +84,37 @@
my $self = {
c => {},
triggers => {},
+ p5 => {},
};
bless $self, ref $class || $class;
return $self;
}
-=back
+=head2 Methods for Main Configuration Data
-=head3 Object Methods
+=over 4
+=item * C<get($key, ...)>
+
=over 4
-=item C<get($key, ...)>
+=item * Purpose
-Provides access to key values.
+Provides access to the values assigned to elements in the
+Parrot::Configure object's main data structure.
-Accepts a list and returns a list.
+=item * Arguments
+List of elements found in the Parrot::Configure object's main data
+structure.
+
+=item * Return Value
+
+List of values associated with corresponding arguments.
+
+=back
+
=cut
sub get {
@@ -92,13 +125,25 @@
return @[EMAIL PROTECTED];
}
-=item C<set($key => $val, ...)>
+=item * C<set($key => $val, ...)>
-Modifies or creates a new value.
+=over 4
-Accepts a list of C<< key => value >> pairs and returns a
-L<Parrot::Configure::Data> object.
+=item * Purpose
+Modifies or creates new values in the main part of the Parrot::Configure
+object's data structure..
+
+=item * Arguments
+
+List of C<< key => value >> pairs.
+
+=item * Return Value
+
+Parrot::Configure::Data object.
+
+=back
+
=cut
sub set {
@@ -126,14 +171,25 @@
return $self;
}
-=item C<add($delim, $key => $val, ...)>
+=item * C<add($delim, $key => $val, ...)>
+=over 4
+
+=item * Purpose
+
Either creates a new key or appends to an existing key, with the previous/new
values joined together by C<$delim>.
-Accepts a delimiter value followed by a list of C<< key => value >> pairs and
-returns a L<Parrot::Configure::Data> object.
+=item * Arguments
+Delimiter value followed by a list of C<< key => value >> pairs.
+
+=item * Return Value
+
+Parrot::Configure::Data object.
+
+=back
+
=cut
sub add {
@@ -153,12 +209,25 @@
return $self;
}
-=item C<keys()>
+=item * C<keys()>
-Provides a list of keys.
+=over 4
-Accepts no arguments and returns a list.
+=item * Purpose
+Provides a list of names of elements in the Parrot::Configure object's
+main data structure.
+
+=item * Arguments
+
+None.
+
+=item * Return Value
+
+List of elements in the Parrot::Configure object's main data structure.
+
+=back
+
=cut
sub keys {
@@ -167,12 +236,24 @@
return keys %{ $self->{c} };
}
-=item C<slurp()>
+=item * C<slurp()>
-Slurps in L<Parrot::Config> data from previous configure.
+=over 4
-Accepts no arguments.
+=item * Purpose
+Slurps in L<Parrot::Config> data from previous run of I<Configure.pl>.
+
+=item * Arguments
+
+None.
+
+=item * Return Value
+
+Reference to hash holding main Parrot::Configure data structure.
+
+=back
+
=cut
sub slurp() {
@@ -189,13 +270,26 @@
$self->{c} = $res;
}
-=item C<slurp_temp()>
+=item * C<slurp_temp()>
-Slurps in L<Parrot::Config> temporary data from previous configure.
-Only to be used when running C<gen::makefiles> plugin.
+=over 4
-Accepts no arguments.
+=item * Purpose
+Slurps in L<Parrot::Config> temporary data from previous run of
+Configure.pl. Only to be used when running C<gen::makefiles> plugin.
+
+=item * Arguments
+
+None.
+
+=item * Return Value
+
+Reference to hash holding that part of the main Parrot::Configure data
+structure holding temporary data.
+
+=back
+
=cut
sub slurp_temp() {
@@ -212,13 +306,19 @@
$self->{c}{$_} = $res->{$_} for CORE::keys %$res;
}
-=item C<dump()>
+=item * C<dump()>
+=over 4
+
+=item * Purpose
+
Provides a L<Data::Dumper> serialized string of the objects key/value pairs
suitable for being C<eval>ed.
-Takes two arguments:
+=item * Arguments
+Two scalar arguments:
+
=over 4
=item 1
@@ -236,8 +336,12 @@
$conf->data->dump(q{c}, q{*PConfig});
$conf->data->dump(q{c_temp}, q{*PConfig_Temp});
-Returns a string.
+=item * Return Value
+String.
+
+=back
+
=cut
# Data::Dumper supports Sortkeys since 2.12
@@ -259,16 +363,30 @@
}
}
-=item C<clean()>
+=item * C<clean()>
-Deletes keys matching C</^TEMP_/> from the internal config store,
+=over 4
+
+=item * Purpose
+
+Deletes keys matching C</^TEMP_/> from the internal configuration store,
and copies them to a special store for temporary keys.
-Keys using this naming convention are intended to be used only temporally,
-e.g. as file lists for Makefile generation.
+Keys using this naming convention are intended to be used only temporarily,
+I<e.g.> as file lists for Makefile generation.
Temporary keys are used B<only> to regenerate makefiles after configuration.
-Accepts no arguments and returns a L<Parrot::Configure::Data> object.
+=item * Arguments
+None.
+
+=item * Return Value
+
+Parrot::Configure::Data object.
+
+=back
+
+=back
+
=cut
sub clean {
@@ -279,16 +397,31 @@
return $self;
}
-=item C<settrigger($key, $trigger, $cb)>
+=head2 Triggers
+=over 4
+
+=item * C<settrigger($key, $trigger, $cb)>
+
+=over 4
+
+=item * Purpose
+
Set a callback on C<$key> named C<$trigger>. Multiple triggers can be set on a
given key. When the key is set via C<set> or C<add> then all callbacks that
are defined will be called. Triggers are passed the key and value that was set
after it has been changed.
-Accepts a key name, a trigger name, & a C<CODE> ref and returns a
-L<Parrot::Configure::Data> object.
+=item * Arguments
+Accepts a key name, a trigger name, & a C<CODE> ref.
+
+=item * Return Value
+
+Parrot::Configure::Data object.
+
+=back
+
=cut
sub settrigger {
@@ -306,12 +439,24 @@
return $self;
}
-=item C<gettriggers($key)>
+=item * C<gettriggers($key)>
+=over 4
+
+=item * Purpose
+
Get the names of all triggers set for C<$key>.
-Accepts a key name and returns a list.
+=item * Arguments
+String holding single key name.
+
+=item * Return Value
+
+List of triggers set for that key.
+
+=back
+
=cut
sub gettriggers {
@@ -327,12 +472,24 @@
return CORE::keys %{ $self->{triggers}{$key} };
}
-=item C<gettrigger($key, $trigger)>
+=item * C<gettrigger($key, $trigger)>
+=over 4
+
+=item * Purpose
+
Get the callback set for C<$key> under the name C<$trigger>
-Accepts a key name & a trigger name and returns a C<CODE> ref.
+=item * Arguments
+Accepts a key name & a trigger name.
+
+=item * Return Value
+
+C<CODE> ref.
+
+=back
+
=cut
sub gettrigger {
@@ -350,13 +507,24 @@
return $self->{triggers}{$key}{$trigger};
}
-=item C<deltrigger($key, $trigger)>
+=item * C<deltrigger($key, $trigger)>
+=over 4
+
+=item * Purpose
+
Removes the trigger on C<$key> named by C<$trigger>
-Accepts a key name & a trigger name and returns a L<Parrot::Configure::Data>
-object.
+=item * Arguments
+Accepts a key name & a trigger name.
+
+=item * Return Value
+
+Parrot::Configure::Data object.
+
+=back
+
=cut
sub deltrigger {
@@ -378,6 +546,133 @@
=back
+=head2 Methods for Perl 5 Data
+
+
+=over 4
+
+=item * C<get_p5($key, ...)>
+
+=over 4
+
+=item * Purpose
+
+Retrieve data originally derived from the Perl 5 environment during
+configuration step C<init::defaults> and stored in a special part of the
+Parrot::Configure::Data object.
+
+=item * Arguments
+
+List of elements found in the Perl 5-related part of the
+Parrot::Configure object's data structure.
+
+=item * Return Value
+
+List of values associated with corresponding arguments.
+
+=item * Note
+
+Once data from Perl 5's C<%Config> or special variables has been stored
+in configuration step C<init::defaults>, C<%Config> and the special
+variables should not be further accessed. Use this method instead.
+
+=back
+
+=cut
+
+sub get_p5 {
+ my $self = shift;
+
+ my $p5 = $self->{p5};
+
+ return @[EMAIL PROTECTED];
+}
+
+=item * C<set_p5($key => $val, ...)>
+
+=over 4
+
+=item * Purpose
+
+Looks up values from either (a) the C<%Config>, located in Config.pm
+and imported via C<use Config;>, associated with the instance of Perl
+(C<$^X>) used to run I<Configure.pl> and assigns those values to a
+special part of the Parrot::Configure::Data object.
+
+=item * Arguments
+
+List of C<< key => value >> pairs. If the key being set is from
+C<%Config>, the corresponding value should have the same name. If,
+however, the key being set is a Perl 5 special variable (I<e.g.>,
+C<%^O>), the corresponding value should be the 'English' name of that
+special variable as documented in L<perlvar> (less the initial C<$>, of
+course).
+
+=item * Return Value
+
+Parrot::Configure::Data object.
+
+=item * Examples
+
+=item * Note
+
+This method should B<only> be used in configuration step
+C<init::defaults>. It is B<not> the method used to assign values to the
+main Parrot::Configure data structure; use C<set()> (above) instead.
+
+=back
+
+=cut
+
+sub set_p5 {
+ my $self = shift;
+
+ my $verbose = defined $self->get('verbose') && $self->get('verbose') == 2;
+
+ print "\nSetting Configuration Data:\n(\n" if $verbose;
+
+ while ( my ( $key, $val ) = splice @_, 0, 2 ) {
+ print "\t$key => ", defined($val) ? "'$val'" : 'undef', ",\n"
+ if $verbose;
+ $self->{p5}{$key} = $val;
+
+ }
+
+ print ");\n" if $verbose;
+
+ return $self;
+}
+
+=item * C<keys_p5()>
+
+=over 4
+
+=item * Purpose
+
+Provides a list of names of elements in the Parrot::Configure object's
+main data structure.
+
+=item * Arguments
+
+None.
+
+=item * Return Value
+
+List of elements in the part of the Parrot::Configure object's data
+structure storing Perl 5 configuration data.
+
+=back
+
+=back
+
+=cut
+
+sub keys_p5 {
+ my $self = shift;
+
+ return CORE::keys %{ $self->{p5} };
+}
+
=head1 CREDITS
Based largely on code written by Brent Royal-Gordon C<[EMAIL PROTECTED]>.
Index: t/configure/105-init_hints-04.t
===================================================================
--- t/configure/105-init_hints-04.t (revision 23311)
+++ t/configure/105-init_hints-04.t (working copy)
@@ -34,8 +34,7 @@
my ( $task, $step_name, @step_params, $step, $ret );
my $pkg = q{init::hints};
-$conf->add_steps($pkg);
-$conf->options->set( %{$args} );
+$conf->add_steps($pkg); $conf->options->set( %{$args} );
$task = $conf->steps->[2];
$step_name = $task->step;
@@ -47,11 +46,12 @@
ok( $step->description(), "$step_name has description" );
{
- local $^O = q{imaginaryOS};
+ $conf->data->set_p5( OSNAME => q{imaginaryOS} );
+ my $os = $conf->data->get_p5( 'OSNAME' );
eval { $ret = $step->runstep($conf); };
like(
$@,
- qr{^Can't locate init/hints/$^O\.pm}i,
+ qr{^Can't locate init/hints/$os\.pm}i,
"Got expected error message upon bad value for \$^O"
);
}
Index: t/configure/160-gen_config_pm.t
===================================================================
--- t/configure/160-gen_config_pm.t (revision 23311)
+++ t/configure/160-gen_config_pm.t (working copy)
@@ -5,16 +5,42 @@
use strict;
use warnings;
-use Test::More tests => 2;
+use Test::More tests => 11;
use Carp;
-use lib qw( lib );
+use lib qw( lib t/configure/testlib );
+use_ok('config::init::defaults');
use_ok('config::gen::config_pm');
+use Parrot::Configure;
+use Parrot::Configure::Options qw( process_options );
+use Parrot::Configure::Test qw( test_step_thru_runstep);
-=for hints_for_testing The grand finale! Try to maximize branch
-coverage.
+my $args = process_options( {
+ argv => [],
+ mode => q{configure},
+} );
-=cut
+my $conf = Parrot::Configure->new();
+test_step_thru_runstep($conf, q{init::defaults}, $args);
+
+my ($task, $step_name, @step_params, $step, $ret);
+my $pkg = q{gen::config_pm};
+
+$conf->add_steps($pkg);
+$conf->options->set(%{$args});
+$task = $conf->steps->[1];
+$step_name = $task->step;
[EMAIL PROTECTED] = @{ $task->params };
+
+$step = $step_name->new();
+ok(defined $step, "$step_name constructor returned defined value");
+isa_ok($step, $step_name);
+ok($step->description(), "$step_name has description");
+
+# Test of runstep() not yet ready for prime time.
+# ok($step->runstep($conf), "runstep() returned true value");
+
+pass("Keep Devel::Cover happy");
pass("Completed all tests in $0");
################### DOCUMENTATION ###################
Index: t/configure/124-auto_alignptrs-04.t
===================================================================
--- t/configure/124-auto_alignptrs-04.t (revision 23311)
+++ t/configure/124-auto_alignptrs-04.t (working copy)
@@ -41,18 +41,17 @@
ok( $step->description(), "$step_name has description" );
{
- use Config;
- local $^O = q{hpux};
+ $conf->data->set_p5( OSNAME => 'hpux' );
my $ret = $step->runstep($conf);
ok( $ret, "$step_name runstep() returned true value" );
- if ( $Config{ccflags} !~ /DD64/ ) {
+ if ( $conf->data->get_p5('ccflags') !~ /DD64/ ) {
is($conf->data->get('ptr_alignment'), 4,
"Got expected pointer alignment for HP Unix");
is($step->result(), qq{for hpux: 4 bytes},
"Expected result was set");
} else {
- pass("Cannot mock %Config");
- pass("Cannot mock %Config");
+ pass("Cannot mock \%Config");
+ pass("Cannot mock \%Config");
}
}
Index: t/configure/125-auto_headers-04.t
===================================================================
--- t/configure/125-auto_headers-04.t (revision 23311)
+++ t/configure/125-auto_headers-04.t (working copy)
@@ -5,9 +5,8 @@
use strict;
use warnings;
-use Test::More tests => 15;
+use Test::More tests => 14;
use Carp;
-use Config;
use lib qw( lib t/configure/testlib );
use_ok('config::init::defaults');
use_ok('config::auto::headers');
@@ -42,13 +41,13 @@
isa_ok( $step, $step_name );
ok( $step->description(), "$step_name has description" );
-auto::headers::_set_from_Config($conf, \%Config);
-ok($conf->data->get('i_netinetin'), "Mapping made correctly");
+auto::headers::_set_from_Config($conf);
ok(! $conf->data->get('i_niin'), "Mapping made correctly");
{
- local $^O = "msys";
- my %extra_headers = map {$_, 1} auto::headers::_list_extra_headers();
+ $conf->data->set_p5( OSNAME => "msys" );
+ my %extra_headers =
+ map {$_, 1} auto::headers::_list_extra_headers($conf);
ok($extra_headers{'sysmman.h'}, "Special header set for msys");
ok($extra_headers{'netdb.h'}, "Special header set for msys");
}
Index: t/configure/102-init_defaults-01.t
===================================================================
--- t/configure/102-init_defaults-01.t (revision 23311)
+++ t/configure/102-init_defaults-01.t (working copy)
@@ -7,7 +7,6 @@
use warnings;
use Test::More tests => 6;
use Carp;
-use Data::Dumper;
use lib qw( lib );
use_ok('config::init::defaults');
use Parrot::Configure;
Index: t/configure/111-auto_gcc-13.t
===================================================================
--- t/configure/111-auto_gcc-13.t (revision 23311)
+++ t/configure/111-auto_gcc-13.t (working copy)
@@ -41,7 +41,7 @@
$gnucref->{__GNUC__} = q{3};
$gnucref->{__GNUC_MINOR__} = q{1};
{
- local $^O = 'hpux';
+ $conf->data->set_p5( OSNAME => 'hpux' );
ok($step->_evaluate_gcc($conf, $gnucref),
"_evaluate_gcc() returned true value");
ok(defined $conf->data->get( 'gccversion' ),
Index: t/configure/125-auto_headers-01.t
===================================================================
--- t/configure/125-auto_headers-01.t (revision 23311)
+++ t/configure/125-auto_headers-01.t (working copy)
@@ -5,7 +5,7 @@
use strict;
use warnings;
-use Test::More tests => 12;
+use Test::More tests => 13;
use Carp;
use lib qw( lib t/configure/testlib );
use_ok('config::init::defaults');
@@ -44,6 +44,7 @@
ok( $ret, "$step_name runstep() returned true value" );
is($step->result(), q{skipped}, "Expected result was set");
+pass("Keep Devel::Cover happy");
pass("Completed all tests in $0");
################### DOCUMENTATION ###################
Index: config/inter/progs.pm
===================================================================
--- config/inter/progs.pm (revision 23311)
+++ config/inter/progs.pm (working copy)
@@ -96,8 +96,9 @@
$conf->data->set( ldflags => $ldflags );
$libs = $conf->data->get('libs');
- $libs = join ' ', grep { $^O =~ /VMS|MSWin/ ||
!/^-l(c|gdbm(_compat)?|dbm|ndbm|db)$/ }
- split( ' ', $libs );
+ $libs = join q{ },
+ grep { $conf->data->get_p5('OSNAME') =~ /VMS|MSWin/ ||
!/^-l(c|gdbm(_compat)?|dbm|ndbm|db)$/ }
+ split( q{ }, $libs );
$libs = integrate( $libs, $conf->options->get('libs') );
$libs = prompt( "What libraries should your C compiler use?", $libs ) if
$ask;
$conf->data->set( libs => $libs );
Index: config/init/hints.pm
===================================================================
--- config/init/hints.pm (revision 23311)
+++ config/init/hints.pm (working copy)
@@ -38,7 +38,7 @@
my $hints_used = 0;
- my $hints = "init::hints::" . lc($^O);
+ my $hints = "init::hints::" . lc( $conf->data->get_p5('OSNAME') );
print "[ $hints " if $verbose;
Index: config/init/defaults.pm
===================================================================
--- config/init/defaults.pm (revision 23311)
+++ config/init/defaults.pm (working copy)
@@ -41,6 +41,37 @@
sub runstep {
my ( $self, $conf ) = @_;
+ # Later configuration steps need access to values from the Perl 5
+ # %Config. However, other later configuration steps may change
+ # the corresponding values in the Parrot::Configure object. In
+ # order to provide access to the original values from Perl 5
+ # %Config, we grab those settings we need now and store them in
+ # special keys within the Parrot::Configure object.
+ # This is a multi-stage process.
+
+ # Stage 1:
+ foreach my $orig ( qw|
+ archname
+ ccflags
+ d_socklen_t
+ longsize
+ optimize
+ sig_name
+ use64bitint
+ | ) {
+ $conf->data->set_p5( $orig => $Config{$orig} );
+ }
+
+ # Stage 2 (anticipating needs of config/auto/headers.pm):
+ $conf->data->set_p5(
+ map { $_ => $Config{$_} } grep { /^i_/ } keys %Config
+ );
+
+ # Stage 3 (Along similar lines, look up values from Perl 5 special
+ # variables and stash them for later lookups. Name them according
+ # to their 'use English' names as documented in 'perlvar'.)
+ $conf->data->set_p5( OSNAME => $^O );
+
# We need a Glossary somewhere!
$conf->data->set(
debugging => $conf->options->get('debugging') ? 1 : 0,
Index: config/init/hints/openbsd.pm
===================================================================
--- config/init/hints/openbsd.pm (revision 23311)
+++ config/init/hints/openbsd.pm (working copy)
@@ -5,7 +5,6 @@
use strict;
use warnings;
-use Config;
sub runstep {
my ( $self, $conf ) = @_;
@@ -22,7 +21,7 @@
}
$conf->data->set( libs => $libs );
- if ( ( split( m/-/, $Config{archname}, 2 ) )[0] eq 'powerpc' ) {
+ if ( ( split( m/-/, $conf->data->get_p5('archname'), 2 ) )[0] eq 'powerpc'
) {
$conf->data->set( as => 'as -mregnames' );
}
Index: config/init/hints/linux.pm
===================================================================
--- config/init/hints/linux.pm (revision 23311)
+++ config/init/hints/linux.pm (working copy)
@@ -6,10 +6,6 @@
use strict;
use warnings;
-use Config;
-
-our $verbose;
-
sub runstep {
my ( $self, $conf ) = @_;
@@ -17,6 +13,7 @@
my $ccflags = $conf->option_or_data('ccflags');
my $cc = $conf->option_or_data('cc');
my $linkflags = $conf->option_or_data('linkflags');
+ my $verbose;
$verbose = $conf->options->get('verbose');
print $/ if $verbose;
@@ -147,7 +144,8 @@
libparrot_soname =>
'-Wl,-soname=libparrot$(SHARE_EXT).$(SOVERSION)',
);
- if ( ( split( m/-/, $Config{archname}, 2 ) )[0] eq 'ia64' ) {
+ if ( ( split( m/-/, $conf->data->get_p5('archname'), 2 ) )[0] eq 'ia64' )
{
+
$conf->data->set( platform_asm => 1 );
}
return;
Index: config/init/optimize.pm
===================================================================
--- config/init/optimize.pm (revision 23311)
+++ config/init/optimize.pm (working copy)
@@ -19,7 +19,6 @@
use base qw(Parrot::Configure::Step::Base);
-use Config;
use Parrot::Configure::Step;
@@ -56,7 +55,7 @@
# use perl5's value
# gcc 4.1 doesn't like -mcpu=xx, i.e. it's deprecated
- my $opts = $Config{optimize};
+ my $opts = $conf->data->get_p5('optimize');
my $gccversion = $conf->data->get( 'gccversion' );
my $arch_opt = 'cpu';
if ( defined $gccversion and $gccversion > 3.3 ) {
Index: config/auto/gdbm.pm
===================================================================
--- config/auto/gdbm.pm (revision 23311)
+++ config/auto/gdbm.pm (working copy)
@@ -19,7 +19,6 @@
use base qw(Parrot::Configure::Step::Base);
-use Config;
use Parrot::Configure::Step ':auto';
@@ -53,7 +52,7 @@
my $linkflags = $conf->data->get('linkflags');
my $ccflags = $conf->data->get('ccflags');
- my $osname = $Config{osname};
+ my $osname = $conf->data->get_p5('OSNAME');
# On OS X check the presence of the gdbm header in the standard
# Fink location.
@@ -68,7 +67,7 @@
}
cc_gen('config/auto/gdbm/gdbm.in');
- if ( $^O =~ /mswin32/i ) {
+ if ( $conf->data->get_p5('OSNAME') =~ /mswin32/i ) {
if ( $cc =~ /^gcc/i ) {
eval { cc_build( '', '-llibgdbm' ); };
}
Index: config/auto/headers.pm
===================================================================
--- config/auto/headers.pm (revision 23311)
+++ config/auto/headers.pm (working copy)
@@ -16,13 +16,9 @@
use strict;
use warnings;
-
use base qw(Parrot::Configure::Step::Base);
-
use Parrot::Configure::Step ':auto';
-use Config;
-
sub _init {
my $self = shift;
my %data;
@@ -39,10 +35,11 @@
$self->set_result('skipped');
return 1;
}
- _set_from_Config($conf, \%Config);
- my @extra_headers = _list_extra_headers();
+ _set_from_Config($conf);
+ my @extra_headers = _list_extra_headers($conf);
+
my @found_headers;
foreach my $header (@extra_headers) {
my $pass = 0;
@@ -81,19 +78,19 @@
}
sub _set_from_Config {
- my ($conf, $Configref) = @_;
+ my $conf = shift;
# perl5's Configure system doesn't call this by its full name, which may
# confuse use later, particularly once we break free and start doing all
# probing ourselves
my %mapping = ( i_niin => "i_netinetin" );
- for ( keys %{$Configref} ) {
- next unless /^i_/;
- $conf->data->set( $mapping{$_} || $_ => $Configref->{$_} );
+ for ( grep { /^i_/ } $conf->data->keys_p5() ) {
+ $conf->data->set( $mapping{$_} || $_ => $conf->data->get_p5($_) );
}
}
sub _list_extra_headers {
+ my $conf = shift;
# some headers may not be probed-for by perl 5, or might not be
# properly reflected in %Config (i_fcntl seems to be wrong on my machine,
# for instance).
@@ -110,7 +107,7 @@
sys/stat.h sysexit.h limits.h);
# more extra_headers needed on mingw/msys; *BSD fails if they are present
- if ( $^O eq "msys" ) {
+ if ( $conf->data->get_p5('OSNAME') eq "msys" ) {
push @extra_headers, qw(sysmman.h netdb.h);
}
return @extra_headers;
Index: config/auto/socklen_t.pm
===================================================================
--- config/auto/socklen_t.pm (revision 23311)
+++ config/auto/socklen_t.pm (working copy)
@@ -19,8 +19,6 @@
use base qw(Parrot::Configure::Step::Base);
-use Config;
-
use Parrot::Configure::Step ':auto';
sub _init {
@@ -44,7 +42,9 @@
sub _probe_for_socklen_t {
my $conf = shift;
- return $conf->data->get('has_socklen_t') || $Config{d_socklen_t};
+ return $conf->data->get('has_socklen_t')
+ ||
+ $conf->data->get_p5('d_socklen_t');
}
sub _evaluate_socklen_t {
Index: config/auto/signal.pm
===================================================================
--- config/auto/signal.pm (revision 23311)
+++ config/auto/signal.pm (working copy)
@@ -84,10 +84,9 @@
# Any changes made here will be lost.
#
EOF
- use Config;
my ( $i, $name );
$i = 0;
- foreach $name ( split( ' ', $Config{sig_name} ) ) {
+ foreach $name ( split( ' ', $conf->data->get_p5('sig_name') ) ) {
print {$O} ".constant SIG$name\t$i\n" if $i;
$i++;
}
Index: config/auto/pack.pm
===================================================================
--- config/auto/pack.pm (revision 23311)
+++ config/auto/pack.pm (working copy)
@@ -19,9 +19,7 @@
use base qw(Parrot::Configure::Step::Base);
use Parrot::Configure::Step;
-use Config;
-
sub _init {
my $self = shift;
my %data;
@@ -47,14 +45,18 @@
my $which = $_ eq 'intvalsize' ? 'packtype_i' : 'packtype_op';
my $size = $conf->data->get($_);
my $format;
- if ( ( $] >= 5.006 ) && ( $size == $longsize ) && ( $size ==
$Config{longsize} ) ) {
+ if (
+ ( $] >= 5.006 ) &&
+ ( $size == $longsize ) &&
+ ( $size == $conf->data->get_p5('longsize') )
+ ) {
$format = 'l!';
}
elsif ( $size == 4 ) {
$format = 'l';
}
- elsif ( $size == 8 || $Config{use64bitint} eq 'define' ) {
-
+ elsif ( $size == 8 ||
+ $conf->data->get_p5('use64bitint') eq 'define' ) {
# pp_pack is annoying, and this won't work unless sizeof(UV) >= 8
$format = 'q';
}
Index: config/auto/m4.pm
===================================================================
--- config/auto/m4.pm (revision 23311)
+++ config/auto/m4.pm (working copy)
@@ -19,7 +19,6 @@
use base qw(Parrot::Configure::Step::Base);
-use Config;
use Parrot::Configure::Step ':auto', 'capture_output';
@@ -40,7 +39,7 @@
$verbose = $conf->options->get( 'verbose' );
print $/ if $verbose;
- my $archname = $Config{archname};
+ my $archname = $conf->data->get_p5('archname');
my ( $cpuarch, $osname ) = split m/-/, $archname, 2;
if ( !defined $osname ) {
( $osname, $cpuarch ) = ( $cpuarch, "" );
Index: config/auto/gmp.pm
===================================================================
--- config/auto/gmp.pm (revision 23311)
+++ config/auto/gmp.pm (working copy)
@@ -18,10 +18,8 @@
use base qw(Parrot::Configure::Step::Base);
-use Config;
use Parrot::Configure::Step ':auto';
-
sub _init {
my $self = shift;
my %data;
@@ -51,7 +49,7 @@
my $libs = $conf->data->get('libs');
my $linkflags = $conf->data->get('linkflags');
my $ccflags = $conf->data->get('ccflags');
- if ( $^O =~ /mswin32/i ) {
+ if ( $conf->data->get_p5('OSNAME') =~ /mswin32/i ) {
if ( $cc =~ /^gcc/i ) {
$conf->data->add( ' ', libs => '-lgmp' );
}
@@ -63,7 +61,7 @@
$conf->data->add( ' ', libs => '-lgmp' );
}
- my $osname = $Config{osname};
+ my $osname = $conf->data->get_p5('OSNAME');
# On OS X check the presence of the gmp header in the standard
# Fink location.
Index: config/auto/readline.pm
===================================================================
--- config/auto/readline.pm (revision 23311)
+++ config/auto/readline.pm (working copy)
@@ -18,10 +18,8 @@
use base qw(Parrot::Configure::Step::Base);
-use Config;
use Parrot::Configure::Step ':auto';
-
sub _init {
my $self = shift;
my %data;
@@ -40,7 +38,7 @@
my $libs = $conf->data->get('libs');
my $linkflags = $conf->data->get('linkflags');
my $ccflags = $conf->data->get('ccflags');
- if ( $^O =~ /mswin32/i ) {
+ if ( $conf->data->get_p5('OSNAME') =~ /mswin32/i ) {
if ( $cc =~ /^gcc/i ) {
$conf->data->add( ' ',
libs => '-lreadline -lgw32c -lole32 -luuid -lwsock32
-lmsvcp60' );
@@ -53,7 +51,7 @@
$conf->data->add( ' ', libs => '-lreadline' );
}
- my $osname = $Config{osname};
+ my $osname = $conf->data->get_p5('OSNAME');
# On OS X check the presence of the readline header in the standard
# Fink/macports location.
Index: config/auto/gcc.pm
===================================================================
--- config/auto/gcc.pm (revision 23311)
+++ config/auto/gcc.pm (working copy)
@@ -106,7 +106,7 @@
HAS_aligned_funcptr => 1
);
$conf->data->set( HAS_aligned_funcptr => 0 )
- if $^O eq 'hpux';
+ if $conf->data->get_p5('OSNAME') eq 'hpux';
}
return 1;
}
Index: config/auto/alignptrs.pm
===================================================================
--- config/auto/alignptrs.pm (revision 23311)
+++ config/auto/alignptrs.pm (working copy)
@@ -19,9 +19,7 @@
use base qw(Parrot::Configure::Step::Base);
use Parrot::Configure::Step ':auto';
-use Config;
-
sub _init {
my $self = shift;
my %data;
@@ -45,7 +43,7 @@
$align = $conf->data->get('ptr_alignment');
$result_str .= "configured: ";
}
- elsif ( $^O eq 'hpux' && $Config{ccflags} !~ /DD64/ ) {
+ elsif ( $conf->data->get_p5('OSNAME') eq 'hpux' &&
$conf->data->get_p5('ccflags') !~ /DD64/ ) {
# HP-UX 10.20/32 hangs in this test.
$align = 4;
Index: config/gen/config_h.pm
===================================================================
--- config/gen/config_h.pm (revision 23311)
+++ config/gen/config_h.pm (working copy)
@@ -80,7 +80,8 @@
}
}
- print {$HH} "\n#define BUILD_OS_NAME \"$^O\"\n";
+ my $osname = $conf->data->get_p5('OSNAME');
+ print {$HH} "\n#define BUILD_OS_NAME \"$osname\"\n";
my $define = $conf->options->get('define');
Index: config/gen/platform.pm
===================================================================
--- config/gen/platform.pm (revision 23311)
+++ config/gen/platform.pm (working copy)
@@ -19,8 +19,6 @@
use base qw(Parrot::Configure::Step::Base);
-use Config;
-
use Parrot::Configure::Step qw(copy_if_diff);
sub _init {
@@ -36,14 +34,14 @@
my ( $self, $conf ) = @_;
my $verbose = $conf->options->get('verbose');
- my $platform = lc $^O;
+ my $platform = lc ( $conf->data->get_p5('OSNAME') );
$platform = "ansi" if defined( $conf->options->get('miniparrot') );
$platform = "win32" if $platform =~ /^msys/;
$platform = "win32" if $platform =~ /^mingw/;
$platform =~ s/^ms//;
- if ( ( split m/-/, $Config{archname}, 2 )[0] eq 'ia64' ) {
+ if ( ( split m/-/, $conf->data->get_p5('archname'), 2 )[0] eq 'ia64' ) {
$platform = 'ia64';
}
