In perl.git, the branch blead has been updated
<https://perl5.git.perl.org/perl.git/commitdiff/64a9c780950becebc7326a31d067801ec9b187a2?hp=14ccab5a6b00da04dd7a4eeb19bb8caadde2bd72>
- Log -----------------------------------------------------------------
commit 64a9c780950becebc7326a31d067801ec9b187a2
Author: David Mitchell <da...@iabyn.com>
Date: Wed May 9 10:54:55 2018 +0100
Revert "set PERL_EXIT_DESTRUCT_END in all embeddings"
This reverts commit 8e920bd341e241f50a74dbf8aa343319f204e200.
Also skip the tests in t/op/blocks.t
RT #132863
8e920bd341 sets the PERL_EXIT_DESTRUCT_END flag on non-UNIXy platforms,
like is already done on UNIXy platforms. This makes things like
BEGIN { exit(1) } call END blocks on those platforms (like they already
do on UNIX).
But it caused problems with win32 pseudo-forks, so revert for 5.28
and re-address the issues sometime later.
commit 6b12a45f5c460336891492f0e67595db5af4983d
Author: David Mitchell <da...@iabyn.com>
Date: Wed May 9 13:52:50 2018 +0100
t/op/blocks.t: indent 6 tests in a new skip block
Apart from the whitespace change, this just wraps 6 tests in
a SKIP: { ... } block which isn't (yet) used.
commit 21e22e9eed0096c170cdd5eb23d7fae995620591
Author: David Mitchell <da...@iabyn.com>
Date: Wed May 9 13:49:14 2018 +0100
t/op/blocks.t: consolidate VMS-skips together
Put the three tests skipped under VMS together into a single SKIP
block rather than 3 separate skips.
As well as being tidier, as a side effect, it makes 6 tests contiguous
that are shortly to be skipped under win32,
commit 0d18e3dc7f3c6651b74dcaf1f7799d9b210ec1e5
Author: David Mitchell <da...@iabyn.com>
Date: Wed May 9 13:35:42 2018 +0100
t/op/blocks.t: add some whitespace
Makes the tests a bit easier to read.
-----------------------------------------------------------------------
Summary of changes:
NetWare/interface.c | 1 -
NetWare/interface.cpp | 1 -
os2/perlrexx.c | 1 -
symbian/PerlBase.cpp | 4 --
t/op/blocks.t | 124 ++++++++++++++++++++++++++++++++++++++++++--------
win32/perllib.c | 1 -
6 files changed, 105 insertions(+), 27 deletions(-)
diff --git a/NetWare/interface.c b/NetWare/interface.c
index b943d21147..1d298854c9 100644
--- a/NetWare/interface.c
+++ b/NetWare/interface.c
@@ -62,7 +62,6 @@ ClsPerlHost::PerlCreate(PerlInterpreter *my_perl)
/* if (!(my_perl = perl_alloc())) // Allocate memory for Perl.
return (1);*/
perl_construct(my_perl);
- PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
return 1;
}
diff --git a/NetWare/interface.cpp b/NetWare/interface.cpp
index 7fe027933c..b08d6c249e 100644
--- a/NetWare/interface.cpp
+++ b/NetWare/interface.cpp
@@ -53,7 +53,6 @@ ClsPerlHost::PerlCreate(PerlInterpreter *my_perl)
/* if (!(my_perl = perl_alloc())) // Allocate memory for Perl.
return (1);*/
perl_construct(my_perl);
- PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
return 1;
}
diff --git a/os2/perlrexx.c b/os2/perlrexx.c
index b9f6789677..18d655137d 100644
--- a/os2/perlrexx.c
+++ b/os2/perlrexx.c
@@ -74,7 +74,6 @@ init_perl(int doparse)
if (!my_perl)
return 0;
perl_construct(my_perl);
- PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
PL_perl_destruct_level = 1;
}
if (!doparse)
diff --git a/symbian/PerlBase.cpp b/symbian/PerlBase.cpp
index 88810bfd12..9312abeb55 100644
--- a/symbian/PerlBase.cpp
+++ b/symbian/PerlBase.cpp
@@ -141,10 +141,6 @@ void CPerlBase::ConstructL()
User::LeaveIfNull(iPerl);
iState = EPerlAllocated;
perl_construct(iPerl); // returns void
- {
- PerlInterpreter *my_perl = iPerl;
- PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
- }
if (!iStdioInitFunc) {
iConsole =
Console::NewL(_L("Perl Console"),
diff --git a/t/op/blocks.t b/t/op/blocks.t
index f220ab2bc9..1fb369a1a1 100644
--- a/t/op/blocks.t
+++ b/t/op/blocks.t
@@ -147,30 +147,116 @@ fresh_perl_is('END { print "ok\n" } INIT { bless {} and
exit }', "ok\n",
{}, 'null PL_curcop in newGP');
# [perl #2754] exit(0) didn't exit from inside a UNITCHECK or CHECK block
-my $testblocks = join(" ", "BEGIN { \$| = 1; }", (map { "@{[uc($_)]} { print
\"$_\\n\"; }" } qw(begin unitcheck check init end)), "print \"main\\n\";");
-fresh_perl_is($testblocks, "begin\nunitcheck\ncheck\ninit\nmain\nend", {},
'blocks execute in right order');
-SKIP: {
- skip "VMS doesn't have the perl #2754 bug", 1 if $^O eq 'VMS';
- fresh_perl_is("$testblocks BEGIN { exit 0; }",
"begin\nunitcheck\ncheck\ninit\nend", {}, "BEGIN{exit 0} doesn't exit yet");
-}
-fresh_perl_is("$testblocks BEGIN { exit 1; }", "begin\nunitcheck\ncheck\nend",
{}, "BEGIN{exit 1} should exit");
-fresh_perl_like("$testblocks BEGIN { die; }", qr/\Abegin\nDied[^\n]*\.\nBEGIN
failed[^\n]*\.\nunitcheck\ncheck\nend\z/, {}, "BEGIN{die} should exit");
+
+my $testblocks =
+ join(" ",
+ "BEGIN { \$| = 1; }",
+ (map { "@{[uc($_)]} { print \"$_\\n\"; }" }
+ qw(begin unitcheck check init end)),
+ "print \"main\\n\";"
+ );
+
+fresh_perl_is(
+ $testblocks,
+ "begin\nunitcheck\ncheck\ninit\nmain\nend",
+ {},
+ 'blocks execute in right order'
+);
+
SKIP: {
- skip "VMS doesn't have the perl #2754 bug", 1 if $^O eq 'VMS';
- fresh_perl_is("$testblocks UNITCHECK { exit 0; }",
"begin\nunitcheck\ncheck\ninit\nmain\nend", {}, "UNITCHECK{exit 0} doesn't exit
yet");
+ skip "VMS doesn't have the perl #2754 bug", 3 if $^O eq 'VMS';
+ fresh_perl_is(
+ "$testblocks BEGIN { exit 0; }",
+ "begin\nunitcheck\ncheck\ninit\nend",
+ {},
+ "BEGIN{exit 0} doesn't exit yet"
+ );
+
+ fresh_perl_is(
+ "$testblocks UNITCHECK { exit 0; }",
+ "begin\nunitcheck\ncheck\ninit\nmain\nend",
+ {},
+ "UNITCHECK{exit 0} doesn't exit yet"
+ );
+
+ fresh_perl_is(
+ "$testblocks CHECK { exit 0; }",
+ "begin\nunitcheck\ncheck\ninit\nmain\nend",
+ {},
+ "CHECK{exit 0} doesn't exit yet"
+ );
}
-fresh_perl_is("$testblocks UNITCHECK { exit 1; }",
"begin\nunitcheck\ncheck\nend", {}, "UNITCHECK{exit 1} should exit");
-fresh_perl_like("$testblocks UNITCHECK { die; }",
qr/\Abegin\nDied[^\n]*\.\nUNITCHECK failed[^\n]*\.\nunitcheck\ncheck\nend\z/,
{}, "UNITCHECK{die} should exit");
+
+
SKIP: {
- skip "VMS doesn't have the perl #2754 bug", 1 if $^O eq 'VMS';
- fresh_perl_is("$testblocks CHECK { exit 0; }",
"begin\nunitcheck\ncheck\ninit\nmain\nend", {}, "CHECK{exit 0} doesn't exit
yet");
+ if ($^O =~ /^(MSWin32|NetWare|os2)$/) {
+ skip "non_UNIX plafforms and PERL_EXIT_DESTRUCT_END (RT #132863)", 6;
+ }
+
+ fresh_perl_is(
+ "$testblocks BEGIN { exit 1; }",
+ "begin\nunitcheck\ncheck\nend",
+ {},
+ "BEGIN{exit 1} should exit"
+ );
+
+ fresh_perl_like(
+ "$testblocks BEGIN { die; }",
+ qr/\Abegin\nDied[^\n]*\.\nBEGIN
failed[^\n]*\.\nunitcheck\ncheck\nend\z/,
+ {},
+ "BEGIN{die} should exit"
+ );
+
+ fresh_perl_is(
+ "$testblocks UNITCHECK { exit 1; }",
+ "begin\nunitcheck\ncheck\nend",
+ {},
+ "UNITCHECK{exit 1} should exit"
+ );
+
+ fresh_perl_like(
+ "$testblocks UNITCHECK { die; }",
+ qr/\Abegin\nDied[^\n]*\.\nUNITCHECK
failed[^\n]*\.\nunitcheck\ncheck\nend\z/,
+ {},
+ "UNITCHECK{die} should exit"
+ );
+
+
+ fresh_perl_is(
+ "$testblocks CHECK { exit 1; }",
+ "begin\nunitcheck\ncheck\nend",
+ {},
+ "CHECK{exit 1} should exit"
+ );
+
+ fresh_perl_like(
+ "$testblocks CHECK { die; }",
+ qr/\Abegin\nunitcheck\nDied[^\n]*\.\nCHECK
failed[^\n]*\.\ncheck\nend\z/,
+ {},
+ "CHECK{die} should exit"
+ );
}
-fresh_perl_is("$testblocks CHECK { exit 1; }", "begin\nunitcheck\ncheck\nend",
{}, "CHECK{exit 1} should exit");
-fresh_perl_like("$testblocks CHECK { die; }",
qr/\Abegin\nunitcheck\nDied[^\n]*\.\nCHECK failed[^\n]*\.\ncheck\nend\z/, {},
"CHECK{die} should exit");
-fresh_perl_is("$testblocks INIT { exit 0; }",
"begin\nunitcheck\ncheck\ninit\nend", {}, "INIT{exit 0} should exit");
-fresh_perl_is("$testblocks INIT { exit 1; }",
"begin\nunitcheck\ncheck\ninit\nend", {}, "INIT{exit 1} should exit");
-fresh_perl_like("$testblocks INIT { die; }",
qr/\Abegin\nunitcheck\ncheck\ninit\nDied[^\n]*\.\nINIT failed[^\n]*\.\nend\z/,
{}, "INIT{die} should exit");
+fresh_perl_is(
+ "$testblocks INIT { exit 0; }",
+ "begin\nunitcheck\ncheck\ninit\nend",
+ {},
+ "INIT{exit 0} should exit"
+);
+
+fresh_perl_is(
+ "$testblocks INIT { exit 1; }",
+ "begin\nunitcheck\ncheck\ninit\nend",
+ {},
+ "INIT{exit 1} should exit"
+);
+
+fresh_perl_like(
+ "$testblocks INIT { die; }",
+ qr/\Abegin\nunitcheck\ncheck\ninit\nDied[^\n]*\.\nINIT
failed[^\n]*\.\nend\z/,
+ {},
+ "INIT{die} should exit"
+);
TODO: {
local $TODO = 'RT #2917: INIT{} in eval is wrongly considered too late';
diff --git a/win32/perllib.c b/win32/perllib.c
index 25b20156ec..246f67aa1a 100644
--- a/win32/perllib.c
+++ b/win32/perllib.c
@@ -230,7 +230,6 @@ RunPerl(int argc, char **argv, char **env)
if (!(my_perl = perl_alloc()))
return (1);
perl_construct(my_perl);
- PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
PL_perl_destruct_level = 0;
/* PERL_SYS_INIT() may update the environment, e.g. via ansify_path().
--
Perl5 Master Repository
