Verify that the debugger has an array where to store lines before

doing so. This fixes an assertion failure when parsing a script
that begins with '#!perl -d'.
Also, code factorization in toke.c.

p4raw-id: //depot/perl@29429

diff --git a/embed.fnc b/embed.fnc
index 284bf44..9d5c7e2 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1471,6 +1471,8 @@ sR        |char*  |scan_subst     |NN char *start
 sR     |char*  |scan_trans     |NN char *start
 s      |char*  |scan_word      |NN char *s|NN char *dest|STRLEN destlen \
                                |int allow_package|NN STRLEN *slp
+s      |void   |update_debugger_info_pv|NN const char *buf|STRLEN len
+s      |void   |update_debugger_info_sv|NN SV *orig_sv
 sR     |char*  |skipspace      |NN char *s
 sR     |char*  |swallow_bom    |NN U8 *s
 s      |void   |checkcomma     |NN const char *s|NN const char *name \

diff --git a/embed.h b/embed.h
index d294609..9714956 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1471,6 +1471,8 @@
 #define scan_subst             S_scan_subst
 #define scan_trans             S_scan_trans
 #define scan_word              S_scan_word
+#define update_debugger_info_pv        S_update_debugger_info_pv
+#define update_debugger_info_sv        S_update_debugger_info_sv
 #define skipspace              S_skipspace
 #define swallow_bom            S_swallow_bom
 #define checkcomma             S_checkcomma
@@ -3676,6 +3678,8 @@
 #define scan_subst(a)          S_scan_subst(aTHX_ a)
 #define scan_trans(a)          S_scan_trans(aTHX_ a)
 #define scan_word(a,b,c,d,e)   S_scan_word(aTHX_ a,b,c,d,e)
+#define update_debugger_info_pv(a,b)   S_update_debugger_info_pv(aTHX_ a,b)
+#define update_debugger_info_sv(a)     S_update_debugger_info_sv(aTHX_ a)
 #define skipspace(a)           S_skipspace(aTHX_ a)
 #define swallow_bom(a)         S_swallow_bom(aTHX_ a)
 #define checkcomma(a,b,c)      S_checkcomma(aTHX_ a,b,c)

diff --git a/op.c b/op.c
index 48c9dcc..ab84ef1 100644 (file)
--- a/op.c
+++ b/op.c
@@ -4002,10 +4002,13 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
     CopSTASH_set(cop, PL_curstash);
 
     if (PERLDB_LINE && PL_curstash != PL_debstash) {
-       SV * const * const svp = av_fetch(CopFILEAVx(PL_curcop), (I32)CopLINE(cop), FALSE);
-       if (svp && *svp != &PL_sv_undef ) {
-           (void)SvIOK_on(*svp);
-           SvIV_set(*svp, PTR2IV(cop));
+       AV *av = CopFILEAVx(PL_curcop);
+       if (av) {
+           SV * const * const svp = av_fetch(av, (I32)CopLINE(cop), FALSE);
+           if (svp && *svp != &PL_sv_undef ) {
+               (void)SvIOK_on(*svp);
+               SvIV_set(*svp, PTR2IV(cop));
+           }
        }
     }
 

diff --git a/proto.h b/proto.h
index 14fec7e..9134296 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3957,6 +3957,12 @@ STATIC char*     S_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_pa
                        __attribute__nonnull__(pTHX_2)
                        __attribute__nonnull__(pTHX_5);
 
+STATIC void    S_update_debugger_info_pv(pTHX_ const char *buf, STRLEN len)
+                       __attribute__nonnull__(pTHX_1);
+
+STATIC void    S_update_debugger_info_sv(pTHX_ SV *orig_sv)
+                       __attribute__nonnull__(pTHX_1);
+
 STATIC char*   S_skipspace(pTHX_ char *s)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_1);

diff --git a/toke.c b/toke.c
index d61063a..c578fad 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -869,6 +869,34 @@ S_skipspace2(pTHX_ register char *s, SV **svp)
 }
 #endif
 
