Re: Literal Values
On Tue, 12 Nov 2002 17:00:17 +, Dave Whipp wrote:
(cross-posting to perl.qa for other perspectives)
When I look at this, I find myself wanting to separate the control from the
data. Here's an alternative:
my input = qw( 4.5 0.0 13.12343 );
my output = qw( 4.5 0.0 13.12343 ); # can't assume that input==output
my $code = join(;, map {print $_} input);
my $expect = join( , output);
output_is($code, $expect, Simple Floats);
This is, perhaps, slightly harder to grok initially. But its easier to
extend the test data; and also to make control-path changes (such as added
the \n to the print statement). It might be better to use a hash for the
test data.
Yes, that is easier to extend. I'm not a big fan of mushing together several
different tests into one output_is() chunk, but that's because we don't have
anything of finer grain yet.
It'd be nice to write something like:
output_lines(INPUT, OUTPUT, NAMES);
4
0.0
13.12343
INPUT
4
0.0
13.12343
OUTPUT
int
float
longer float
NAMES
and get individual tests as:
ok 1 # int
ok 2 # float
ok 3 # longer float
Maybe that's a wrapper around output_is() for the string test. Maybe it should
be a new method in the Parrot test module.
It is possible to make this type of test much easier to read. A mechanism I
have used in the past is to put the test data into a table (I used html).
Then, you have the test data and expected output as a nice table in a
document; and a simple piece of code to extract tests from it (assuming you
use a perl5 module to parse the table).
Being able to specify an output separator (assuming \n in its absence) may
alleviate this.
-- c
Re: And for the mod_perl folks... Test::Builder-reset
On Mon, 11 Nov 2002 02:24:23 +, Michael G Schwern wrote: Also, for those who aren't happy with the fact that Test::Builder is a hard singleton with its state held in a bunch of file-scoped lexicals (hard to debug) reset() made me collect together all those state variables in one point in the source making it much easier someone to convert them into object data, if they feel so inclined. I'm not yet convinced its a good idea. We *could* add a method called really_create_a_new_builder() that doesn't have the singleton properties, but what problem does that solve? As long as we're stuck with test numbers, we have to try not to confuse Test::Harness. -- c
Re: And for the mod_perl folks... Test::Builder-reset
On Monday 11 November 2002 14:40, Michael G Schwern wrote:
We *could* add a method called really_create_a_new_builder() that doesn't
have the singleton properties, but what problem does that solve? As long
as we're stuck with test numbers, we have to try not to confuse
Test::Harness.
Little known fact: test numbers are optional.
With the mandatory Test::Harness upgrade, yes. My point is that mixing
Test::Builder outputs is bad juju:
ok 1
ok 2
ok
ok 3
ok 1
ok 2
ok
ok 4
Maybe stuck with isn't the right phrase, but the conservative in me says
test numbers will be around for a while. Plus, I *like* them as a final
sanity check.
I know people have grumbled before about there being no way around the
singleton property, I just can't remember why. I'm doing that a lot
lately. Maybe I should check my hospital receipt, make sure all they took
out was my appendix. What's this scar on the back of my head...?
And why are you beeping?
Ok, here's one from me.
It would make Test::Builder easier to test itself for one. There's lots of
T::B tests which deliberately throw it off into some bizarre state or cause
lots of failures. These results must be pipped off somewhere and analyzed
seperately. For those tests, we're back to using a hand-rolled ok()
function.
With two T::B objects, we could beat on one object while leaving another in
a normal state to perform the tests.
Simplifying the tests there is a *good* reason. They scare me.
I suppose we could also log only certain kinds of tests, too. That might make
some of my fiendish plans easier. (Log only can_ok(), in this T::B object.)
Maybe we're too coarsely grained on the singletonness. It's only the test
counters and outputs that really need to be single, right? We could make
Test::Builder::Counter and Test::Builder::Output as singletons and let
Test::Builder use those by default. For the tests, we could mock them or
override them, or whatever we find necessary.
Serious suggestion.
The real reason why I put all the data into lexicals rather than a hash is
because its easier to type $Have_Plan than $self-{Have_Plan}.
Hmm, perhaps a source filter that allows:
.$Have_Plan
It's only one character longer...
-- c
Re: [ANNOUNCE] tv (Test::Verbose 0.001)
On Thu, 24 Oct 2002 13:56:00 -0700, Nicholas Clark wrote: But does it come complete with a free Schwern to write your tests for you? That's what I want. :-) [To be honest, I don't care if it's a Schwern (closure) who merely puts it onto his (captured lexical) $TODO, as long as there's also a reference to Chromatic to actually get a round tuit. That still gets my tests written for me with maximal laziness] Then who'll write the tests for me? There are only so many Autrijuses, Tatsuhikos, and petdances to go around. -- c
Re: Test::Class - comments wanted
On Mon, 14 Oct 2002 14:46:38 -0700, Michael G Schwern wrote: OTOH, my thinking recently is that the explicit plan has become obsolescent. [1] The explicit plan protects against: 1. Your test dying. 2. Your test not printing tests to STDOUT 3. Exiting early via exit(). #1 and #2 are protected by other implicit mechanisms in Test::Builder. #3 will be protected against by overriding CORE::exit in a future version. 4. Running too many tests (see File::Find escaping from $topdir on Mac OS 9). [1] This thinking makes me nervous, so I'm open to someone convincing me otherwise. I'd keep it as the non-default. It's nice to be able to specify exactly N tests, with the test suite catching that. If it's optional, that's fine. I'd miss it if it were completely gone. -- c
Re: Help spreading Test
On Sunday 28 July 2002 02:52, Johan Vromans wrote: On Fri, 26 Jul 2002 13:19:51 -0700, Johan Vromans wrote: This idea appeals to me, but I have thought of two drawbacks. The first is minor, and it's that I don't think Test::Builder should have special logic for installation. It seems that this would be better in CPANPLUS. It could then be something more modules would be able to use. Just for the sake of completeness: this is a non-issue in case of an CPAN or CPANPLUS install. Since Test::* is specified as a requirement this will be handled automatically. The case I aimed at is the case where a package is installed standalone (i.e., without CPAN(PLUS)). I agree that in this case it is better to just use the bundled version instead. Perhaps we are looking at this from the wrong direction. Instead of installing bundled modules, perhaps a shell should be able to specify that certain dependencies are available only for testing. That way, users wouldn't necessarily have to install Test::Builder and Test::Builder::Tester and so forth in the public directories. That doesn't sound completely right either. Johan, there's a real problem here you've identified, but I can't quite put my finger on what it is! -- c
[PATCH MakeMaker.pm] Add documentation for ExtUtils::MakeMaker::prompt()
Hi, Here's a rough cut at documentation for the hitherto rumored prompt() function. Suggestions welcome. -- c diff -ur ExtUtils-MakeMaker-6.03~/lib/ExtUtils/MakeMaker.pm ExtUtils-MakeMaker-6.03/lib/ExtUtils/MakeMaker.pm --- ExtUtils-MakeMaker-6.03~/lib/ExtUtils/MakeMaker.pm Wed Jun 19 14:07:36 2002 +++ ExtUtils-MakeMaker-6.03/lib/ExtUtils/MakeMaker.pm Sun Aug 18 18:44:32 2002 -2310,6 +2310,27 =back +=head1 Other Handy Functions + +=over 4 + +=item * prompt( $message, $default ) + +The Cprompt() function provides an easy way to request user input used to +write a makefile. It displays the first argument as a prompt for input. If +the second argument is provided, its value will be used as a default. The +function returns the selected value. + +If prompt() detects that it is not running in interactive mode (say, if it is +running from CPAN or CPANPLUS), or if PERL_MM_USE_DEFAULT is set to +true, the default value will be used without prompting. This prevents +automated processes from blocking on user input. + +If no default is provided as an argument, the default default value is a single +space character. + +=back + =head1 SEE ALSO ExtUtils::MM_Unix, ExtUtils::Manifest ExtUtils::Install,
Re: [PATCH Test::Builder] Add diagnostic messages to details
On Wednesday 31 July 2002 12:39, Michael G Schwern wrote:
This patch captures messages sent through diag() and stores them in the
diagnostic array. Now all of the information the tests generate is
available for later inspection.
Dude, where's my patch?
Did I completely miss it? Let's try this instead.
-- c
diff -ur Test-Simple-0.46~/lib/Test/Builder.pm Test-Simple-0.46/lib/Test/Builder.pm
--- Test-Simple-0.46~/lib/Test/Builder.pm Sat Jul 20 17:16:02 2002
+++ Test-Simple-0.46/lib/Test/Builder.pm Sat Jul 27 09:39:22 2002
-296,7 +296,7
my $todo = $self-todo($pack);
my $out;
-my $result = {};
+my $result = $Test_Results[$Curr_Test-1] ||= {};
unless( $test ) {
$out .= not ;
-329,7 +329,6
$result-{type} = '';
}
-$Test_Results[$Curr_Test-1] = $result;
$out .= \n;
$self-_print($out);
-658,13 +657,8
lock($Curr_Test);
$Curr_Test++;
-$Test_Results[$Curr_Test-1] = {
-'ok' = 1,
-actual_ok = 1,
-name = '',
-type = 'skip',
-reason= $why,
-};
+my $results = $Test_Results[$Curr_Test-1] ||= {};
+$results{qw( ok actual_ok name type reason )} = ( 1, 1, '', 'skip', $why );
my $out = ok;
$out .= $Curr_Test if $self-use_numbers;
-700,13 +694,9
lock($Curr_Test);
$Curr_Test++;
-$Test_Results[$Curr_Test-1] = {
-'ok' = 1,
-actual_ok = 0,
-name = '',
-type = 'todo_skip',
-reason= $why,
-};
+my $results = $Test_Results[$Curr_Test-1] ||= {};
+$results{qw( ok actual_ok name type reason )} =
+( 1, 0, '', 'todo_skip', $why );
my $out = not ok;
$out .= $Curr_Test if $self-use_numbers;
-897,6 +887,10
my $fh = $self-todo ? $self-todo_output : $self-failure_output;
local($\, $, $,) = (undef, ' ', '');
print $fh msgs;
+my $prev_test = $Curr_Test - 1;
+$prev_test = 0 if $prev_test 0;
+$Test_Results[ $prev_test ]{diag} ||= [];
+push { $Test_Results[ $prev_test ]{diag} }, msgs;
return 0;
}
-1350,7 +1344,7
In perl 5.8.0 and later, Test::Builder is thread-safe. The test
number is shared amongst all threads. This means if one thread sets
-the test number using current_test() they will all be effected.
+the test number using current_test() they will all be affected.
=head1 EXAMPLES
diff -ur Test-Simple-0.46~/t/details.t Test-Simple-0.46/t/details.t
--- Test-Simple-0.46~/t/details.t Sat Jul 20 17:08:36 2002
+++ Test-Simple-0.46/t/details.t Sat Jul 27 08:45:45 2002
-47,6 +47,7
TODO: {
local $TODO = 'i need a todo';
+#line 50
$Test-ok( 0, 'a test to todo!' );
push Expected_Details, { 'ok' = 1,
-54,6 +55,7
name = 'a test to todo!',
type = 'todo',
reason = 'i need a todo',
+ diag = [ # Failed (TODO) test ($0 at line 50)\n ],
};
$Test-todo_skip( 'i need both' );
-76,15 +78,19
reason= '',
};
+
$Test-current_test(6);
+
print ok 6 - current_test incremented\n;
push Expected_Details, { 'ok' = 1,
actual_ok = undef,
name = undef,
type = 'unknown',
reason= 'incrementing test number',
+ diag = [ '# Added', '# diagnostics', \n ],
};
+$Test-diag(qw( Added diagnostics ));
my details = $Test-details();
$Test-is_num( scalar details, 6,
'details() should return a list of all test details');
Re: [perl #15479] perl 5.8.0 segfault
On Wed, 31 Jul 2002 04:30:12 -0700, Nicholas Clark wrote: On Wed, Jul 31, 2002 at 01:20:25PM +0200, Rafael Garcia-Suarez wrote: Wasn't there a .t file to run separate perl interpreters and test for core dumps ? I keep forgetting that I need to remember to ask this. Is there a FAQ for regression test writing? Well, an guide to so I want to write a regression test, explaining how to do it, how perl5's tests are structured to reduce interdependencies, use Test::More; when Test::More is not appropriate.. Schwern and I talked about this last week. pod/perltest.pod was a likely candidate, though Perl QA have been working on Test::FAQ on the Wiki. There's also Test::Tutorial. It's in the core. And where did the p5p FAQ get to? MJD said he was taking it off his website... or do you mean the serious one? No idea. -- c
[PATCH Test::Builder] Add diagnostic messages to details
This patch captures messages sent through diag() and stores them in the diagnostic array. Now all of the information the tests generate is available for later inspection. It made the most sense to attach diagnostics to the previous test data. The documentation suggests a construct something like: ok( $foo, 'testing truth' ) or diag ( 'Backwards day!' ); There's a potential problem here, if diag() occurs before any tests. I changed the way test data is gathered, slightly, to take care of this. For that one case, the test output will be attached to the first test. I'm planning to add per-test-package level checking, but that'll be a separate patch. -- c the Implementor
Re: Help spreading Test
On Fri, 26 Jul 2002 13:19:51 -0700, Johan Vromans wrote: One of the problems I have with using Test::Builder is that I want to distribute packages to systems that do not (necessarily) have a decent version of Test::* installed. Now it is easy to include a copy of a suitable version of Test::Builder with the package (provided it is not too big). Would it be a good idea to add a provision to Test::Builder that can be called, from the Makefile.PL, to display a message like this: The verificiation tests for this package require the Test::Builder package of at least version X.Y. You do not seem to have this installed. I have included a copy of Test::Builder in this distribution that I can use for testing. Do you want me to install this version of Test::Builder as well? This would help spreading the good stuff. This idea appeals to me, but I have thought of two drawbacks. The first is minor, and it's that I don't think Test::Builder should have special logic for installation. It seems that this would be better in CPANPLUS. It could then be something more modules would be able to use. The second drawback is that the bundled version may be out of date. This is also mostly minor, as the prompt will only happen if the currently installed version is older (or not installed). There's a minor possibility of distributing buggy code and not updating the bundled file appropriately -- dependencies help with that. Maybe a better option yet is to mark something as a testing dependency, which can be installed if the user wants, but fall back to the bundled version otherwise. It's an interesting issue, and I'm glad you brought it up. -- c
[PATCH Test::Simple] Implement Test::Builder::details()
Since Test::Builder::details() is marked UNIMPLMENTED in 0.45, it seemed like a
useful method to add. This patch does so, with the appropriate tests in
t/Builder.t. It works as per my understanding of the Test::Builder POD.
I very nearly updated the copyright notice in Test::Builder, while I was at it.
-- c
diff -ur Test-Simple-0.45.old/lib/Test/Builder.pm Test-Simple-0.45/lib/Test/Builder.pm
--- Test-Simple-0.45.old/lib/Test/Builder.pmWed Jun 19 15:27:04 2002
+++ Test-Simple-0.45/lib/Test/Builder.pmFri Jul 5 22:44:24 2002
-281,12 +281,14
my $todo = $self-todo($pack);
my $out;
+my $result = {};
+
unless( $test ) {
$out .= not ;
-$Test_Results[$Curr_Test-1] = $todo ? 1 : 0;
+$result{ 'ok', 'actual_ok' } = ( ( $todo ? 1 : 0 ), 0 );
}
else {
-$Test_Results[$Curr_Test-1] = 1;
+$result{ 'ok', 'actual_ok' } = ( 1, $test );
}
$out .= ok;
-295,13 +297,17
if( defined $name ) {
$name =~ s|#|\\#|g; # # in a name can confuse Test::Harness.
$out .= - $name;
+$result-{name} = $name;
}
if( $todo ) {
my $what_todo = $todo;
$out .= # TODO $what_todo;
+$result-{reason} = $what_todo;
}
+$result-{type} = 'todo';
+$Test_Results[$Curr_Test-1] = $result;
$out .= \n;
$self-_print($out);
-630,7 +636,12
lock($Curr_Test);
$Curr_Test++;
-$Test_Results[$Curr_Test-1] = 1;
+$Test_Results[$Curr_Test-1] = {
+ok= 1,
+actual_ok = 0,
+type = 'skip',
+reason= $why,
+};
my $out = ok;
$out .= $Curr_Test if $self-use_numbers;
-666,7 +677,12
lock($Curr_Test);
$Curr_Test++;
-$Test_Results[$Curr_Test-1] = 1;
+$Test_Results[$Curr_Test-1] = {
+ok= 1,
+actual_ok = 0,
+type = 'todo_skip',
+reason= $why,
+};
my $out = not ok;
$out .= $Curr_Test if $self-use_numbers;
-1026,7 +1042,8
if( $num Test_Results ) {
my $start = Test_Results ? $#Test_Results : 0;
for ($start..$num-1) {
-$Test_Results[$_] = 1;
+{ $Test_Results[$_]}{qw( ok actual_ok reason )} =
+( 1, 0, 'incrementing test number' );
}
}
}
-1048,10 +1065,10
sub summary {
my($self) = shift;
-return Test_Results;
+return map { $_-{ok} } Test_Results;
}
-=item Bdetails IUNIMPLEMENTED
+=item Bdetails
my tests = $Test-details;
-1065,6 +1082,12
reason = reason for the above (if any)
};
+=cut
+
+sub details {
+return Test_Results;
+}
+
=item Btodo
my $todo_reason = $Test-todo;
-1218,7 +1241,7
$Test_Results[$Expected_Tests-1] = undef
unless defined $Test_Results[$Expected_Tests-1];
-my $num_failed = grep !$_, Test_Results[0..$Expected_Tests-1];
+my $num_failed = grep !$_-{ok}, Test_Results[0..$Expected_Tests-1];
$num_failed += abs($Expected_Tests - Test_Results);
if( $Curr_Test $Expected_Tests ) {
diff -ur Test-Simple-0.45.old/t/Builder.t Test-Simple-0.45/t/Builder.t
--- Test-Simple-0.45.old/t/Builder.tWed Jun 19 15:18:49 2002
+++ Test-Simple-0.45/t/Builder.tFri Jul 5 22:43:07 2002
-7,10 +7,11
}
}
+use vars '$TODO';
use Test::Builder;
my $Test = Test::Builder-new;
-$Test-plan( tests = 7 );
+$Test-plan( tests = 26 );
my $default_lvl = $Test-level;
$Test-level(0);
-28,3 +29,38
print ok $test_num - current_test() set\n;
$Test-ok( 1, 'counter still good' );
+
+my tests = $Test-summary();
+$Test-ok( (grep { ! ref $_ } tests ) == 7,
+'summary() should return only booleans' );
+$Test-skip( 'i need a skip' );
+{
+local $TODO = 'i need a todo';
+$Test-ok( 0, 'a test to todo!' );
+}
+$Test-todo_skip( 'i need both' );
+
+my details = $Test-details();
+$Test-ok( details == 11,
+'details() should return a list of all test details');
+
+foreach my $detail ([ 0, 'ok', '1'], [ 1, 'name', 'level()' ]) {
+my ($number, $field, $value) = $detail;
+$Test-ok( $details[$number]{$field} eq $value,
+... with the correct '$field' fields );
+}
+
+$Test-ok( $details[8]{ok} == 1, '... marking skipped tests as ok' );
+$Test-ok( $details[8]{actual_ok} == 0, '... but actually false' );
+$Test-ok( $details[8]{type} eq 'skip', ... with the 'skip' type );
+$Test-ok( $details[8]{reason} eq 'i need a skip', '... and the skip label' );
+
+$Test-ok( $details[9]{ok} == 1, '... marking todo tests as ok' );
+$Test-ok( $details[9]{actual_ok} == 0, '... and saving their actual truth' );
+$Test-ok( $details[9]{type} eq 'todo', ... with the 'todo' type );
+$Test-ok( $details[9]{reason} eq 'i need a todo', '... and the todo label' );
+
+$Test-ok( $details[10]{ok} == 1, '... marking todo_skip tests as ok' );
+$Test-ok( $details[10]{actual_ok} == 0,
[PATCH Test::More] Allow isa_ok( $classname, $parent )
Here's a patch to the Test::Simple 0.45 distribution to make isa_ok() work with
class names, not just objects. It tries to respect custom isa() methods, as
well.
-- c
diff -ur Test-Simple-0.45.old/lib/Test/More.pm Test-Simple-0.45/lib/Test/More.pm
--- Test-Simple-0.45.old/lib/Test/More.pm Wed Jun 19 14:45:52 2002
+++ Test-Simple-0.45/lib/Test/More.pm Sun Jun 30 17:05:09 2002
-522,7 +522,13
$diag = $obj_name isn't defined;
}
elsif( !ref $object ) {
-$diag = $obj_name isn't a reference;
+ local $;
+ if (my $isa = eval{ $object-can( 'isa' ) }) {
+ $isa-( $object, $class )
+ or $diag = $obj_name isn't a $class;
+ } else {
+ $diag = $obj_name isn't a reference or a class;
+ }
}
else {
# We can't use UNIVERSAL::isa because we want to honor isa() overrides
diff -ur Test-Simple-0.45.old/t/More.t Test-Simple-0.45/t/More.t
--- Test-Simple-0.45.old/t/More.t Sat Apr 20 17:34:40 2002
+++ Test-Simple-0.45/t/More.t Sun Jun 30 17:02:46 2002
-7,7 +7,7
}
}
-use Test::More tests = 41;
+use Test::More tests = 42;
# Make sure we don't mess with $ or $!. Test at bottom.
my $Err = this should not be touched;
-59,6 +59,14
isa_ok( $foo, 'blah');
}
+# isa_ok() should handle classes, as well
+{
+ package Bar;
+ package Foo;
+ Foo::ISA = 'Bar';
+ package main;
+ isa_ok( 'Foo', 'Bar' );
+}
pass('pass() passed');
diff -ur Test-Simple-0.45.old/t/fail-more.t Test-Simple-0.45/t/fail-more.t
--- Test-Simple-0.45.old/t/fail-more.t Mon Jan 21 11:33:53 2002
+++ Test-Simple-0.45/t/fail-more.t Sun Jun 30 17:07:52 2002
-167,7 +167,7
# Failed test ($0 at line 55)
# The object isn't a 'Wibble' it's a 'Foo'
# Failed test ($0 at line 56)
-# My Wibble isn't a reference
+# My Wibble isn't a reference or a class
# Failed test ($0 at line 57)
# Another Wibble isn't defined
# Failed test ($0 at line 58)
Re: RFC: Test::Warn
On Thu, 27 Jun 2002 07:32:31 -0700, Janek Schleicher wrote: I couldn't find a module doing this job on CPAN, so I'm ready to write a Test::Warn module. This is something I'd use. I'd like to know what you are thinking about ?, especially: - is it already on CPAN - Name: Test::Warn / Test::Warning / Test::Warnings / ... - method names - missing functionality no_warns_ok() seems awkward, but my best alternative is warns_nok(), which isn't any better. It might be nice if you could check for Carp methods, too. I've found myself doing that several times. -- c
Re: Pondering Test::Depend
On Saturday 08 June 2002 11:02, Michael G Schwern wrote: If this dependency information changes, it'll fail a test (or maybe warn) because there's a potential interface change that Bar.pm may need to know. It looks interesting up to this point. Basically, everytime Bar.pm is touched, edited or upgraded, the test will fail. Every doc patch, typo fix and minor upgrade. This will produce orders of magnitude more false negatives than real failures, which will sap the credibility of the test causing it to be ignored. If these cause a version number bump, yes, that'll be a problem. I was unclear, though. My plan is to use the test for the unit *providing* the dependency as the most accurate sort of information. The heuristic might be, in order of ascending importance: - version number changes in the dependency module may mark a change - timestamp changes of the test file probably mark a change - a change in the number of tests (expected/passing/failed/skipped) marks a change That gives me three levels of certainty. The important thing is that it uses the depending module's tests to be more sure if something has changed. In reality, if Bar.pm changes in an incompatible way Foo.pm's own tests should fail and that should cover you. Not in a strict isolation testing environment, where I don't want to use the real Bar.pm when testing Foo.pm. Maybe I'm being too strict about my isolation, but it's had good results for me so far. -- c
Re: Pondering Test::Depend
On Saturday 08 June 2002 11:39, Michael G Schwern wrote: It gives you three levels of uncertainy. If Bar.pm is being actively developed, the tests and version number will be changing constantly and the dependency check will also be constantly failing, causing it to be ignored, or only given a cursory glance. If Bar.pm is relatively static, ie. from CPAN, failures will be rare but when it does fail, it will still be false orders of magnitude more often than it will be true. Since the developer will have to go in and check if the API has been broken *by hand* they will rapidly tire of it and begin ignoring it, or only giving it a glance. Realistically, the best you could expect is for the developer to look at the module's change log and see if there's any flashing THE API HAS CHANGED lights. I see where you're coming from. It sounds like there are three possibilities for a dependency: 1) It's under active development, so it will change fairly frequently. 2) It's supplied by a third party, so it should be treated as a black box and should be upgraded only after careful human testing. 3) It's in maintenance, so changes are relatively few. I agree with you about #1. Unless Test::Depend is amazingly brilliant about identifying the appropriate bits-of-a-unit level dependencies, it'll produce too many false positives. That's counterproductive, and worse than useless. I don't really care about #2, because a good development process ought to manage it. I'm trying to solve #3 right now. It's intended to say, Hey, you changed Foo.pm. You (might|should|need to) check Bar.pm, Baz.pm, and Fluxx.pm to see if they need similar changes. I have some ideas as to how to approach #1, but it'll require more human intervention and it's more difficult. It looks like it'll have more benefits, though. Not in a strict isolation testing environment, where I don't want to use the real Bar.pm when testing Foo.pm. I presume you're refering to things like IO::Socket and friends that are frequently mocked? Exactly. There are at least three somewhat overlapping classes of dependencies I usually mock: things I don't want to communicate with the outside world, things that mutate important data (data sinks and data sources), and things that are hard to control for testing purposes (sockets, timeouts, deaths, and other exceptional conditions). -- c
Re: Pondering Test::Depend
On Saturday 08 June 2002 17:32, Adrian Howard wrote:
I found that, once you have a moderately complex system, it's hard to
determine whether changes you are being warned about are going to be an
issue (beyond simple things like method renaming). I spent too much time
looking at the code, and usually ended up writing a functional test to
make sure that I wasn't missing something.
I eventually just bit the bullet and started writing more functional
tests. This (of course) had the usual affect of writing more tests ---
it made development faster.
What would one of these functional tests look like? I usually end up with a
few tests per function with names similar to:
- save() should croak() without an 'id' parameter
- ... and should return false if serialization fails
- ... or true if it succeeds
I'll probably also have several other tests that don't exercise save()'s
effective interface. They're not so important for dependency tracking, so
I'll ignore them for now.
My current thinking is that marking the interface tests as special is just
about the only way to track them reliably:
$foo-{_store} = $mock;
$mock-set_series( 'serialize', 0, 1 );
eval { $foo-save() };
dlike( $, qr/No id provided!/, 'save() should croak()...' );
my $result = $foo-save( 77 );
dok( ! $result, '... and should return false...' );
dok( $foo-save( 88 ), '... or true...' );
where dlike() and dok() are Test::Depend wrappers around Test::More's
like() and ok().
Test::Depend will save the names and results away and compare them at the end
of the test suite's run.
There, that's my handwaving magic in a nutshell. I'm not thrilled with the
dopey names, but haven't a better idea at the moment.
-- c
Re: Test::MockObject 0.03
On Sunday 28 April 2002 02:00, Tatsuhiko Miyagawa wrote:
Here's a patch
* pass tests in 5.005_03
* can() should return subref instead of just 1
Thanks, applied! I also added a test to prevent that can() thinko from
reoccurring.
Seems interesting. But I prefer a direct way to define Mock classes
manually in a test code like:
package Mock::CGI;
sub param {
my($self, $name) = _;
return $self-{$name};
}
package main;
my $q = bless {}, 'Mock::CGI';
my $app = WebApp-new($q);
$app-run;
It's not so irresistable to me. And doing so gives me a flexibility.
Well I believe you'll convert me with your future article (on
perl.com?) ;)
The idea's not very complicated at all. If you know how functions and
methods differ and can localize a code slot in the symbol table, you can do
nearly everything Test::MockObject can do on your own. The same applies to
using only ok() in your tests, or just printing ok or not ok.
As I see it, there are three advantages. These may not always apply:
- it's already done, so if you don't know it's possible or how to do it, you
don't have to figure it out
- for repeated tests, it's a lot shorter and simpler than reproducing code
- it uses Test::Builder, so it integrates nicely with existing tests
There are probably three or four feature types that have yet to be discovered.
If you only need to fake one call, it's not a big advantage. If you need to
test SQL statements sent through DBI, it may come in handy.
I'll show some example code in the article. It will probably end up on
Perl.com (it's for the O'Reilly Network, so it'll be *somewhere*.)
-- c
[PROPOSED PATCH] Sanitize Test::Builder Output (was Re: [ PATCH ] Re: Smoke 14406 /pro/3gl/CPAN/perl-current)
On Sunday 27 January 2002 09:31, Jarkko Hietaniemi wrote:
Thanks, applied. Check to skip() that the message ends sanely?
Here's an approach with a test case that demonstrates the problem.
-- c
--- lib/Test/~Builder.pm Sun Jan 27 12:09:35 2002
+++ lib/Test/Builder.pm Sun Jan 27 12:15:52 2002
@@ -207,7 +207,7 @@
my $out = 1..0;
$out .= # Skip $reason if $reason;
-$out .= \n;
+$out .= \n unless $out =~ /\n\z/;
$Skip_All = 1;
@@ -275,7 +275,7 @@
$out .= # TODO $what_todo;
}
-$out .= \n;
+$out .= \n unless $out =~ /\n\z/;
$self-_print($out);
@@ -573,7 +573,8 @@
my $out = ok;
$out .= $Curr_Test if $self-use_numbers;
-$out .= # skip $why\n;
+$out .= # skip $why;
+$out .= \n unless $out =~ /\n\z/;
$Test-_print($out);
@@ -607,7 +608,8 @@
my $out = not ok;
$out .= $Curr_Test if $self-use_numbers;
-$out .= # TODO $why\n;
+$out .= # TODO $why;
+$out .= \n unless $out =~ /\n\z/;
$Test-_print($out);
--- lib/Test/Simple/t/~output.t Sun Jan 27 11:54:29 2002
+++ lib/Test/Simple/t/output.t Sun Jan 27 12:17:59 2002
@@ -3,12 +3,12 @@
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
-@INC = '../lib';
+@INC = ('../lib', 'lib');
}
}
# Can't use Test.pm, that's a 5.005 thing.
-print 1..3\n;
+print 1..4\n;
my $test_num = 1;
# Utility testing functions.
@@ -23,6 +23,13 @@
$test_num++;
}
+BEGIN {
+package Test::Builder;
+use subs qw( exit );
+package main;
+}
+
+use vars qw( $TODO );
use Test::Builder;
my $Test = Test::Builder-new();
@@ -55,3 +62,27 @@
ok($lines[1] =~ /Hello!/);
unlink('foo');
+
+use TieOut;
+local *FAKEOUT;
+$out = tie *FAKEOUT, 'TieOut';
+$Test-output(\*FAKEOUT);
+{
+$TODO = '';
+
+local *Test::Builder::exit;
+*Test::Builder::exit = sub (;$) {};
+$Test-exported_to('main');
+$Test-no_ending(1);
+$Test-no_plan();
+
+# create output, add extraneous newlines
+$Test-skip_all(skip all\n);
+$Test-ok(1, ok\n);
+$Test-skip(skip\n);
+$Test-todo_skip(todo skip\n);
+}
+
+# each test should have only one newline, so as not to confuse Test::Harness
+@lines = split(/\n/, $out-read());
+ok( @lines == 4, 'should suppress extra newlines in test names' );
Re: is() with arbitrary comparisions
On Wed, 19 Dec 2001 10:04:17 -0700, Tels wrote: First, ok() is no no longer ok(), but is now is(), because ok() is no longer ok to use with ok($this,$that); but is() is ok with $that. And then there is isnt(), isn't it? Not to speak of the use of can_ok(), which you can use, ok? isnt() $that ok() with you? $that should pass() ok() be ! like() $this fail() function I've heard about. I'll better skip() some releases until it is() ok() to use Test::More without() going insane().[0] You just hurt my eyes, and I've read Slashcode. If you wrote up your experiences, perhaps it'd make a good article or tutorial on converting an existing test suite to Test::More. -- c
[PATCH] Re: emitting messages in Test::*
On Wed, 19 Dec 2001 05:12:05 -0700, Michael G Schwern wrote:
On Wed, Dec 19, 2001 at 07:52:03AM -0500, Barrie Slaymaker wrote:
I noticed that Test::Builder offers the ability to emit messages with s/^/#
/mg, which is very nice. Can/should this capability be exposed via
Test::Simple, Test::More, etc?
Its been on the TODO list to toss a diag() into Test::More.
ok( ... ) || diag(...);
for some reason I keep putting it off.
Test::Simple won't get one, it would double the size of the API! ;)
Something like this? diffing against a directory tree is odd... there must be
a better way.
-- c
diff -ur /var/tmp/.cpan/build/Test-Simple-0.36/MANIFEST Test-Simple-0.36/MANIFEST
--- /var/tmp/.cpan/build/Test-Simple-0.36/MANIFEST Thu Nov 29 12:11:49 2001
+++ Test-Simple-0.36/MANIFEST Wed Dec 19 12:17:21 2001
@@ -10,6 +10,7 @@
t/Builder.t
t/More.t
t/buffer.t
+t/diag.t
t/exit.t
t/extra.t
t/fail-like.t
diff -ur /var/tmp/.cpan/build/Test-Simple-0.36/lib/Test/More.pm
Test-Simple-0.36/lib/Test/More.pm
--- /var/tmp/.cpan/build/Test-Simple-0.36/lib/Test/More.pm Tue Nov 27 13:41:34
2001
+++ Test-Simple-0.36/lib/Test/More.pm Wed Dec 19 12:01:26 2001
@@ -28,6 +28,7 @@
$TODO
plan
can_ok isa_ok
+diag
);
my $Test = Test::Builder-new;
@@ -905,6 +906,21 @@
return eq_array( [sort _bogus_sort @$a1], [sort _bogus_sort @$a2] );
}
+=cut
+
+=item Bdiag
+
+ diag(Uh oh\n, Something is wrong...\n);
+
+Prints a diagnostic message or messages. These are guaranteed not to interfere
+with test output, and they will be suppressed by any test harness when running
+in quiet mode. They can be very handy otherwise.
+
+=cut
+
+sub diag {
+ $Test-diag(@_);
+}
=back
--- /dev/null Thu Aug 30 03:54:37 2001
+++ Test-Simple-0.36/t/diag.t Wed Dec 19 12:16:18 2001
@@ -0,0 +1,46 @@
+#!perl -w
+use strict;
+
+use Test::More;
+use Test::Builder;
+
+# this is a singleton, easy enough to test this
+my $Test = Test::Builder-new();
+
+# now make a filehandle where we can send data
+my $output;
+tie *FAKEOUT, 'FakeOut', \$output;
+
+# force diagnostic output to a filehandle, glad I added this to Test::Builder :)
+use vars qw( $TODO );
+$TODO = 1;
+$Test-todo_output(\*FAKEOUT);
+
+diag(a single line);
+
+my @lines;
+push @lines, $output;
+$output = '';
+
+diag(multiple\n, lines);
+push @lines, split(/\n/, $output);
+
+undef $TODO;
+
+plan tests = 4;
+
+is( scalar @lines, 3, 'diag() should send messages to its filehandle' );
+like( $lines[0], '/^#\s+/', '... should add comment mark to all lines' );
+is( $lines[0], # a single line, '... should send exact message' );
+is( $output, # multiple\n# lines, '... should append multi messages');
+
+package FakeOut;
+
+sub TIEHANDLE {
+ bless( $_[1], $_[0] );
+}
+
+sub PRINT {
+ my $self = shift;
+ $$self .= join('', @_);
+}
Re: Tentative Term::ReadLine patch/test
On Sat, 08 Dec 2001 12:04:27 -0700, Richard Clamp wrote:
Does it look like I'm heading down the right road with this? If so let me
know and I'll submit it to p5p for applying to blead.
+BEGIN {
+chdir 't' if -d 't';
+
+if ( $ENV{PERL_CORE} ) {
+@INC = '../lib';
+}
+}
When I was writing tests for libnet, Graham recommended not to chdir() into 't'
for testing outside of the core. I'd probably move that inside the if block.
+can_ok($t, qw( ReadLine readline addhistory IN OUT MinLine
+ findConsole Attribs Features new ));
I'd loop over these:
foreach my $method (qw( ReadLine readline addhistory IN OUT MinLine
findConsole Attribs Features new) ) {
can_ok( $t, $method );
}
It seems easier to find the one failure if each method has a separate test.
(My assumption is that can_ok() does all in the list, looking at the test plan
earlier.)
Neither is a big deal, just stylistic things. Thanks for sending it along!
-- c
[PATCH MANIFEST lib/ExtUtils/MM_Cygwin.t] Add tests for ExtUtils::MM_Cygwin
Here's tests for ExtUtils::MM_Cygwin. They're skipped on all platforms where
$^O does not match /cygwin/i. The tests out to pass just about everywhere
anyway.
It would be good for someone with Cygwin to test them, though.
-- c
--- ~MANIFEST Sun Nov 25 19:50:46 2001
+++ MANIFESTSun Nov 25 19:51:06 2001
@@ -930,6 +930,7 @@
lib/ExtUtils/Mkbootstrap.t See if ExtUtils::Mkbootstrap works
lib/ExtUtils/Mksymlists.pm Writes a linker options file for extensions
lib/ExtUtils/MM_Cygwin.pm MakeMaker methods for Cygwin
+lib/ExtUtils/MM_Cygwin.pm See if ExtUtils::MM_Cygwin works
lib/ExtUtils/MM_NW5.pm MakeMaker methods for NetWare
lib/ExtUtils/MM_OS2.pm MakeMaker methods for OS/2
lib/ExtUtils/MM_Unix.pmMakeMaker base class for Unix
--- /dev/null Thu Aug 30 03:54:37 2001
+++ lib/ExtUtils/MM_Cygwin.tSun Nov 25 20:03:22 2001
@@ -0,0 +1,120 @@
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use Test::More;
+
+BEGIN {
+ if ($^O =~ /cygwin/i) {
+ plan tests = 17;
+ $ENV{'ExtUtils/MM_Unix.pm'} = 1;
+ } else {
+ plan skip_all = 'Test irrelevant outside of Cygwin';
+ }
+}
+
+use Config;
+use File::Spec;
+
+use_ok( 'ExtUtils::MM_Cygwin' );
+
+# test canonpath
+my $path = File::Spec-canonpath('/a/../../c');
+is( ExtUtils::MM_Cygwin-canonpath('/a/../../c'), $path,
+ 'canonpath() should delegate to File::Spec' );
+
+# test cflags, with the fake package below
+my $args = ExtUtils::MM_Unix-new({
+ CFLAGS = 'fakeflags',
+ CCFLAGS = '',
+});
+
+# with CFLAGS set, it should be returned
+is( ExtUtils::MM_Cygwin::cflags($args), 'fakeflags',
+ 'cflags() should return CFLAGS member data, if set' );
+
+delete $args-{CFLAGS};
+
+# respects the config setting, should ignore whitespace around equal sign
+my $ccflags = $Config{useshrplib} eq 'true' ? ' -DUSEIMPORTLIB' : '';
+ExtUtils::MM_Cygwin::cflags($args, FLAGS);
+OPTIMIZE = opt
+PERLTYPE =pt
+LARGE= lg
+SPLIT=split
+FLAGS
+
+like( $args-{CFLAGS}, qr/OPTIMIZE = opt/, '... should set OPTIMIZE' );
+like( $args-{CFLAGS}, qr/PERLTYPE = pt/, '... should set PERLTYPE' );
+like( $args-{CFLAGS}, qr/LARGE = lg/, '... should set LARGE' );
+like( $args-{CFLAGS}, qr/SPLIT = split/, '... should set SPLIT' );
+like( $args-{CFLAGS}, qr/CCFLAGS = $ccflags/, '... should set CCFLAGS' );
+
+# test manifypods
+my $args = ExtUtils::MM_Unix-new({
+ NOECHO = 'noecho',
+ MAN3PODS = {},
+ MAN1PODS = {},
+});
+like( ExtUtils::MM_Cygwin::manifypods($args), qr/pure_all\n\tnoecho/,
+ 'manifypods() should return without PODS values set' );
+
+$args-{MAN3PODS} = { foo = 1 };
+my $out = tie *STDOUT, 'FakeOut';
+my $res = ExtUtils::MM_Cygwin::manifypods($args);
+like( $$out, qr/could not locate your pod2man/,
+ '... should warn if pod2man cannot be located' );
+like( $res, qr/POD2MAN_EXE = -S pod2man/,
+ '... should use default pod2man target' );
+like( $res, qr/pure_all.+foo/, '... should add MAN3PODS targets' );
+
+$args-{PERL_SRC} = 'perlsrc';
+$args-{MAN1PODS} = { bar = 1 };
+$$out = '';
+$res = ExtUtils::MM_Cygwin::manifypods($args);
+is( $$out, '', '... should not warn if PERL_SRC provided' );
+like( $res, qr/bar \\\n\t1 \\\n\tfoo/, '... should join MAN1PODS and MAN3PODS');
+
+
+# test perl_archive
+my $libperl = $Config{libperl} || 'libperl.a';
+is( ExtUtils::MM_Cygwin::perl_archive(), \$(PERL_INC)/$libperl,
+ 'perl_archive() should respect libperl setting' );
+
+# test import of $Verbose and neatvalue
+can_ok( 'ExtUtils::MM_Cygwin::neatvalue' );
+is( $ExtUtils::MM_Cygwin::Verbose, $ExtUtils::MakeMaker::Verbose,
+ 'ExtUtils::MM_Cygwin should import $Verbose from ExtUtils::MakeMaker' );
+
+package ExtUtils::MM_Unix;
+
+sub new {
+ bless($_[1], $_[0]);
+}
+
+sub cflags {
+ return $_[1];
+}
+
+sub catfile {
+ my $self = shift;
+ return join('/', @_);
+}
+
+sub perl_script {
+ exists $_[0]-{PERL_SRC};
+}
+
+package FakeOut;
+
+sub TIEHANDLE {
+ bless(\(my $scalar), $_[0]);
+}
+
+sub PRINT {
+ my $self = shift;
+ $$self .= shift;
+}
Re: [PATCH MANIFEST lib/ExtUtils/MM_Cygwin.t] Add tests for ExtUtils::MM_Cygwin
On Sunday 25 November 2001 20:47, Michael G Schwern wrote:
$ENV{'ExtUtils/MM_Unix.pm'} ?? Maybe this supposed to be %INC?
Indeed it is. Never patch while cursing the heavy hand of George Lucas.
You should be playing with MM objects instead. ExtUtils::MM_Cygwin
will handle setting @MM::ISA. So just write a little MM-new instead.
This also means...
...that you can call cflags() and the rest properly as methods.
Something like this?
Rhetorical question: why do I have such trouble updating MANIFEST correctly?
-- c
--- ~MANIFEST Sun Nov 25 19:50:46 2001
+++ MANIFEST Sun Nov 25 21:08:01 2001
@@ -930,6 +930,7 @@
lib/ExtUtils/Mkbootstrap.t See if ExtUtils::Mkbootstrap works
lib/ExtUtils/Mksymlists.pm Writes a linker options file for extensions
lib/ExtUtils/MM_Cygwin.pm MakeMaker methods for Cygwin
+lib/ExtUtils/MM_Cygwin.t See if ExtUtils::MM_Cygwin works
lib/ExtUtils/MM_NW5.pm MakeMaker methods for NetWare
lib/ExtUtils/MM_OS2.pm MakeMaker methods for OS/2
lib/ExtUtils/MM_Unix.pm MakeMaker base class for Unix
--- /dev/null Thu Aug 30 03:54:37 2001
+++ lib/ExtUtils/MM_Cygwin.t Sun Nov 25 21:04:45 2001
@@ -0,0 +1,122 @@
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use Test::More;
+
+BEGIN {
+ if ($^O =~ /cygwin/i) {
+ plan tests = 17;
+ $INC{'ExtUtils/MM_Unix.pm'} = 1;
+ } else {
+ plan skip_all = 'Test irrelevant outside of Cygwin';
+ }
+}
+
+use Config;
+use File::Spec;
+
+use_ok( 'ExtUtils::MM_Cygwin' );
+
+# test canonpath, MM is a fake package inheriting from ExtUtils::MM_Cygwin
+my $path = File::Spec-canonpath('/a/../../c');
+is( MM-canonpath('/a/../../c'), $path,
+ 'canonpath() should delegate to File::Spec' );
+
+# test cflags, with the fake package below
+my $args = MM-new({
+ CFLAGS = 'fakeflags',
+ CCFLAGS = '',
+});
+
+# with CFLAGS set, it should be returned
+is( $args-cflags(), 'fakeflags',
+ 'cflags() should return CFLAGS member data, if set' );
+
+delete $args-{CFLAGS};
+
+# respects the config setting, should ignore whitespace around equal sign
+my $ccflags = $Config{useshrplib} eq 'true' ? ' -DUSEIMPORTLIB' : '';
+$args-cflags(FLAGS);
+OPTIMIZE = opt
+PERLTYPE =pt
+LARGE= lg
+SPLIT=split
+FLAGS
+
+like( $args-{CFLAGS}, qr/OPTIMIZE = opt/, '... should set OPTIMIZE' );
+like( $args-{CFLAGS}, qr/PERLTYPE = pt/, '... should set PERLTYPE' );
+like( $args-{CFLAGS}, qr/LARGE = lg/, '... should set LARGE' );
+like( $args-{CFLAGS}, qr/SPLIT = split/, '... should set SPLIT' );
+like( $args-{CFLAGS}, qr/CCFLAGS = $ccflags/, '... should set CCFLAGS' );
+
+# test manifypods
+$args = MM-new({
+ NOECHO = 'noecho',
+ MAN3PODS = {},
+ MAN1PODS = {},
+});
+like( $args-manifypods(), qr/pure_all\n\tnoecho/,
+ 'manifypods() should return without PODS values set' );
+
+$args-{MAN3PODS} = { foo = 1 };
+my $out = tie *STDOUT, 'FakeOut';
+my $res = $args-manifypods();
+like( $$out, qr/could not locate your pod2man/,
+ '... should warn if pod2man cannot be located' );
+like( $res, qr/POD2MAN_EXE = -S pod2man/,
+ '... should use default pod2man target' );
+like( $res, qr/pure_all.+foo/, '... should add MAN3PODS targets' );
+
+$args-{PERL_SRC} = 'perlsrc';
+$args-{MAN1PODS} = { bar = 1 };
+$$out = '';
+$res = $args-manifypods();
+is( $$out, '', '... should not warn if PERL_SRC provided' );
+like( $res, qr/bar \\\n\t1 \\\n\tfoo/, '... should join MAN1PODS and MAN3PODS');
+
+
+# test perl_archive
+my $libperl = $Config{libperl} || 'libperl.a';
+is( $args-perl_archive(), \$(PERL_INC)/$libperl,
+ 'perl_archive() should respect libperl setting' );
+
+# test import of $Verbose and neatvalue
+can_ok( 'ExtUtils::MM_Cygwin::neatvalue' );
+is( $ExtUtils::MM_Cygwin::Verbose, $ExtUtils::MakeMaker::Verbose,
+ 'ExtUtils::MM_Cygwin should import $Verbose from ExtUtils::MakeMaker' );
+
+package MM;
+
+sub new {
+ bless($_[1], $_[0]);
+}
+
+package ExtUtils::MM_Unix;
+
+sub cflags {
+ return $_[1];
+}
+
+sub catfile {
+ my $self = shift;
+ return join('/', @_);
+}
+
+sub perl_script {
+ exists $_[0]-{PERL_SRC};
+}
+
+package FakeOut;
+
+sub TIEHANDLE {
+ bless(\(my $scalar), $_[0]);
+}
+
+sub PRINT {
+ my $self = shift;
+ $$self .= shift;
+}
[REPATCH MANIFEST lib/ExtUtils/MM_Cygwin.t] use more 'Schwernishness';
On Sunday 25 November 2001 21:38, Michael G Schwern wrote:
Indeed it is. Never patch while cursing the heavy hand of George Lucas.
Hard to code while beating the hell out of your television, I know the
feeling.
Television? He's playing congas two doors down. Noisy old goat...
+# test import of $Verbose and neatvalue
+can_ok( 'ExtUtils::MM_Cygwin::neatvalue' );
can_ok( 'ExtUtils::MM_Cygwin', 'neatvalue' );
Changed.
And I'm curious why it's necessary to still override bits of
ExtUtils::MM_Unix?
Porta-paranoia. cflags() and canonpath() are delegated to it. This may be
why File::Spec was commingled.
I don't really care to figure out *what* ExtUtils::MM_Unix expects
(especially on Unix-on-Windows), as what it is produces is easily
faked.
Plus, I'm lazy. It's a virtue.
-- c
--- ~MANIFEST Sun Nov 25 19:50:46 2001
+++ MANIFEST Sun Nov 25 21:08:01 2001
@@ -930,6 +930,7 @@
lib/ExtUtils/Mkbootstrap.t See if ExtUtils::Mkbootstrap works
lib/ExtUtils/Mksymlists.pm Writes a linker options file for extensions
lib/ExtUtils/MM_Cygwin.pm MakeMaker methods for Cygwin
+lib/ExtUtils/MM_Cygwin.t See if ExtUtils::MM_Cygwin works
lib/ExtUtils/MM_NW5.pm MakeMaker methods for NetWare
lib/ExtUtils/MM_OS2.pm MakeMaker methods for OS/2
lib/ExtUtils/MM_Unix.pm MakeMaker base class for Unix
--- /dev/null Thu Aug 30 03:54:37 2001
+++ lib/ExtUtils/MM_Cygwin.t Sun Nov 25 21:04:45 2001
@@ -0,0 +1,122 @@
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use Test::More;
+
+BEGIN {
+ if ($^O =~ /cygwin/i) {
+ plan tests = 17;
+ $INC{'ExtUtils/MM_Unix.pm'} = 1;
+ } else {
+ plan skip_all = 'Test irrelevant outside of Cygwin';
+ }
+}
+
+use Config;
+use File::Spec;
+
+use_ok( 'ExtUtils::MM_Cygwin' );
+
+# test canonpath, MM is a fake package inheriting from ExtUtils::MM_Cygwin
+my $path = File::Spec-canonpath('/a/../../c');
+is( MM-canonpath('/a/../../c'), $path,
+ 'canonpath() should delegate to File::Spec' );
+
+# test cflags, with the fake package below
+my $args = MM-new({
+ CFLAGS = 'fakeflags',
+ CCFLAGS = '',
+});
+
+# with CFLAGS set, it should be returned
+is( $args-cflags(), 'fakeflags',
+ 'cflags() should return CFLAGS member data, if set' );
+
+delete $args-{CFLAGS};
+
+# respects the config setting, should ignore whitespace around equal sign
+my $ccflags = $Config{useshrplib} eq 'true' ? ' -DUSEIMPORTLIB' : '';
+$args-cflags(FLAGS);
+OPTIMIZE = opt
+PERLTYPE =pt
+LARGE= lg
+SPLIT=split
+FLAGS
+
+like( $args-{CFLAGS}, qr/OPTIMIZE = opt/, '... should set OPTIMIZE' );
+like( $args-{CFLAGS}, qr/PERLTYPE = pt/, '... should set PERLTYPE' );
+like( $args-{CFLAGS}, qr/LARGE = lg/, '... should set LARGE' );
+like( $args-{CFLAGS}, qr/SPLIT = split/, '... should set SPLIT' );
+like( $args-{CFLAGS}, qr/CCFLAGS = $ccflags/, '... should set CCFLAGS' );
+
+# test manifypods
+$args = MM-new({
+ NOECHO = 'noecho',
+ MAN3PODS = {},
+ MAN1PODS = {},
+});
+like( $args-manifypods(), qr/pure_all\n\tnoecho/,
+ 'manifypods() should return without PODS values set' );
+
+$args-{MAN3PODS} = { foo = 1 };
+my $out = tie *STDOUT, 'FakeOut';
+my $res = $args-manifypods();
+like( $$out, qr/could not locate your pod2man/,
+ '... should warn if pod2man cannot be located' );
+like( $res, qr/POD2MAN_EXE = -S pod2man/,
+ '... should use default pod2man target' );
+like( $res, qr/pure_all.+foo/, '... should add MAN3PODS targets' );
+
+$args-{PERL_SRC} = 'perlsrc';
+$args-{MAN1PODS} = { bar = 1 };
+$$out = '';
+$res = $args-manifypods();
+is( $$out, '', '... should not warn if PERL_SRC provided' );
+like( $res, qr/bar \\\n\t1 \\\n\tfoo/, '... should join MAN1PODS and MAN3PODS');
+
+
+# test perl_archive
+my $libperl = $Config{libperl} || 'libperl.a';
+is( $args-perl_archive(), \$(PERL_INC)/$libperl,
+ 'perl_archive() should respect libperl setting' );
+
+# test import of $Verbose and neatvalue
+can_ok( 'ExtUtils::MM_Cygwin', 'neatvalue' );
+is( $ExtUtils::MM_Cygwin::Verbose, $ExtUtils::MakeMaker::Verbose,
+ 'ExtUtils::MM_Cygwin should import $Verbose from ExtUtils::MakeMaker' );
+
+package MM;
+
+sub new {
+ bless($_[1], $_[0]);
+}
+
+package ExtUtils::MM_Unix;
+
+sub cflags {
+ return $_[1];
+}
+
+sub catfile {
+ my $self = shift;
+ return join('/', @_);
+}
+
+sub perl_script {
+ exists $_[0]-{PERL_SRC};
+}
+
+package FakeOut;
+
+sub TIEHANDLE {
+ bless(\(my $scalar), $_[0]);
+}
+
+sub PRINT {
+ my $self = shift;
+ $$self .= shift;
+}
Re: [REPATCH MANIFEST lib/ExtUtils/MM_Cygwin.t] use more 'Schwernishness';
On Sunday 25 November 2001 22:31, Michael G Schwern wrote: Porta-paranoia. cflags() and canonpath() are delegated to it. This may be why File::Spec was commingled. Now wait a second, this means you're not actually testing what ExtUtils::MM_Cygwin-catfile() and cflags() and perl_script() do. There exist neither ExtUtils::MM_Cygwin::catfile() or ExtUtils::MM_Cygwin::perl_script(). They're both inherited from somewhere, and are called within ExtUtils::MM_Cygwin::manifypods(). ExtUtils::MM_Cygwin::cflags() does exist, and it calls ExtUtils::MM_Unix::cflags(). My assumption (which may very well be invalid) is that anything that breaks ExtUtils::MM_Unix should be caught by the ExtUtils::MM_Unix test. The ExtUtils::MM_Cygwin test is predicated upon the assumption that the bits in ExtUtils::MM_Unix Just Work. As such, I considered them fair game to be replaced with decaf crystals. I may very well be wrong on this, but I think it's testing the essentials. -- c
Re: is(), undef, '' and 0 (was Re: [PATCH lib/DB.pm MANIFEST lib/DB.t] Add Tests for DB.pm)
On Friday 23 November 2001 15:59, you wrote:
On Fri, Nov 23, 2001 at 03:32:41PM -0700, chromatic wrote:
+ is( DB::DB(), undef, 'DB::DB() should return undef if $DB::ready is
false');
Crap, this doesn't quite work in the general case.
is( undef, undef ); # ok
is( 0, undef ); # not ok
is('', undef ); # ok
is() uses eq and undef stringifies to ''. is( $foo, undef ) is a nice
idiom, though.
I got it from *somewhere*. I'd almost swear it was in the first version of
Test::Builder, having been untimely ripped from the womb of pre-wrapper
Test::More.
Should is() distinguish between undef, 0 and ''? Seeing as how it
already does between undef and 0 (accidentally), I guess it wouldn't
hurt.
Perl does, why shouldn't the tests? Something like this only has one problem:
$test = 'undef' unless defined $test;
Most people likely to write tests are smart enough to avoid nasty literal
phrases like '0 but true' and 'undef'. I hope. I left room at lunch to eat
those words, though.
-- c
[PATCH lib/Net/Config.pm, MANIFEST, t/lib/Mock/Socket.pm, lib/Net/Config.t] Add Tests for Net::Config
Here's a test suite for Net::Config. In the process of writing this, I've
fixed an apparent bug that prevented single values from becoming array
references when necessary. I think it's right, but perhaps Graham should weigh
in on this.
In the process, with some advice from perl-qa, I've added a mock object so the
test could control the output of Socket::inet_ntoa() and Socket::inet_aton().
t/lib/Mock/ seemed like as good a place as any.
I'm happy to rework this patch if it personally offends anyone whose opinion
matters. :)
-- c
--- lib/Net/~Config.pm Sat Oct 20 01:23:46 2001
+++ lib/Net/Config.pm Sat Oct 20 01:23:54 2001
@@ -13,7 +13,7 @@
@EXPORT = qw(%NetConfig);
@ISA = qw(Net::LocalCfg Exporter);
-$VERSION = 1.05; # $Id: //depot/libnet/Net/Config.pm#9 $
+$VERSION = 1.06; # $Id: //depot/libnet/Net/Config.pm#9 $
eval { local $SIG{__DIE__}; require Net::LocalCfg };
@@ -54,11 +54,11 @@
}
my ($k,$v);
while(($k,$v) = each %NetConfig) {
-$v = [ $v ]
- if($k =~ /_hosts$/ !ref($v));
+ $NetConfig{$k} = [ $v ]
+ if($k =~ /_hosts$/ !ref($v));
}
-# Take a hostname and determine if it is inside te firewall
+# Take a hostname and determine if it is inside the firewall
sub requires_firewall {
shift; # ignore package
--- ~MANIFEST Sat Oct 20 01:24:04 2001
+++ MANIFESTSat Oct 20 01:24:42 2001
@@ -1065,6 +1065,7 @@
lib/Net/Cmd.pm libnet
lib/Net/Config.eg libnet
lib/Net/Config.pm libnet
+lib/Net/Config.pm libnet (see if Net::Config works)
lib/Net/demos/ftp libnet
lib/Net/demos/inetdlibnet
lib/Net/demos/nntp libnet
--- /dev/null Thu Aug 30 03:54:37 2001
+++ t/lib/Mock/Socket.pmSat Oct 20 00:02:49 2001
@@ -0,0 +1,31 @@
+package Mock::Socket;
+
+# this is not the package you're looking for
+
+package Socket;
+
+$INC{'Socket.pm'} = 1;
+
+use Exporter;
+@Socket::ISA = ( 'Exporter' );
+@EXPORT = qw( inet_aton inet_ntoa );
+
+my (%aton, %ntoa);
+
+sub set_dns {
+ while (my ($name, $number) = splice(@_, 0, 2)) {
+ my $packed = unpack( N, pack(C*, split(/\./, $number)));
+ $aton{$name} = $packed;
+ $ntoa{$packed} = $number;
+ }
+}
+
+sub inet_aton {
+ return $aton{$_[0]};
+}
+
+sub inet_ntoa {
+ return $ntoa{$_[0]};
+}
+
+1;
--- /dev/null Thu Aug 30 03:54:37 2001
+++ lib/Net/Config.tSat Oct 20 01:18:50 2001
@@ -0,0 +1,85 @@
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = ( 'lib', '../lib' );
+}
+
+# lots of magic, see t/lib/Mock/Socket
+use Mock::Socket;
+use Test::More tests = 14;
+
+use_ok( 'Net::Config' );
+ok( keys %NetConfig, '%NetConfig should be imported' );
+
+undef $NetConfig{'ftp_firewall'};
+is( Net::Config-requires_firewall, 0,
+ 'requires_firewall() should return 0 without ftp_firewall defined' );
+
+# this calls inet_aton in the mock Socket, so it *may* not be portable
+$NetConfig{'ftp_firewall'} = 1;
+is( Net::Config-requires_firewall, -1,
+ '... should return -1 without a valid hostname' );
+
+# use the mock Socket to resolve addresses our way
+Socket::set_dns( localhost = '127.0.0.1', remotehost = '192.168.10.0' );
+delete $NetConfig{'local_netmask'};
+is( Net::Config-requires_firewall('localhost'), 0,
+ '... should return 0 without local_netmask defined' );
+
+#
+$NetConfig{'local_netmask'} = '127.0.0.1/24';
+is( Net::Config-requires_firewall('localhost'), 0,
+ '... should return false if host is within netmask' );
+is( Net::Config-requires_firewall('remotehost'), 1,
+ '... should return true if host is outside netmask' );
+
+# now try more netmasks
+Socket::set_dns( otherlocal = '10.10.255.254' );
+$NetConfig{'local_netmask'} = [ '127.0.0.1/24', '10.0.0.0/8' ];
+is( Net::Config-requires_firewall('otherlocal'), 0,
+ '... should find success with mutiple local netmasks' );
+is( Net::Config-requires_firewall('remotehost'), 1,
+ '... should handle failure with multiple local netmasks' );
+
+# now fool Perl into compiling this again. HEY, LOOK OVER THERE!
+my $path = $INC{'Net/Config.pm'};
+delete $INC{'Net/Config.pm'};
+
+# Net::Config populates %NetConfig from 'libnet.cfg', if possible
+my $wrote_file = 0;
+
+(my $cfgfile = $path) =~ s/Config.pm/libnet.cfg/;
+if (open(OUT, '' . $cfgfile)) {
+ use Data::Dumper;
+ print OUT Dumper({
+ some_hosts = [ 1, 2, 3 ],
+ time_hosts = 'abc',
+ some_value = 11,
+ });
+ close OUT;
+ $wrote_file = 1;
+}
+
+SKIP: {
+ skip('could not write cfg file', 4) unless $wrote_file;
+
+ # and here comes Net::Config, again! no import() necessary
+ require $path;
+
+ is( $NetConfig{some_value}, 11,
+ 'Net::Config should populate %NetConfig from libnet.cfg file' );
+ is( scalar @{ $NetConfig{time_hosts} }, 1,
+ '... should turn _hosts keys into array
Re: [PATCH Test/Simple.pm Test/More.pm] Add skip_rest() Function
On Wednesday 10 October 2001 12:46, Michael G Schwern wrote: I'm wary of putting this in. I'm afraid that a skip_rest() in a test wouldn't last long under continued additions to the test. It imposes a restriction that every test below that point must be effected by it, and anything you don't want skipped must be above it which seems to me too broad. That's a good point. I see this as helpful in situations like the Term::Complete test, where there's a range of configurations where the test can't be run at all. If the test gets to that point, it's not worth even attempting to continue. It may just be that we're getting in to the Hard To Test Portably modules now in the core, where this is much more common than normal. I'm curious what trouble you ran into with the usual SKIP block. It's doable there, yes. I just don't like the potential of nesting them. Of course, commenting tests well does a lot for maintenance too... but that's another rant and rave. -- c
[PATCH lib/Term/Cap.t] Fix Debian Failures on Test 22
In article [EMAIL PROTECTED], Nicholas Clark
[EMAIL PROTECTED] wrote:
2: Term/Cap.t
# this is ugly, but -f $0 really *ought* to work
There seems to be some reliance later on in the test on $0 being reliable, but
I've not quite figured out where in Term/Cap.pm this is. The test failure is:
not ok 22 - Tgetent() should dies with bad termcap # Failed test
(lib/Term/Cap.t at line 107) # 'Insecure $ENV{PATH} while
running with -T switch at ../lib/Term/Cap.pm line 176, DATA line 6. ' #
doesn't match '(?-xism:failed termcap lookup)'
Alright, I tracked down a Debian 2.2 box and verified this failure with taint
mode enabled (and another failure on the same test with taint mode disabled).
This patch fixes both failures, and passes fine on another Linux box. It
assumes Nick's patch has been checked in, though it shouldn't make a big
difference.
Given my inspectacular track record on this test, this is worth testing before
anyone pokes poor Jarkko with the check it in stick. Copying to perl-qa.
-- c
--- lib/Term/~Cap.t Sun Oct 7 16:37:06 2001
+++ lib/Term/Cap.t Mon Oct 8 13:56:09 2001
@@ -1,6 +1,8 @@
#!./perl
+my $file;
BEGIN {
+ $file = $0;
chdir 't' if -d 't';
@INC = '../lib';
}
@@ -34,14 +36,14 @@
SKIP: {
# this is ugly, but -f $0 really *ought* to work
- skip(-f $0 fails, some tests difficult now, 2) unless -f $0;
+ skip(-f $file fails, some tests difficult now, 2) unless -f $file;
- $ENV{TERMCAP} = $ENV{TERMPATH} = $0;
- ok( grep($0, Term::Cap::termcap_path()),
+ $ENV{TERMCAP} = $ENV{TERMPATH} = $file;
+ ok( grep($file, Term::Cap::termcap_path()),
'termcap_path() should find file from $ENV{TERMCAP}' );
$ENV{TERMCAP} = (grep { $^O eq $_ } qw( os2 MSWin32 dos )) ? 'a:/' : '/';
- ok( grep($0, Term::Cap::termcap_path()),
+ ok( grep($file, Term::Cap::termcap_path()),
'termcap_path() should find file from $ENV{TERMPATH}' );
}
@@ -100,18 +102,17 @@
eval { $t = Term::Cap-Tgetent($vals) };
isn't( $@, '', 'Tgetent() should catch bad termcap file' );
-# if there's no valid termcap file found, it should croak
-$vals-{TERM} = '';
-$ENV{TERMPATH} = $0;
-eval { $t = Term::Cap-Tgetent($vals) };
-like( $@, qr/failed termcap lookup/, 'Tgetent() should dies with bad termcap' );
-
SKIP: {
- skip( Can't write 'tcout' file for tests, 8 ) unless $writable;
+ skip( Can't write 'tcout' file for tests, 9 ) unless $writable;
+
+ # it won't find the termtype in this fake file, so it should croak
+ $vals-{TERM} = 'quux';
+ $ENV{TERMPATH} = 'tcout';
+ eval { $t = Term::Cap-Tgetent($vals) };
+ like( $@, qr/failed termcap/, 'Tgetent() should die with bad termcap' );
# it shouldn't try to read one file more than 32(!) times
# see __END__ for a really awful termcap example
-
$ENV{TERMPATH} = join(' ', ('tcout') x 33);
$vals-{TERM} = 'bar';
eval { $t = Term::Cap-Tgetent($vals) };
[PATCH MANIFEST lib/ExtUtils/Mkbootstrap.t] Add Tests for ExtUtils::Mkbootstrap
This passes all tests, within, without t/.
Hoping someday to be mentioned in Simon's p5p-summary,
-- c
--- ~MANIFEST Mon Oct 8 23:56:56 2001
+++ MANIFESTMon Oct 8 23:57:12 2001
@@ -893,6 +893,7 @@
lib/ExtUtils/MANIFEST.SKIP The default MANIFEST.SKIP
lib/ExtUtils/Manifest.tSee if ExtUtils::Manifest works
lib/ExtUtils/Mkbootstrap.pmWrites a bootstrap file (see MakeMaker)
+lib/ExtUtils/Mkbootstrap.t See if ExtUtils::Mkbootstrap works
lib/ExtUtils/Mksymlists.pm Writes a linker options file for extensions
lib/ExtUtils/MM_Cygwin.pm MakeMaker methods for Cygwin
lib/ExtUtils/MM_NW5.pm MakeMaker methods for NetWare
--- /dev/null Thu Aug 30 03:54:37 2001
+++ lib/ExtUtils/Mkbootstrap.t Tue Oct 9 00:02:59 2001
@@ -0,0 +1,159 @@
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use vars qw( $required );
+use Test::More tests = 18;
+
+use_ok( 'ExtUtils::Mkbootstrap' );
+
+
+# Mkbootstrap makes a backup copy of $_[0].bs if it exists and is non-zero
+my $file_is_ready;
+local *OUT;
+if (open(OUT, 'mkboot.bs')) {
+ $file_is_ready = 1;
+ print OUT 'meaningless text';
+ close OUT;
+}
+
+SKIP: {
+ skip(could not make dummy .bs file: $!, 2) unless $file_is_ready;
+
+ Mkbootstrap('mkboot');
+ ok( -s 'mkboot.bso', 'Mkbootstrap should backup the .bs file' );
+ local *IN;
+ if (open(IN, 'mkboot.bso')) {
+ chomp ($file_is_ready = IN);
+ close IN;
+ }
+
+ is( $file_is_ready, 'meaningless text', 'backup should be a perfect copy' );
+}
+
+
+# if it doesn't exist or is zero bytes in size, it won't be backed up
+Mkbootstrap('fakeboot');
+ok( !( -f 'fakeboot.bso' ), 'Mkbootstrap should not backup an empty file' );
+
+
+my $out = tie *STDOUT, 'TieOut';
+
+# with $Verbose set, it should print status messages about libraries
+$ExtUtils::Mkbootstrap::Verbose = 1;
+Mkbootstrap();
+is( $out-read, \tbsloadlibs=\n, 'should report libraries in Verbose mode' );
+
+Mkbootstrap('', 'foo');
+like( $out-read, qr/bsloadlibs=foo/, 'should still report libraries' );
+
+
+# if ${_[0]}_BS exists, require it
+$file_is_ready = open(OUT, 'boot_BS');
+
+SKIP: {
+ skip(cannot open boot_BS for writing: $!, 1) unless $file_is_ready;
+
+ print OUT '$main::required = 1';
+ close OUT;
+ Mkbootstrap('boot');
+
+ ok( $required, 'baseext_BS file should be require()d' );
+}
+
+
+# if there are any arguments, open a file named baseext.bs
+$file_is_ready = open(OUT, 'dasboot.bs');
+
+SKIP: {
+ skip(cannot make dasboot.bs: $!, 5) unless $file_is_ready;
+
+ # if it can't be opened for writing, we want to prove that it'll die
+ close OUT;
+ chmod 0444, 'dasboot.bs';
+
+ eval{ Mkbootstrap('dasboot', 1) };
+ like( $@, qr/Unable to open dasboot\.bs/, 'should die given bad filename' );
+
+ # now put it back like it was
+ chmod 0777, 'dasboot.bs';
+ eval{ Mkbootstrap('dasboot', 'myarg') };
+ is( $@, '', 'should not die, given good filename' );
+
+ # red and reed (a visual pun makes tests worth reading)
+ my $read = $out-read();
+ like( $read, qr/Writing dasboot.bs/, 'should print status' );
+ like( $read, qr/containing: my/, 'should print verbose status on request' );
+
+ # now be tricky, and set the status for the next skip block
+ $file_is_ready = open(IN, 'dasboot.bs');
+ ok( $file_is_ready, 'should have written a new .bs file' );
+}
+
+
+SKIP: {
+ skip(cannot read .bs file: $!, 2) unless $file_is_ready;
+
+ my $file = do { local $/ = IN };
+
+ # filename should be in header
+ like( $file, qr/# dasboot DynaLoader/, 'file should have boilerplate' );
+
+ # should print arguments within this array
+ like( $file, qr/qw\(myarg\);/, 'should have written array to file' );
+}
+
+
+# overwrite this file (may whack portability, but the name's too good to waste)
+$file_is_ready = open(OUT, 'dasboot.bs');
+
+SKIP: {
+ skip(cannot make dasboot.bs again: $!, 1) unless $file_is_ready;
+ close OUT;
+
+ # if $DynaLoader::bscode is set, write its contents to the file
+ $DynaLoader::bscode = 'Wall';
+ $ExtUtils::Mkbootstrap::Verbose = 0;
+
+ # if arguments contain '-l' or '-L' or '-R' print dl_findfile message
+ eval{ Mkbootstrap('dasboot', '-Larry') };
+ is( $@, '', 'should be able to open a file again');
+
+ $file_is_ready = open(IN, 'dasboot.bs');
+}
+
+SKIP: {
+ skip(cannot open dasboot.bs for reading: $!, 3) unless $file_is_ready;
+
+ my $file = do { local $/ = IN };
+ is( $out-read, Writing dasboot.bs\n, 'should hush without Verbose set' );
+
+ # and find our hidden tribute to a fine example
+ like( $file, qr/dl_findfile.+Larry/s, 'should load libraries if needed' );
+ like( $file, qr/Wall\n1;\n/ms, 'should write $DynaLoader::bscode if set' );
+}
Re: [PATCH] Test::More isa_ok function
In article [EMAIL PROTECTED], Dave Rolsky
[EMAIL PROTECTED] wrote:
On Tue, 25 Sep 2001, Michael G Schwern wrote:
A, ok. How about this:
my $yarrow = Bar-new;
isa_ok($yarrow, Bar, 'yarrow');
isa_ok($foo, 'Alzabo::Foo', 'Return value from $bar-foreign_keys should be
Alzabo::Foo');
Combining the two gives us a test and a very contrived test failure output:
isa_ok($foo, 'Alzabo::Foo', 'Return value from $bar-foreign_keys');
not ok 1 - $foo-isa('bar')
# Failed test (foo.plx at line 3)
# Return value from $bar-foreign_keys isn't a 'Alzabo::Foo'
The syntax is a little different, but it's *really* close.
-- c
AutoSplit.t Patch (was Re: [PATCH)
In article [EMAIL PROTECTED], Nicholas Clark
[EMAIL PROTECTED] wrote:
I hope this patch works. The one without MANIFEST did.
Here's a patch to the patch that ties a filehandle and removes the spawning. I
had to tweak one little regex and add a chomp to get things to work.
p5p's trimmed from this followup. Saying REPATCH seems a little rude.
That's an impressive test: AutoSplit is scary.
-- c
--- lib/~AutoSplit.tMon Sep 24 21:05:59 2001
+++ lib/AutoSplit.t Mon Sep 24 21:05:01 2001
@@ -4,19 +4,16 @@
# work.
my $incdir;
-my $lib = '-I../lib'; # ok on unix, nt, The extra \ are for VMS
BEGIN {
chdir 't' if -d 't';
if ($^O eq 'MacOS') {
$incdir = :auto-$$;
-$lib = '-x -I::lib:'; # -x overcomes MPW $Config{startperl} anomaly
} else {
$incdir = auto-$$;
}
@INC = $incdir;
push @INC, '../lib';
}
-my $runperl = $^X $lib;
use warnings;
use strict;
@@ -24,8 +21,7 @@
use File::Spec;
use File::Find;
-require AutoSplit; # Run time. Check it compiles.
-ok (1, AutoSplit loaded);
+require_ok('AutoSplit');
END {
use File::Path;
@@ -45,6 +41,7 @@
close DATA;
}
+my $out = tie *OUT, 'TieOut';
sub split_a_file {
my $contents = shift;
my $file = $_[0];
@@ -54,15 +51,10 @@
close FILE or die Can't close $file: $!;
}
- # Assumption: no characters in arguments need escaping from the shell or perl
- my $com = qq($runperl -e use AutoSplit; autosplit (qw(@_)));
- print # $com\n;
- # There may be a way to capture STDOUT without spawning a child process, but
- # it's probably worthwhile spawning, as it ensures that nothing in AutoSplit
- # can load functions from split modules into this perl.
- my $output = `$com`;
- warn Exit status $? from running: $com if $?;
- return $output;
+ my $orig = select(OUT);
+ AutoSplit::autosplit(@_);
+ select($orig);
+ return $out-read();
}
my $i = 0;
@@ -79,10 +71,10 @@
| \#(?!\#) # or a # character not followed by #
| (?!\n)\# # or a # character not preceded by \n
)*)/sgmx;
- foreach ($args{Name}, $args{Require}) {
+ foreach (@args{qw( Name Require Extra )}) {
chomp $_ if defined $_;
}
- my @extra_args = !defined $args{Extra} ? () : split /,/, $args{Extra};
+ my @extra_args = !defined $args{Extra} ? () : split /,\s*/, $args{Extra};
my ($output, $body);
if ($args{File}) {
$body =package $module;\n . $args{File};
@@ -152,6 +144,30 @@
mkdir $dir, 0775;
}
}
+
+package TieOut;
+
+sub TIEHANDLE {
+ bless( \(my $scalar), $_[0] );
+}
+
+sub PRINT {
+ my $self = shift;
+ $$self .= join('', @_);
+}
+
+sub PRINTF {
+ my $self = shift;
+ my $format = shift;
+ $$self .= sprintf($format, @_);
+}
+
+sub read {
+ my $self = shift;
+ substr($$self, 0, length($$self), '');
+}
+
+package main;
__DATA__
## Name
Re: A new lease on life for Perl Refactoring
In article [EMAIL PROTECTED], Andrew M. Langmead [EMAIL PROTECTED] wrote: So I'd think the best thing to do to make something that can produce answers to things like what are the implementors of foo. Ideally, there'd also be a comprehensive test suite to run after the refactoring to see what breaks. If the browser doesn't catch everything, and if the test suite is kept at 100% pass, and if the coverage is close enough to comprehensive, it ought to catch almost everything else. There's a chapter in Extreme Programming Examined that discusses the Smalltalk refactoring browser. They worked up some sort of change object that can be applied, reverted, and reapplied as necessary. Any change is represented with one of these objects. Granted, that's a ways in the future. The point is, getting an 80% solution, with proper behavior to back it up, is a really really big win. Refactoring without a test suite is a risky business. -- c
[PATCH Test/Simple.pm Test/More.pm] Add skip_rest() Function
Hi there,
I've just added a really simple convenience function that skips the rest of the
tests in a suite. It's different from the normal skip() in that it doesn't
require nested named blocks.
This came about trying to find a better way to fix t/op/lfs.t in bleadperl. (I
have a patch for that as well that illustrates my dilemma. If anyone's
interested, I can post it as well.)
There may be a much more elegant way to solve this. I'm all ears. (The POD
patch may rather belong in Test::More instead of Test::Simple, as well.)
-- c
--- lib/Test/~More.pm Thu Sep 6 06:57:08 2001
+++ lib/Test/More.pmFri Sep 14 23:36:28 2001
@@ -21,7 +21,7 @@
skip todo
pass fail
eq_array eq_hash eq_set
- skip
+ skip skip_rest
$TODO
plan
can_ok isa_ok
--- lib/Test/~Simple.pm Sat Sep 15 00:29:54 2001
+++ lib/Test/Simple.pm Sat Sep 15 00:29:30 2001
@@ -57,6 +57,7 @@
no strict 'refs';
my($caller) = caller;
*{$caller.'::ok'} = \ok;
+*{$caller.'::skip_rest'} = \skip_rest;
}
@@ -199,6 +200,35 @@
return $test ? 1 : 0;
}
+=cut
+
+=over 4
+
+=item Bskip_rest
+
+ skip_rest();
+ skip_rest( $why );
+
+skip_rest() is given an explanation as to why to skip the rest of the tests.
+It'll happily report ok $testnum # skip $why for each skipped test. If no
+reason is provided, it will just say that it skipped things. This is a
+last-resort test, to ditch things without having to wrap everything in a SKIP
+block.
+
+=cut
+
+
+sub skip_rest {
+ my($why) = shift;
+
+my $msg;
+ for ($Num_Tests + 1 .. $Planned_Tests) {
+ _skipped($why);
+ ($why) = (split(/\n/, $why))[0];
+ }
+
+exit(0);
+}
sub _skipped {
my($why) = shift;
