cvs commit: httpd-test/perl-framework/Apache-Test/lib/Apache TestRun.pm

[geoff]

geoff       2003/11/16 11:16:19

  Modified:    perl-framework/Apache-Test Changes
               perl-framework/Apache-Test/lib/Apache TestRun.pm
  Log:
  added bugreport and file argument options to
  Apache::TestRun::generate_script()
  
  Revision  Changes    Path
  1.65      +3 -0      httpd-test/perl-framework/Apache-Test/Changes
  
  Index: Changes
  ===================================================================
  RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/Changes,v
  retrieving revision 1.64
  retrieving revision 1.65
  diff -u -r1.64 -r1.65
  --- Changes   10 Nov 2003 21:12:52 -0000      1.64
  +++ Changes   16 Nov 2003 19:16:19 -0000      1.65
  @@ -8,6 +8,9 @@
   
   =item 1.07-dev
   
  +added bugreport and file argument options to 
  +Apache::TestRun::generate_script() [Geoffrey Young]
  +
   =item 1.06 - November 10, 2003
   
   added -startup_timeout and $ENV{APACHE_TEST_STARTUP_TIMEOUT} as places
  
  
  
  1.122     +22 -8     
httpd-test/perl-framework/Apache-Test/lib/Apache/TestRun.pm
  
  Index: TestRun.pm
  ===================================================================
  RCS file: 
/home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestRun.pm,v
  retrieving revision 1.121
  retrieving revision 1.122
  diff -u -r1.121 -r1.122
  --- TestRun.pm        5 Nov 2003 09:49:27 -0000       1.121
  +++ TestRun.pm        16 Nov 2003 19:16:19 -0000      1.122
  @@ -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) = @_;
   
  -    $file ||= catfile 't', 'TEST';
  +    my %opts = ();
  +
  +    # 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,16 @@
       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}) {
  +        $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