perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From s...@apache.org
Subject cvs commit: modperl-2.0/t/response/TestModperl exit.pm
Date Tue, 04 May 2004 06:16:46 GMT
stas        2004/05/03 23:16:46

  Modified:    t/modperl .cvsignore
               ModPerl-Registry/lib/ModPerl RegistryCooker.pm
               src/modules/perl modperl_util.c
               t/response/TestModperl exit.pm
  Added:       t/modperl exit.t
  Log:
  ModPerl::Util::exit now throws an exception object, so it's possible to
  rethrow exit if it gets trapped in eval context on the user side
  
  Revision  Changes    Path
  1.16      +0 -1      modperl-2.0/t/modperl/.cvsignore
  
  Index: .cvsignore
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/t/modperl/.cvsignore,v
  retrieving revision 1.15
  retrieving revision 1.16
  diff -u -u -r1.15 -r1.16
  --- .cvsignore	18 Feb 2004 00:23:36 -0000	1.15
  +++ .cvsignore	4 May 2004 06:16:46 -0000	1.16
  @@ -1,7 +1,6 @@
   current_callback.t
   env.t
   endav.t
  -exit.t
   printf.t
   print.t
   pnotes.t
  
  
  
  1.1                  modperl-2.0/t/modperl/exit.t
  
  Index: exit.t
  ===================================================================
  use Apache::TestRequest 'GET_BODY_ASSERT';
  
  use Apache::Test;
  use Apache::TestUtil;
  
  my $location = "/TestModperl__exit";
  
  plan tests => 3;
  
  {
      ok t_cmp('exited',
               GET_BODY_ASSERT("$location?noneval"),
               "exit in non eval context");
  
  }
  {
      my $body = GET_BODY_ASSERT("$location?eval");
      ok t_cmp(qr/^ModPerl::Util::exit: exit was called/,
               $body,
               "exit in eval context");
  
      ok !t_cmp(qr/must not be reached/,
               $body,
               "exit in eval context");
  
  }
  
  
  
  1.47      +5 -4      modperl-2.0/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm
  
  Index: RegistryCooker.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm,v
  retrieving revision 1.46
  retrieving revision 1.47
  diff -u -u -r1.46 -r1.47
  --- RegistryCooker.pm	2 Apr 2004 02:17:45 -0000	1.46
  +++ RegistryCooker.pm	4 May 2004 06:16:46 -0000	1.47
  @@ -41,7 +41,8 @@
   use File::Spec::Functions ();
   use File::Basename;
   
  -use Apache::Const -compile => qw(:common &OPT_EXECCGI);
  +use Apache::Const  -compile => qw(:common &OPT_EXECCGI);
  +use ModPerl::Const -compile => 'EXIT';
   
   unless (defined $ModPerl::Registry::MarkLine) {
       $ModPerl::Registry::MarkLine = 1;
  @@ -714,10 +715,10 @@
   sub error_check {
       my $self = shift;
   
  -    # ModPerl::Util::exit() is implemented as croak with no message
  -    # so perl will set $@ to " at /some/path", which is not an error
  +    # ModPerl::Util::exit() throws an exception object whose rc is
  +    # ModPerl::EXIT
       # (see modperl_perl_exit() and modperl_errsv() C functions)
  -    if ($@ and substr($@, 0, 4) ne " at ") {
  +    if ($@ && !(ref $@ && $@ == ModPerl::EXIT)) {
           $self->log_error($@);
           return Apache::SERVER_ERROR;
       }
  
  
  
  1.67      +5 -19     modperl-2.0/src/modules/perl/modperl_util.c
  
  Index: modperl_util.c
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.c,v
  retrieving revision 1.66
  retrieving revision 1.67
  diff -u -u -r1.66 -r1.67
  --- modperl_util.c	3 Apr 2004 02:35:47 -0000	1.66
  +++ modperl_util.c	4 May 2004 06:16:46 -0000	1.67
  @@ -261,25 +261,16 @@
       return p;
   }
   
  -char *modperl_apr_strerror(apr_status_t rv)
  -{
  -    dTHX;
  -    char buf[256];
  -    apr_strerror(rv, buf, sizeof(buf));
  -    return Perl_form(aTHX_ "%d:%s", rv, buf);
  -}
  -
   int modperl_errsv(pTHX_ int status, request_rec *r, server_rec *s)
   {
       SV *sv = ERRSV;
       STRLEN n_a;
   
       if (SvTRUE(sv)) {
  -        if (SvMAGICAL(sv) && (SvCUR(sv) > 4) &&
  -            strnEQ(SvPVX(sv), " at ", 4))
  -        {
  +        if (sv_derived_from(sv, "APR::Error") &&
  +            SvIVx(sv) == MODPERL_RC_EXIT) {
               /* ModPerl::Util::exit was called */
  -            return DECLINED;
  +            return OK;
           }
   #if 0
           if (modperl_sv_is_http_code(ERRSV, &status)) {
  @@ -572,15 +563,10 @@
   
   void modperl_perl_exit(pTHX_ int status)
   {
  -    const char *pat = NULL;
       ENTER;
       SAVESPTR(PL_diehook);
       PL_diehook = Nullsv; 
  -    sv_setpv(ERRSV, "");
  -#ifdef MP_PERL_5_6_0
  -    pat = ""; /* NULL segvs in 5.6.0 */
  -#endif
  -    Perl_croak(aTHX_ pat);
  +    modperl_croak(aTHX_ MODPERL_RC_EXIT, "ModPerl::Util::exit");
   }
   
   MP_INLINE SV *modperl_dir_config(pTHX_ request_rec *r, server_rec *s,
  @@ -716,7 +702,7 @@
       if (rc != APR_SUCCESS) { \
           SvREFCNT_dec(sv); \
           Perl_croak(aTHX_ "Error " action " '%s': %s ", r->filename, \
  -                   modperl_apr_strerror(rc)); \
  +                   modperl_error_strerror(aTHX_ rc)); \
       }
   
   MP_INLINE SV *modperl_slurp_filename(pTHX_ request_rec *r, int tainted)
  
  
  
  1.3       +24 -9     modperl-2.0/t/response/TestModperl/exit.pm
  
  Index: exit.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/t/response/TestModperl/exit.pm,v
  retrieving revision 1.2
  retrieving revision 1.3
  diff -u -u -r1.2 -r1.3
  --- exit.pm	11 Apr 2002 11:08:44 -0000	1.2
  +++ exit.pm	4 May 2004 06:16:46 -0000	1.3
  @@ -1,25 +1,40 @@
   package TestModperl::exit;
   
  +# there is no need to call ModPerl::Util::exit() explicitly, a plain
  +# exit() will do. We do the explicit fully qualified call in this
  +# test, in case something has messed up with CORE::GLOBAL::exit and we
  +# want to make sure that we test the right API
  +
   use strict;
   use warnings FATAL => 'all';
   
   use ModPerl::Util ();
   
  -use Apache::Test;
  -
  -use Apache::Const -compile => 'OK';
  +use Apache::Const  -compile => 'OK';
  +use ModPerl::Const -compile => 'EXIT';
   
   sub handler {
       my $r = shift;
   
  -    plan $r, test => 1;
  -
  -    ok 1;
  +    $r->content_type('text/plain');
  +    my $args = $r->args;
   
  -    ModPerl::Util::exit();
  +    if ($args eq 'eval') {
  +        eval {
  +            my $whatever = 1;
  +            ModPerl::Util::exit();
  +        };
  +        # test whether we can stringify our custom error messages
  +        $r->print("$@");
  +        ModPerl::Util::exit if $@ && ref $@ && $@ == ModPerl::EXIT;
  +    }
  +    elsif ($args eq 'noneval') {
  +        $r->print("exited");
  +        ModPerl::Util::exit();
  +    }
   
  -    #not reached
  -    ok 2;
  +    # must not be reached
  +    $r->print("must not be reached");
   
       Apache::OK;
   }
  
  
  

Mime
View raw message