Here is the test case:
#--------------------------------
package TestFilter::out_str_eval;

use strict;
use warnings FATAL => 'all';

use Apache::RequestRec ();
use Apache::RequestIO ();
use Apache::Filter ();

use Apache::Test;
use Apache::TestUtil;

use Apache::Const -compile => qw(OK DECLINED);

# dummy pass_through filter was good enough to trigger the problem
sub handler {
    return Apache::DECLINED;
}

sub response {
    my $r = shift;

    plan $r, tests => 1;
    eval { i_do_not_exist_really_i_do_not() };
    ok t_cmp(qr/Undefined subroutine/, $@, "some croak");

    return Apache::OK;
}

1;
#--------------------------------
PerlModule TestFilter::out_str_eval
<Location /TestFilter__out_str_eval>
    SetHandler modperl
    PerlResponseHandler TestFilter::out_str_eval::response
    PerlOutputFilterHandler TestFilter::out_str_eval
</Location>

#--------------------------------

This part worked just fine:

  eval { i_do_not_exist_really_i_do_not() };
      ok t_cmp(qr/Undefined subroutine/, $@, "some croak");

but:

  ok t_cmp(qr/Undefined subroutine/, $@, "some croak");

didn't. What happens is that t_cmp, prints some debug headers. Since we have an output filter, we get a new handler invoked, which resets [EMAIL PROTECTED] By the time t_cmp gets to use $@ it's already not the one it had at the beginning. And all the related tests fail.

For now the solution I found is to adjust t_cmp, not to try to print anything before it has done the comparison and created the strings it wants to print as a debug:

Index: lib/Apache/TestUtil.pm
===================================================================
RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestUtil.pm,v
retrieving revision 1.39
diff -u -r1.39 TestUtil.pm
--- lib/Apache/TestUtil.pm      2 Jun 2004 02:13:23 -0000       1.39
+++ lib/Apache/TestUtil.pm      5 Jun 2004 00:42:08 -0000
@@ -100,10 +100,14 @@
         ' usage: $res = t_cmp($expected, $received, [$comment])')
             if @_ < 2 || @_ > 3;

-    t_debug("testing : " . pop) if @_ == 3;
-    t_debug("expected: " . struct_as_string(0, $_[0]));
-    t_debug("received: " . struct_as_string(0, $_[1]));
-    return t_is_equal($_[0], $_[1]);
+    my $result = t_is_equal($_[0], $_[1]);
+
+    my @debug = ();
+    push @debug, t_debug_no_print("testing : " . pop) if @_ == 3;
+    push @debug, t_debug_no_print("expected: " . struct_as_string(0, $_[0]));
+    push @debug, t_debug_no_print("received: " . struct_as_string(0, $_[1]));
+    print @debug;
+    return $result;
 }

 # Essentially t_cmp, but on Win32, first converts pathnames
@@ -123,7 +127,11 @@
     sub { @_ };

 sub t_debug {
-    print map {"# $_\n"} map {split /\n/} grep {defined} expand(@_);
+    print t_debug_no_print(@_);
+}
+
+sub t_debug_no_print {
+    map {"# $_\n"} map {split /\n/} grep {defined} expand(@_);
 }

 sub t_open_file {

This is something that we need to at least document, it took me some time to figure it out. I doubt we can and should fix it to restore $@ after the filter handler returns. Comments?


-- __________________________________________________________________ Stas Bekman JAm_pH ------> Just Another mod_perl Hacker http://stason.org/ mod_perl Guide ---> http://perl.apache.org mailto:[EMAIL PROTECTED] http://use.perl.org http://apacheweek.com http://modperlbook.org http://apache.org http://ticketmaster.com

---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]



Reply via email to