perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From tors...@apache.org
Subject svn commit: r1302389 - in /perl/modperl/trunk: Changes t/conf/post_config_startup.pl t/lib/TestAPRlib/pool.pm xs/APR/Pool/APR__Pool.h xs/Apache2/ServerUtil/Apache2__ServerUtil.h
Date Mon, 19 Mar 2012 12:03:52 GMT
Author: torsten
Date: Mon Mar 19 12:03:52 2012
New Revision: 1302389

URL: http://svn.apache.org/viewvc?rev=1302389&view=rev
Log:
Pool cleanup functions must not longjmp. Catch these exceptions and turn
them into warnings.

Affected methods:
  APR::Pool->cleanup_register
  Apache2::ServerUtil->server_shutdown_cleanup_register

Modified:
    perl/modperl/trunk/Changes
    perl/modperl/trunk/t/conf/post_config_startup.pl
    perl/modperl/trunk/t/lib/TestAPRlib/pool.pm
    perl/modperl/trunk/xs/APR/Pool/APR__Pool.h
    perl/modperl/trunk/xs/Apache2/ServerUtil/Apache2__ServerUtil.h

Modified: perl/modperl/trunk/Changes
URL: http://svn.apache.org/viewvc/perl/modperl/trunk/Changes?rev=1302389&r1=1302388&r2=1302389&view=diff
==============================================================================
--- perl/modperl/trunk/Changes (original)
+++ perl/modperl/trunk/Changes Mon Mar 19 12:03:52 2012
@@ -12,7 +12,8 @@ Also refer to the Apache::Test changes l
 
 =item 2.0.6-dev
 
-Do not stringify $@ upon exception propagation. [Torsten Foertsch] 
+Pool cleanup functions must not longjmp. Catch these exceptions and turn
+them into warnings. [Torsten Foertsch] 
 
 Fix a race condition in our tipool management.
 See http://www.gossamer-threads.com/lists/modperl/dev/104026

