[PATCH] Add -DO option to disable optimizations and disable constant folding and the peephole optimizer when used. #11606
Comments
From gerard@ggoossen.netThis is a bug report for perl from gerard@ggoossen.net, From aa47563c38380baa2e72acca68124d8b796a4b9e Mon Sep 17 00:00:00 2001 Running the tests with PERL5OPT_TEST=-DOq reveals the following op.c | 4 ++++ Inline Patchdiff --git a/op.c b/op.c
index 73dccf8..c292b7b 100644
--- a/op.c
+++ b/op.c
@@ -2948,6 +2948,8 @@ S_fold_constants(pTHX_ register OP *o)
break;
}
+ DEBUG_O( goto nope );
+
if (PL_parser && PL_parser->error_count)
goto nope; /* Don't try to run w/ errors */
@@ -9726,6 +9728,8 @@ Perl_rpeep(pTHX_ register OP *o)
int defer_base = 0;
int defer_ix = -1;
+ DEBUG_O( return );
+
if (!o || o->op_opt)
return;
ENTER;
diff --git a/perl.c b/perl.c
index 9ebb3d2..a5bbf41 100644
--- a/perl.c
+++ b/perl.c
@@ -2949,7 +2949,8 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
" A Consistency checks on internal structures\n"
" q quiet - currently only suppresses the 'EXECUTING' message\n"
" M trace smart match resolution\n"
- " B dump suBroutine definitions, including special Blocks like BEGIN\n",
+ " B dump suBroutine definitions, including special Blocks like BEGIN\n"
+ " O Disable optimizations\n",
NULL
};
int i = 0;
@@ -2958,7 +2959,7 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
if (isALPHA(**s)) {
/* if adding extra options, remember to update DEBUG_MASK */
- static const char debopts[] = "psltocPmfrxuUHXDSTRJvCAqMB";
+ static const char debopts[] = "psltocPmfrxuUHXDSTRJvCAqMBO";
for (; isALNUM(**s); (*s)++) {
const char * const d = strchr(debopts,**s);
diff --git a/perl.h b/perl.h
index 30bee51..86e0b96 100644
--- a/perl.h
+++ b/perl.h
@@ -3675,7 +3675,8 @@ Gid_t getegid (void);
#define DEBUG_q_FLAG 0x00800000 /*8388608 */
#define DEBUG_M_FLAG 0x01000000 /*16777216*/
#define DEBUG_B_FLAG 0x02000000 /*33554432*/
-#define DEBUG_MASK 0x03FEEFFF /* mask of all the standard flags */
+#define DEBUG_O_FLAG 0x04000000 /*67108864*/
+#define DEBUG_MASK 0x07FEEFFF /* mask of all the standard flags */
#define DEBUG_DB_RECURSE_FLAG 0x40000000
#define DEBUG_TOP_FLAG 0x80000000 /* XXX what's this for ??? Signal
@@ -3706,6 +3707,7 @@ Gid_t getegid (void);
# define DEBUG_q_TEST_ (PL_debug & DEBUG_q_FLAG)
# define DEBUG_M_TEST_ (PL_debug & DEBUG_M_FLAG)
# define DEBUG_B_TEST_ (PL_debug & DEBUG_B_FLAG)
+# define DEBUG_O_TEST_ (PL_debug & DEBUG_O_FLAG)
# define DEBUG_Xv_TEST_ (DEBUG_X_TEST_ && DEBUG_v_TEST_)
# define DEBUG_Uv_TEST_ (DEBUG_U_TEST_ && DEBUG_v_TEST_)
# define DEBUG_Pv_TEST_ (DEBUG_P_TEST_ && DEBUG_v_TEST_)
@@ -3737,6 +3739,7 @@ Gid_t getegid (void);
# define DEBUG_q_TEST DEBUG_q_TEST_
# define DEBUG_M_TEST DEBUG_M_TEST_
# define DEBUG_B_TEST DEBUG_B_TEST_
+# define DEBUG_O_TEST DEBUG_O_TEST_
# define DEBUG_Xv_TEST DEBUG_Xv_TEST_
# define DEBUG_Uv_TEST DEBUG_Uv_TEST_
# define DEBUG_Pv_TEST DEBUG_Pv_TEST_
@@ -3787,6 +3790,7 @@ Gid_t getegid (void);
# define DEBUG_q(a) DEBUG__(DEBUG_q_TEST, a)
# define DEBUG_M(a) DEBUG__(DEBUG_M_TEST, a)
# define DEBUG_B(a) DEBUG__(DEBUG_B_TEST, a)
+# define DEBUG_O(a) DEBUG__(DEBUG_O_TEST, a)
#else /* DEBUGGING */
@@ -3815,6 +3819,7 @@ Gid_t getegid (void);
# define DEBUG_q_TEST (0)
# define DEBUG_M_TEST (0)
# define DEBUG_B_TEST (0)
+# define DEBUG_O_TEST (0)
# define DEBUG_Xv_TEST (0)
# define DEBUG_Uv_TEST (0)
# define DEBUG_Pv_TEST (0)
@@ -3845,6 +3850,7 @@ Gid_t getegid (void);
# define DEBUG_q(a)
# define DEBUG_M(a)
# define DEBUG_B(a)
+# define DEBUG_O(a)
# define DEBUG_Xv(a)
# define DEBUG_Uv(a)
# define DEBUG_Pv(a)
diff --git a/pod/perlrun.pod b/pod/perlrun.pod
index 22f50cc..d257d71 100644
--- a/pod/perlrun.pod
+++ b/pod/perlrun.pod
@@ -412,6 +412,7 @@ B<-D14> is equivalent to B<-Dtls>):
16777216 M trace smart match resolution
33554432 B dump suBroutine definitions, including special Blocks
like BEGIN
+ 67108864 O Disable optimizations
All these flags require B<-DDEBUGGING> when you compile the Perl
executable (but see C<:opd> in L<Devel::Peek> or L<re/'debug' mode>
--
Flags: Site configuration information for perl 5.15.2: Configured by gerard at Sun Aug 28 16:17:23 CEST 2011. Summary of my perl5 (revision 5 version 15 subversion 2) configuration: Locally applied patches: @INC for perl 5.15.2: Environment for perl 5.15.2: |
From @cpansproutOn Sun Aug 28 07:48:48 2011, ggoossen wrote:
If it still has problems, do we really want to apply it yet? |
|
The RT System itself - Status changed from 'new' to 'open' |
From @obraOn Sun, Aug 28, 2011 at 06:12:25PM -0700, Father Chrysostomos via RT wrote:
I'd certainly prefer that we not apply such patches to blead. -- |
|
@cpansprout - Status changed from 'open' to 'rejected' |
|
@cpansprout - Status changed from 'rejected' to 'open' |
From @cpansproutI’m reopening this, as Gerard is actively working on fixing the issues. |
From @cpansproutOn Sun Aug 28 07:48:48 2011, ggoossen wrote:
I tried applying this patch again, but it still causes test failures -- Father Chrysostomos |
From @nthykierHi, Some of these failures are caused by the mere presence of "-D" or "-Dq" I also rebased the original patch against the current blead. ~Niels |
From @nthykier0001-Add-DO-option-to-disable-optimizations-and-disable-c.patchFrom eb119268bed14aedc648d1ffde8453885ddc8c4f Mon Sep 17 00:00:00 2001
From: Gerard Goossen <gerard@ggoossen.net>
Date: Sat, 27 Aug 2011 16:48:38 +0200
Subject: [PATCH] Add -DO option to disable optimizations and disable constant
folding and the peephole optimizer when used.
Running the tests with PERL5OPT_TEST=-DOq reveals the following
problems:
- overloaded <> causes strange error
- deref type detection in derefed lvalue subs goes wrong.
- constant expressions produce modifiable temporaries instead of
read-only constants
- for (revert @a) does no longer alias the elements of @a
- warnings about uninitialized values miss some variable names
- limits $[ assignments which are possible
- problem with line numbers in coresubs errors
---
op.c | 4 ++++
perl.c | 5 +++--
perl.h | 8 +++++++-
pod/perlrun.pod | 1 +
4 files changed, 15 insertions(+), 3 deletions(-)
diff --git a/op.c b/op.c
index d5323a0..6822f5c 100644
--- a/op.c
+++ b/op.c
@@ -3259,6 +3259,8 @@ S_fold_constants(pTHX_ OP *o)
if (o->op_private & OPpREPEAT_DOLIST) goto nope;
}
+ DEBUG_O( goto nope );
+
if (PL_parser && PL_parser->error_count)
goto nope; /* Don't try to run w/ errors */
@@ -10846,6 +10848,8 @@ Perl_rpeep(pTHX_ OP *o)
int defer_base = 0;
int defer_ix = -1;
+ DEBUG_O( return );
+
if (!o || o->op_opt)
return;
ENTER;
diff --git a/perl.c b/perl.c
index ee36fd1..b6145e5 100644
--- a/perl.c
+++ b/perl.c
@@ -3115,7 +3115,8 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
" A Consistency checks on internal structures\n"
" q quiet - currently only suppresses the 'EXECUTING' message\n"
" M trace smart match resolution\n"
- " B dump suBroutine definitions, including special Blocks like BEGIN\n",
+ " B dump suBroutine definitions, including special Blocks like BEGIN\n"
+ " O Disable optimizations\n",
NULL
};
int i = 0;
@@ -3124,7 +3125,7 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
if (isALPHA(**s)) {
/* if adding extra options, remember to update DEBUG_MASK */
- static const char debopts[] = "psltocPmfrxuUHXDSTRJvCAqMB";
+ static const char debopts[] = "psltocPmfrxuUHXDSTRJvCAqMBO";
for (; isWORDCHAR(**s); (*s)++) {
const char * const d = strchr(debopts,**s);
diff --git a/perl.h b/perl.h
index cfcf871..8a7055d 100644
--- a/perl.h
+++ b/perl.h
@@ -3543,7 +3543,8 @@ Gid_t getegid (void);
#define DEBUG_q_FLAG 0x00800000 /*8388608 */
#define DEBUG_M_FLAG 0x01000000 /*16777216*/
#define DEBUG_B_FLAG 0x02000000 /*33554432*/
-#define DEBUG_MASK 0x03FFEFFF /* mask of all the standard flags */
+#define DEBUG_O_FLAG 0x04000000 /*67108864*/
+#define DEBUG_MASK 0x07FFEFFF /* mask of all the standard flags */
#define DEBUG_DB_RECURSE_FLAG 0x40000000
#define DEBUG_TOP_FLAG 0x80000000 /* XXX what's this for ??? Signal
@@ -3575,6 +3576,7 @@ Gid_t getegid (void);
# define DEBUG_q_TEST_ (PL_debug & DEBUG_q_FLAG)
# define DEBUG_M_TEST_ (PL_debug & DEBUG_M_FLAG)
# define DEBUG_B_TEST_ (PL_debug & DEBUG_B_FLAG)
+# define DEBUG_O_TEST_ (PL_debug & DEBUG_O_FLAG)
# define DEBUG_Xv_TEST_ (DEBUG_X_TEST_ && DEBUG_v_TEST_)
# define DEBUG_Uv_TEST_ (DEBUG_U_TEST_ && DEBUG_v_TEST_)
# define DEBUG_Pv_TEST_ (DEBUG_P_TEST_ && DEBUG_v_TEST_)
@@ -3607,6 +3609,7 @@ Gid_t getegid (void);
# define DEBUG_q_TEST DEBUG_q_TEST_
# define DEBUG_M_TEST DEBUG_M_TEST_
# define DEBUG_B_TEST DEBUG_B_TEST_
+# define DEBUG_O_TEST DEBUG_O_TEST_
# define DEBUG_Xv_TEST DEBUG_Xv_TEST_
# define DEBUG_Uv_TEST DEBUG_Uv_TEST_
# define DEBUG_Pv_TEST DEBUG_Pv_TEST_
@@ -3658,6 +3661,7 @@ Gid_t getegid (void);
# define DEBUG_q(a) DEBUG__(DEBUG_q_TEST, a)
# define DEBUG_M(a) DEBUG__(DEBUG_M_TEST, a)
# define DEBUG_B(a) DEBUG__(DEBUG_B_TEST, a)
+# define DEBUG_O(a) DEBUG__(DEBUG_O_TEST, a)
#else /* DEBUGGING */
@@ -3687,6 +3691,7 @@ Gid_t getegid (void);
# define DEBUG_q_TEST (0)
# define DEBUG_M_TEST (0)
# define DEBUG_B_TEST (0)
+# define DEBUG_O_TEST (0)
# define DEBUG_Xv_TEST (0)
# define DEBUG_Uv_TEST (0)
# define DEBUG_Pv_TEST (0)
@@ -3718,6 +3723,7 @@ Gid_t getegid (void);
# define DEBUG_q(a)
# define DEBUG_M(a)
# define DEBUG_B(a)
+# define DEBUG_O(a)
# define DEBUG_Xv(a)
# define DEBUG_Uv(a)
# define DEBUG_Pv(a)
diff --git a/pod/perlrun.pod b/pod/perlrun.pod
index 05dea4e..749eb23 100644
--- a/pod/perlrun.pod
+++ b/pod/perlrun.pod
@@ -414,6 +414,7 @@ B<-D14> is equivalent to B<-Dtls>):
16777216 M trace smart match resolution
33554432 B dump suBroutine definitions, including special Blocks
like BEGIN
+ 67108864 O Disable optimizations
All these flags require B<-DDEBUGGING> when you compile the Perl
executable (but see C<:opd> in L<Devel::Peek> or L<re/'debug' mode>
--
1.7.10.4
|
From @nthykierfix-test-failure-with-D-in-PERL5OPT.diffdiff --git a/t/op/split.t b/t/op/split.t
index 7e0008e..125840f 100644
--- a/t/op/split.t
+++ b/t/op/split.t
@@ -78,9 +78,18 @@ $_ = "1 2 3 4";
$_ = join(':', split);
is($_ , '1:2:3:4', "Split and join without specifying a split pattern");
-# Does assignment to a list imply split to one more field than that?
-$foo = runperl( switches => ['-Dt'], stderr => 1, prog => '($a,$b)=split;' );
-ok($foo =~ /DEBUGGING/ || $foo =~ /const\n?\Q(IV(3))\E/);
+{
+ my @env_Dopts;
+ if (exists $ENV{'PERL5OPT'}) {
+ while ($ENV{'PERL5OPT'} =~ s/-D([^ :]*)//) {
+ push @env_Dopts, "-D$1";
+ }
+ }
+
+ # Does assignment to a list imply split to one more field than that?
+ $foo = runperl( switches => [@env_Dopts, '-Dt'], stderr => 1, prog => '($a,$b)=split;' );
+ ok($foo =~ /DEBUGGING/ || $foo =~ /const\n?\Q(IV(3))\E/);
+}
# Can we say how many fields to split to when assigning to a list?
($a,$b) = split(' ','1 2 3 4 5 6', 2);
diff --git a/t/re/pat_re_eval.t b/t/re/pat_re_eval.t
index e47aaf3..0e9f86e 100644
--- a/t/re/pat_re_eval.t
+++ b/t/re/pat_re_eval.t
@@ -991,6 +991,12 @@ sub run_tests {
{
my $out;
+ my @env_Dopts;
+ if (exists $ENV{'PERL5OPT'}) {
+ while ($ENV{'PERL5OPT'} =~ s/-D([^ :]*)//) {
+ push @env_Dopts, "-D$1";
+ }
+ }
for my $prog (
'/(?{$a[0]})/',
'q() =~ qr/(?{$a[0]})/',
@@ -998,9 +1004,9 @@ sub run_tests {
'use re q(eval); $c = q{(?{$a[0]})}; /$c/',
'use re q(eval); $c = q{(?{$a[0]})}; /(?{1;})$c/',
) {
- $out = runperl(switches => ["-Dt"], prog => $prog, stderr => 1);
+ $out = runperl(switches => [@env_Dopts, "-Dt"], prog => $prog, stderr => 1);
like($out, qr/aelemfast|Recompile perl with -DDEBUGGING/,
- "optimise: '$prog'");
+ "optimise: '$prog' ... @env_Dopts");
}
}
diff --git a/t/re/recompile.t b/t/re/recompile.t
index 63a7068..dce07ad 100644
--- a/t/re/recompile.t
+++ b/t/re/recompile.t
@@ -24,6 +24,7 @@ BEGIN {
plan tests => 38;
+my @env_Dopts;
my $results = runperl(
switches => [ '-Dr' ],
prog => '1',
@@ -33,6 +34,11 @@ my $has_Dr = $results !~ /Recompile perl with -DDEBUGGING/;
my $tmpfile = tempfile();
+if ($has_Dr && exists $ENV{'PERL5OPT'}) {
+ while ($ENV{'PERL5OPT'} =~ s/-D([^ :]*)//) {
+ push @env_Dopts, "-D$1";
+ }
+}
# Check that a pattern triggers a regex compilation exactly N times,
# using either -Dr or 'use re debug'
@@ -42,7 +48,7 @@ sub _comp_n {
my ($use_Dr, $n, $prog, $desc) = @_;
open my $tf, ">$tmpfile" or die "Cannot open $tmpfile: $!";
- my $switches = [];
+ my $switches = [@env_Dopts];
if ($use_Dr) {
push @$switches, '-Dr';
}
|
From @cpansproutOn Thu Jul 18 07:01:20 2013, niels@thykier.net wrote:
Thank you. Why does adding -DO to the runperl command line make things pass in the -- Father Chrysostomos |
From @nthykier
To be honest, I have no clue why the tests breaks with containing -D ~Niels |
Migrated from rt.perl.org#97942 (status was 'open')
Searchable as RT97942$
The text was updated successfully, but these errors were encountered: