richter 01/02/05 03:19:04
Modified: . Tag: Embperl2c Makefile.PL epcomp.c epeval.c
test.pl
Embperl Tag: Embperl2c Syntax.pm
test/conf Tag: Embperl2c httpd.conf.src
Log:
- Added support for interactive debugger :-)
Revision Changes Path
No revision
No revision
1.31.4.6 +1 -1 embperl/Makefile.PL
Index: Makefile.PL
===================================================================
RCS file: /home/cvs/embperl/Makefile.PL,v
retrieving revision 1.31.4.5
retrieving revision 1.31.4.6
diff -u -r1.31.4.5 -r1.31.4.6
--- Makefile.PL 2000/11/13 18:38:43 1.31.4.5
+++ Makefile.PL 2001/02/05 11:18:52 1.31.4.6
@@ -352,7 +352,7 @@
}
else
{
- $ccdebug = '-g' ;
+ $ccdebug = '-ggdb' ;
$lddebug = '-g' ;
}
}
1.4.2.33 +120 -1 embperl/Attic/epcomp.c
Index: epcomp.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epcomp.c,v
retrieving revision 1.4.2.32
retrieving revision 1.4.2.33
diff -u -r1.4.2.32 -r1.4.2.33
--- epcomp.c 2000/12/22 06:19:46 1.4.2.32
+++ epcomp.c 2001/02/05 11:18:53 1.4.2.33
@@ -1433,10 +1433,129 @@
r -> nPhase = phPerlCompile ;
- if ((rc = EvalOnly (r, r -> pProgRun, ppCompResult, G_SCALAR, "")) != ok)
+ if (PERLDB_LINE)
+ { /* feed source to file gv (@/%_<filename) if we are running under the
debugger */
+ AV * pAV ;
+ GV * pGVFile = gv_fetchfile (r -> Buf.pFile -> sSourcefile) ;
+ AV * pDebugArray = GvAV (pGVFile) ;
+
+
+ char * p = r -> Buf.pBuf ;
+ char * end ;
+ I32 i = 1 ;
+ while (*p)
+ {
+ end = strchr (p, '\n') ;
+ if (end)
+ {
+ SV * pLine ;
+ pLine = newSVpv (p, end - p + 1) ;
+ SvUPGRADE (pLine, SVt_PVMG) ;
+ av_store (pDebugArray, i++, pLine) ;
+ p = end + 1 ;
+ }
+ else if (p < r -> Buf.pEndPos)
+ {
+ SV * pLine ;
+ pLine = newSVpv (p, r -> Buf.pEndPos - p + 1) ;
+ SvUPGRADE (pLine, SVt_PVMG) ;
+ av_store (pDebugArray, i++, pLine) ;
+ break ;
+ }
+ }
+ if (r -> bDebug)
+ lprintf (r, "Setup source code for interactive debugger\n") ;
+ }
+
+ if ((rc = EvalOnly (r, r -> pProgRun, ppCompResult, G_SCALAR, "main")) != ok)
return rc ;
+#if 0
+ /*xxx*/lprintf (r, "evalno = %d\n" , PL_evalseq - 1) ;
+ //if (*ppSV && SvROK (*ppSV))
+ //if (0)
+ { /* copy debugging infos from eval gv to file gv (@/%_<filename) */
+ AV * pAV ;
+ HV * pHV ;
+ char tmp [64] ;
+ GV * pGVFile = gv_fetchfile (r -> Buf.pFile -> sSourcefile) ;
+ GV * pGVEval ;
+
+ sprintf (tmp, "(eval %lu)", PL_evalseq) ;
+ pGVEval = gv_fetchfile (tmp) ;
+
+ /*xxx*/lprintf (r, "file = %s %x eval = %s %x\n" , GvNAME(pGVFile), pGVFile,
GvNAME(pGVEval), pGVEval) ;
+ if (pGVFile != pGVEval)
+ {
+ AV * pDebugArray = GvAV (pGVFile) ;
+ AV * pEvalArray = GvAV (pGVEval) ;
+ char * p ;
+ char * end ;
+ I32 i ;
+
+ for (i = 0; i < AvFILL(pEvalArray); i++)
+ {
+ SV * pLine ;
+ SV * * ppLine ;
+ if ((ppLine = av_fetch (pEvalArray, i, 0)) && (pLine = *ppLine))
+ {
+ /* xxx */ lprintf (r, "Eval pLine %d type = %x, ", i,
SvTYPE(pLine)) ;
+ /* xxx */ lprintf (r, "int = %d", SvIVX(pLine)) ;
+ /* xxx */ lprintf (r, "str = %s\n", SvPVX(pLine)) ;
+ }
+ }
+
+ for (i = 0; i < AvFILL(pDebugArray); i++)
+ {
+ SV * pLine ;
+ SV * * ppLine ;
+ if ((ppLine = av_fetch (pDebugArray, i, 0)) && (pLine = *ppLine))
+ {
+ /* xxx */ lprintf (r, "Debug pLine %d type = %x, ", i,
SvTYPE(pLine)) ;
+ /* xxx */ lprintf (r, "int = %d", SvIVX(pLine)) ;
+ /* xxx */ lprintf (r, "str = %s\n", SvPVX(pLine)) ;
+ }
+ }
+
+
+ p = r -> Buf.pBuf ;
+ i = 1 ;
+ while (*p)
+ {
+ end = strchr (p, '\n') ;
+ if (end)
+ {
+ SV * pLine ;
+ SV * * ppLine ;
+ /* lprintf (r, "i = %d len = %d, str = %s", i, end - p + 1, SvPV
(pLine, n)) ; */
+ if ((ppLine = av_fetch (pEvalArray, i, 0)) && (pLine = *ppLine))
+ {
+ STRLEN len = end - p + 1 ;
+ /* xxx */ lprintf (r, "pLine type = %x, ", SvTYPE(pLine)) ;
+ /* xxx */ lprintf (r, "int = %d", SvIVX(pLine)) ;
+ /* xxx */ lprintf (r, "str = %s\n", SvPVX(pLine)) ;
+ SvREFCNT_inc (pLine) ;
+ SvUPGRADE (pLine, SVt_PVMG) ;
+ SvGROW (pLine, len + 1) ;
+ Move (p, SvPVX(pLine), len+1, char) ;
+ *(SvPVX(pLine) + len) = '\0' ;
+ SvCUR_set (pLine, len) ;
+ SvPOK_on (pLine) ;
+ }
+ else
+ pLine = newSVpv (p, end - p + 1) ;
+ av_store (pDebugArray, i++, pLine) ;
+ p = end + 1 ;
+ }
+ else if (p < r -> Buf.pEndPos)
+ {
+ av_store (pDebugArray, i++, newSVpv (p, r -> Buf.pEndPos - p + 1))
;
+ break ;
+ }
+ }
+#endif
+
StringFree (&r -> pProgRun) ;
StringFree (&r -> pProgDef) ;
1.23.4.7 +5 -1 embperl/epeval.c
Index: epeval.c
===================================================================
RCS file: /home/cvs/embperl/epeval.c,v
retrieving revision 1.23.4.6
retrieving revision 1.23.4.7
diff -u -r1.23.4.6 -r1.23.4.7
--- epeval.c 2000/11/15 07:21:52 1.23.4.6
+++ epeval.c 2001/02/05 11:18:54 1.23.4.7
@@ -853,12 +853,16 @@
lprintf (r, "CV ppSV=%s type=%d\n", *ppSV?"ok":"NULL", *ppSV?SvTYPE (*ppSV):0)
;
if (*ppSV == NULL || SvTYPE (*ppSV) != SVt_PVCV)
{
+
if ((rc = EvalOnly (r, sArg, ppSV, G_SCALAR, "")) != ok)
{
*pRet = NULL ;
return rc ;
}
- *pRet = *ppSV ;
+
+
+
+ *pRet = *ppSV ;
return ok ;
}
1.70.4.26 +8 -7 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.70.4.25
retrieving revision 1.70.4.26
diff -u -r1.70.4.25 -r1.70.4.26
--- test.pl 2000/12/21 09:37:50 1.70.4.25
+++ test.pl 2001/02/05 11:18:55 1.70.4.26
@@ -474,7 +474,7 @@
$opt_offline $opt_ep1 $opt_cgi $opt_modperl $opt_execute $opt_nokill
$opt_loop
$opt_multchild $opt_memcheck $opt_exitonmem $opt_exitonsv $opt_config
$opt_nostart $opt_uniquefn
$opt_quite $opt_ignoreerror $opt_tests $opt_blib $opt_help
$opt_dbgbreak $opt_finderr
- $opt_ddd $opt_gdb $opt_ab $opt_abpre $opt_abverbose $opt_start
$opt_kill $opt_showcookie $opt_cache) ;
+ $opt_ddd $opt_gdb $opt_ab $opt_abpre $opt_abverbose $opt_start
$opt_startinter $opt_kill $opt_showcookie $opt_cache) ;
{
local $^W = 0 ;
@@ -549,7 +549,7 @@
$ret = GetOptions ("offline|o", "ep1|1", "cgi|c", "cache|a", "modperl|httpd|h",
"execute|e", "nokill|r", "loop|l:i",
"multchild|m", "memcheck|v", "exitonmem|g", "exitonsv", "config|f=s",
"nostart|x", "uniquefn|u",
"quite|q", "ignoreerror|i", "tests|t", "blib|b", "help", "dbgbreak",
"finderr",
- "ddd", "gdb", "ab:s", "abverbose", "abpre", "start", "kill", "showcookie")
;
+ "ddd", "gdb", "ab:s", "abverbose", "abpre", "start", "startinter", "kill",
"showcookie") ;
$opt_help = 1 if ($ret == 0) ;
@@ -619,6 +619,7 @@
print "--abverbose show whole ab output\n" ;
print "--abpre prefetch first request\n" ;
print "--start start apache only\n" ;
+ print "--startinter start apache only for interactive session\n" ;
print "--kill kill apache only\n" ;
print "--showcookie shows sent and received cookies\n" ;
print "\n\n" ;
@@ -1034,9 +1035,9 @@
}
-$opt_modperl = $opt_cgi = $opt_offline = $opt_execute = 0 if ($opt_start ||
$opt_kill) ;
+$opt_modperl = $opt_cgi = $opt_offline = $opt_execute = $opt_cache = 0 if
($opt_start || $opt_startinter || $opt_kill) ;
-$opt_nokill = 1 if ($opt_nostart || $opt_start) ;
+$opt_nokill = 1 if ($opt_nostart || $opt_start || $opt_startinter) ;
$looptest = defined ($opt_loop)?1:0 ; # endless loop tests
$outfile .= ".$$" if ($opt_uniquefn) ;
@@ -1666,7 +1667,7 @@
{ $loc = '' ; }
- if (($loc ne '' && $err == 0 && $loopcnt == 0 && !$opt_nostart) || $opt_start)
+ if (($loc ne '' && $err == 0 && $loopcnt == 0 && !$opt_nostart) || $opt_start
|| $opt_startinter)
{
#### Configure httpd conf file
$EPDEBUG = $defaultdebug ;
@@ -1712,11 +1713,11 @@
print FH "r\n" ;
print FH "BT\n" if ($opt_gdb) ;
close FH ;
- system (($opt_ddd?'ddd':'gdb') . " -x dbinitembperlapache $EPHTTPD &")
and die "***Cannot start $EPHTTPD" ;
+ system (($opt_ddd?'ddd':'gdb') . " -x dbinitembperlapache $EPHTTPD " .
($opt_startinter?'':'&')) and die "***Cannot start $EPHTTPD" ;
}
else
{
- system ("$EPHTTPD $XX -f $EPPATH/$httpdconf &") and die "***Cannot
start $EPHTTPD" ;
+ system ("$EPHTTPD $XX -f $EPPATH/$httpdconf " .
($opt_startinter?'':'&')) and die "***Cannot start $EPHTTPD" ;
}
}
sleep (3) ;
No revision
No revision
1.1.4.14 +5 -2 embperl/Embperl/Attic/Syntax.pm
Index: Syntax.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Attic/Syntax.pm,v
retrieving revision 1.1.4.13
retrieving revision 1.1.4.14
diff -u -r1.1.4.13 -r1.1.4.14
--- Syntax.pm 2000/12/22 06:19:46 1.1.4.13
+++ Syntax.pm 2001/02/05 11:19:01 1.1.4.14
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: Syntax.pm,v 1.1.4.13 2000/12/22 06:19:46 richter Exp $
+# $Id: Syntax.pm,v 1.1.4.14 2001/02/05 11:19:01 richter Exp $
#
###################################################################################
@@ -790,6 +790,7 @@
embperl => {
perlcode => q{
# any initialisation could be put here
+$DB::single = 1 ;
},
compiletimeperlcode => q{
use vars ('$_ep_DomTree') ;
@@ -802,7 +803,9 @@
*_ep_ac=\\&XML::Embperl::DOM::Node::iAppendChild;
*_ep_sa=\\&XML::Embperl::DOM::Element::iSetAttribut;
},
- perlcodeend => '# Include here any cleanup code',
+ perlcodeend => q{# Include here any cleanup code
+ $DB::single = 0 ;
+ },
stackname => 'metacmd',
stackmatch => 'Document',
'push' => 'Document',
No revision
No revision
1.24.4.7 +10 -0 embperl/test/conf/httpd.conf.src
Index: httpd.conf.src
===================================================================
RCS file: /home/cvs/embperl/test/conf/httpd.conf.src,v
retrieving revision 1.24.4.6
retrieving revision 1.24.4.7
diff -u -r1.24.4.6 -r1.24.4.7
--- httpd.conf.src 2000/12/21 07:41:19 1.24.4.6
+++ httpd.conf.src 2001/02/05 11:19:03 1.24.4.7
@@ -114,6 +114,7 @@
Alias /embperl/ $EPPATH/test/html/
Alias /embperl2/ $EPPATH/test/html2/
Alias /eg/ $EPPATH/eg/
+Alias /registrydbg/ $EPPATH/test/html/registry/
<Location /embperl/sub>
SetHandler perl-script
@@ -307,6 +308,15 @@
PerlHandler Apache::Registry
Options ExecCGI
</Location>
+
+<Location /registrydbg/>
+PerlFixupHandler Apache::DB
+SetHandler perl-script
+PerlHandler Apache::Registry
+Options ExecCGI
+</Location>
+
+
<Location /embperl/EmbperlObject/base3>
PerlSetEnv EMBPERL_OBJECT_BASE epobase3.htm
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
