Adds PERL_EXIT_DESTRUCT_END to PL_exit_flags which if set moves END block running...

p4raw-id: //depot/perl@11702

diff --git a/embed.pl b/embed.pl
index 71144cb..84ff77b 100755 (executable)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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);