richter 00/09/13 01:38:41
Modified: . Tag: Embperl2c Embperl.pm Embperl.xs MANIFEST
Makefile.PL ep.h epcmd2.c epcomp.c epdat.h epdom.h
epmain.c epparse.c test.pl
test/cmp Tag: Embperl2c errdoc2.htm
test/html/errdoc Tag: Embperl2c errdoc.htm
test/html/errdoc/epl Tag: Embperl2c errdoc2.htm
Added: test/cmp2 Tag: Embperl2c error.htm errormismatch.htm
errormismatchcmd.htm rawinput.htm unclosed.htm
varerr.htm
test/html2 Tag: Embperl2c error.htm errormismatch.htm
errormismatchcmd.htm
Log:
Source integration Embperl 1 & 2
Revision Changes Path
No revision
No revision
1.118.4.1 +17 -6 embperl/Embperl.pm
Index: Embperl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl.pm,v
retrieving revision 1.118
retrieving revision 1.118.4.1
diff -u -r1.118 -r1.118.4.1
--- Embperl.pm 2000/09/12 12:49:46 1.118
+++ Embperl.pm 2000/09/13 08:37:53 1.118.4.1
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: Embperl.pm,v 1.118 2000/09/12 12:49:46 richter Exp $
+# $Id: Embperl.pm,v 1.118.4.1 2000/09/13 08:37:53 richter Exp $
#
###################################################################################
@@ -24,7 +24,11 @@
require Exporter;
require DynaLoader;
-##ep2## use HTML::Embperl::Syntax ;
+##ep2##
+#use XML::Embperl::DOM ;
+#use HTML::Embperl::Cmd ;
+use HTML::Embperl::Syntax ;
+##/ep2##
use strict ;
use vars qw(
@@ -83,8 +87,10 @@
@ISA = qw(Exporter DynaLoader);
-$VERSION = '1.3b6_dev';
-##ep2## $VERSION = '2.0a7';
+##ep2##
+$VERSION = '2.0a7' ;
+##/ep2##
+##ep1##$VERSION = '1.3b6_dev';
# HTML::Embperl cannot be bootstrapped in nonlazy mode except
# under mod_perl, because its dependencies import symbols like ap_palloc
@@ -680,7 +686,9 @@
$$req{'cookie_path'} = $ENV{EMBPERL_COOKIE_PATH} if (exists
($ENV{EMBPERL_COOKIE_PATH})) ;
$$req{'cookie_expires'} = $ENV{EMBPERL_COOKIE_EXPIRES} if (exists
($ENV{EMBPERL_COOKIE_EXPIRES})) ;
- ##ep2## $$req{'ep1compat'} = $ENV{EMBPERL_EP1COMPAT} || 0 ;
+ ##ep2##
+ $$req{'ep1compat'} = $ENV{EMBPERL_EP1COMPAT} || 0 ;
+ ##/ep2##
}
@@ -1772,7 +1780,10 @@
*{"$package\:\:escmode"} = \$HTML::Embperl::escmode ;
*{"$package\:\:http_headers_out"} = \%HTML::Embperl::http_headers_out ;
*{"$package\:\:req_rec"} = \$HTML::Embperl::req_rec if defined
($HTML::Embperl::req_rec) ;
- ##ep2## *{"$package\:\:_ep_node"} = \$HTML::Embperl::_ep_node ;
+ ##ep2##
+ *{"$package\:\:_ep_node"} = \$HTML::Embperl::_ep_node ;
+ ##/ep2##
+
if (defined (&Apache::exit))
{
*{"$package\:\:exit"} = \&Apache::exit
1.29.4.1 +15 -0 embperl/Embperl.xs
Index: Embperl.xs
===================================================================
RCS file: /home/cvs/embperl/Embperl.xs,v
retrieving revision 1.29
retrieving revision 1.29.4.1
diff -u -r1.29 -r1.29.4.1
--- Embperl.xs 2000/09/11 09:53:27 1.29
+++ Embperl.xs 2000/09/13 08:37:54 1.29.4.1
@@ -647,3 +647,18 @@
tReq * r
CODE:
FreeRequest(r) ;
+
+
+#ifdef EP2
+
+INCLUDE: Cmd.xs
+
+INCLUDE: DOM.xs
+
+#endif
+
+# Reste Module, so we get the correct boot function
+
+MODULE = HTML::Embperl PACKAGE = HTML::Embperl PREFIX = embperl_
+
+
1.50.4.1 +11 -0 embperl/MANIFEST
Index: MANIFEST
===================================================================
RCS file: /home/cvs/embperl/MANIFEST,v
retrieving revision 1.50
retrieving revision 1.50.4.1
diff -u -r1.50 -r1.50.4.1
--- MANIFEST 2000/09/11 09:53:28 1.50
+++ MANIFEST 2000/09/13 08:37:57 1.50.4.1
@@ -1,3 +1,14 @@
+epcomp.c
+epdom.c
+epdom.h
+epparse.c
+epcmd2.c
+ep2.h
+Embperl/Syntax.pm
+Embperl/Cmd.pm
+Embperl/Cmd.xs
+XML/Embperl/DOM.pm
+XML/Embperl/DOM.xs
Changes.pod
Embperl.pm
Embperl.xs
1.31.4.1 +5 -1 embperl/Makefile.PL
Index: Makefile.PL
===================================================================
RCS file: /home/cvs/embperl/Makefile.PL,v
retrieving revision 1.31
retrieving revision 1.31.4.1
diff -u -r1.31 -r1.31.4.1
--- Makefile.PL 2000/09/11 09:53:28 1.31
+++ Makefile.PL 2000/09/13 08:37:58 1.31.4.1
@@ -885,13 +885,17 @@
}
+$d .= ' -DEP2' if ($EP2) ;
+
$dynlib->{'OTHERLDFLAGS'} .= " $lddebug" ;
WriteMakefile(
'NAME' => 'HTML::Embperl',
'VERSION_FROM' => 'Embperl.pm', # finds $VERSION
- 'OBJECT' => 'Embperl$(OBJ_EXT) epmain$(OBJ_EXT) epio$(OBJ_EXT)
epchar$(OBJ_EXT) epcmd$(OBJ_EXT) eputil$(OBJ_EXT) epeval$(OBJ_EXT) epdbg$(OBJ_EXT) ' .
($EP2?'epcmd2$(OBJ_EXT) epparse$(OBJ_EXT) epdom$(OBJ_EXT) epcomp$(OBJ_EXT)':'') . $o,
+ 'OBJECT' => 'Embperl$(OBJ_EXT) epmain$(OBJ_EXT) epio$(OBJ_EXT)
epchar$(OBJ_EXT) epcmd$(OBJ_EXT) eputil$(OBJ_EXT) epeval$(OBJ_EXT) epdbg$(OBJ_EXT) ' .
+ ($EP2?'epcmd2$(OBJ_EXT) epparse$(OBJ_EXT) epdom$(OBJ_EXT)
epcomp$(OBJ_EXT)':'') . $o,
+# 'XS' => { 'Embperl.xs' => 'Embperl.c', ($EP2?('Cmd.xs' => 'Cmd.c',
'DOM.xs' => 'DOM.c'):())},
'LIBS' => [''],
'DEFINE' => "$d \$(DEFS)",
'INC' => $i,
1.27.4.1 +10 -0 embperl/ep.h
Index: ep.h
===================================================================
RCS file: /home/cvs/embperl/ep.h,v
retrieving revision 1.27
retrieving revision 1.27.4.1
diff -u -r1.27 -r1.27.4.1
--- ep.h 2000/09/12 12:50:31 1.27
+++ ep.h 2000/09/13 08:37:58 1.27.4.1
@@ -144,6 +144,10 @@
#endif
#endif
+struct tReq ;
+
+typedef struct tReq req ;
+typedef struct tReq tReq ;
#include "epnames.h"
@@ -526,3 +530,9 @@
int SetupDebugger (/*i/o*/ register req * r) ;
+
+
+#ifdef EP2
+#include "ep2.h"
+#endif
+
1.4.2.1 +2 -1 embperl/Attic/epcmd2.c
Index: epcmd2.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epcmd2.c,v
retrieving revision 1.4
retrieving revision 1.4.2.1
diff -u -r1.4 -r1.4.2.1
--- epcmd2.c 2000/09/12 18:17:27 1.4
+++ epcmd2.c 2000/09/13 08:37:59 1.4.2.1
@@ -336,6 +336,7 @@
SV * pSVValue ;
tNode xNode ;
int i = 0 ;
+ I32 l32 ;
xOldChild = Node_replaceChildWithCDATA (DomTree_self(xDomTree), -1,
xOldChild, "", 0, 4, nflgModified | nflgReturn) ;
@@ -344,7 +345,7 @@
{
if (i++ > 0)
Node_appendChild (pDomTree, ntypCDATA, 0, "&", 1, xOldChild, 0, 0) ;
- pKey = hv_iterkey (pEntry, &l) ;
+ pKey = hv_iterkey (pEntry, &l32) ;
xNode = Node_appendChild (pDomTree, ntypText, 0, pKey, l, xOldChild, 0,
0) ;
if (pCurrReq -> nCurrEscMode & 2)
Node_self (pDomTree, xNode) -> bFlags |= nflgEscUrl ;
1.4.2.1 +24 -9 embperl/Attic/epcomp.c
Index: epcomp.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epcomp.c,v
retrieving revision 1.4
retrieving revision 1.4.2.1
diff -u -r1.4 -r1.4.2.1
--- epcomp.c 2000/09/12 18:17:28 1.4
+++ epcomp.c 2000/09/13 08:38:00 1.4.2.1
@@ -78,7 +78,8 @@
int embperl_CompileInitItem (/*i/o*/ register req * r,
/*in*/ HV * pHash,
/*in*/ int nNodeName,
- /*in*/ int nNodeType)
+ /*in*/ int nNodeType,
+ /*in*/ int nTagSet)
{
SV * * ppSV ;
@@ -94,14 +95,24 @@
if (pCmd -> bValid)
{
tEmbperlCmd * pNewCmd ;
+ if (pCmd -> bValid == nTagSet)
+ return ok ;
+
while (pCmd -> pNext)
+ {
+ if (pCmd -> bValid == nTagSet)
+ return ok ;
pCmd = pCmd -> pNext ;
-
+ }
+
+ if (pCmd -> bValid == nTagSet)
+ return ok ;
+
pNewCmd = malloc (sizeof (*pNewCmd)) ;
pCmd -> pNext = pNewCmd ;
pCmd = pNewCmd ;
}
- pCmd -> bValid = 1 ;
+ pCmd -> bValid = nTagSet ;
ppSV = hv_fetch(pHash, "perlcode", 8, 0) ;
if (ppSV != NULL && *ppSV != NULL &&
@@ -954,7 +965,8 @@
/*in*/ tDomTree * pDomTree,
/*in*/ tNodeData * pNode,
/*in*/ tEmbperlCmd * pCmd,
- /*in*/ int nStartCodeOffset)
+ /*in*/ int nStartCodeOffset,
+ /*i/o*/ int * bCheckpointPending)
{
@@ -1049,6 +1061,7 @@
tNode xChildNode ;
tStringIndex nNdx ;
tEmbperlCmd * pCmd ;
+ tEmbperlCmd * pCmdHead ;
tNodeData * pNode = Node_self (pDomTree, xNode) ;
tAttrData * pAttr ;
int nAttr = 0 ;
@@ -1087,7 +1100,7 @@
// pCmd = NULL ;
}
else
- pCmd = NULL ;
+ pCmd = pCmdHead = NULL ;
if (pCmd && pCmd -> nSwitchCodeType == 2)
pProg = &pProgDef ;
@@ -1114,14 +1127,15 @@
while (pCmd)
{
- if ((rc = embperl_compileCmd (r, pDomTree, pNode, pCmd, nStartCodeOffset,
bCheckPointPending) != ok)
+ if ((rc = embperl_CompileCmd (r, pDomTree, pNode, pCmd, &nStartCodeOffset)) !=
ok)
return rc ;
pCmd = pCmd -> pNext ;
}
pCmd = pCmdHead ;
- if ((rc = embperl_compilePostProcess (r, pDomTree, pNode, pCmd,
nCheckPointCodeOffset, bCheckPointPending) != ok)
- return rc ;
+ if (pCmd)
+ if ((rc = embperl_CompilePostProcess (r, pDomTree, pNode, pCmd,
nCheckpointCodeOffset, bCheckpointPending)) != ok)
+ return rc ;
if (pCmd == NULL || pCmd -> bCompileChilds)
@@ -1140,7 +1154,7 @@
while (pCmd)
{
- if ((rc = embperl_compileCmdEnd (r, pDomTree, pNode, pCmd, nStartCodeOffset,
bCheckPointPending) != ok)
+ if ((rc = embperl_CompileCmdEnd (r, pDomTree, pNode, pCmd, nStartCodeOffset,
bCheckpointPending)) != ok)
return rc ;
pCmd = pCmd -> pNext ;
}
@@ -1204,6 +1218,7 @@
clock_t cl3 ;
clock_t cl4 ;
STRLEN l ;
+ tProcessor * pProcessor = NULL ;
tainted = 0 ;
1.20.4.1 +15 -5 embperl/epdat.h
Index: epdat.h
===================================================================
RCS file: /home/cvs/embperl/epdat.h,v
retrieving revision 1.20
retrieving revision 1.20.4.1
diff -u -r1.20 -r1.20.4.1
--- epdat.h 2000/09/12 12:50:31 1.20
+++ epdat.h 2000/09/13 08:38:00 1.20.4.1
@@ -30,11 +30,7 @@
#endif
-struct tReq ;
-typedef struct tReq req ;
-typedef struct tReq tReq ;
-
/*-----------------------------------------------------------------*/
/* */
/* Per (directory) configuration data */
@@ -288,7 +284,18 @@
int nSessionMgnt ; /* how to retrieve the session id */
int nInsideSub ; /* Are we inside of a sub? */
int bExit ; /* We should exit the page */
-
+#ifdef EP2
+ bool bEP1Compat ; /* run in Embperl 1.x compatible mode */
+
+ /* --- DomTree ---*/
+
+ tNode xDocument ;
+ tNode xCurrNode ;
+ tIndex xCurrDomTree ;
+ struct tTokenTable * pTokenTable ;
+
+#endif
+
/* --- Source in memory --- */
tSrcBuf Buf ; /* Buffer */
@@ -393,6 +400,9 @@
HV * pUserHash ; /* User data */
HV * pModHash ; /* Module data */
HV * pHeaderHash ;/* http headers */
+#ifdef EP2
+ AV * pDomTreeAV ; /* holds all DomTrees alocated during the request */
+#endif
/* --- for statistics --- */
1.4.2.1 +6 -0 embperl/Attic/epdom.h
Index: epdom.h
===================================================================
RCS file: /home/cvs/embperl/Attic/epdom.h,v
retrieving revision 1.4
retrieving revision 1.4.2.1
diff -u -r1.4 -r1.4.2.1
--- epdom.h 2000/09/12 18:17:29 1.4
+++ epdom.h 2000/09/13 08:38:01 1.4.2.1
@@ -233,6 +233,7 @@
int DomTree_delete (tDomTree * pDomTree) ;
void DomTree_checkpoint (tIndex xDomTree, tNode xChild) ;
+void DomTree_selfCheckpoint (tDomTree * pDomTree, tNode xFromNode, tNode xToNode) ;
int DomTree_selfDiscardAfterCheckpoint (/*in*/ tDomTree * pDomTree,
/*in*/ tNodeData * pNode,
@@ -295,6 +296,11 @@
tNodeData * Node_selfCloneNode (/*in*/ tDomTree * pDomTree,
/*in*/ tNodeData * pNode,
/*in*/ int bDeep) ;
+
+tNode Node_cloneNode (/*in*/ tDomTree * pDomTree,
+ /*in*/ tNode xNode,
+ /*in*/ int bDeep) ;
+
void Node_toString (/*in*/ tDomTree * pDomTree,
/*i/o*/ register req * r,
1.75.4.1 +2 -2 embperl/epmain.c
Index: epmain.c
===================================================================
RCS file: /home/cvs/embperl/epmain.c,v
retrieving revision 1.75
retrieving revision 1.75.4.1
diff -u -r1.75 -r1.75.4.1
--- epmain.c 2000/09/12 12:49:49 1.75
+++ epmain.c 2000/09/13 08:38:01 1.75.4.1
@@ -121,7 +121,7 @@
case rcUnknownVarType: msg ="[%d]ERR: %d: Line %d: Type for
Variable %s is unknown %s" ; break ;
case rcPerlWarn: msg ="[%d]ERR: %d: Line %d: Warning in
Perl code: %s%s" ; break ;
case rcVirtLogNotSet: msg ="[%d]ERR: %d: Line %d:
EMBPERL_VIRTLOG must be set, when dbgLogLink is set %s%s" ; break ;
- case rcMissingInput: msg ="[%d]ERR: %d: Line %d: Sourcedaten
fehlen %s%s" ; break ;
+ case rcMissingInput: msg ="[%d]ERR: %d: Line %d: Sourcedata
missing %s%s" ; break ;
case rcUntilWithoutDo: msg ="[%d]ERR: %d: Line %d: until without
do%s%s" ; break ;
case rcEndforeachWithoutForeach:msg ="[%d]ERR: %d: Line %d: endforeach
without foreach%s%s" ; break ;
case rcMissingArgs: msg ="[%d]ERR: %d: Line %d: Too few
arguments%s%s" ; break ;
@@ -3148,7 +3148,7 @@
if (rc == ok)
rc = ReadInputFile (r) ;
- if (rc == ok && r -> Buf.pBuf == NULL)
+ if (rc == ok && r -> Buf.pBuf == NULL && r -> Buf.pFile -> nFilesize == 0)
rc = rcMissingInput ;
/* --- ok so far? if not exit ---- */
1.4.2.1 +1 -1 embperl/Attic/epparse.c
Index: epparse.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epparse.c,v
retrieving revision 1.4
retrieving revision 1.4.2.1
diff -u -r1.4 -r1.4.2.1
--- epparse.c 2000/09/12 18:17:29 1.4
+++ epparse.c 2000/09/13 08:38:02 1.4.2.1
@@ -136,7 +136,7 @@
}
if (strcmp (pKey, "embperl") == 0)
- embperl_CompileInitItem (r, (HV *)(SvRV (pSVValue)), pToken ->
nNodeName, pToken -> nNodeType) ;
+ embperl_CompileInitItem (r, (HV *)(SvRV (pSVValue)), pToken ->
nNodeName, pToken -> nNodeType, 1) ;
}
}
1.70.4.1 +411 -42 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.70
retrieving revision 1.70.4.1
diff -u -r1.70 -r1.70.4.1
--- test.pl 2000/09/11 09:53:30 1.70
+++ test.pl 2000/09/13 08:38:03 1.70.4.1
@@ -1,7 +1,358 @@
#!/usr/bin/perl --
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
+
+
+@testdata = (
+ 'ascii' => { },
+ 'pure.htm' => { },
+ 'plain.htm' => {
+ repeat => 3,
+ },
+ 'plainblock.htm' => {
+ repeat => 2,
+ },
+ 'error.htm' => {
+ 'repeat' => 3,
+ 'errors' => 8,
+ 'version' => 1,
+ },
+ 'error.htm' => {
+ 'repeat' => 3,
+ 'errors' => 7,
+ 'version' => 2,
+ },
+ 'errormismatch.htm' => {
+ 'errors' => '1',
+ 'version' => 2,
+ },
+ 'errormismatchcmd.htm' => {
+ 'errors' => '1',
+ 'version' => 2,
+ },
+ 'unclosed.htm' => {
+ 'errors' => '1',
+ },
+ 'notfound.htm' => {
+ 'errors' => '1',
+ },
+ 'notallow.xhtm' => {
+ 'errors' => '1',
+ },
+ 'noerr/noerrpage.htm' => {
+ 'option' => 2,
+ 'errors' => 7,
+ 'version' => 1,
+ },
+ 'errdoc/errdoc.htm' => {
+ 'option' => '262144',
+ 'errors' => 7,
+ },
+ 'errdoc/epl/errdoc2.htm' => {
+ 'option' => '262144',
+ 'errors' => 7,
+ },
+ 'rawinput/rawinput.htm' => {
+ 'option' => '16',
+ },
+ 'var.htm' => { },
+ 'varerr.htm' => {
+ 'errors' => '-1',
+ },
+ 'varerr.htm' => {
+ 'errors' => '2',
+ 'version' => 1,
+ },
+ 'escape.htm' => { },
+ 'escape.htm' => { },
+ 'spaces.htm' => {
+ 'version' => 1,
+ },
+ 'tagscan.htm' => { },
+ 'tagscan.htm' => {
+ 'debug' => '1',
+ },
+ 'if.htm' => { },
+ 'ifperl.htm' => { },
+ 'loop.htm' => {
+ 'query_info' =>
'erstes=Hallo&zweites=Leer+zeichen&drittes=%21%22%23%2a%2B&erstes=Wert2',
+ },
+ 'loopperl.htm' => {
+ 'query_info' =>
'erstes=Hallo&zweites=Leer+zeichen&drittes=%21%22%23&erstes=Wert2',
+ },
+ 'table.htm' => { },
+ 'table.htm' => {
+ 'debug' => '1',
+ },
+ 'lists.htm' => {
+ 'query_info' => 'sel=2&SEL1=B&SEL3=D&SEL4=cc',
+ },
+ 'mix.htm' => { },
+ 'nesting.htm' => {
+ 'version' => 1,
+ },
+ 'object.htm' => {
+ 'errors' => '2',
+ },
+ 'discard.htm' => {
+ 'errors' => '12',
+ 'version' => 1,
+ },
+ 'input.htm' => {
+ 'query_info' =>
'feld5=Wert5&feld6=Wert6&feld7=Wert7&feld8=Wert8&cb5=cbv5&cb6=cbv6&cb7=cbv7&cb8=cbv8&cb9=ncbv9&cb10=ncbv10&cb11=ncbv11&mult=Wert3&mult=Wert6&esc=a<b&escmult=a>b&escmult=Wert3',
+ },
+ 'hidden.htm' => {
+ 'query_info' => 'feld1=Wert1&feld2=Wert2&feld3=Wert3&feld4=Wert4',
+ },
+ 'java.htm' => { },
+ 'inputjava.htm' => { },
+ 'post.htm' => {
+ 'offline' => 0,
+ },
+ 'upload.htm' => {
+ 'query_info' => 'multval=A&multval=B&multval=C&single=S',
+ 'offline' => 0,
+ },
+ 'reqrec.htm' => {
+ 'offline' => 0,
+ },
+ 'reqrec.htm' => {
+ 'offline' => 0,
+ },
+ 'include.htm' => {
+ 'version' => 1,
+ },
+ 'rawinput/include.htm' => {
+ 'option' => '16',
+ 'version' => 2,
+ },
+ 'includeerr1.htm' => {
+ 'errors' => '1',
+ },
+ 'includeerr2.htm' => {
+ 'errors' => '4',
+ },
+ 'registry/Execute.htm' => {
+ 'modperl' => 1,
+ },
+ 'registry/errpage.htm' => {
+ 'modperl' => 1,
+ 'errors' => '16',
+ 'version' => 1,
+ },
+ 'registry/tied.htm' => {
+ 'modperl' => 1,
+ 'errors' => '3',
+ },
+ 'registry/tied.htm' => {
+ 'modperl' => 1,
+ 'errors' => '3',
+ },
+ 'callsub.htm' => {
+ 'version' => 1,
+ },
+ 'callsub.htm' => {
+ 'version' => 1,
+ },
+ 'importsub.htm' => {
+ 'version' => 1,
+ },
+ 'importsub.htm' => {
+ 'version' => 1,
+ },
+ 'importsub2.htm' => {
+ 'version' => 1,
+ },
+ 'importmodule.htm' => {
+ 'version' => 1,
+ },
+ 'recursexec.htm' => {
+ 'version' => 1,
+ },
+ 'nph/div.htm' => {
+ 'option' => '64',
+ },
+ 'nph/npherr.htm' => {
+ 'option' => '64',
+ 'errors' => '8',
+ 'version' => 1,
+ },
+ 'nph/nphinc.htm' => {
+ 'option' => '64',
+ },
+ 'sub.htm' => { },
+ 'sub.htm' => { },
+ 'exit.htm' => {
+ 'version' => 1,
+ 'offline' => 0,
+ },
+ 'exit2.htm' => {
+ 'version' => 1,
+ 'offline' => 0,
+ },
+ 'exit3.htm' => {
+ 'version' => 1,
+ 'offline' => 0,
+ },
+ 'chdir.htm' => {
+ 'query_info' => 'a=1&b=2&c=&d=&f=5&g&h=7&=8&=',
+ },
+ 'chdir.htm' => {
+ 'query_info' => 'a=1&b=2&c=&d=&f=5&g&h=7&=8&=',
+ },
+ 'allform/allform.htm' => {
+ 'query_info' => 'a=1&b=2&c=&d=&f=5&g&h=7&=8&=',
+ 'option' => '8192',
+ },
+ 'stdout/stdout.htm' => {
+ 'option' => '16384',
+ 'version' => 1,
+ },
+ 'nochdir/nochdir.htm' => {
+ 'query_info' => 'a=1&b=2',
+ 'option' => '384',
+ },
+ 'match/div.htm' => {
+ 'offline' => 0,
+ },
+ 'match/div.asc' => {
+ 'offline' => 0,
+ },
+ 'http.htm' => {
+ 'offline' => 0,
+ 'version' => 1,
+ },
+ 'div.htm' => { },
+ 'taint.htm' => {
+ 'offline' => 0,
+ 'errors' => '1',
+ },
+ 'ofunc/div.htm' => { },
+ 'safe/safe.htm' => {
+ 'option' => '4',
+ 'errors' => '-1',
+ 'version' => 1,
+ },
+ 'safe/safe.htm' => {
+ 'option' => '4',
+ 'errors' => '-1',
+ 'version' => 1,
+ },
+ 'safe/safe.htm' => {
+ 'option' => '4',
+ 'errors' => '-1',
+ 'version' => 1,
+ },
+ 'opmask/opmask.htm' => {
+ 'option' => '12',
+ 'errors' => '-1',
+ 'compartment'=> 'TEST',
+ 'version' => 1,
+ },
+ 'opmask/opmasktrap.htm' => {
+ 'option' => '12',
+ 'errors' => '2',
+ 'compartment'=> 'TEST',
+ 'version' => 1,
+ },
+ 'mdatsess.htm' => {
+ 'offline' => 0,
+ 'query_info' => 'cnt=0',
+ },
+ 'setsess.htm' => {
+ 'offline' => 0,
+ 'query_info' => 'a=1',
+ },
+ 'mdatsess.htm' => {
+ 'offline' => 0,
+ 'query_info' => 'cnt=1',
+ },
+ 'getnosess.htm' => {
+ 'offline' => 0,
+ 'query_info' => 'nocookie=2',
+ },
+ 'mdatsess.htm' => {
+ 'offline' => 0,
+ 'query_info' => 'cnt=2',
+ },
+ 'getsess.htm' => {
+ 'offline' => 0,
+ },
+ 'mdatsess.htm' => {
+ 'offline' => 0,
+ 'query_info' => 'cnt=3',
+ },
+ 'execgetsess.htm' => {
+ 'offline' => 0,
+ },
+ 'registry/reggetsess.htm' => {
+ 'modperl' => 1,
+ },
+ 'getsess.htm' => {
+ 'offline' => 0,
+ },
+ 'delsess.htm' => {
+ 'offline' => 0,
+ },
+ 'getdelsess.htm' => {
+ 'offline' => 0,
+ },
+ 'clearsess.htm' => {
+ 'offline' => 0,
+ },
+ 'EmbperlObject/epopage1.htm' => {
+ 'offline' => 0,
+ },
+ 'EmbperlObject/epodiv.htm' => {
+ 'offline' => 0,
+ 'version' => 1,
+ },
+ 'EmbperlObject/sub/epopage2.htm' => {
+ 'offline' => 0,
+ 'version' => 1,
+ },
+ 'EmbperlObject/sub/epopage2.htm' => {
+ 'offline' => 0,
+ 'version' => 1,
+ },
+ 'EmbperlObject/sub/eponotfound.htm' => {
+ 'offline' => 0,
+ 'version' => 1,
+ },
+ 'EmbperlObject/obj/epoobj1.htm' => {
+ 'offline' => 0,
+ 'version' => 1,
+ },
+ 'EmbperlObject/obj/epoobj2.htm' => {
+ 'offline' => 0,
+ 'version' => 1,
+ },
+ 'EmbperlObject/obj/epoobj3.htm' => {
+ 'offline' => 0,
+ 'version' => 1,
+ },
+ 'EmbperlObject/obj/epoobj4.htm' => {
+ 'offline' => 0,
+ 'version' => 1,
+ },
+ 'EmbperlObject/base2/epostopdir.htm' => {
+ 'offline' => 0,
+ 'version' => 1,
+ },
+ 'EmbperlObject/base3/epobaselib.htm' => {
+ 'offline' => 0,
+ 'version' => 1,
+ },
+) ;
+
+for ($i = 0 ; $i < @testdata; $i += 2)
+ {
+ for ($j = 0; $j < ($testdata[$i+1]->{repeat} || 1); $j++)
+ { push @tests, $i ; }
+ }
+
+=pod
@tests = (
'ascii',
'pure.htm',
@@ -217,8 +568,8 @@
'EmbperlObject/epopage1.htm',
## 'EmbperlObject/sub/epopage2.htm',
) ;
+=cut
-
# avoid some warnings:
use vars qw ($httpconfsrc $httpconf $EPPORT $EPPORT2 *SAVEERR *ERR $EPHTTPDDLL
$EPSTARTUP $EPDEBUG
@@ -383,7 +734,7 @@
$i = 0 ;
foreach $t (@tests)
{
- print "$i = $t\n" ;
+ print "$i = $testdata[$t]\n" ;
$i++ ;
}
$fatal = 0 ;
@@ -735,7 +1086,7 @@
$opt_ep1 = 0 if (!$EP2) ;
$EP1COMPAT = 1 if ($opt_ep1) ;
-@tests = @tests2 if ($EP2) ;
+#@tests = @tests2 if ($EP2) ;
$startnumber = 0 ;
if ($#ARGV >= 0)
@@ -794,7 +1145,8 @@
$loopcnt = 0 ;
$notseen = 1 ;
%seen = () ;
-$max_sv = 0 ;
+$max_sv = 0 ;
+$version = $EP2?2:1 ;
$cp = HTML::Embperl::AddCompartment ('TEST') ;
@@ -832,40 +1184,38 @@
$ENV{EMBPERL_EP1COMPAT} = $ep1compat ;
print "\nTesting Embperl 1.x compatibility mode...\n\n" if ($ep1compat) ;
- foreach $url (@tests)
+ foreach $testno (@tests)
{
+ $file = $testdata[$testno] ;
+ $test = $testdata[$testno+1] ;
+ $org = '' ;
+
$testnum++ ;
- ($file, $query_info, $debug, $errcnt, $option, $ns) = split (/\?/,
$url) ;
- next if ($file eq 'http.htm') ;
- next if ($file eq 'taint.htm') ;
- next if ($file eq 'reqrec.htm') ;
- next if ($file eq 'http.htm') ;
- next if ($file eq 'post.htm') ;
- next if ($file eq 'upload.htm') ;
- next if ($file =~ /^exit.htm/) ;
- next if ($file =~ /registry/) ;
- next if ($file =~ /match\//) ;
- next if ($file =~ /sess\.htm/) ;
- next if ($file =~ /EmbperlObject/) ;
+ next if ($test->{version} && $version != $test->{version}) ;
+ next if ((defined ($test -> {offline}) && $test -> {offline} == 0)
||
+ (!$test -> {offline} && ($test -> {modperl} || $test
-> {cgi} || $test -> {http}))) ;
+
next if ($DProf && ($file =~ /safe/)) ;
next if ($DProf && ($file =~ /opmask/)) ;
+
+ $errcnt = $test -> {errors} || 0 ;
$errcnt = 7 if ($file eq 'varerr.htm' && $^V && $^V ge v5.6.0) ;
- $debug ||= $defaultdebug ;
- $page = "$inpath/$file" ;
- $page .= '-1' if ($ep1compat && -e "$page-1") ;
- $errcnt ||= 0 ;
+ $debug = $test -> {debug} || $defaultdebug ;
+ $page = "$inpath/$file" ;
+ $page = "$inpath$version/$file" if (-e "$inpath$version/$file") ;
+ #$page .= '-1' if ($ep1compat && -e "$page-1") ;
$notseen = $seen{"o:$page"}?0:1 ;
$seen{"o:$page"} = 1 ;
delete $ENV{EMBPERL_OPTIONS} if (defined ($ENV{EMBPERL_OPTIONS})) ;
- $ENV{EMBPERL_OPTIONS} = $option if (defined ($option)) ;
- $ENV{EMBPERL_COMPARTMENT} = $ns if (defined ($ns)) ;
+ $ENV{EMBPERL_OPTIONS} = $test -> {option} if (defined ($test ->
{option})) ;
+ $ENV{EMBPERL_COMPARTMENT} = $test -> {compartment} if (defined ($test
-> {compartment})) ;
@testargs = ( '-o', $outfile ,
'-l', $logfile,
'-d', $debug,
- $page, $query_info || '') ;
+ $page, $test -> {query_info} || '') ;
unshift (@testargs, 'dbgbreak') if ($opt_dbgbreak) ;
$txt = "#$testnum ". $file . ($debug != $defaultdebug ?"-d $debug
":"") . '...' ;
@@ -897,9 +1247,10 @@
if ($err == 0 && $errin != 500 && $file ne 'notfound.htm' && $file ne
'notallow.xhtm')
{
$page =~ /.*\/(.*)$/ ;
- $org = "$cmppath/$1" ;
+ $org = "$cmppath/$1" ;
+ $org = "$cmppath$version/$1" if (-e "$cmppath$version/$1") ;
$org .= '56' if ($file eq 'varerr.htm' && $^V && $^V ge v5.6.0)
;
- $org .= '-1' if ($ep1compat && -e "$org-1") ;
+ #$org .= '-1' if ($ep1compat && -e "$org-1") ;
$err = CmpFiles ($outfile, $org, $errin) ;
}
@@ -1238,11 +1589,24 @@
$n_req = 0 ;
$n = 0 ;
$testnum = -1 + $startnumber;
- foreach $url (@tests)
- {
- $testnum++ ;
- ($file, $query_info, $debug, $errcnt) = split (/\?/, $url) ;
+ foreach $testno (@tests)
+ {
+ $file = $testdata[$testno] ;
+ $test = $testdata[$testno+1] ;
+ $org = '' ;
+ $testnum++ ;
+ next if ($test->{version} && $version != $test->{version}) ;
+ next if ($loc eq $embploc &&
+ ((defined ($test -> {modperl}) && $test -> {modperl} == 0) ||
+ (!$test -> {modperl} && ($test -> {offline} || $test ->
{cgi})))) ;
+
+ next if ($loc eq $cgiloc &&
+ ((defined ($test -> {cgi}) && $test -> {cgi} == 0) ||
+ (!$test -> {cgi} && ($test -> {offline} || $test ->
{modperl})))) ;
+
+
+=pod
next if ($file =~ /\// && $loc eq $cgiloc) ;
next if ($file eq 'taint.htm' && $loc eq $cgiloc) ;
next if ($file eq 'reqrec.htm' && $loc eq $cgiloc) ;
@@ -1253,13 +1617,13 @@
next if (($file =~ /registry/) && $loc eq $cgiloc) ;
next if (($file =~ /match/) && $loc eq $cgiloc) ;
#next if ($file eq 'http.htm' && $loc eq $cgiloc) ;
- next if ($file eq 'chdir.htm' && $EPWIN32) ;
- next if ($file eq 'notfound.htm' && $loc eq $cgiloc && $EPWIN32) ;
#next if ($file eq 'notallow.xhtm' && $loc eq $cgiloc && $EPWIN32) ;
- next if ($file =~ /opmask/ && $EPSTARTUP =~ /_dso/) ;
next if ($file eq 'clearsess.htm' && !$looptest) ;
next if (($file =~ /EmbperlObject/) && $loc eq $cgiloc) ;
- $errcnt = 7 if ($file eq 'varerr.htm' && $^V && $^V ge v5.6.0) ;
+=cut
+ next if ($file eq 'chdir.htm' && $EPWIN32) ;
+ next if ($file eq 'notfound.htm' && $loc eq $cgiloc && $EPWIN32) ;
+ next if ($file =~ /opmask/ && $EPSTARTUP =~ /_dso/) ;
if ($file =~ /sess\.htm/)
{
next if ($loc eq $cgiloc && $EPSESSIONCLASS ne 'Embperl') ;
@@ -1272,10 +1636,13 @@
}
}
- $debug ||= $defaultdebug ;
- $errcnt ||= 0 ;
- $errcnt = -1 if ($EPWIN32 && $loc eq $cgiloc) ;
+ $errcnt = $test -> {errors} || 0 ;
+ $errcnt = 7 if ($file eq 'varerr.htm' && $^V && $^V ge v5.6.0) ;
+ $errcnt = -1 if ($EPWIN32 && $loc eq $cgiloc) ;
+
+ $debug = $test -> {debug} || $defaultdebug ;
$page = "$inpath/$file" ;
+ $page = "$inpath$version/$file" if (-e "$inpath$version/$file") ;
if ($opt_nostart)
{
$notseen = 0 ;
@@ -1319,13 +1686,13 @@
if (defined ($opt_ab))
{
$opt_ab = 10 if (!$opt_ab) ;
- my $cmd = "ab -n $opt_ab 'http://$host:$port/$loc$file?$query_info'";
+ my $cmd = "ab -n $opt_ab
'http://$host:$port/$loc$file?$test->{query_info}'";
print "$cmd\n" ;
system ($cmd) and die "Cannot start ab ($!)" ;
}
else
{
- $m = REQ ($loc, $file, $query_info, $outfile, $content, $upload) ;
+ $m = REQ ($loc, $file, $test -> {query_info}, $outfile, $content,
$upload) ;
}
$t_req += HTML::Embperl::Clock () - $t1 ;
@@ -1353,8 +1720,9 @@
{
$page =~ /.*\/(.*)$/ ;
$org = "$cmppath/$1" ;
+ $org = "$cmppath$version/$1" if (-e "$cmppath$version/$1") ;
$org .= '56' if ($file eq 'varerr.htm' && $^V && $^V ge v5.6.0) ;
- $org .= '-1' if ($opt_ep1 && -e "$org-1") ;
+ #$org .= '-1' if ($opt_ep1 && -e "$org-1") ;
#print "Compare $page with $org\n" ;
$err = CmpFiles ($outfile, $org) ;
@@ -1403,11 +1771,12 @@
if ($err)
{
$page ||= '???' ;
- $org ||= '???' ;
print "Input:\t\t$page\n" ;
print "Output:\t\t$outfile\n" ;
- print "Compared to:\t$org\n" ;
+ print "Compared to:\t$org\n" if ($org) ;
print "Log:\t\t$logfile\n" ;
+ @p = map { " $_ = $test->{$_}\n" } keys %$test if (ref ($test) eq 'HASH') ;
+ print "Testparameter:\n @p" if (@p) ;
print "\n ERRORS detected! NOT all test have been passed successfully\n\n" ;
}
else
No revision
No revision
1.2.4.1 +0 -4 embperl/test/cmp/errdoc2.htm
Index: errdoc2.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/errdoc2.htm,v
retrieving revision 1.2
retrieving revision 1.2.4.1
diff -u -r1.2 -r1.2.4.1
--- errdoc2.htm 2000/09/11 09:53:33 1.2
+++ errdoc2.htm 2000/09/13 08:38:15 1.2.4.1
@@ -42,10 +42,6 @@
^ <tr><td>\[\d+\]ERR: 24: Line 46: Error in Perl code: syntax error at
^Missing right.*?bracket at
^syntax error at
-
-^ <tr><td>\[\d+\]ERR: 20: Line 58: </tr> without <tr></td></tr>
-
-^ <tr><td>\[\d+\]ERR: 45: Line 58: Unclosed HTML tag <table> at end of
file </td></tr>
</table>
</body>
No revision
No revision
1.1.2.1 +19 -0 embperl/test/cmp2/Attic/error.htm
1.1.2.1 +8 -0 embperl/test/cmp2/Attic/errormismatch.htm
1.1.2.1 +8 -0 embperl/test/cmp2/Attic/errormismatchcmd.htm
1.1.2.1 +82 -0 embperl/test/cmp2/Attic/rawinput.htm
1.1.2.1 +7 -0 embperl/test/cmp2/Attic/unclosed.htm
1.1.2.1 +10 -0 embperl/test/cmp2/Attic/varerr.htm
No revision
No revision
1.1.6.1 +0 -5 embperl/test/html/errdoc/errdoc.htm
Index: errdoc.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/errdoc/errdoc.htm,v
retrieving revision 1.1
retrieving revision 1.1.6.1
diff -u -r1.1 -r1.1.6.1
--- errdoc.htm 1999/03/22 05:20:48 1.1
+++ errdoc.htm 2000/09/13 08:38:30 1.1.6.1
@@ -52,11 +52,6 @@
[$endif$]
-Tag missmatch:
-
-<table>
-</tr>
-
<P>Ok.<P>
No revision
No revision
1.1.4.1 +0 -5 embperl/test/html/errdoc/epl/errdoc2.htm
Index: errdoc2.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/errdoc/epl/errdoc2.htm,v
retrieving revision 1.1
retrieving revision 1.1.4.1
diff -u -r1.1 -r1.1.4.1
--- errdoc2.htm 2000/08/24 06:03:49 1.1
+++ errdoc2.htm 2000/09/13 08:38:33 1.1.4.1
@@ -52,11 +52,6 @@
[$endif$]
-Tag missmatch:
-
-<table>
-</tr>
-
<P>Ok.<P>
No revision
No revision
1.1.2.1 +60 -0 embperl/test/html2/Attic/error.htm
1.1.2.1 +19 -0 embperl/test/html2/Attic/errormismatch.htm
1.1.2.1 +23 -0 embperl/test/html2/Attic/errormismatchcmd.htm
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
