richter 00/09/13 13:01:27
Modified: . Embperl.xs Makefile.PL ep.h epdat.h epmain.c
test.pl
test/cmp errdoc2.htm escape.htm
test/html escape.htm
test/html/errdoc errdoc.htm
test/html/errdoc/epl errdoc2.htm
Added: test/cmp escraw.htm tagscandisable.htm
test/html escraw.htm tagscandisable.htm
Log:
Embperl 1+2 Source Integration & Tests
Revision Changes Path
1.30 +15 -0 embperl/Embperl.xs
Index: Embperl.xs
===================================================================
RCS file: /home/cvs/embperl/Embperl.xs,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -r1.29 -r1.30
--- Embperl.xs 2000/09/11 09:53:27 1.29
+++ Embperl.xs 2000/09/13 20:01:06 1.30
@@ -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.32 +5 -1 embperl/Makefile.PL
Index: Makefile.PL
===================================================================
RCS file: /home/cvs/embperl/Makefile.PL,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -r1.31 -r1.32
--- Makefile.PL 2000/09/11 09:53:28 1.31
+++ Makefile.PL 2000/09/13 20:01:06 1.32
@@ -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.28 +10 -0 embperl/ep.h
Index: ep.h
===================================================================
RCS file: /home/cvs/embperl/ep.h,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -r1.27 -r1.28
--- ep.h 2000/09/12 12:50:31 1.27
+++ ep.h 2000/09/13 20:01:07 1.28
@@ -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.21 +15 -5 embperl/epdat.h
Index: epdat.h
===================================================================
RCS file: /home/cvs/embperl/epdat.h,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- epdat.h 2000/09/12 12:50:31 1.20
+++ epdat.h 2000/09/13 20:01:07 1.21
@@ -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.76 +2 -2 embperl/epmain.c
Index: epmain.c
===================================================================
RCS file: /home/cvs/embperl/epmain.c,v
retrieving revision 1.75
retrieving revision 1.76
diff -u -r1.75 -r1.76
--- epmain.c 2000/09/12 12:49:49 1.75
+++ epmain.c 2000/09/13 20:01:08 1.76
@@ -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.71 +461 -48 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.70
retrieving revision 1.71
diff -u -r1.70 -r1.71
--- test.pl 2000/09/11 09:53:30 1.70
+++ test.pl 2000/09/13 20:01:08 1.71
@@ -1,7 +1,389 @@
#!/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' => 8,
+ 'version' => 1,
+ },
+ 'errdoc/errdoc.htm' => {
+ 'option' => '262144',
+ 'errors' => 6,
+ 'version' => 1,
+ },
+ 'errdoc/errdoc.htm' => {
+ 'option' => '262144',
+ 'errors' => 7,
+ 'version' => 2,
+ },
+ 'errdoc/epl/errdoc2.htm' => {
+ 'option' => '262144',
+ 'errors' => 6,
+ 'version' => 1,
+ },
+ 'errdoc/epl/errdoc2.htm' => {
+ 'option' => '262144',
+ 'errors' => 7,
+ 'version' => 2,
+ },
+ 'rawinput/rawinput.htm' => {
+ 'option' => '16',
+ },
+ 'var.htm' => { },
+ 'varerr.htm' => {
+ 'errors' => '-1',
+ },
+ 'varerr.htm' => {
+ 'errors' => '2',
+ 'version' => 1,
+ },
+ 'escape.htm' => {
+ repeat => 2,
+ },
+ 'escraw.htm' => {
+ 'version' => 1,
+ },
+ 'spaces.htm' => {
+ 'version' => 1,
+ },
+ 'tagscan.htm' => { },
+ 'tagscan.htm' => {
+ 'debug' => '1',
+ },
+ 'tagscandisable.htm' => {
+ 'version' => 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',
+ },
+ 'tabmode.htm' => {
+ 'version' => 1,
+ },
+ 'lists.htm' => {
+ 'query_info' => 'sel=2&SEL1=B&SEL3=D&SEL4=cc',
+ },
+ 'mix.htm' => { },
+ 'nesting.htm' => {
+ 'version' => 1,
+ },
+ 'object.htm' => {
+ 'version' => 1,
+ 'errors' => '2',
+ },
+ 'object.htm' => {
+ 'version' => 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,
+ 'version' => 1,
+ },
+ 'includeerr2.htm' => {
+ 'errors' => 1,
+ 'version' => 2,
+ },
+ '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 +599,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 +765,7 @@
$i = 0 ;
foreach $t (@tests)
{
- print "$i = $t\n" ;
+ print "$i = $testdata[$t]\n" ;
$i++ ;
}
$fatal = 0 ;
@@ -421,6 +803,8 @@
{
$_[0] = $1
}
+ $_[0] =~ s/\s+/ /g ;
+ $_[0] =~ s/\s+>/>/g ;
}
#####################################################
@@ -440,11 +824,19 @@
while (defined ($l1 = <F1>))
{
chompcr ($l1) ;
+ while (($l1 =~ /^\s*$/) && defined ($l1 = <F1>))
+ { chompcr ($l1) ; }
+
+
if (!$errin)
{
$l2 = <F2> ;
chompcr ($l2) ;
+ while (($l2 =~ /^\s*$/) && defined ($l2 = <F2>))
+ { chompcr ($l2) ; }
}
+ last if (!defined ($l2) && !defined ($l1)) ;
+
if (!defined ($l2))
{
print "\nError in Line $line\nIs:\t$l1\nShould:\t<EOF>\n" ;
@@ -453,7 +845,7 @@
$eq = 0 ;
- while (((!$notseen && ($l2 =~ /^\^\^(.*?)$/)) || ($l2 =~ /^\^\-(.*?)$/)) &&
!$eq)
+ while (((!$notseen && ($l2 =~ /^\^\^(.*?)$/i)) || ($l2 =~ /^\^\-(.*?)$/i)) &&
!$eq)
{
$l2 = $1 ;
if (($l1 =~ /^\s*$/) && ($l2 =~ /^\s*$/))
@@ -470,10 +862,10 @@
if (!$eq)
{
- if ($l2 =~ /^\^(.*?)$/)
+ if ($l2 =~ /^\^(.*?)$/i)
{
$l2 = $1 ;
- $eq = $l1 =~ /$l2/ ;
+ $eq = $l1 =~ /$l2/i ;
}
else
{
@@ -735,7 +1127,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 +1186,8 @@
$loopcnt = 0 ;
$notseen = 1 ;
%seen = () ;
-$max_sv = 0 ;
+$max_sv = 0 ;
+$version = $EP2?2:1 ;
$cp = HTML::Embperl::AddCompartment ('TEST') ;
@@ -825,47 +1218,46 @@
$t_offline = 0 ;
$n_offline = 0 ;
$testnum = -1 + $startnumber ;
- foreach $ep1compat (0, 1)
+ foreach $ep1compat (($version == 2 && $opt_ep1)?(0, 1):(0))
{
- next if (($ep1compat && !($opt_ep1)) || (!$ep1compat &&
!($opt_offline)));
+ #next if (($ep1compat && !($opt_ep1)) || (!$ep1compat &&
!($opt_offline)));
$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 = '' ;
+ $testversion = $version == 2 && !$ep1compat?2:1 ;
+
$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} && $testversion != $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$testversion/$file" if (-e
"$inpath$testversion/$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 +1289,10 @@
if ($err == 0 && $errin != 500 && $file ne 'notfound.htm' && $file ne
'notallow.xhtm')
{
$page =~ /.*\/(.*)$/ ;
- $org = "$cmppath/$1" ;
+ $org = "$cmppath/$1" ;
+ $org = "$cmppath$testversion/$1" if (-e "$cmppath$testversion/$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) ;
}
@@ -1225,7 +1618,7 @@
print "without apache httpd installed.\n" ;
}
-
+ $ep1compat = 0 ;
while ($loc ne '' && $err == 0)
{
if ($loc eq $embploc)
@@ -1238,11 +1631,26 @@
$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++ ;
+ $testversion = $version == 2 && !$ep1compat?2:1 ;
+
+ next if ($test->{version} && $testversion != $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 +1661,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 +1680,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$testversion/$file" if (-e "$inpath$testversion/$file")
;
if ($opt_nostart)
{
$notseen = 0 ;
@@ -1319,13 +1730,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 +1764,9 @@
{
$page =~ /.*\/(.*)$/ ;
$org = "$cmppath/$1" ;
+ $org = "$cmppath$testversion/$1" if (-e "$cmppath$testversion/$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 +1815,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
1.3 +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.3
diff -u -r1.2 -r1.3
--- errdoc2.htm 2000/09/11 09:53:33 1.2
+++ errdoc2.htm 2000/09/13 20:01:15 1.3
@@ -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>
1.20 +11 -68 embperl/test/cmp/escape.htm
Index: escape.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/escape.htm,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -r1.19 -r1.20
--- escape.htm 2000/08/18 09:20:36 1.19
+++ escape.htm 2000/09/13 20:01:16 1.20
@@ -29,7 +29,8 @@
A Tag 9: <A HREF="9" TARGET="9">x</A>
A Tag 10: <A TARGET="10" HREF="10" TARGET="10">x</A>
A Tag 11: <A HREF="11" >x</A>
-A Tag 12: <A HREF=12>x</A>
+^A Tag 12\: <A HREF=(12|\"12\")>x<\/A>
+^A Tag 12b\: <A HREF=(12b|\"12b\") >x<\/A>
A Tag 13: <A HREF="abcd%20%3E">x</A>
A Tag 14: <A HREF="abcd%20%3E">x</A>
FRAME: <FRAME
SRC="http://localhost/tests?id=abcdefghijklmnopqrstuvwxyz&text=This%20is%20a%20text%20%3F%20%26%20%2B%20-%20%2521"
name="%20foo">
@@ -39,9 +40,11 @@
IMG: <IMG
SRC="http://localhost/tests?id=abcdefghijklmnopqrstuvwxyz&text=This%20is%20a%20text%20%3F%20%26%20%2B%20-%20%2521"
name="%20foo">
FORM: <FORM
action="http://localhost/tests?id=abcdefghijklmnopqrstuvwxyz&text=This%20is%20a%20text%20%3F%20%26%20%2B%20-%20%2521"
name="%20foo">
-Hash via Array A <A HREF="http://localhost/tests?A=1&B=2">
-Hash in A <A HREF="http://localhost/tests?A=1&B=2">
-Array in A <A HREF="http://localhost/tests?X=9&Y=8&Z=7">
+Hash in A <a href="http://localhost/tests?A=1&B=2">
+Array in A <a href="http://localhost/tests?X=9&Y=8&Z=7">
+
+Hash in H <a href="http://localhost/tests?A=1&B=2">
+Array in H <a href="http://localhost/tests?X=9&Y=8&Z=7">
1
@@ -102,14 +105,14 @@
&#129;&#130;<BR>
0
-<A HREF='http://host/script?name=My%20Name%20���'>
+^<A
HREF=('http://host/script\?name=My%20Name%20���'|"http://host/script\?name=My%20Name%20���")>
-<A HREF='http://host/script?name=My%20Name%20���'>
+^<A
HREF=('http://host/script\?name=My%20Name%20���'|"http://host/script\?name=My%20Name%20���")>
0
-<A HREF='http://host/script?name=My%20Name%20���'>
+^<A
HREF=('http://host/script\?name=My%20Name%20���'|"http://host/script\?name=My%20Name%20���")>
-<A HREF='http://host/script?name=My Name ���'>
+^<A HREF=('http://host/script\?name=My Name ���'|"http://host/script\?name=My Name
���")>
<br>
@@ -152,66 +155,6 @@
-$optRawInput 0
-$escmode 0
-'here is a \ ' -> here is a \
-'here is a \\ ' -> here is a \
-'here is a \\\ ' -> here is a \\
-'here is a \\\\ ' -> here is a \\
-'here is a <tag> ' -> here is a
-'here is a \<tag> ' -> here is a <tag>
-'here is a \\<tag> ' -> here is a \<tag>
-'here is a \\\<tag> ' -> here is a \<tag>
-'here is a \\\\<tag> ' -> here is a \\<tag>
-'here is a \<tag\> ' -> here is a <tag\>
-'here is a \\<tag\\> ' -> here is a \<tag\>
-'here is a \\\<tag\\\> ' -> here is a \<tag\\>
-'here is a \\\\<tag\\\\> ' -> here is a \\<tag\\>
-$optRawInput 1
-$escmode 0
-'here is a \ ' -> here is a \
-'here is a \\ ' -> here is a \
-'here is a \\\ ' -> here is a \\
-'here is a \\\\ ' -> here is a \\
-'here is a <tag> ' -> here is a <tag>
-'here is a \<tag> ' -> here is a \<tag>
-'here is a \\<tag> ' -> here is a \<tag>
-'here is a \\\<tag> ' -> here is a \\<tag>
-'here is a \\\\<tag> ' -> here is a \\<tag>
-'here is a \<tag\> ' -> here is a \<tag\>
-'here is a \\<tag\\> ' -> here is a \<tag\>
-'here is a \\\<tag\\\> ' -> here is a \\<tag\\>
-'here is a \\\\<tag\\\\> ' -> here is a \\<tag\\>
-$optRawInput 0
-$escmode 1
-'here is a \ ' -> here is a
-'here is a \\ ' -> here is a
-'here is a \\\ ' -> here is a \
-'here is a \\\\ ' -> here is a \
-'here is a <tag> ' -> here is a
-'here is a \<tag> ' -> here is a <tag>
-'here is a \\<tag> ' -> here is a <tag>
-'here is a \\\<tag> ' -> here is a <tag>
-'here is a \\\\<tag> ' -> here is a \<tag>
-'here is a \<tag\> ' -> here is a <tag>
-'here is a \\<tag\\> ' -> here is a <tag>
-'here is a \\\<tag\\\> ' -> here is a <tag\>
-'here is a \\\\<tag\\\\> ' -> here is a \<tag\>
-$optRawInput 1
-$escmode 1
-'here is a \ ' -> here is a
-'here is a \\ ' -> here is a
-'here is a \\\ ' -> here is a \
-'here is a \\\\ ' -> here is a \
-'here is a <tag> ' -> here is a <tag>
-'here is a \<tag> ' -> here is a <tag>
-'here is a \\<tag> ' -> here is a <tag>
-'here is a \\\<tag> ' -> here is a \<tag>
-'here is a \\\\<tag> ' -> here is a \<tag>
-'here is a \<tag\> ' -> here is a <tag>
-'here is a \\<tag\\> ' -> here is a <tag>
-'here is a \\\<tag\\\> ' -> here is a \<tag\>
-'here is a \\\\<tag\\\\> ' -> here is a \<tag\>
<P>Ok.<P>
1.2 +69 -0 embperl/test/cmp/escraw.htm
1.2 +82 -0 embperl/test/cmp/tagscandisable.htm
1.14 +10 -80 embperl/test/html/escape.htm
Index: escape.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/escape.htm,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- escape.htm 2000/08/17 07:32:10 1.13
+++ escape.htm 2000/09/13 20:01:20 1.14
@@ -34,6 +34,7 @@
A Tag 10: <A TARGET="10" HREF="10" TARGET="10">x</A>
A Tag 11: <A HREF="11" >x</A>
A Tag 12: <A HREF=12>x</A>
+A Tag 12b: <A HREF=12b >x</A>
A Tag 13: <A HREF="[+ "abcd"+]%20[+ "%3e" +]">x</A>
A Tag 14: <A HREF="[+ "abcd"+]%20[+ ">" +]">x</A>
FRAME: <FRAME SRC="http://localhost/tests?id=[+%20$id +]&text=[+$text+]"
name="%20foo">
@@ -43,12 +44,15 @@
IMG: <IMG SRC="http://localhost/tests?id=[+%20$id +]&text=[+$text+]"
name="%20foo">
FORM: <FORM action="http://localhost/tests?id=[+%20$id +]&text=[+$text+]"
name="%20foo">
-[- %A = (A => 1, B => 2) ; @A = (X, 9, Y, 8, Z, 7) -]
-Hash via Array A <A HREF="http://localhost/tests?[+ [ %A ] +]">
-Hash in A <A HREF="http://localhost/tests?[+ \\%A +]">
-Array in A <A HREF="http://localhost/tests?[+ \@A +]">
-
-
+[- %A = (A => 1, B => 2) ; @A = (X, 9, Y, 8, Z, 7) -]
+Hash in A <A HREF="http://localhost/tests?[+ [ %A ] +]">
+Array in A <A HREF="http://localhost/tests?[+ \@A +]">
+
+[- %H = (A => 1, B => 2) ; @H = (X, 9, Y, 8, Z, 7) -]
+Hash in H <A HREF="http://localhost/tests?[+ \\%H +]">
+Array in H <A HREF="http://localhost/tests?[+ scalar { @H } +]">
+
+
[+ $escmode = 1 +]
Now lets look what we are getting from this:<BR>
@@ -168,80 +172,6 @@
</table>
-
-
-[- $optRawInput = 0 -]
-[- $escmode = 0 -]
-$optRawInput [+ $optRawInput +]
-$escmode [+ $escmode +]
-'here is a \ ' -> [+ 'here is a \ ' +]
-'here is a \\ ' -> [+ 'here is a \\ ' +]
-'here is a \\\ ' -> [+ 'here is a \\\ ' +]
-'here is a \\\\ ' -> [+ 'here is a \\\\ ' +]
-'here is a <tag> ' -> [+ 'here is a <tag>' +]
-'here is a \<tag> ' -> [+ 'here is a \<tag>' +]
-'here is a \\<tag> ' -> [+ 'here is a \\<tag>' +]
-'here is a \\\<tag> ' -> [+ 'here is a \\\<tag>' +]
-'here is a \\\\<tag> ' -> [+ 'here is a \\\\<tag>' +]
-'here is a \<tag\> ' -> [+ 'here is a \<tag\>' +]
-'here is a \\<tag\\> ' -> [+ 'here is a \\<tag\\>' +]
-'here is a \\\<tag\\\> ' -> [+ 'here is a \\\<tag\\\>' +]
-'here is a \\\\<tag\\\\> ' -> [+ 'here is a \\\\<tag\\\\>' +]
-
-
-[- $optRawInput = 1 -]
-[- $escmode = 0 -]
-$optRawInput [+ $optRawInput +]
-$escmode [+ $escmode +]
-'here is a \ ' -> [+ 'here is a \ ' +]
-'here is a \\ ' -> [+ 'here is a \\ ' +]
-'here is a \\\ ' -> [+ 'here is a \\\ ' +]
-'here is a \\\\ ' -> [+ 'here is a \\\\ ' +]
-'here is a <tag> ' -> [+ 'here is a <tag>' +]
-'here is a \<tag> ' -> [+ 'here is a \<tag>' +]
-'here is a \\<tag> ' -> [+ 'here is a \\<tag>' +]
-'here is a \\\<tag> ' -> [+ 'here is a \\\<tag>' +]
-'here is a \\\\<tag> ' -> [+ 'here is a \\\\<tag>' +]
-'here is a \<tag\> ' -> [+ 'here is a \<tag\>' +]
-'here is a \\<tag\\> ' -> [+ 'here is a \\<tag\\>' +]
-'here is a \\\<tag\\\> ' -> [+ 'here is a \\\<tag\\\>' +]
-'here is a \\\\<tag\\\\> ' -> [+ 'here is a \\\\<tag\\\\>' +]
-
-[- $optRawInput = 0 -]
-[- $escmode = 1 -]
-$optRawInput [+ $optRawInput +]
-$escmode [+ $escmode +]
-'here is a \ ' -> [+ 'here is a \ ' +]
-'here is a \\ ' -> [+ 'here is a \\ ' +]
-'here is a \\\ ' -> [+ 'here is a \\\ ' +]
-'here is a \\\\ ' -> [+ 'here is a \\\\ ' +]
-'here is a <tag> ' -> [+ 'here is a <tag>' +]
-'here is a \<tag> ' -> [+ 'here is a \<tag>' +]
-'here is a \\<tag> ' -> [+ 'here is a \\<tag>' +]
-'here is a \\\<tag> ' -> [+ 'here is a \\\<tag>' +]
-'here is a \\\\<tag> ' -> [+ 'here is a \\\\<tag>' +]
-'here is a \<tag\> ' -> [+ 'here is a \<tag\>' +]
-'here is a \\<tag\\> ' -> [+ 'here is a \\<tag\\>' +]
-'here is a \\\<tag\\\> ' -> [+ 'here is a \\\<tag\\\>' +]
-'here is a \\\\<tag\\\\> ' -> [+ 'here is a \\\\<tag\\\\>' +]
-
-[- $optRawInput = 1 -]
-[- $escmode = 1 -]
-$optRawInput [+ $optRawInput +]
-$escmode [+ $escmode +]
-'here is a \ ' -> [+ 'here is a \ ' +]
-'here is a \\ ' -> [+ 'here is a \\ ' +]
-'here is a \\\ ' -> [+ 'here is a \\\ ' +]
-'here is a \\\\ ' -> [+ 'here is a \\\\ ' +]
-'here is a <tag> ' -> [+ 'here is a <tag>' +]
-'here is a \<tag> ' -> [+ 'here is a \<tag>' +]
-'here is a \\<tag> ' -> [+ 'here is a \\<tag>' +]
-'here is a \\\<tag> ' -> [+ 'here is a \\\<tag>' +]
-'here is a \\\\<tag> ' -> [+ 'here is a \\\\<tag>' +]
-'here is a \<tag\> ' -> [+ 'here is a \<tag\>' +]
-'here is a \\<tag\\> ' -> [+ 'here is a \\<tag\\>' +]
-'here is a \\\<tag\\\> ' -> [+ 'here is a \\\<tag\\\>' +]
-'here is a \\\\<tag\\\\> ' -> [+ 'here is a \\\\<tag\\\\>' +]
<P>Ok.<P>
1.2 +82 -0 embperl/test/html/escraw.htm
1.2 +73 -0 embperl/test/html/tagscandisable.htm
1.2 +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.2
diff -u -r1.1 -r1.2
--- errdoc.htm 1999/03/22 05:20:48 1.1
+++ errdoc.htm 2000/09/13 20:01:23 1.2
@@ -52,11 +52,6 @@
[$endif$]
-Tag missmatch:
-
-<table>
-</tr>
-
<P>Ok.<P>
1.2 +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.2
diff -u -r1.1 -r1.2
--- errdoc2.htm 2000/08/24 06:03:49 1.1
+++ errdoc2.htm 2000/09/13 20:01:26 1.2
@@ -52,11 +52,6 @@
[$endif$]
-Tag missmatch:
-
-<table>
-</tr>
-
<P>Ok.<P>
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