Modified: perl/modperl/trunk/t/conf/post_config_startup.pl
URL: http://svn.apache.org/viewvc/perl/modperl/trunk/t/conf/post_config_startup.pl?rev=1302389&r1=1302388&r2=1302389&view=diff
==============================================================================
--- perl/modperl/trunk/t/conf/post_config_startup.pl (original)
+++ perl/modperl/trunk/t/conf/post_config_startup.pl Mon Mar 19 12:03:52 2012
@@ -98,20 +98,29 @@ sub test_perl_ithreads {
 }
 
 sub test_server_shutdown_cleanup_register {
-    # we can't really test the functionality since it happens at
-    # server shutdown, when the test suite has finished its run
-    # so just check that we can register the cleanup and that it
-    # doesn't segfault
-    Apache2::ServerUtil::server_shutdown_cleanup_register(sub { Apache2::Const::OK });
-
-    # replace the sub with the following to get some visual debug
-    # should log cnt:1 on -start, oncand cnt: 2 -stop followed by cnt: 1)
-    #Apache2::ServerUtil::server_shutdown_cleanup_register( sub {
-    #    my $cnt = Apache2::ServerUtil::restart_count();
-    #    open my $fh, ">>/tmp/out" or die "$!";
-    #    print $fh "cnt: $cnt\n";
-    #    close $fh;
-    #});
+    Apache2::ServerUtil::server_shutdown_cleanup_register sub {
+       warn <<'EOF';
+*** done with server_shutdown_cleanup_register                               ***
+********************************************************************************
+EOF
+    };
+
+    Apache2::ServerUtil::server_shutdown_cleanup_register sub {
+       die "testing server_shutdown_cleanup_register\n";
+    };
+
+    Apache2::ServerUtil::server_shutdown_cleanup_register sub {
+        warn <<'EOF';
+********************************************************************************
+*** This is a test for Apache2::ServerUtil::server_shutdown_cleanup_register ***
+*** Following a line consisting only of * characters there should be a line  ***
+*** containing                                                               ***
+***     "cleanup died: testing server_shutdown_cleanup_register".            ***
+*** The next line should then read                                           ***
+***     "done with server_shutdown_cleanup_register"                         ***
+********************************************************************************
+EOF
+    };
 }
 
 sub ModPerl::Test::exit_handler {

Modified: perl/modperl/trunk/t/lib/TestAPRlib/pool.pm
URL: http://svn.apache.org/viewvc/perl/modperl/trunk/t/lib/TestAPRlib/pool.pm?rev=1302389&r1=1302388&r2=1302389&view=diff
==============================================================================
--- perl/modperl/trunk/t/lib/TestAPRlib/pool.pm (original)
+++ perl/modperl/trunk/t/lib/TestAPRlib/pool.pm Mon Mar 19 12:03:52 2012
@@ -11,7 +11,7 @@ use APR::Pool ();
 use APR::Table ();
 
 sub num_of_tests {
-    return 75;
+    return 76;
 }
 
 sub test {
@@ -333,21 +333,42 @@ sub test {
     {
         my $p = APR::Pool->new;
         $p->cleanup_register('TestAPR::pool::some_non_existing_sub', 1);
-        eval { $p->destroy };
-        ok t_cmp($@,
+
+        my @warnings;
+        local $SIG{__WARN__} = sub {push @warnings, @_};
+        $p->destroy;
+
+        ok t_cmp($warnings[0],
                  qr/Undefined subroutine/,
                  "non existing function");
     }
     {
         my $p = APR::Pool->new;
         $p->cleanup_register(\&non_existing1, 1);
-        eval { $p->destroy };
-        ok t_cmp($@,
+
+        my @warnings;
+        local $SIG{__WARN__} = sub {push @warnings, @_};
+        $p->destroy;
+
+        ok t_cmp($warnings[0],
                  qr/Undefined subroutine/,
                  "non existing function");
     }
 
+    # cleanups throwing exceptions
+    {
+        my $p = APR::Pool->new;
+        $p->cleanup_register(sub {die "1\n"}, 1);
+        $p->cleanup_register(sub {die "2\n"}, 1);
 
+        my @warnings;
+        local $SIG{__WARN__} = sub {push @warnings, @_};
+        undef $p;
+
+        ok t_cmp(\@warnings,
+                 [map "APR::Pool: cleanup died: $_\n", 2, 1],
+                 "exceptions thrown by cleanups");
+    }
 
     ### $p->clear ###
     {

Modified: perl/modperl/trunk/xs/APR/Pool/APR__Pool.h
URL: http://svn.apache.org/viewvc/perl/modperl/trunk/xs/APR/Pool/APR__Pool.h?rev=1302389&r1=1302388&r2=1302389&view=diff
==============================================================================
--- perl/modperl/trunk/xs/APR/Pool/APR__Pool.h (original)
+++ perl/modperl/trunk/xs/APR/Pool/APR__Pool.h Mon Mar 19 12:03:52 2012
@@ -285,6 +285,7 @@ static apr_status_t mpxs_cleanup_run(voi
     }
     PUTBACK;
 
+    save_gp(PL_errgv, 1);       /* local *@ */
     count = call_sv(cdata->cv, G_SCALAR|G_EVAL);
 
     SPAGAIN;
@@ -293,6 +294,11 @@ static apr_status_t mpxs_cleanup_run(voi
         (void)POPs; /* the return value is ignored */
     }
 
+    if (SvTRUE(ERRSV)) {
+        Perl_warn(aTHX_ "APR::Pool: cleanup died: %s", 
+                  SvPV_nolen(ERRSV));
+    }
+
     PUTBACK;
     FREETMPS;LEAVE;
 
@@ -311,10 +317,6 @@ static apr_status_t mpxs_cleanup_run(voi
     }
 #endif
 
-    if (SvTRUE(ERRSV)) {
-        Perl_croak(aTHX_ Nullch);
-    }
-
     /* the return value is ignored by apr_pool_destroy anyway */
     return APR_SUCCESS;
 }

Modified: perl/modperl/trunk/xs/Apache2/ServerUtil/Apache2__ServerUtil.h
URL: http://svn.apache.org/viewvc/perl/modperl/trunk/xs/Apache2/ServerUtil/Apache2__ServerUtil.h?rev=1302389&r1=1302388&r2=1302389&view=diff
==============================================================================
--- perl/modperl/trunk/xs/Apache2/ServerUtil/Apache2__ServerUtil.h (original)
+++ perl/modperl/trunk/xs/Apache2/ServerUtil/Apache2__ServerUtil.h Mon Mar 19 12:03:52 2012
@@ -53,6 +53,7 @@ static apr_status_t mpxs_cleanup_run(voi
     mpxs_cleanup2_t *cdata = (mpxs_cleanup2_t *)data;
 #ifdef USE_ITHREADS
     dTHXa(cdata->perl);
+    PERL_SET_CONTEXT(aTHX);
 #endif
     dSP;
 
@@ -63,6 +64,7 @@ static apr_status_t mpxs_cleanup_run(voi
     }
     PUTBACK;
 
+    save_gp(PL_errgv, 1);       /* local *@ */
     count = call_sv(cdata->cv, G_SCALAR|G_EVAL);
 
     SPAGAIN;
@@ -71,6 +73,11 @@ static apr_status_t mpxs_cleanup_run(voi
         (void)POPs; /* the return value is ignored */
     }
 
+    if (SvTRUE(ERRSV)) {
+        Perl_warn(aTHX_ "Apache2::ServerUtil: cleanup died: %s",
+                  SvPV_nolen(ERRSV));
+    }
+
     PUTBACK;
     FREETMPS;LEAVE;
 
@@ -79,10 +86,6 @@ static apr_status_t mpxs_cleanup_run(voi
         SvREFCNT_dec(cdata->arg);
     }
 
-    if (SvTRUE(ERRSV)) {
-        Perl_croak(aTHX_ Nullch);
-    }
-
     /* the return value is ignored by apr_pool_destroy anyway */
     return APR_SUCCESS;
 }



Mime
View raw message