Segfaults if $^P

	Message-Id: <199907130944.FAA04473@monk.mps.ohio-state.edu>

p4raw-id: //depot/perl@3683

diff --git a/embed.h b/embed.h
index 7789679..c90f50d 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -205,6 +205,7 @@
 #define ibcmp                  Perl_ibcmp
 #define ibcmp_locale           Perl_ibcmp_locale
 #define ingroup                        Perl_ingroup
+#define init_debugger          Perl_init_debugger
 #define init_stacks            Perl_init_stacks
 #define intro_my               Perl_intro_my
 #define instr                  Perl_instr
@@ -782,7 +783,6 @@
 #define incpush                        S_incpush
 #define init_interp            S_init_interp
 #define init_ids               S_init_ids
-#define init_debugger          S_init_debugger
 #define init_lexer             S_init_lexer
 #define init_main_stash                S_init_main_stash
 #define init_perllib           S_init_perllib
@@ -1525,6 +1525,7 @@
 #define ibcmp(a,b,c)           Perl_ibcmp(aTHX_ a,b,c)
 #define ibcmp_locale(a,b,c)    Perl_ibcmp_locale(aTHX_ a,b,c)
 #define ingroup(a,b)           Perl_ingroup(aTHX_ a,b)
+#define init_debugger()                Perl_init_debugger(aTHX)
 #define init_stacks()          Perl_init_stacks(aTHX)
 #define intro_my()             Perl_intro_my(aTHX)
 #define instr(a,b)             Perl_instr(aTHX_ a,b)
@@ -2093,7 +2094,6 @@
 #define incpush(a,b)           S_incpush(aTHX_ a,b)
 #define init_interp()          S_init_interp(aTHX)
 #define init_ids()             S_init_ids(aTHX)
-#define init_debugger()                S_init_debugger(aTHX)
 #define init_lexer()           S_init_lexer(aTHX)
 #define init_main_stash()      S_init_main_stash(aTHX)
 #define init_perllib()         S_init_perllib(aTHX)
@@ -3027,6 +3027,8 @@
 #define ibcmp_locale           Perl_ibcmp_locale
 #define Perl_ingroup           CPerlObj::Perl_ingroup
 #define ingroup                        Perl_ingroup
+#define Perl_init_debugger     CPerlObj::Perl_init_debugger
+#define init_debugger          Perl_init_debugger
 #define Perl_init_stacks       CPerlObj::Perl_init_stacks
 #define init_stacks            Perl_init_stacks
 #define Perl_intro_my          CPerlObj::Perl_intro_my
@@ -4139,8 +4141,6 @@
 #define init_interp            S_init_interp
 #define S_init_ids             CPerlObj::S_init_ids
 #define init_ids               S_init_ids
-#define S_init_debugger                CPerlObj::S_init_debugger
-#define init_debugger          S_init_debugger
 #define S_init_lexer           CPerlObj::S_init_lexer
 #define init_lexer             S_init_lexer
 #define S_init_main_stash      CPerlObj::S_init_main_stash

diff --git a/embed.pl b/embed.pl
index 1af25ad..cbd2294 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -1192,6 +1192,7 @@ p |void   |hv_undef       |HV* tb
 p      |I32    |ibcmp          |const char* a|const char* b|I32 len
 p      |I32    |ibcmp_locale   |const char* a|const char* b|I32 len
 p      |I32    |ingroup        |I32 testgid|I32 effective
+p      |void   |init_debugger
 p      |void   |init_stacks
 p      |U32    |intro_my
 p      |char*  |instr          |const char* big|const char* little
@@ -1820,7 +1821,6 @@ s |void   |forbid_setid   |char *
 s      |void   |incpush        |char *|int
 s      |void   |init_interp
 s      |void   |init_ids
-s      |void   |init_debugger
 s      |void   |init_lexer
 s      |void   |init_main_stash
 s      |void   |init_perllib

diff --git a/global.sym b/global.sym
index 8a3e725..fba0306 100644 (file)
--- a/global.sym
+++ b/global.sym
@@ -179,6 +179,7 @@ Perl_hv_undef
 Perl_ibcmp
 Perl_ibcmp_locale
 Perl_ingroup
+Perl_init_debugger
 Perl_init_stacks
 Perl_intro_my
 Perl_instr

diff --git a/mg.c b/mg.c
index 2b6459f..695272d 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1676,6 +1676,8 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        break;
     case '\020':       /* ^P */
        PL_perldb = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+       if (PL_perldb && !PL_DBsingle)
