Segfaults if $^P

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

p4raw-id: //depot/perl@3683

8 files changed, 26 insertions, 9 deletions

diff --git a/embed.h b/embed.h
index 7789679fa7..c90f50dced 100644
--- 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 1af25adc21..cbd2294633 100755
--- 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 8a3e7256ae..fba03069d8 100644
--- 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 2b6459f785..695272dc9f 100644
--- 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 9728482089..8134c177a5 100644
--- 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 8db7c21764..23aec9705e 100644
--- 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 037ad3d77a..fb078f3ce9 100755
--- 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 e4a9db8b93..ed2fdb14f5 100644
--- 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);