You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by do...@hyperreal.org on 1998/10/01 05:21:49 UTC
cvs commit: modperl/t/internal croak.t
dougm 98/09/30 20:21:49
Modified: . Changes MANIFEST
lib/Apache test.pm
src/modules/perl mod_perl.c mod_perl.h
t/conf httpd.conf-dist httpd.conf-win32 httpd.conf.pl
t/docs startup.pl
Added: t/docs badsyntax.pl
t/internal croak.t
Log:
fix bug that would hose child if a croak() happened, be it from a
syntax error, Carp::croak(), etc. remove child_terminate() hack that
was blaming the Perl stack being corrupt
Revision Changes Path
1.165 +4 -0 modperl/Changes
Index: Changes
===================================================================
RCS file: /export/home/cvs/modperl/Changes,v
retrieving revision 1.164
retrieving revision 1.165
diff -u -r1.164 -r1.165
--- Changes 1998/09/30 17:46:20 1.164
+++ Changes 1998/10/01 03:21:43 1.165
@@ -8,6 +8,10 @@
=item 1.15_02-dev
+fix bug that would hose child if a croak() happened, be it from a
+syntax error, Carp::croak(), etc. remove child_terminate() hack that
+was blaming the Perl stack being corrupt
+
Apache::StatINC can now be configured to write debug stuff with
a PerlSetVar [Ask Bjoern Hansen <as...@netcetera.dk>]
1.44 +2 -0 modperl/MANIFEST
Index: MANIFEST
===================================================================
RCS file: /export/home/cvs/modperl/MANIFEST,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -r1.43 -r1.44
--- MANIFEST 1998/09/26 16:11:05 1.43
+++ MANIFEST 1998/10/01 03:21:44 1.44
@@ -124,6 +124,7 @@
t/modules/symbol.t
t/internal/api.t
t/internal/auth.t
+t/internal/croak.t
t/internal/dirmagic.t
t/internal/error.t
t/internal/headers.t
@@ -181,6 +182,7 @@
t/docs/lists.ehtml
t/docs/test.html
t/docs/rgy-include.shtml
+t/docs/badsyntax.pl
t/docs/startup.pl
t/docs/rl.pl
t/docs/stacked.pl
1.9 +3 -1 modperl/lib/Apache/test.pm
Index: test.pm
===================================================================
RCS file: /export/home/cvs/modperl/lib/Apache/test.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- test.pm 1998/07/28 17:09:16 1.8
+++ test.pm 1998/10/01 03:21:45 1.9
@@ -67,7 +67,9 @@
sub simple_fetch {
my $ua = LWP::UserAgent->new;
my $url = URI::URL->new("http://$net::httpserver");
- $url->path(shift);
+ my($path,$q) = split /\?/, shift;
+ $url->path($path);
+ $url->query($q) if $q;
my $request = new HTTP::Request('GET', $url);
my $response = $ua->request($request, undef, undef);
$response->is_success;
1.52 +0 -13 modperl/src/modules/perl/mod_perl.c
Index: mod_perl.c
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/mod_perl.c,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -r1.51 -r1.52
--- mod_perl.c 1998/09/28 18:04:21 1.51
+++ mod_perl.c 1998/10/01 03:21:45 1.52
@@ -1417,19 +1417,6 @@
MP_STORE_ERROR(r->uri, ERRSV);
if(!perl_sv_is_http_code(ERRSV, &status))
status = SERVER_ERROR;
-#if MODULE_MAGIC_NUMBER >= MMN_130
- if(!SvREFCNT(TOPs)) {
-#ifdef WIN32
- mod_perl_error(r->server,
- "mod_perl: stack is corrupt, server may need restart\n");
-#else
- mod_perl_error(r->server,
- "mod_perl: stack is corrupt, exiting process\n");
- my_setenv("PERL_DESTRUCT_LEVEL", "-1");
- child_terminate(r);
-#endif /*WIN32*/
- }
-#endif
}
else if(count != 1) {
mod_perl_error(r->server,
1.52 +1 -1 modperl/src/modules/perl/mod_perl.h
Index: mod_perl.h
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/mod_perl.h,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -r1.51 -r1.52
--- mod_perl.h 1998/09/19 22:27:43 1.51
+++ mod_perl.h 1998/10/01 03:21:46 1.52
@@ -153,7 +153,7 @@
ERRHV && hv_exists(ERRHV, k, strlen(k))
#define MP_STORE_ERROR(k,v) \
-hv_store(ERRHV, k, strlen(k), v, FALSE)
+hv_store(ERRHV, k, strlen(k), newSVsv(v), FALSE)
#define MP_FETCH_ERROR(k) \
*hv_fetch(ERRHV, k, strlen(k), FALSE)
1.14 +4 -0 modperl/t/conf/httpd.conf-dist
Index: httpd.conf-dist
===================================================================
RCS file: /export/home/cvs/modperl/t/conf/httpd.conf-dist,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- httpd.conf-dist 1998/08/28 22:33:29 1.13
+++ httpd.conf-dist 1998/10/01 03:21:47 1.14
@@ -255,4 +255,8 @@
PerlHandler $My::Obj->method
</Location>
+<Location /death>
+PerlHandler Apache::Death
+SetHandler perl-script
+</Location>
1.7 +5 -0 modperl/t/conf/httpd.conf-win32
Index: httpd.conf-win32
===================================================================
RCS file: /export/home/cvs/modperl/t/conf/httpd.conf-win32,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- httpd.conf-win32 1998/09/18 00:15:17 1.6
+++ httpd.conf-win32 1998/10/01 03:21:47 1.7
@@ -274,3 +274,8 @@
PerlSendHeader Off
PerlSetupEnv Off
</Location>
+
+<Location /death>
+PerlHandler Apache::Death
+SetHandler perl-script
+</Location>
1.20 +5 -0 modperl/t/conf/httpd.conf.pl
Index: httpd.conf.pl
===================================================================
RCS file: /export/home/cvs/modperl/t/conf/httpd.conf.pl,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -r1.19 -r1.20
--- httpd.conf.pl 1998/09/22 15:33:42 1.19
+++ httpd.conf.pl 1998/10/01 03:21:47 1.20
@@ -220,5 +220,10 @@
PerlHandler => [map { "Stacked::$_" } qw(one two three four)],
};
+$Location{"/death"} = {
+ @mod_perl,
+ PerlHandler => "Apache::Death",
+};
+
</Perl>
1.23 +25 -0 modperl/t/docs/startup.pl
Index: startup.pl
===================================================================
RCS file: /export/home/cvs/modperl/t/docs/startup.pl,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -r1.22 -r1.23
--- startup.pl 1998/09/23 19:29:28 1.22
+++ startup.pl 1998/10/01 03:21:48 1.23
@@ -199,6 +199,31 @@
warn "[notice] END block called for startup.pl\n";
}
+package Apache::Death;
+my $say_ok = <<EOF;
+*** The follow [error] is expected, no cause for alarm ***
+EOF
+
+sub handler {
+ my $r = shift;
+
+ my $args = $r->args || "";
+ if ($args =~ /die/) {
+ warn $say_ok;
+ delete $INC{"badsyntax.pl"};
+ require "badsyntax.pl"; # contains syntax error
+ }
+ if($args =~ /croak/) {
+ warn $say_ok;
+ Carp::croak("Apache::Death");
+ }
+
+ $r->content_type('text/html');
+ $r->send_http_header();
+ print "<h1>Script completed</h1>\n";
+ return 0;
+}
+
package Destruction;
sub new { bless {} }
1.1 modperl/t/docs/badsyntax.pl
Index: badsyntax.pl
===================================================================
package Apache::BadSyntax;
for (1..2) {
sub foo;
1;
__END__
1.1 modperl/t/internal/croak.t
Index: croak.t
===================================================================
use Apache::test;
my $i = 0;
print "1..12\n";
for (1..2) {
test ++$i, simple_fetch "/death/";
test ++$i, !simple_fetch "/death/?die";
test ++$i, simple_fetch "/death/";
test ++$i, simple_fetch "/death/";
test ++$i, !simple_fetch "/death/?croak";
test ++$i, simple_fetch "/death/";
}