1 package ExtUtils::TBone;
6 ExtUtils::TBone - a "skeleton" for writing "t/*.t" test files.
11 Include a copy of this module in your t directory (as t/ExtUtils/TBone.pm),
12 and then write your t/*.t files like this:
14 use lib "./t"; # to pick up a ExtUtils::TBone
17 # Make a tester... here are 3 different alternatives:
18 my $T = typical ExtUtils::TBone; # standard log
19 my $T = new ExtUtils::TBone; # no log
20 my $T = new ExtUtils::TBone "testout/Foo.tlog"; # explicit log
22 # Begin testing, and expect 3 tests in all:
23 $T->begin(3); # expect 3 tests
24 $T->msg("Something for the log file"); # message for the log
27 $T->ok($this); # test 1: no real info logged
28 $T->ok($that, # test 2: logs a comment
29 "Is that ok, or isn't it?");
30 $T->ok(($this eq $that), # test 3: logs comment + vars
35 # That last one could have also been written...
36 $T->ok_eq($this, $that); # does 'eq' and logs operands
37 $T->ok_eqnum($this, $that); # does '==' and logs operands
45 This module is intended for folks who release CPAN modules with
46 "t/*.t" tests. It makes it easy for you to output syntactically
47 correct test-output while at the same time logging all test
48 activity to a log file. Hopefully, bug reports which include
49 the contents of this file will be easier for you to investigate.
53 =head2 Standard output
55 Pretty much as described by C<Test::Harness>, with a special
56 "# END" comment placed at the very end:
67 A typical log file output by this module looks like this:
71 ** A message logged with msg().
73 1: My first test, using test(): how'd I do?
76 ** Yet another message.
77 2: My second test, using test_eq()...
78 2: A: The first string
79 2: B: The second string
87 Each test() is logged with the test name and results, and
88 the test-number prefixes each line.
89 This allows you to scan a large file easily with "grep" (or, ahem, "perl").
90 A blank line follows each test's record, for clarity.
93 =head1 PUBLIC INTERFACE
99 use vars qw($VERSION);
103 # The package version, both in 1.23 style *and* usable by MakeMaker:
104 $VERSION = substr q$Revision: 1.1 $, 10;
108 #------------------------------
116 #------------------------------
120 I<Class method, constructor.>
121 Create a new tester. Any arguments are sent to log_open().
132 $self->log_open(@_) if @_;
136 #------------------------------
140 I<Class method, constructor.>
141 Create a typical tester.
142 Use this instead of new() for most applicaitons.
143 The directory "testout" is created for you automatically, to hold
144 the output log file, and log_warnings() is invoked.
150 my ($tfile) = basename $0;
151 unless (-d "testout") {
152 mkdir "testout", 0755
153 or die "Couldn't create a 'testout' subdirectory: $!\n";
154 ### warn "$class: created 'testout' directory\n";
156 my $self = $class->new($class->catfile('.', 'testout', "${tfile}log"));
161 #------------------------------
163 #------------------------------
164 # Class method, destructor.
165 # Automatically closes the log.
172 #------------------------------
182 #------------------------------
188 This outputs the 1..NUMTESTS line to the standard output.
194 return if $self->{Begin}++;
196 $self->l_print("1..$n\n\n");
197 print {$self->{OUT}} "1..$n\n";
200 #------------------------------
205 Indicate the end of testing.
206 This outputs a "# END" line to the standard output.
212 return if $self->{End}++;
213 $self->l_print("# END\n");
214 print {$self->{OUT}} "# END\n";
217 #------------------------------
219 =item ok BOOL, [TESTNAME], [PARAMHASH...]
222 Do a test, and log some information connected with it.
223 This outputs the test result lines to the standard output:
230 $T->ok(-e $dotforward);
232 Or better yet, like this:
234 $T->ok((-e $dotforward),
235 "Does the user have a .forward file?");
237 Or even better, like this:
239 $T->ok((-e $dotforward),
240 "Does the user have a .forward file?",
245 That last one, if it were test #3, would be logged as:
247 3: Does the user have a .forward file?
249 3: Path: "/home/alice/.forward"
253 You get the idea. Note that defined quantities are logged with delimiters
254 and with all nongraphical characters suitably escaped, so you can see
255 evidence of unexpected whitespace and other badnasties.
256 Had "Fwd" been the string "this\nand\nthat", you'd have seen:
258 3: Fwd: "this\nand\nthat"
260 And unblessed array refs like ["this", "and", "that"] are
261 treated as multiple values:
270 my ($self, $ok, $test, @ps) = @_;
271 ++($self->{Count}); # next test
274 my $status = ($ok ? "ok " : "not ok ") . $self->{Count};
275 print {$self->{OUT}} $status, "\n";
278 $self->ln_print($test, "\n") if $test;
280 my ($k, $v) = (shift @ps, shift @ps);
281 my @vs = ((ref($v) and (ref($v) eq 'ARRAY'))? @$v : ($v));
283 if (!defined($_)) { # value not defined: output keyword
284 $self->ln_print(qq{ $k: undef\n});
286 else { # value defined: output quoted, encoded form
287 s{([\n\t\x00-\x1F\x7F-\xFF\\\"])}
288 {'\\'.sprintf("%02X",ord($1)) }exg;
290 $self->ln_print(qq{ $k: "$_"\n});
294 $self->ln_print($status, "\n");
295 $self->l_print("\n");
300 #------------------------------
302 =item ok_eq ASTRING, BSTRING, [TESTNAME], [PARAMHASH...]
305 Convenience front end to ok(): test whether C<ASTRING eq BSTRING>, and
306 logs the operands as 'A' and 'B'.
311 my ($self, $this, $that, $test, @ps) = @_;
312 $self->ok(($this eq $that),
313 ($test || "(Is 'A' string-equal to 'B'?)"),
320 #------------------------------
322 =item ok_eqnum ANUM, BNUM, [TESTNAME], [PARAMHASH...]
325 Convenience front end to ok(): test whether C<ANUM == BNUM>, and
326 logs the operands as 'A' and 'B'.
331 my ($self, $this, $that, $test, @ps) = @_;
332 $self->ok(($this == $that),
333 ($test || "(Is 'A' numerically-equal to 'B'?)"),
339 #------------------------------
343 =head2 Logging messages
349 #------------------------------
354 Open a log file for messages to be output to. This is invoked
355 for you automatically by C<new(PATH)> and C<typical()>.
360 my ($self, $path) = @_;
361 $self->{LogPath} = $path;
362 $self->{LOG} = FileHandle->new(">$path") || die "open $path: $!";
366 #------------------------------
371 Close the log file and stop logging.
372 You shouldn't need to invoke this directly; the destructor does it.
378 close(delete $self->{LOG}) if $self->{LOG};
381 #------------------------------
386 Invoking this redefines $SIG{__WARN__} to log to STDERR and
387 to the tester's log. This is automatically invoked when
388 using the C<typical> constructor.
394 $SIG{__WARN__} = sub {
396 $self->log("warning: ", $_[0]);
400 #------------------------------
405 Log a message to the log file. No alterations are made on the
406 text of the message. See msg() for an alternative.
412 print {$self->{LOG}} @_ if $self->{LOG};
415 #------------------------------
420 Log a message to the log file. Lines are prefixed with "** " for clarity,
421 and a terminating newline is forced.
427 my $text = join '', @_;
429 $text =~ s{^}{** }gm;
430 $self->l_print($text, "\n");
433 #------------------------------
437 # Instance method, private.
438 # Print to the log file if there is one.
442 print { $self->{LOG} } @_ if $self->{LOG};
445 #------------------------------
447 # ln_print MESSAGE...
449 # Instance method, private.
450 # Print to the log file, prefixed by message number.
454 foreach (split /\n/, join('', @_)) {
455 $self->l_print("$self->{Count}: $_\n");
459 #------------------------------
469 #------------------------------
471 =item catdir DIR, ..., DIR
473 I<Class/instance method.>
474 Concatenate several directories into a path ending in a directory.
475 Lightweight version of the one in C<File::Spec>; this method
476 dates back to a more-innocent time when File::Spec was younger
479 Paths are assumed to be absolute.
480 To signify a relative path, the first DIR must be ".",
481 which is processed specially.
483 On Mac, the path I<does> end in a ':'.
484 On Unix, the path I<does not> end in a '/'.
490 my $relative = shift @_ if ($_[0] eq '.');
492 return ($relative ? ':' : '') . (join ':', @_) . ':';
495 return ($relative ? './' : '/') . join '/', @_;
499 #------------------------------
501 =item catfile DIR, ..., DIR, FILE
503 I<Class/instance method.>
504 Like catdir(), but last element is assumed to be a file.
505 Note that, at a minimum, you must supply at least a single DIR.
513 return $self->catdir(@_) . $file;
516 return $self->catdir(@_) . "/$file";
520 #------------------------------
527 $Id: TBone.pm,v 1.1 2005/02/10 19:38:36 dfs Exp $
534 =item Version 1.124 (2001/08/20)
536 The terms-of-use have been placed in the distribution file "COPYING".
537 Also, small documentation tweaks were made.
540 =item Version 1.122 (2001/08/20)
542 Changed output of C<"END"> to C<"# END">; apparently, "END" is
543 not a directive. Maybe it never was.
544 I<Thanks to Michael G. Schwern for the bug report.>
547 need not say "the end" aloud;
550 Automatically invoke C<log_warnings()> when constructing
554 =item Version 1.120 (2001/08/17)
556 Added log_warnings() to support the logging of SIG{__WARN__}
557 messages to the log file (if any).
560 =item Version 1.116 (2000/03/23)
562 Cosmetic improvements only.
565 =item Version 1.112 (1999/05/12)
567 Added lightweight catdir() and catfile() (a la File::Spec)
568 to enhance portability to Mac environment.
571 =item Version 1.111 (1999/04/18)
573 Now uses File::Basename to create "typical" logfile name,
577 =item Version 1.110 (1999/04/17)
579 Fixed bug in constructor that surfaced if no log was being used.
583 Created: Friday-the-13th of February, 1998.
588 Eryq (F<eryq@zeegee.com>).
589 President, ZeeGee Software Inc. (F<http://www.zeegee.com>).
591 Go to F<http://www.zeegee.com> for the latest downloads
592 and on-line documentation for this module.
594 Enjoy. Yell if it breaks.
598 #------------------------------
603 my $T = new ExtUtils::TBone "testout/foo.tlog";
605 $T->msg("before 1\nor 2");
608 $T->ok(3, "Three", Roman=>'III', Arabic=>[3, '03'], Misc=>"3\nor 3");