You are viewing a plain text version of this content. The canonical link for it is here.
Posted to embperl-cvs@perl.apache.org by ri...@apache.org on 2010/10/04 05:49:26 UTC
svn commit: r1004099 - in /perl/embperl/trunk: embperl.h epmain.c test.pl
Author: richter
Date: Mon Oct 4 03:49:25 2010
New Revision: 1004099
URL: http://svn.apache.org/viewvc?rev=1004099&view=rev
Log:
- Fix Execute parameter app_name (was appname, but app_name
is correct, appname is still accepted, but might not always
work)
- Add parameter checks for Execute parameters to avoid segfaults
in case of non refs where refs are expected.
Modified:
perl/embperl/trunk/embperl.h
perl/embperl/trunk/epmain.c
perl/embperl/trunk/test.pl
Modified: perl/embperl/trunk/embperl.h
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/embperl.h?rev=1004099&r1=1004098&r2=1004099&view=diff
==============================================================================
--- perl/embperl/trunk/embperl.h (original)
+++ perl/embperl/trunk/embperl.h Mon Oct 4 03:49:25 2010
@@ -97,6 +97,7 @@ enum tRc
rcTimeFormatErr,
rcSubCallNotRequest,
rcTokenNotFound,
+ rcNotScalarRef,
rcForbidden = 403,
rcNotFound = 404,
rcDecline = -1
Modified: perl/embperl/trunk/epmain.c
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/epmain.c?rev=1004099&r1=1004098&r2=1004099&view=diff
==============================================================================
--- perl/embperl/trunk/epmain.c (original)
+++ perl/embperl/trunk/epmain.c Mon Oct 4 03:49:25 2010
@@ -179,6 +179,7 @@ static char * DoLogError (/*i/o*/ struct
case rcUnknownOption: msg ="[%d]ERR: %d: %s Unkown option '%s' in configuration directive '%s'" ; break ;
case rcTimeFormatErr: msg ="[%d]ERR: %d: %s Format error in %s = %s" ; break ;
case rcSubCallNotRequest: msg ="[%d]ERR: %d: %s A Embperl sub is called and no Embperl request is running %s %s" ; break ;
+ case rcNotScalarRef: msg ="[%d]ERR: %d: %s %s need scalar in '%s'" ; break ;
default: msg ="[%d]ERR: %d: %s Error (no description) %s %s" ; break ;
}
@@ -1058,10 +1059,19 @@ static int OutputToMem (/*i/o*/ register
{
epTHX_
- SV * pOut = SvRV (r -> Component.Param.pOutput) ;
+ SV * pOut ;
char * pData ;
STRLEN l ;
+ if (!SvROK (r -> Component.Param.pOutput))
+ {
+ strcpy (r -> errdat1, "OutputToMem") ;
+ strcpy (r -> errdat2, "parameter output") ;
+
+ return rcNotScalarRef ;
+ }
+
+ pOut = SvRV (r -> Component.Param.pOutput) ;
if (!r -> bError && r -> Component.pOutputSV && !r -> Component.pImportStash)
{
sv_setsv (pOut, r -> Component.pOutputSV) ;
Modified: perl/embperl/trunk/test.pl
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/test.pl?rev=1004099&r1=1004098&r2=1004099&view=diff
==============================================================================
--- perl/embperl/trunk/test.pl (original)
+++ perl/embperl/trunk/test.pl Mon Oct 4 03:49:25 2010
@@ -2328,14 +2328,16 @@ do
print "ok\n" unless ($err) ;
}
- if ($err == 0 || $opt_ignoreerror)
+ if (0) #$err == 0 || $opt_ignoreerror)
{
$txt2 = "errornous parameter (path) ...";
$txt2 .= ' ' x (30 - length ($txt2)) ;
print $txt2 ;
- $err = eval { Embperl::Execute ({'inputfile' => $src,
+ $err = eval { Embperl::Execute ({'inputfile' => 'xxxx0',
'errors' => \@errors,
+ 'debug' => $defaultdebug,
+ input_escmode => 7,
path => "not an array ref",
}) ; } ;
$err ||= 0 ;
@@ -2354,10 +2356,14 @@ do
$txt2 .= ' ' x (30 - length ($txt2)) ;
print $txt2 ;
my $out ;
-
- $err = Embperl::Execute ({'inputfile' => $src,
+ @errors = () ;
+
+ $err = Embperl::Execute ({'inputfile' => 'xxxx1',
'errors' => \@errors,
+ 'debug' => $defaultdebug,
+ input_escmode => 7,
input => $out,
+ output => \$out,
}) ;
$err = CheckError (1) ;
@@ -2371,6 +2377,32 @@ do
print "ok\n" unless ($err) ;
}
+ if ($err == 0 || $opt_ignoreerror)
+ {
+ $txt2 = "errornous parameter (output) ...";
+ $txt2 .= ' ' x (30 - length ($txt2)) ;
+ print $txt2 ;
+ my $out ;
+ @errors = () ;
+
+ $err = Embperl::Execute ({'inputfile' => 'xxxx2',
+ 'errors' => \@errors,
+ 'debug' => $defaultdebug,
+ input_escmode => 7,
+ output => $out,
+ }) ;
+ $err = CheckError (2) ;
+
+ if (@errors != 2)
+ {
+ print "\n\n\@errors does not return correct number of errors (is " . scalar(@errors) . ", should 2)\n" ;
+ $err = 1 ;
+ }
+
+
+ print "ok\n" unless ($err) ;
+ }
+
foreach $src (
'EmbperlObject/epopage1.htm', 'EmbperlObject/sub/epopage2.htm', 'EmbperlObject/obj/epoobj3.htm',
'EmbperlObject/sub/epobless.htm', 'EmbperlObject/sub/epobless.htm',
@@ -2457,8 +2489,8 @@ do
},
{
text => 'No cache 2',
- param => { param => [2], },
- 'cmp' => 2,
+ param => { param => [99], },
+ 'cmp' => 99,
},
{
text => 'Expires in 1 sec',
---------------------------------------------------------------------
To unsubscribe, e-mail: embperl-cvs-unsubscribe@perl.apache.org
For additional commands, e-mail: embperl-cvs-help@perl.apache.org