+STATIC void
+S_update_debugger_info_pv(pTHX_ const char *buf, STRLEN len)
+{
+    AV *av = CopFILEAVx(PL_curcop);
+    if (av) {
+       SV * const sv = newSV(0);
+       sv_upgrade(sv, SVt_PVMG);
+       sv_setpvn(sv, buf, len);
+       (void)SvIOK_on(sv);
+       SvIV_set(sv, 0);
+       av_store(av, (I32)CopLINE(PL_curcop), sv);
+    }
+}
+
+STATIC void
+S_update_debugger_info_sv(pTHX_ SV *orig_sv)
+{
+    AV *av = CopFILEAVx(PL_curcop);
+    if (av) {
+       SV * const sv = newSV(0);
+       sv_upgrade(sv, SVt_PVMG);
+       sv_setsv(sv, orig_sv);
+       (void)SvIOK_on(sv);
+       SvIV_set(sv, 0);
+       av_store(av, (I32)CopLINE(PL_curcop), sv);
+    }
+}
+
 /*
  * S_skipspace
  * Called to gobble the appropriate amount and type of whitespace.
@@ -1032,15 +1060,8 @@ S_skipspace(pTHX_ register char *s)
        /* debugger active and we're not compiling the debugger code,
         * so store the line into the debugger's array of lines
         */
-       if (PERLDB_LINE && PL_curstash != PL_debstash) {
-           SV * const sv = newSV(0);
-
-           sv_upgrade(sv, SVt_PVMG);
-           sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr);
-            (void)SvIOK_on(sv);
-            SvIV_set(sv, 0);
-           av_store(CopFILEAVx(PL_curcop),(I32)CopLINE(PL_curcop),sv);
-       }
+       if (PERLDB_LINE && PL_curstash != PL_debstash)
+           update_debugger_info_pv(PL_bufptr, PL_bufend - PL_bufptr);
     }
 
 #ifdef PERL_MAD
@@ -3545,15 +3566,8 @@ Perl_yylex(pTHX)
            PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
            PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
            PL_last_lop = PL_last_uni = NULL;
-           if (PERLDB_LINE && PL_curstash != PL_debstash) {
-               SV * const sv = newSV(0);
-
-               sv_upgrade(sv, SVt_PVMG);
-               sv_setsv(sv,PL_linestr);
-                (void)SvIOK_on(sv);
-                SvIV_set(sv, 0);
-               av_store(CopFILEAVx(PL_curcop),(I32)CopLINE(PL_curcop),sv);
-           }
+           if (PERLDB_LINE && PL_curstash != PL_debstash)
+               update_debugger_info_sv(PL_linestr);
            goto retry;
        }
        do {
@@ -3645,15 +3659,8 @@ Perl_yylex(pTHX)
            incline(s);
        } while (PL_doextract);
        PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s;
-       if (PERLDB_LINE && PL_curstash != PL_debstash) {
-           SV * const sv = newSV(0);
-
-           sv_upgrade(sv, SVt_PVMG);
-           sv_setsv(sv,PL_linestr);
-            (void)SvIOK_on(sv);
-            SvIV_set(sv, 0);
-           av_store(CopFILEAVx(PL_curcop),(I32)CopLINE(PL_curcop),sv);
-       }
+       if (PERLDB_LINE && PL_curstash != PL_debstash)
+           update_debugger_info_sv(PL_linestr);
        PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
        PL_last_lop = PL_last_uni = NULL;
        if (CopLINE(PL_curcop) == 1) {
@@ -11215,15 +11222,8 @@ S_scan_heredoc(pTHX_ register char *s)
        else if (PL_bufend - PL_linestart == 1 && PL_bufend[-1] == '\r')
            PL_bufend[-1] = '\n';
 #endif
-       if (PERLDB_LINE && PL_curstash != PL_debstash) {
-           SV * const sv = newSV(0);
-
-           sv_upgrade(sv, SVt_PVMG);
-           sv_setsv(sv,PL_linestr);
-            (void)SvIOK_on(sv);
-            SvIV_set(sv, 0);
-           av_store(CopFILEAVx(PL_curcop), (I32)CopLINE(PL_curcop),sv);
-       }
+       if (PERLDB_LINE && PL_curstash != PL_debstash)
+           update_debugger_info_sv(PL_linestr);
        if (*s == term && memEQ(s,PL_tokenbuf,len)) {
            STRLEN off = PL_bufend - 1 - SvPVX_const(PL_linestr);
            *(SvPVX(PL_linestr) + off ) = ' ';
@@ -11719,15 +11719,8 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
        CopLINE_inc(PL_curcop);
 
        /* update debugger info */
-       if (PERLDB_LINE && PL_curstash != PL_debstash) {
-           SV * const line_sv = newSV(0);
-
-           sv_upgrade(line_sv, SVt_PVMG);
-           sv_setsv(line_sv,PL_linestr);
-           (void)SvIOK_on(line_sv);
-           SvIV_set(line_sv, 0);
-           av_store(CopFILEAVx(PL_curcop), (I32)CopLINE(PL_curcop), line_sv);
-       }
+       if (PERLDB_LINE && PL_curstash != PL_debstash)
+           update_debugger_info_sv(PL_linestr);
 
        /* having changed the buffer, we must update PL_bufend */
        PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);