# New Ticket Created by James Keenan
# Please include the string: [perl #44493]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=44493 >
---
osname= linux
osvers= 2.6.18.3
arch= i486-linux-gnu-thread-multi
cc= cc
---
Flags:
category=core
severity=medium
ack=no
---
Several weeks back method slurp_temp() was added to
lib/Parrot/Configure/Data.pm and then subsequently used in Configure.pl.
No unit tests were provided. I've been trying to boost test coverage in
the reconfigure/ branch and finally got around to examining
slurp_temp(). I noted a slight difference between slurp() and
slurp_temp(). The former stated 'use Parrot::Config::Generated', while
the latter simply said 'use Parrot::Config'. The former is only created
during configuration; the latter is MANIFEST-listed. So in the former
the 'eval' return value could meaningfully be either defined or
undefined, whereas in the latter it was all but guaranteed to be
defined.
The patch attached corrects Parrot::Configure::Data::slurp_temp,
corrects two existing test files, and adds one new test file in
t/postconfigure.
I will apply this patch to trunk within a couple of days unless someone
objects.
Thank you very much.
kid 51
Index: MANIFEST
===================================================================
--- MANIFEST (revision 20550)
+++ MANIFEST (working copy)
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Tue Aug 7 23:41:36 2007 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Tue Aug 7 23:56:32 2007 UT
#
# See tools/dev/install_files.pl for documentation on the
# format of this file.
@@ -3151,6 +3151,7 @@
t/postconfigure/03-revision_no_DEVELOPING.t []
t/postconfigure/04-revision.t []
t/postconfigure/05-trace.t []
+t/postconfigure/06-data_slurp_temp.t []
t/run/README []
t/run/exit.t []
t/run/options.t []
Index: lib/Parrot/Configure/Data.pm
===================================================================
--- lib/Parrot/Configure/Data.pm (revision 20550)
+++ lib/Parrot/Configure/Data.pm (working copy)
@@ -203,7 +203,7 @@
my $self = shift;
my $res = eval <<EVAL_CONFIG_TEMP;
no strict;
-use Parrot::Config;
+use Parrot::Config::Generated;
\\%PConfig_Temp;
EVAL_CONFIG_TEMP
Index: t/configure/004-configure.t
===================================================================
--- t/configure/004-configure.t (revision 20550)
+++ t/configure/004-configure.t (working copy)
@@ -6,7 +6,7 @@
use strict;
use warnings;
-use Test::More tests => 30;
+use Test::More tests => 31;
use Carp;
use lib qw( . lib ../lib ../../lib );
use Parrot::BuildUtil;
@@ -98,9 +98,25 @@
eval { $conf->data()->slurp(); };
like($@,
qr/You cannot use --step until you have completed the full configure
process/,
- "Got expected error message when using --step option without prior
completed configuration");
+ "Got expected error message when using --step option and slurp()
without prior completed configuration");
}
+$res = eval "no strict; use Parrot::Config::Generated; \\%PConfig_Temp";
+SKIP: {
+ my $reason = <<REASON;
+If you have already completed configuration,
+you can call Parrot::Configure::Data::slurp_temp().
+But here you are testing for that method's failure.
+REASON
+
+ skip $reason, 1 if defined $res;
+
+ eval { $conf->data()->slurp_temp(); };
+ like($@,
+ qr/You cannot use --step until you have completed the full configure
process/,
+ "Got expected error message when using --step option and slurp_temp()
without prior completed configuration");
+}
+
pass("Completed all tests in $0");
################### DOCUMENTATION ###################
Index: t/postconfigure/02-data_slurp.t
===================================================================
--- t/postconfigure/02-data_slurp.t (revision 20550)
+++ t/postconfigure/02-data_slurp.t (working copy)
@@ -85,7 +85,7 @@
is($conf->options->{c}->{debugging}, 1,
"command-line option '--debugging' has been stored in object");
-my $res = eval "no strict; use Parrot::Config; \\%PConfig";
+my $res = eval "no strict; use Parrot::Config::Generated; \\%PConfig";
SKIP: {
my $reason = <<REASON;
If you have already completed configuration,
Index: t/postconfigure/06-data_slurp_temp.t
===================================================================
--- t/postconfigure/06-data_slurp_temp.t (revision 0)
+++ t/postconfigure/06-data_slurp_temp.t (revision 0)
@@ -0,0 +1,150 @@
+#! perl
+# Copyright (C) 2007, The Perl Foundation.
+# $Id: 06-data_slurp_temp.t 20500 2007-08-05 20:49:59Z jkeenan $
+# 06-data_slurp_temp.t
+
+use strict;
+use warnings;
+
+use Test::More tests => 33;
+use Carp;
+use lib qw( . lib ../lib ../../lib );
+use Parrot::BuildUtil;
+use Parrot::Configure;
+use Parrot::Configure::Options qw( process_options );
+use_ok('Parrot::Configure::Step::List', qw|
+ get_steps_list
+| );
+use Parrot::IO::Capture::Mini;
+
+my $parrot_version = Parrot::BuildUtil::parrot_version();
+like($parrot_version, qr/\d+\.\d+\.\d+/,
+ "Parrot version is in 3-part format");
+
+$| = 1;
+is($|, 1, "output autoflush is set");
+
+my $args = process_options( {
+ argv => [ q{--step=gen::makefiles}, q{--target=Makefile} ],
+ script => $0,
+ parrot_version => $parrot_version,
+ svnid => '$Id: 02-data_slurp.t 20550 2007-08-07 23:46:54Z
jkeenan $',
+} );
+ok(defined $args, "process_options returned successfully");
+my %args = %$args;
+
+my $conf = Parrot::Configure->new;
+ok(defined $conf, "Parrot::Configure->new() returned okay");
+isa_ok($conf, "Parrot::Configure");
+
+my $newconf = Parrot::Configure->new;
+ok(defined $newconf, "Parrot::Configure->new() returned okay");
+isa_ok($newconf, "Parrot::Configure");
+is($conf, $newconf, "Parrot::Configure object is a singleton");
+
+# Since these tests peek into the Parrot::Configure object, they will break if
+# the structure of that object changes. We retain them for now to delineate
+# our progress in testing the object.
+foreach my $k (qw| steps options data |) {
+ ok(defined $conf->$k, "Parrot::Configure object has $k key");
+}
+is(ref($conf->steps), q{ARRAY},
+ "Parrot::Configure object 'steps' key is array reference");
+is(scalar @{$conf->steps}, 0,
+ "Parrot::Configure object 'steps' key holds empty array reference");
+foreach my $k (qw| options data |) {
+ isa_ok($conf->$k, "Parrot::Configure::Data");
+}
+
+can_ok("Parrot::Configure", qw| data |);
+can_ok("Parrot::Configure", qw| options |);
+can_ok("Parrot::Configure", qw| steps |);
+can_ok("Parrot::Configure", qw| add_step |);
+can_ok("Parrot::Configure", qw| add_steps |);
+can_ok("Parrot::Configure", qw| run_single_step |);
+can_ok("Parrot::Configure", qw| runsteps |);
+can_ok("Parrot::Configure", qw| _run_this_step |);
+
+$conf->add_step($args->{step});
+my @confsteps = @{$conf->steps};
+isnt(scalar @confsteps, 0,
+ "Parrot::Configure object 'steps' key holds non-empty array reference");
+my $nontaskcount = 0;
+foreach my $k (@confsteps) {
+ $nontaskcount++ unless $k->isa("Parrot::Configure::Task");
+}
+is($nontaskcount, 0, "Each step is a Parrot::Configure::Task object");
+
+$conf->options->set(%{$args});
+is($conf->options->{c}->{step}, 'gen::makefiles',
+ "command-line option '--step=gen::makefiles' has been stored in object");
+is($conf->options->{c}->{target}, 'Makefile',
+ "command-line option '--target=Makefiles' has been stored in object");
+is($conf->options->{c}->{debugging}, 1,
+ "command-line option '--debugging' has been stored in object");
+
+my $res = eval "no strict; use Parrot::Config::Generated; \\%PConfig";
+SKIP: {
+ my $reason = <<REASON;
+If you have already completed configuration,
+you can call Parrot::Configure::Data::slurp().
+You appear not to have completed configuration;
+hence, two tests are skipped.
+REASON
+
+ skip $reason, 2 unless defined $res;
+
+ eval { $conf->data()->slurp(); };
+ ok( (defined $@) && (! $@), "Parrot::Configure::slurp() succeeded");
+
+ eval { $conf->data()->slurp_temp(); };
+ ok( (defined $@) && (! $@), "Parrot::Configure::slurp_temp() succeeded");
+
+ my $tie_out = tie *STDOUT, "Parrot::IO::Capture::Mini"
+ or croak "Unable to tie";
+ my $ret = $conf->run_single_step( $args->{step} );
+ my @more_lines = $tie_out->READLINE;
+ ok( (defined $@) && (! $@),
+ "Parrot::Configure::run_single_step() succeeded");
+}
+
+pass("Completed all tests in $0");
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+06-data_slurp_temp.t - test Parrot::Configure::Data::slurp() once
configuration has been completed
+
+=head1 SYNOPSIS
+
+ % prove t/postconfigure/06-data_slurp_temp.t
+
+=head1 DESCRIPTION
+
+The files in this directory test functionality used by F<Configure.pl>.
+Certain of the modules C<use>d by F<Configure.pl> have functionality which is
+only meaningful I<after> F<Configure.pl> has actually been run and
+Parrot::Config::Generated has been created. So certain tests need to be run
+when your Parrot filesystem is in a "pre-F<make>, post-F<Configure.pl>" state.
+
+The tests in this file mimic the functionality of F<tools/dev/reconfigure.pl>
+and test C<Parrot::Configure::Data::slurp()>. What is 'slurped' here is an
+already created C<%Parrot::Config::PConfig>.
+
+=head1 AUTHOR
+
+James E Keenan
+
+=head1 SEE ALSO
+
+Parrot::Configure, F<Configure.pl>.
+
+=cut
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
---
Summary of my parrot 0.4.14 (r20550) configuration:
configdate='Tue Aug 7 23:58:13 2007 GMT'
Platform:
osname=linux, archname=i686-linux
jitcapable=1, jitarchname=i386-linux,
jitosname=LINUX, jitcpuarch=i386
execcapable=1
perl=/usr/local/bin/perl
Compiler:
cc='cc', ccflags=' -pipe -I/usr/local/include -D_LARGEFILE_SOURCE
-D_FILE_OFFSET_BITS=64 -D_GNU_SOURCE -DHASATTRIBUTE_CONST
-DHASATTRIBUTE_DEPRECATED -DHASATTRIBUTE_MALLOC -DHASATTRIBUTE_NORETURN
-DHASATTRIBUTE_PURE -DHASATTRIBUTE_UNUSED -DHASATTRIBUTE_WARN_UNUSED_RESULT',
Linker and Libraries:
ld='cc', ldflags=' -L/usr/local/lib',
cc_ldflags='',
libs='-lnsl -ldl -lm -lcrypt -lutil -lpthread -lrt'
Dynamic Linking:
share_ext='.so', ld_share_flags='-shared -L/usr/local/lib -fPIC',
load_ext='.so', ld_load_flags='-shared -L/usr/local/lib -fPIC'
Types:
iv=long, intvalsize=4, intsize=4, opcode_t=long, opcode_t_size=4,
ptrsize=4, ptr_alignment=1 byteorder=1234,
nv=double, numvalsize=8, doublesize=8
---
Environment:
HOME =/home/jimk
LANG (unset)
LANGUAGE (unset)
LD_LIBRARY_PATH (unset)
LOGDIR (unset)
PATH
=/usr/local/bin:/usr/local/bin:/usr/bin:/bin:/usr/bin/X11:/usr/games:/usr/local/mysql/bin:/home/jimk/bin:/home/jimk/bin/perl
SHELL =/bin/bash