+           init_debugger();
        break;
     case '\024':       /* ^T */
 #ifdef BIG_TIME

diff --git a/objXSUB.h b/objXSUB.h
index 9728482..8134c17 100644 (file)
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -1529,6 +1529,10 @@
 #define Perl_ingroup           pPerl->Perl_ingroup
 #undef  ingroup
 #define ingroup                        Perl_ingroup
+#undef  Perl_init_debugger
+#define Perl_init_debugger     pPerl->Perl_init_debugger
+#undef  init_debugger
+#define init_debugger          Perl_init_debugger
 #undef  Perl_init_stacks
 #define Perl_init_stacks       pPerl->Perl_init_stacks
 #undef  init_stacks

diff --git a/perl.c b/perl.c
index 8db7c21..23aec97 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -2478,23 +2478,26 @@ S_forbid_setid(pTHX_ char *s)
         Perl_croak(aTHX_ "No %s allowed while running setgid", s);
 }
 
-STATIC void
-S_init_debugger(pTHX)
+void
+Perl_init_debugger(pTHX)
 {
     dTHR;
+    HV *ostash = PL_curstash;
+
     PL_curstash = PL_debstash;
     PL_dbargs = GvAV(gv_AVadd((gv_fetchpv("args", GV_ADDMULTI, SVt_PVAV))));
     AvREAL_off(PL_dbargs);
     PL_DBgv = gv_fetchpv("DB", GV_ADDMULTI, SVt_PVGV);
     PL_DBline = gv_fetchpv("dbline", GV_ADDMULTI, SVt_PVAV);
     PL_DBsub = gv_HVadd(gv_fetchpv("sub", GV_ADDMULTI, SVt_PVHV));
+    sv_upgrade(GvSV(PL_DBsub), SVt_IV);        /* IVX accessed if PERLDB_SUB_NN */
     PL_DBsingle = GvSV((gv_fetchpv("single", GV_ADDMULTI, SVt_PV)));
     sv_setiv(PL_DBsingle, 0); 
     PL_DBtrace = GvSV((gv_fetchpv("trace", GV_ADDMULTI, SVt_PV)));
     sv_setiv(PL_DBtrace, 0); 
     PL_DBsignal = GvSV((gv_fetchpv("signal", GV_ADDMULTI, SVt_PV)));
     sv_setiv(PL_DBsignal, 0); 
-    PL_curstash = PL_defstash;
+    PL_curstash = ostash;
 }
 
 #ifndef STRESS_REALLOC

diff --git a/perlapi.c b/perlapi.c
index 037ad3d..fb078f3 100755 (executable)
--- a/perlapi.c
+++ b/perlapi.c
@@ -1349,6 +1349,13 @@ Perl_ingroup(pTHXo_ I32 testgid, I32 effective)
     return ((CPerlObj*)pPerl)->Perl_ingroup(testgid, effective);
 }
 
+#undef  Perl_init_debugger
+void
+Perl_init_debugger(pTHXo)
+{
+    ((CPerlObj*)pPerl)->Perl_init_debugger();
+}
+
 #undef  Perl_init_stacks
 void
 Perl_init_stacks(pTHXo)

diff --git a/proto.h b/proto.h
index e4a9db8..ed2fdb1 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -198,6 +198,7 @@ VIRTUAL void        Perl_hv_undef(pTHX_ HV* tb);
 VIRTUAL I32    Perl_ibcmp(pTHX_ const char* a, const char* b, I32 len);
 VIRTUAL I32    Perl_ibcmp_locale(pTHX_ const char* a, const char* b, I32 len);
 VIRTUAL I32    Perl_ingroup(pTHX_ I32 testgid, I32 effective);
+VIRTUAL void   Perl_init_debugger(pTHX);
 VIRTUAL void   Perl_init_stacks(pTHX);
 VIRTUAL U32    Perl_intro_my(pTHX);
 VIRTUAL char*  Perl_instr(pTHX_ const char* big, const char* little);
@@ -791,7 +792,6 @@ STATIC void S_forbid_setid(pTHX_ char *);
 STATIC void    S_incpush(pTHX_ char *, int);
 STATIC void    S_init_interp(pTHX);
 STATIC void    S_init_ids(pTHX);
-STATIC void    S_init_debugger(pTHX);
 STATIC void    S_init_lexer(pTHX);
 STATIC void    S_init_main_stash(pTHX);
 STATIC void    S_init_perllib(pTHX);