gozer 2003/11/13 13:03:47
Modified: . Changes
src/modules/perl modperl_cmd.c
t/conf extra.last.conf.in
t/response/TestDirective perldo.pm
Log:
<Perl> sections now proprely set filename and line number information,
making error messages report the correct location.
Reviewed by: stas
Revision Changes Path
1.250 +3 -0 modperl-2.0/Changes
Index: Changes
===================================================================
RCS file: /home/cvs/modperl-2.0/Changes,v
retrieving revision 1.249
retrieving revision 1.250
diff -u -r1.249 -r1.250
--- Changes 10 Nov 2003 21:11:53 -0000 1.249
+++ Changes 13 Nov 2003 21:03:46 -0000 1.250
@@ -12,6 +12,9 @@
=item 1.99_12-dev
+<Perl> sections now proprely set filename and line number information,
+making error messages report the correct location. [Philippe M. Chiasson]
+
=item 1.99_11 - November 10, 2003
add a build/win32_fetch_apxs script (called within the top-level
1.50 +10 -2 modperl-2.0/src/modules/perl/modperl_cmd.c
Index: modperl_cmd.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_cmd.c,v
retrieving revision 1.49
retrieving revision 1.50
diff -u -r1.49 -r1.50
--- modperl_cmd.c 20 Oct 2003 17:44:48 -0000 1.49
+++ modperl_cmd.c 13 Nov 2003 21:03:46 -0000 1.50
@@ -310,6 +310,7 @@
char line[MAX_STRING_LEN];
apr_table_t *args;
ap_directive_t **current = mconfig;
+ int line_num;
if (!endp) {
return modperl_cmd_unclosed_directive(parms);
@@ -321,6 +322,7 @@
return errmsg;
}
+ line_num = parms->config_file->line_number+1;
while (!ap_cfg_getline(line, sizeof(line), parms->config_file)) {
/*XXX: Not sure how robust this is */
if (strEQ(line, "</Perl>")) {
@@ -337,7 +339,7 @@
}
(*current)->filename = parms->config_file->name;
- (*current)->line_num = parms->config_file->line_number;
+ (*current)->line_num = line_num;
(*current)->directive = apr_pstrdup(p, "Perl");
(*current)->args = code;
(*current)->data = args;
@@ -360,6 +362,7 @@
const char *handler_name = NULL;
modperl_handler_t *handler = NULL;
const char *package_name = NULL;
+ const char *line_header = NULL;
int status = OK;
AV *args = Nullav;
#ifdef USE_ITHREADS
@@ -397,8 +400,13 @@
apr_table_set(options, "package", package_name);
}
+ line_header = apr_psprintf(p, "\n#line %d %s\n",
+ parms->directive->line_num,
+ parms->directive->filename);
+
/* put the code about to be executed in the configured package */
- arg = apr_pstrcat(p, "package ", package_name, ";", arg, NULL);
+ arg = apr_pstrcat(p, "package ", package_name, ";", line_header,
+ arg, NULL);
}
eval_pv(arg, FALSE);
1.8 +6 -0 modperl-2.0/t/conf/extra.last.conf.in
Index: extra.last.conf.in
===================================================================
RCS file: /home/cvs/modperl-2.0/t/conf/extra.last.conf.in,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- extra.last.conf.in 17 Mar 2003 06:46:55 -0000 1.7
+++ extra.last.conf.in 13 Nov 2003 21:03:46 -0000 1.8
@@ -21,6 +21,12 @@
$TestDirective::perl::comments="yes";
</Perl>
+<Perl >
+$Apache::Server::SaveConfig = 1;
+$TestDirective::perl::filename = __FILE__;
+$TestDirective::perl::line = __LINE__;
+</Perl>
+
### --------------------------------- ###
Perl $TestDirective::perl::worked="yes";
1.4 +6 -1 modperl-2.0/t/response/TestDirective/perldo.pm
Index: perldo.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestDirective/perldo.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- perldo.pm 17 Mar 2003 06:46:56 -0000 1.3
+++ perldo.pm 13 Nov 2003 21:03:47 -0000 1.4
@@ -10,7 +10,7 @@
sub handler {
my $r = shift;
- plan $r, tests => 5;
+ plan $r, tests => 7;
ok t_cmp('yes', $TestDirective::perl::worked);
@@ -21,6 +21,11 @@
ok t_cmp('PerlSection',
$Apache::ReadConfig::Location{'/perl_sections_saved'}{'AuthName'});
ok t_cmp('yes', $TestDirective::perl::comments);
+
+ ok t_cmp(qr/extra.last.conf/, $TestDirective::perl::filename, '__FILE__');
+
+ # 3 would mean we are still counting lines from the context of the eval
+ ok $TestDirective::perl::line > 3;
Apache::OK;
}
