Author: richter Date: Fri Sep 7 22:31:31 2012 New Revision: 1382194 URL: http://svn.apache.org/viewvc?rev=1382194&view=rev Log: Adpations for Perl 5.14 & 5.16
Added: perl/embperl/trunk/test/cmp/includeerr3.htm514 Modified: perl/embperl/trunk/MANIFEST perl/embperl/trunk/epcomp.c perl/embperl/trunk/epeval.c perl/embperl/trunk/epinit.c perl/embperl/trunk/eputil.c perl/embperl/trunk/test.pl perl/embperl/trunk/test/cmp/epodiv.htm perl/embperl/trunk/test/cmp/epoincdiv.htm perl/embperl/trunk/test/cmp/includeerr2.htm514 Modified: perl/embperl/trunk/MANIFEST URL: http://svn.apache.org/viewvc/perl/embperl/trunk/MANIFEST?rev=1382194&r1=1382193&r2=1382194&view=diff ============================================================================== --- perl/embperl/trunk/MANIFEST (original) +++ perl/embperl/trunk/MANIFEST Fri Sep 7 22:31:31 2012 @@ -237,6 +237,7 @@ eptypes.h eputil.c mod_embperl.c test.pl +test/cmp/includeerr3.htm514 test/cmp/includeerr2.htm514 test/cmp/error.htm514 test/cmp/varerr.htm514 Modified: perl/embperl/trunk/epcomp.c URL: http://svn.apache.org/viewvc/perl/embperl/trunk/epcomp.c?rev=1382194&r1=1382193&r2=1382194&view=diff ============================================================================== --- perl/embperl/trunk/epcomp.c (original) +++ perl/embperl/trunk/epcomp.c Fri Sep 7 22:31:31 2012 @@ -1739,9 +1739,15 @@ int embperl_Compile (/*i lprintf (r -> pApp, "Setup source code for interactive debugger\n") ; } - UndefSub (r, r -> Component.sMainSub, r -> Component.sCurrPackage) ; + /* + * Does not work with perl >= 5.14 + */ +#if PERL_VERSION < 14 + UndefSub (r, r -> Component.sMainSub, r -> Component.sCurrPackage) ; +#endif + rc = EvalOnly (r, r -> Component.pProgRun, pProg, G_SCALAR, r -> Component.sMainSub) ; - + StringFree (r -> pApp, &r -> Component.pProgRun) ; StringFree (r -> pApp, &r -> Component.pProgDef) ; Modified: perl/embperl/trunk/epeval.c URL: http://svn.apache.org/viewvc/perl/embperl/trunk/epeval.c?rev=1382194&r1=1382193&r2=1382194&view=diff ============================================================================== --- perl/embperl/trunk/epeval.c (original) +++ perl/embperl/trunk/epeval.c Fri Sep 7 22:31:31 2012 @@ -53,7 +53,8 @@ int EvalDirect (/*i/o*/ register req * epTHX_ /* dTHXsem */ dSP; SV * pSVErr ; - int num ; + int num ; + int n ; tainted = 0 ; @@ -62,8 +63,13 @@ int EvalDirect (/*i/o*/ register req * XPUSHs(pArgs [num]) ; /* push pointer to argument */ PUTBACK; - perl_eval_sv(pArg, G_SCALAR | G_KEEPERR); + n = perl_eval_sv(pArg, G_SCALAR | G_KEEPERR); + SPAGAIN; + if (n > 0) + pSVErr = POPs; + PUTBACK; + //delap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "eval direct %s serial=%d", SvPVX(pArg), pSVErr->sv_debug_serial) ; tainted = 0 ; pSVErr = ERRSV ; @@ -196,6 +202,7 @@ int EvalConfig (/*i/o*/ tApp * *pCV = (CV *)SvRV (pSV) ; } } + //del ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "eval config %s serial=%d", s, ((SV *)(*pCV))->sv_debug_serial) ; if (!*pCV || SvTYPE (*pCV) != SVt_PVCV) { @@ -294,6 +301,7 @@ int EvalRegEx (/*i/o*/ tApp * #ifdef DMALLOC AddDMallocMagic (*ppCV, sRegex?sRegex:"EvalRegEx", __FILE__, __LINE__) ; #endif +//del ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "eval regex %s serial=%d", sRegex, ((SV *)(*ppCV))->sv_debug_serial) ; } else *ppCV = NULL ; @@ -322,7 +330,7 @@ static int EvalAll (/*i/o*/ register req /*in*/ const char * sName, /*out*/ SV ** pRet) { - epTHX_ /* dTHXsem */ + epTHX_ /* dTHXsem */ static char sFormat [] = "package %s ; sub %s { \n#line %d \"%s\"\n%s\n} %s%s" ; static char sFormatStrict [] = "package %s ; use strict ; sub %s {\n#line %d \"%s\"\n%s\n} %s%s" ; static char sFormatArray [] = "package %s ; sub %s { \n#line %d \"%s\"\n[%s]\n} %s%s" ; @@ -362,7 +370,11 @@ static int EvalAll (/*i/o*/ register req newSVpvf2(pSVCmd) ; PUSHMARK(sp); +#if PERL_VERSION >= 14 + n = perl_eval_sv(pSVCmd, G_SCALAR); +#else n = perl_eval_sv(pSVCmd, G_SCALAR | G_KEEPERR); +#endif SvREFCNT_dec(pSVCmd); tainted = 0 ; @@ -388,14 +400,15 @@ static int EvalAll (/*i/o*/ register req l-- ; r -> errdat1[l] = '\0' ; - if (pRet && *pRet) + /*if (pRet && *pRet) SvREFCNT_dec (*pRet) ; - + */ *pRet = newSVpv (r -> errdat1, 0) ; /* LogError (r, rcEvalErr) ; */ sv_setpv(pSVErr, ""); - return rcEvalErr ; + + return rcEvalErr ; } return ok ; Modified: perl/embperl/trunk/epinit.c URL: http://svn.apache.org/viewvc/perl/embperl/trunk/epinit.c?rev=1382194&r1=1382193&r2=1382194&view=diff ============================================================================== --- perl/embperl/trunk/epinit.c (original) +++ perl/embperl/trunk/epinit.c Fri Sep 7 22:31:31 2012 @@ -345,12 +345,10 @@ int embperl_EndPass1 (void) { tThreadData * pThread ; dTHX ; -fprintf (stderr, "embperl_EndPass1\n") ; pThread = embperl_GetThread (aTHX) ; hv_clear (pThread -> pApplications) ; -fprintf (stderr, "embperl_EndPass1 done\n") ; return ok ; } @@ -1592,8 +1590,6 @@ int embperl_CleanupOutput (/*in*/ t epTHX_ tComponentOutput * pOutput = c -> pOutput ; -fprintf (stderr, "embperl_CleanupOutput\n") ; - if (!pOutput || (c -> pPrev && c -> pPrev -> pOutput == pOutput)) { /* this component uses the main output object */ return ok ; @@ -1611,7 +1607,6 @@ fprintf (stderr, "embperl_CleanupOutput\ SvREFCNT_dec (pOutput -> _perlsv) ; ep_destroy_pool (pOutput -> pPool) ; -fprintf (stderr, "embperl_CleanupOutput done\n") ; return ok ; } @@ -1641,7 +1636,6 @@ int embperl_CleanupComponent (/*in*/ epTHX_ SV * pHV ; MAGIC * mg; -fprintf (stderr, "embperl_CleanupComponent\n") ; if (c -> Param.sISA && c -> sCurrPackage) { @@ -1727,7 +1721,6 @@ fprintf (stderr, "embperl_CleanupCompone { c -> _perlsv = NULL ; } -fprintf (stderr, "embperl_CleanupComponent done\n") ; return ok ; } @@ -1760,7 +1753,6 @@ int embperl_CleanupRequest (/*in*/ tR MAGIC * mg; dSP ; -fprintf (stderr, "embperl_CleanupRequest\n") ; hv_iterinit (r -> pCleanupPackagesHV) ; while ((pEntry = hv_iternext (r -> pCleanupPackagesHV))) @@ -1882,7 +1874,6 @@ fprintf (stderr, "embperl_CleanupRequest if (r -> pPrevReq) sv_setsv(r -> pThread -> pReqRV, r -> pPrevReq -> _perlsv) ; -fprintf (stderr, "embperl_CleanupRequest done\n") ; return ok ; } @@ -2255,8 +2246,6 @@ int embperl_InitRequest (/*in*/ pTHX tApacheDirConfig * pApacheCfg = NULL ; -fprintf (stderr, "embperl_InitRequest\n") ; - /* get our thread & Application object */ if ((rc = embperl_InitAppForRequest (aTHX_ Modified: perl/embperl/trunk/eputil.c URL: http://svn.apache.org/viewvc/perl/embperl/trunk/eputil.c?rev=1382194&r1=1382193&r2=1382194&view=diff ============================================================================== --- perl/embperl/trunk/eputil.c (original) +++ perl/embperl/trunk/eputil.c Fri Sep 7 22:31:31 2012 @@ -386,7 +386,7 @@ int TransHtml (/*i/o*/ register req * char * s ; char * e ; struct tCharTrans * pChar ; - bool bInUrl = r -> Component.bEscInUrl ; + int bInUrl = r -> Component.bEscInUrl ; bool bUrlEsc = r -> Component.Config.nInputEscMode & iescUrl ; bool bHtmlEsc = r -> Component.Config.nInputEscMode & iescHtml ; bool bRemove = r -> Component.Config.nInputEscMode & iescRemoveTags ; @@ -1369,14 +1369,14 @@ void UndefSub (/*i/o*/ register req * strcpy (sFullname, sPackage) ; strcat (sFullname, "::") ; strcat (sFullname, sName) ; - - if (!(pCV = perl_get_cv (sFullname, FALSE))) + if (!(pCV = perl_get_cv (sFullname, 0))) { _free (r, sFullname) ; return ; } _free (r, sFullname) ; + cv_undef (pCV) ; } Modified: perl/embperl/trunk/test.pl URL: http://svn.apache.org/viewvc/perl/embperl/trunk/test.pl?rev=1382194&r1=1382193&r2=1382194&view=diff ============================================================================== --- perl/embperl/trunk/test.pl (original) +++ perl/embperl/trunk/test.pl Fri Sep 7 22:31:31 2012 @@ -77,23 +77,7 @@ 'errors' => 6, 'version' => 2, 'cgi' => 0, - 'condition' => '$] >= 5.010000 && $] < 5.014000', - }, - 'error.htm' => { - 'repeat' => 3, - 'errors' => 2, - 'version' => 2, - 'offline' => 1, - 'condition' => '$] >= 5.014000', - 'cmpext' => '514', - }, - 'error.htm' => { - 'repeat' => 3, - 'errors' => 1, - 'version' => 2, - 'modperl' => 1, - 'condition' => '$] >= 5.014000', - 'cmpext' => '514', + 'condition' => '$] >= 5.010000', }, 'error.htm' => { 'repeat' => 3, @@ -114,15 +98,7 @@ 'errors' => 7, 'version' => 2, 'cgi' => 1, - 'condition' => '$MP2 && $] >= 5.010000 && $] < 5.014000', - }, - 'error.htm' => { - 'repeat' => 3, - 'errors' => 3, - 'version' => 2, - 'cgi' => 1, - 'condition' => '$MP2 && $] >= 5.014000', - 'cmpext' => '514', + 'condition' => '$MP2 && $] >= 5.010000', }, 'errormismatch.htm' => { 'errors' => '1', @@ -165,14 +141,7 @@ 'errors' => 6, 'version' => 2, 'modperl' => 1, - 'condition' => '$] >= 5.010000 && $] < 5.014000', - }, - 'errdoc/errdoc.htm' => { - 'option' => '262144', - 'errors' => 1, - 'version' => 2, - 'modperl' => 1, - 'condition' => '$] >= 5.014000', + 'condition' => '$] >= 5.010000', }, 'errdoc/epl/errdoc2.htm' => { 'option' => '262144', @@ -198,16 +167,7 @@ 'cgi' => 0, 'noloop' => 1, 'modperl' => 1, - 'condition' => '$] >= 5.010000 && $] < 5.014000', - }, - 'errdoc/epl/errdoc2.htm' => { - 'option' => '262144', - 'errors' => 1, - 'version' => 2, - 'cgi' => 0, - 'noloop' => 1, - 'modperl' => 1, - 'condition' => '$] >= 5.014000', + 'condition' => '$] >= 5.010000', }, 'rawinput/rawinput.htm' => { 'option' => '16', @@ -245,18 +205,11 @@ 'varerr.htm' => { 'errors' => 7, 'noloop' => 1, - 'condition' => '$] >= 5.006000 && $] < 5.014000', + 'condition' => '$] >= 5.006000', 'cmpext' => '56', 'version' => 2, }, 'varerr.htm' => { - 'errors' => 1, - 'noloop' => 1, - 'condition' => '$] >= 5.014000', - 'cmpext' => '514', - 'version' => 2, - }, - 'varerr.htm' => { 'errors' => 2, 'version' => 1, 'cgi' => 0, @@ -455,7 +408,7 @@ 'condition' => '$] >= 5.006001 && $] < 5.014000', }, 'includeerr2.htm' => { - 'errors' => 1, + 'errors' => 3, 'version' => 2, 'repeat' => 2, 'condition' => '$] >= 5.014000', @@ -463,6 +416,18 @@ }, 'includeerr3.htm' => { 'errors' => 2, + 'condition' => '$] < 5.014000', + 'cgi' => 0, + }, + 'includeerr3.htm' => { + 'errors' => 2, + 'condition' => '$] >= 5.014000', + 'cmpext' => '514', + 'cgi' => 0, + }, + 'includeerr3.htm' => { + 'errors' => 2, + 'cgi' => 1, }, 'includeerrbt.htm' => { 'errors' => 3, @@ -2339,7 +2304,7 @@ do } $txt = 'error.htm' ; - $org = "$cmppath/$txt" . ($] >= 5.014000?'514':'') ; + $org = "$cmppath/$txt" ;#. ($] >= 5.014000?'514':'') ; $org = "$cmppath$version/$txt" if (-e "$cmppath$version/$txt") ; $src = "$inpath/$txt" ; $src = "$inpath$version/$txt" if (-e "$inpath$version/$txt") ; @@ -2368,9 +2333,9 @@ do }) ; $t_exec += 0 ; # Embperl::Clock () - $t1 ; - $err = CheckError ($EP2?($] >= 5.010000?($] >= 5.014000?2:6):5):8) if ($err == 0) ; + $err = CheckError ($EP2?($] >= 5.010000?6:5):8) if ($err == 0) ; - if (@errors != ($EP2?($] >= 5.014000?9:4):12)) + if (@errors != ($EP2?4:12)) { print "\n\n\@errors does not return correct number of errors (is " . scalar(@errors) . ", should 4)\n" ; $err = 1 ; Modified: perl/embperl/trunk/test/cmp/epodiv.htm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/test/cmp/epodiv.htm?rev=1382194&r1=1382193&r2=1382194&view=diff ============================================================================== --- perl/embperl/trunk/test/cmp/epodiv.htm (original) +++ perl/embperl/trunk/test/cmp/epodiv.htm Fri Sep 7 22:31:31 2012 @@ -280,7 +280,7 @@ $a[0][0] = '1/1' ;<BR> </tr> </table> -^<P>(2\.4.*?|1\.3.*?)<P> +^<P>(2\.5.*?|1\.3.*?)<P> <P>17<P> <P>1<P> Modified: perl/embperl/trunk/test/cmp/epoincdiv.htm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/test/cmp/epoincdiv.htm?rev=1382194&r1=1382193&r2=1382194&view=diff ============================================================================== --- perl/embperl/trunk/test/cmp/epoincdiv.htm (original) +++ perl/embperl/trunk/test/cmp/epoincdiv.htm Fri Sep 7 22:31:31 2012 @@ -284,7 +284,7 @@ $a[0][0] = '1/1' ;<BR> </tr> </table> -^<P>2.4 +^<P>2.5 <P>17<P> <P>1<P> Modified: perl/embperl/trunk/test/cmp/includeerr2.htm514 URL: http://svn.apache.org/viewvc/perl/embperl/trunk/test/cmp/includeerr2.htm514?rev=1382194&r1=1382193&r2=1382194&view=diff ============================================================================== --- perl/embperl/trunk/test/cmp/includeerr2.htm514 (original) +++ perl/embperl/trunk/test/cmp/includeerr2.htm514 Fri Sep 7 22:31:31 2012 @@ -28,31 +28,46 @@ The server encountered an internal error ^\[\d+\]ERR: 24: Error in Perl code: Can't locate object method "is" via package "here" \(perhaps you forgot to load "here"\?\) at /usr/msrc/embperl/test/html/incerr.htm line 6. <!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --> </td></tr> -^^<tr bgcolor='#eeeeee'><td> -^^<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --> -^^\[\d+\]ERR: 32: Warning in Perl code: \(in cleanup\) syntax error at /usr/msrc/embperl/test/html/incerr.htm line 4, near "\+\]" -^^<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --> -^^</td></tr> -^^<tr bgcolor='#eeeeee'><td> -^^<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --> -^^\[\d+\]ERR: 32: Warning in Perl code: Unquoted string "table" may clash with future reserved word at /usr/msrc/embperl/test/html/incerr.htm line 6. -^^<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --> -^^</td></tr> -^^<tr bgcolor='#eeeeee'><td> -^^<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --> -^^\[\d+\]ERR: 32: Warning in Perl code: Unquoted string "td" may clash with future reserved word at /usr/msrc/embperl/test/html/incerr.htm line 8. -^^<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --> -^^</td></tr> -^^<tr bgcolor='#eeeeee'><td> -^^<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --> -^^\[\d+\]ERR: 32: Warning in Perl code: Having no space between pattern and following word is deprecated at /usr/msrc/embperl/test/html/incerr.htm line 11. -^^<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --> -^^</td></tr> -^^<tr bgcolor='#eeeeee'><td> -^^<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --> -^^\[\d+\]ERR: 32: Warning in Perl code: \(in cleanup\) Transliteration replacement not terminated at /usr/msrc/embperl/test/html/incerr.htm line 12. -^^<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --> -^^</td></tr> +<tr bgcolor='#eeeeee'><td> +<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --> +^\[\d+\]ERR: 32: Warning in Perl code: Unquoted string "table" may clash with future reserved word at /usr/msrc/embperl/test/html/incerr.htm line 6. +<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --> +</td></tr> +<tr bgcolor='#eeeeee'><td> +<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --> +^\[\d+\]ERR: 32: Warning in Perl code: Unquoted string "td" may clash with future reserved word at /usr/msrc/embperl/test/html/incerr.htm line 8. +<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --> +</td></tr> +<tr bgcolor='#eeeeee'><td> +<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --> +^\[\d+\]ERR: 32: Warning in Perl code: Having no space between pattern and following word is deprecated at /usr/msrc/embperl/test/html/incerr.htm line 11. +<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --> +</td></tr> +^<tr bgcolor='#eeeeee'><td> +<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --> +^\[\d+\]ERR: 24: Error in Perl code: Transliteration replacement not terminated at /usr/msrc/embperl/test/html/incerr.htm line 12. +<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --> +</td></tr> +<tr bgcolor='#eeeeee'><td> +<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --> +^\[\d+\]ERR: 32: Warning in Perl code: Unquoted string "table" may clash with future reserved word at /usr/msrc/embperl/test/html/incerr.htm line 6. +<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --> +</td></tr> +<tr bgcolor='#eeeeee'><td> +<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --> +^\[\d+\]ERR: 32: Warning in Perl code: Unquoted string "td" may clash with future reserved word at /usr/msrc/embperl/test/html/incerr.htm line 8. +<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --> +</td></tr> +<tr bgcolor='#eeeeee'><td> +<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --> +^\[\d+\]ERR: 32: Warning in Perl code: Having no space between pattern and following word is deprecated at /usr/msrc/embperl/test/html/incerr.htm line 11. +<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --> +</td></tr> +^<tr bgcolor='#eeeeee'><td> +<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --> +^\[\d+\]ERR: 24: Error in Perl code: Transliteration replacement not terminated at /usr/msrc/embperl/test/html/incerr.htm line 12. +<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --> +</td></tr> </table> <br> ^Embperl Added: perl/embperl/trunk/test/cmp/includeerr3.htm514 URL: http://svn.apache.org/viewvc/perl/embperl/trunk/test/cmp/includeerr3.htm514?rev=1382194&view=auto ============================================================================== --- perl/embperl/trunk/test/cmp/includeerr3.htm514 (added) +++ perl/embperl/trunk/test/cmp/includeerr3.htm514 Fri Sep 7 22:31:31 2012 @@ -0,0 +1,27 @@ + +<html> +<head> +<title>Embperl Tests - Errors in Include other Embperl pages via Execute 3</title> +</head> + +<h1>Embperl Tests - Errors in Include other Embperl pages via Execute 3</h1> + + + +^\*\*\*errors: \[\d+\]ERR: 32: Warning in Perl code: Subroutine _ep_main\d+ redefined at .+ line 1. \[\d+\]ERR: 24: Error in Perl code: Can't locate object method "is" via package "here".+at .+incerr.htm line 6.<br> + + +***rc:0 +^\*\*\*errors: #(2|3)<br> +^\*\*\*errors: \[\d+\]ERR: 32: Warning in Perl code: Subroutine _ep_main\d+ redefined at .+ line 1. + +^\[\d+\]ERR: 24: Error in Perl code: Can't locate object method "is" via package "here".+at .+incerr.htm line 6. + +^testerrobj=HASH\(0x +^\*\*\*errobj: testerrobj=HASH\(0x +***errobj msg: Error Message from Object<br> +***errors msg: Error Message from Object<br> + + +</body> +</html> --------------------------------------------------------------------- To unsubscribe, e-mail: embperl-cvs-unsubscr...@perl.apache.org For additional commands, e-mail: embperl-cvs-h...@perl.apache.org