indeed. can you post the script? I'll take a look at it too and see if I can figure out a way to reproduce it as well.
package CGItest;
sorry, I wasn't able to reproduce the warning with that script. maybe it's something else?
no, I was talking about the change I did to fix the undef-on-exit problem (i.e. replacing POPi with POPs)
ok. I didn't see how to fix the undef warning with POPi, though, since it's undocumented what POPi returns when the stack is undef, and whether it will always compare to PL_sv_undef (whose name indicates to me an undef SV, not an undef IV, and I'm recalling some of stephen clouse's comments that undef isn't undef for all values of undef). so, using POPs seems reasonable to me :)
at any rate, the attached status.t/status.pm tests work as expected against modperl_callback.c 1.59 but break with 1.60.
so, also included is a reinsertion of the logic for HTTP guessing in 1.60 (that I removed in 1.61), but with fixes for the pv/iv problem - no additional logic was added to correct for things like string return values or non-HTTP return values.
in the end, what the patch does is add some status tests and maintain the HTTP return code logic we've always had, while fixing the exit() undef errors.
so I think this is what we agreed on, unless I totally misunderstood something. feel free to interject if it doesn't match what you had in mind.
after we agree on this, we can figure out what behaviors we want from modperl_callback() concerning strings, non-HTTP codes, etc.
--Geoff
Index: src/modules/perl/modperl_callback.c
===================================================================
RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/modperl_callback.c,v
retrieving revision 1.61
diff -u -r1.61 modperl_callback.c
--- src/modules/perl/modperl_callback.c 7 Oct 2003 19:16:13 -0000 1.61
+++ src/modules/perl/modperl_callback.c 9 Oct 2003 17:32:19 -0000
@@ -4,6 +4,7 @@
request_rec *r, server_rec *s, AV *args)
{
CV *cv=Nullcv;
+ SV *status_sv;
I32 flags = G_EVAL|G_SCALAR;
dSP;
int count, status = OK;
@@ -71,19 +72,47 @@
SPAGAIN;
if (count != 1) {
+ /* XXX can this really happen with G_EVAL|G_SCALAR? */
+ MP_TRACE_h(MP_FUNC, "callback count not 1 - assuming OK\n");
+
status = OK;
}
else {
- SV* status_sv = POPs;
+ status_sv = POPs;
+
+ /* cases arranged in order of expected occurence:
+ * integer returns (Apache::OK)
+ * valid void API calls (die or ModPerl::Util::exit)
+ * strings that ought to be treated as integers ("0")
+ */
if (SvIOK(status_sv)) {
- status = (IV)SvIVx(status_sv);
+ status = SvIVX(status_sv);
+ MP_TRACE_h(MP_FUNC, "callback returned valid integer status %d\n",
+ status);
+
+ }
+ else if (status_sv == &PL_sv_undef) {
+ /* croak sets count to 1 but the stack to undef with G_EVAL|G_SCALAR
+ * if it was an error, it will be caught with ERRSV below */
+ MP_TRACE_h(MP_FUNC, "callback returned undef - assuming OK\n");
+
+ status = OK;
+ }
+ else if (SvPOK(status_sv)) {
+ status = SvIVx(status_sv);
+ MP_TRACE_h(MP_FUNC, "callback returned a string - coerced to integer
status %d\n",
+ status);
}
else {
- /* ModPerl::Util::exit doesn't return an integer value */
+ /* XXX yikes! */
+ MP_TRACE_h(MP_FUNC, "callback IV and PV status slots empty - assuming
OK?\n");
+
status = OK;
}
- /* assume OK for 200 (HTTP_OK) */
- if ((status == 200)) {
+
+ /* assume OK for non-http status codes and for 200 (HTTP_OK) */
+ if (((status > 0) && (status < 100)) ||
+ (status == 200) || (status > 600)) {
status = OK;
}
}
Index: t/response/TestModperl/current_callback.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/response/TestModperl/current_callback.pm,v
retrieving revision 1.3
diff -u -r1.3 current_callback.pm
--- t/response/TestModperl/current_callback.pm 31 Mar 2003 01:50:52 -0000 1.3
+++ t/response/TestModperl/current_callback.pm 9 Oct 2003 17:32:20 -0000
@@ -36,6 +36,8 @@
die "expecting $expected callback, instead got $callback"
unless $callback eq $expected;
#warn "in callback: $callback\n";
+
+ return Apache::OK;
}
1;
--- /dev/null 2003-01-30 05:24:37.000000000 -0500
+++ t/modperl/status.t 2003-10-09 12:57:03.000000000 -0400
@@ -0,0 +1,142 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+use Apache::TestUtil qw(t_cmp t_server_log_error_is_expected);
+
+use Apache2;
+use Apache::Const -compile => qw(OK DECLINED
+ NOT_FOUND SERVER_ERROR FORBIDDEN
+ HTTP_OK);
+
+plan tests => 13;
+
+my $base = "/TestModperl__status";
+
+# valid Apache return codes
+{
+ my $uri = join '?', $base, Apache::OK;
+ my $code = GET_RC $uri;
+
+ ok t_cmp(Apache::HTTP_OK,
+ $code,
+ $uri);
+}
+
+{
+ my $uri = join '?', $base, Apache::DECLINED;
+ my $code = GET_RC $uri;
+
+ # no Alias to map us to DocumentRoot
+ ok t_cmp(Apache::NOT_FOUND,
+ $code,
+ $uri);
+}
+
+# standard HTTP status codes
+{
+ my $uri = join '?', $base, Apache::NOT_FOUND;
+ my $code = GET_RC $uri;
+
+ ok t_cmp(Apache::NOT_FOUND,
+ $code,
+ $uri);
+}
+
+{
+ my $uri = join '?', $base, Apache::FORBIDDEN;
+ my $code = GET_RC $uri;
+
+ ok t_cmp(Apache::FORBIDDEN,
+ $code,
+ $uri);
+}
+
+{
+ my $uri = join '?', $base, Apache::SERVER_ERROR;
+ my $code = GET_RC $uri;
+
+ ok t_cmp(Apache::SERVER_ERROR,
+ $code,
+ $uri);
+}
+
+# the return code guessing game
+{
+ my $uri = join '?', $base, Apache::HTTP_OK;
+ my $code = GET_RC $uri;
+
+ ok t_cmp(Apache::HTTP_OK,
+ $code,
+ $uri);
+}
+
+{
+ my $uri = join '?', $base, 601;
+ my $code = GET_RC $uri;
+
+ ok t_cmp(Apache::HTTP_OK,
+ $code,
+ $uri);
+}
+
+{
+ my $uri = join '?', $base, 1;
+ my $code = GET_RC $uri;
+
+ ok t_cmp(Apache::HTTP_OK,
+ $code,
+ $uri);
+}
+
+# apache translates non-HTTP codes into 500
+# see ap_index_of_response
+{
+ my $uri = join '?', $base, 313;
+ my $code = GET_RC $uri;
+
+ ok t_cmp(Apache::SERVER_ERROR,
+ $code,
+ $uri);
+}
+
+# mod_perl-specific implementation tests
+{
+ # ModPerl::Util::exit - voids return OK
+ my $uri = join '?', $base, 'exit';
+ my $code = GET_RC $uri;
+
+ ok t_cmp(Apache::HTTP_OK,
+ $code,
+ $uri);
+}
+
+{
+ # die gets trapped
+ my $uri = join '?', $base, 'die';
+ my $code = GET_RC $uri;
+
+ ok t_cmp(Apache::SERVER_ERROR,
+ $code,
+ $uri);
+}
+
+{
+ my $uri = join '?', $base, 'foobar';
+ my $code = GET_RC $uri;
+
+ ok t_cmp(Apache::HTTP_OK,
+ $code,
+ $uri);
+}
+
+{
+ my $uri = join '?', $base, 'foo9bar';
+ my $code = GET_RC $uri;
+
+ ok t_cmp(Apache::HTTP_OK,
+ $code,
+ $uri);
+}
+
--- /dev/null 2003-01-30 05:24:37.000000000 -0500
+++ t/response/TestModperl/status.pm 2003-10-09 12:57:49.000000000 -0400
@@ -0,0 +1,29 @@
+package TestModperl::status;
+
+use strict;
+use warnings;
+
+use Apache::RequestRec;
+use Apache::Const -compile => qw(DECLINED);
+
+use ModPerl::Util;
+use Apache::TestUtil qw(t_server_log_error_is_expected);
+
+sub handler {
+
+ my $rc = shift->args;
+
+ if ($rc eq 'die' ||
+ $rc eq Apache::DECLINED) {
+ t_server_log_error_is_expected();
+ }
+
+ ModPerl::Util::exit if $rc eq 'exit';
+
+ die if $rc eq 'die';
+
+ return $rc;
+}
+
+1;
+__END__
--------------------------------------------------------------------- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
