From: Artur Bergman <sky@nanisky.com>
Date: Fri, 17 Aug 2001 04:18:11 +0000 (+0000)
Subject: Adds PERL_EXIT_DESTRUCT_END to PL_exit_flags which if set moves END block running... 
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=31d77e546f9eed28b984703264e32f2200f7aa8b;p=p5sagit%2Fp5-mst-13.2.git

Adds PERL_EXIT_DESTRUCT_END to PL_exit_flags which if set moves END block running to perl_destruct, changes prototype of perl_destruct to return exitstatus.

p4raw-id: //depot/perl@11702
---

diff --git a/embed.pl b/embed.pl
index 71144cb..84ff77b 100755
--- a/embed.pl
+++ b/embed.pl
@@ -1339,7 +1339,7 @@ Ajno	|PerlInterpreter*	|perl_alloc_using \
 #endif
 Ajnod	|PerlInterpreter*	|perl_alloc
 Ajnod	|void	|perl_construct	|PerlInterpreter* interp
-Ajnod	|void	|perl_destruct	|PerlInterpreter* interp
+Ajnod	|int	|perl_destruct	|PerlInterpreter* interp
 Ajnod	|void	|perl_free	|PerlInterpreter* interp
 Ajnod	|int	|perl_run	|PerlInterpreter* interp
 Ajnod	|int	|perl_parse	|PerlInterpreter* interp|XSINIT_t xsinit \
diff --git a/miniperlmain.c b/miniperlmain.c
index ee09fbe..9995b2b 100644
--- a/miniperlmain.c
+++ b/miniperlmain.c
@@ -70,14 +70,13 @@ main(int argc, char **argv, char **env)
 	perl_construct(my_perl);
 	PL_perl_destruct_level = 0;
     }
-
+    PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
     exitstatus = perl_parse(my_perl, xs_init, argc, argv, (char **)NULL);
     if (!exitstatus) {
-	exitstatus = perl_run(my_perl);
-       perl_destruct(my_perl);
-       exitstatus = STATUS_NATIVE_EXPORT;
+        perl_run(my_perl);
+        exitstatus = perl_destruct(my_perl);
     } else {
-      perl_destruct(my_perl);
+        perl_destruct(my_perl);
     }
 
     perl_free(my_perl);
diff --git a/perl.c b/perl.c
index dc6fede..4bda944 100644
--- a/perl.c
+++ b/perl.c
@@ -301,7 +301,7 @@ Shuts down a Perl interpreter.  See L<perlembed>.
 =cut
 */
 
-void
+int
 perl_destruct(pTHXx)
 {
     int destruct_level;  /* 0=none, 1=full, 2=full with checks */
@@ -397,7 +397,8 @@ perl_destruct(pTHXx)
     }
 #endif
 
-    {
+
+    if(PL_exit_flags & PERL_EXIT_DESTRUCT_END) {
         dJMPENV;
         int x = 0;
 
@@ -456,7 +457,7 @@ perl_destruct(pTHXx)
 	DEBUG_P(debprofdump());
 
 	/* The exit() function will do everything that needs doing. */
-	return;
+        return STATUS_NATIVE_EXPORT;;
     }
 
     /* jettison our possibly duplicated environment */
@@ -854,6 +855,7 @@ perl_destruct(pTHXx)
 	Safefree(PL_mess_sv);
 	PL_mess_sv = Nullsv;
     }
+    return STATUS_NATIVE_EXPORT;
 }
 
 /*
@@ -1513,6 +1515,9 @@ perl_run(pTHXx)
 	    LEAVE;
 	FREETMPS;
 	PL_curstash = PL_defstash;
+	if (!(PL_exit_flags & PERL_EXIT_DESTRUCT_END) && 
+	    PL_endav && !PL_minus_c)
+	    call_list(oldscope, PL_endav);
 #ifdef MYMALLOC
 	if (PerlEnv_getenv("PERL_DEBUG_MSTATS"))
 	    dump_mstats("after execution:  ");
diff --git a/perl.h b/perl.h
index 1ff9d32..36b1939 100644
--- a/perl.h
+++ b/perl.h
@@ -2070,6 +2070,7 @@ typedef pthread_key_t	perl_key;
 
 /* flags in PL_exit_flags for nature of exit() */
 #define PERL_EXIT_EXPECTED	0x01
+#define PERL_EXIT_DESTRUCT_END  0x02  /* Run END in perl_destruct */
 
 #ifndef MEMBER_TO_FPTR
 #  define MEMBER_TO_FPTR(name)		name
diff --git a/proto.h b/proto.h
index 06ce95a..698b184 100644
--- a/proto.h
+++ b/proto.h
@@ -13,7 +13,7 @@ PERL_CALLCONV PerlInterpreter*	perl_alloc_using(struct IPerlMem* m, struct IPerl
 #endif
 PERL_CALLCONV PerlInterpreter*	perl_alloc(void);
 PERL_CALLCONV void	perl_construct(PerlInterpreter* interp);
-PERL_CALLCONV void	perl_destruct(PerlInterpreter* interp);
+PERL_CALLCONV int	perl_destruct(PerlInterpreter* interp);
 PERL_CALLCONV void	perl_free(PerlInterpreter* interp);
 PERL_CALLCONV int	perl_run(PerlInterpreter* interp);
 PERL_CALLCONV int	perl_parse(PerlInterpreter* interp, XSINIT_t xsinit, int argc, char** argv, char** env);