[EMAIL PROTECTED] wrote:
stas 2003/11/05 01:52:18
Modified: . Makefile.PL Changes ModPerl-Registry/t TEST.PL lib/ModPerl TestRun.pm Log: When 'make test' fails we now print the info on what to do next
the attached patch makes it possible to use -bugreport with the Apache::TestRun(Perl)->generate_script() form, which is nice for end users who are not interested in creating a t/TEST.PL template (which is most at this point I'd think).
I realize now that $self->can('bug_report') was a better idea - using the no-op method throws warnings that are trapped with fatal => ALL.
--Geoff
Index: Apache-Test/lib/Apache/TestRun.pm
===================================================================
RCS file: /home/cvspublic/httpd-test/perl-framework/Apache-Test/lib/Apache/TestRun.pm,v
retrieving revision 1.121
diff -u -r1.121 TestRun.pm
--- Apache-Test/lib/Apache/TestRun.pm 5 Nov 2003 09:49:27 -0000 1.121
+++ Apache-Test/lib/Apache/TestRun.pm 7 Nov 2003 17:51:42 -0000
@@ -322,14 +322,12 @@
sub try_bug_report {
my $self = shift;
- if ($? && $self->{opts}->{bugreport}) {
+ if ($? && $self->{opts}->{bugreport} &&
+ $self->can('bug_report')) {
$self->bug_report;
}
}
-# virtual method: does nothing
-sub bug_report {}
-
#throw away cached config and start fresh
sub refresh {
my $self = shift;
@@ -983,9 +981,18 @@
# generate t/TEST script (or a different filename) which will drive
# Apache::TestRun
sub generate_script {
- my ($class, $file) = @_;
+ my ($class, @opts) = @_;
+
+ my %opts = ();
- $file ||= catfile 't', 'TEST';
+ # back-compat
+ if (@opts == 1) {
+ $opts{file} = $opts[0];
+ }
+ else {
+ %opts = @opts;
+ $opts{file} ||= catfile 't', 'TEST';
+ }
my $body = "BEGIN { eval { require blib; } }\n";
@@ -998,9 +1005,18 @@
my $header = Apache::TestConfig->perlscript_header;
$body .= join "\n",
- $header, "use $class ();", "$class->new->run([EMAIL PROTECTED]);";
+ $header, "use $class ();";
+
+ if (my $report = $opts{bugreport}) {
+ $report = eval { $report->() } if UNIVERSAL::isa($report, 'CODE');
+
+ $body .= "\n\npackage $class;\n" .
+ "sub bug_report { print '$report' }\n\n";
+ }
+
+ $body .= "$class->new->run([EMAIL PROTECTED]);";
- Apache::Test::config()->write_perlscript($file, $body);
+ Apache::Test::config()->write_perlscript($opts{file}, $body);
}
# in idiomatic perl functions return 1 on success 0 on--------------------------------------------------------------------- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
