Change 11702 by sky@sky-borderline on 2001/08/17 04:18:11
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.
Affected files ...
... //depot/perl/embed.pl#264 edit
... //depot/perl/miniperlmain.c#28 edit
... //depot/perl/perl.c#360 edit
... //depot/perl/perl.h#382 edit
... //depot/perl/proto.h#323 edit
Differences ...
==== //depot/perl/embed.pl#264 (xtext) ====
Index: perl/embed.pl
--- perl/embed.pl.~1~ Thu Aug 16 22:30:05 2001
+++ perl/embed.pl Thu Aug 16 22:30:05 2001
@@ -1339,7 +1339,7 @@
#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 \
==== //depot/perl/miniperlmain.c#28 (text) ====
Index: perl/miniperlmain.c
--- perl/miniperlmain.c.~1~ Thu Aug 16 22:30:05 2001
+++ perl/miniperlmain.c Thu Aug 16 22:30:05 2001
@@ -70,14 +70,13 @@
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);
==== //depot/perl/perl.c#360 (text) ====
Index: perl/perl.c
--- perl/perl.c.~1~ Thu Aug 16 22:30:05 2001
+++ perl/perl.c Thu Aug 16 22:30:05 2001
@@ -301,7 +301,7 @@
=cut
*/
-void
+int
perl_destruct(pTHXx)
{
int destruct_level; /* 0=none, 1=full, 2=full with checks */
@@ -397,7 +397,8 @@
}
#endif
- {
+
+ if(PL_exit_flags & PERL_EXIT_DESTRUCT_END) {
dJMPENV;
int x = 0;
@@ -456,7 +457,7 @@
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 @@
Safefree(PL_mess_sv);
PL_mess_sv = Nullsv;
}
+ return STATUS_NATIVE_EXPORT;
}
/*
@@ -1513,6 +1515,9 @@
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: ");
==== //depot/perl/perl.h#382 (text) ====
Index: perl/perl.h
--- perl/perl.h.~1~ Thu Aug 16 22:30:05 2001
+++ perl/perl.h Thu Aug 16 22:30:05 2001
@@ -2070,6 +2070,7 @@
/* 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
==== //depot/perl/proto.h#323 (text+w) ====
Index: perl/proto.h
--- perl/proto.h.~1~ Thu Aug 16 22:30:05 2001
+++ perl/proto.h Thu Aug 16 22:30:05 2001
@@ -13,7 +13,7 @@
#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);
End of Patch.
