FAQ
In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/aea0412a260d9d7295c0a5bebb8bb6978dc02ccd?hp=4caf7d8c4666d39b6b752a52ec5e19d9504f5f31>

- Log -----------------------------------------------------------------
commit aea0412a260d9d7295c0a5bebb8bb6978dc02ccd
Author: David Mitchell <davem@iabyn.com>
Date: Mon Mar 28 15:36:42 2016 +0100

     RT #127786: assertion failure with eval in DB pkg.

     Normally a cloned anon sud has a NULL CvOUTSIDE(), unless that
     sub can contain code that will do an eval.
     However, calling eval from within the DB package pretends that the eval
     was done in the caller's scope. which then trips up on the NULL
     CvOUTSIDE().

     ts)

M op.c
M t/op/eval.t

commit daeb874b6b0d9720a5b3cffd11054bd7d7678888
Author: David Mitchell <davem@iabyn.com>
Date: Mon Mar 28 09:59:10 2016 +0100

     re_exec_indentf,re_indentf: silence warnings

     Pass the right types to printf.

     For re_exec_indentf(), really the type of the depth arg should be changed
     so that it and the depth var are consistent throughout regexec.c, but
     that's probably something for post-5.24.

M regcomp.c
M regexec.c

commit 9d9905599cad5eeb33b2a64c023b97005694fbcd
Author: David Mitchell <davem@iabyn.com>
Date: Mon Mar 28 10:52:18 2016 +0100

     silence -Wparentheses-equality

     Clang has taken it upon itself to warn when an equality is wrapped in
     double parentheses, e.g.

         ((foo == bar))

     Which is a bit dumb, as any code along the lines of

         #define isBAR (foo == BAR)
         if (isBAR) {}

     will trigger the warning.

     This commit shuts clang up by putting in a harmless cast:

         #define isBAR cBOOL(foo == BAR)

M cop.h
M perl.h
M regcomp.h
M regen/warnings.pl
M warnings.h
-----------------------------------------------------------------------

Summary of changes:
  cop.h | 4 ++--
  op.c | 8 +++++++-
  perl.h | 2 +-
  regcomp.c | 2 +-
  regcomp.h | 2 +-
  regen/warnings.pl | 4 ++--
  regexec.c | 4 ++--
  t/op/eval.t | 14 +++++++++++++-
  warnings.h | 4 ++--
  9 files changed, 31 insertions(+), 13 deletions(-)

diff --git a/cop.h b/cop.h
index dfb4a00..1795dc3 100644
--- a/cop.h
+++ b/cop.h
@@ -1055,8 +1055,8 @@ typedef struct stackinfo PERL_SI;
   } \
      } STMT_END

-#define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
-#define IN_PERL_RUNTIME (PL_curcop != &PL_compiling)
+#define IN_PERL_COMPILETIME cBOOL(PL_curcop == &PL_compiling)
+#define IN_PERL_RUNTIME cBOOL(PL_curcop != &PL_compiling)



diff --git a/op.c b/op.c
index b1c480b..e58f711 100644
--- a/op.c
+++ b/op.c
@@ -2622,7 +2622,13 @@ S_mark_padname_lvalue(pTHX_ PADNAME *pn)
      PadnameLVALUE_on(pn);
      while (PadnameOUTER(pn) && PARENT_PAD_INDEX(pn)) {
   cv = CvOUTSIDE(cv);
- assert(cv);
+ /* RT #127786: cv can be NULL due to an eval within the DB package
+ * called from an anon sub - anon subs don't have CvOUTSIDE() set
+ * unless they contain an eval, but calling eval within DB
+ * pretends the eval was done in the caller's scope.
+ */
+ if (!cv)
+ break;
   assert(CvPADLIST(cv));
   pn =
      PadlistNAMESARRAY(CvPADLIST(cv))[PARENT_PAD_INDEX(pn)];
diff --git a/perl.h b/perl.h
index 2ee79c4..0468a1c 100644
--- a/perl.h
+++ b/perl.h
@@ -5275,7 +5275,7 @@ EXTCONST char *const PL_phase_names[];
  /* Do not use this macro. It only exists for extensions that rely on PL_dirty
   * instead of using the newer PL_phase, which provides everything PL_dirty
   * provided, and more. */
-# define PL_dirty (PL_phase == PERL_PHASE_DESTRUCT)
+# define PL_dirty cBOOL(PL_phase == PERL_PHASE_DESTRUCT)

  # define PL_amagic_generation PL_na
  #endif /* !PERL_CORE */
diff --git a/regcomp.c b/regcomp.c
index 2f46a24..63f6e9e 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -933,7 +933,7 @@ Perl_re_indentf(pTHX_ const char *fmt, U32 depth, ...)
      PerlIO *f= Perl_debug_log;
      PERL_ARGS_ASSERT_RE_INDENTF;
      va_start(ap, depth);
- PerlIO_printf(f, "%*s", ( depth % 20 ) * 2, "");
+ PerlIO_printf(f, "%*s", ( (int)depth % 20 ) * 2, "");
      result = PerlIO_vprintf(f, fmt, ap);
      va_end(ap);
      return result;
diff --git a/regcomp.h b/regcomp.h
index c2e44aa..a8842a1 100644
--- a/regcomp.h
+++ b/regcomp.h
@@ -368,7 +368,7 @@ struct regnode_ssc {

  #define REG_MAGIC 0234

-#define SIZE_ONLY (RExC_emit == (regnode *) & RExC_emit_dummy)
+#define SIZE_ONLY cBOOL(RExC_emit == (regnode *) & RExC_emit_dummy)
  #define PASS1 SIZE_ONLY
  #define PASS2 (! SIZE_ONLY)

diff --git a/regen/warnings.pl b/regen/warnings.pl
index d81a078..22c9c15 100644
--- a/regen/warnings.pl
+++ b/regen/warnings.pl
@@ -358,8 +358,8 @@ EOM

    print $warn <<'EOM';

-#define isLEXWARN_on (PL_curcop->cop_warnings != pWARN_STD)
-#define isLEXWARN_off (PL_curcop->cop_warnings == pWARN_STD)
+#define isLEXWARN_on cBOOL(PL_curcop->cop_warnings != pWARN_STD)
+#define isLEXWARN_off cBOOL(PL_curcop->cop_warnings == pWARN_STD)
  #define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE))
  #define isWARN_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)))
  #define isWARNf_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)+1))
diff --git a/regexec.c b/regexec.c
index f2e0164..29429b2 100644
--- a/regexec.c
+++ b/regexec.c
@@ -3640,7 +3640,7 @@ S_regtry(pTHX_ regmatch_info *reginfo, char **startposp)
     messages are inline with the regop output that created them.
  */
  #define REPORT_CODE_OFF 29
-#define INDENT_CHARS(depth) ((depth) % 20)
+#define INDENT_CHARS(depth) ((int)(depth) % 20)
  #ifdef DEBUGGING
  int
  Perl_re_exec_indentf(pTHX_ const char *fmt, U32 depth, ...)
@@ -3650,7 +3650,7 @@ Perl_re_exec_indentf(pTHX_ const char *fmt, U32 depth, ...)
      PerlIO *f= Perl_debug_log;
      PERL_ARGS_ASSERT_RE_EXEC_INDENTF;
      va_start(ap, depth);
- PerlIO_printf(f, "%*s|%4d| %*s", REPORT_CODE_OFF, "", depth, INDENT_CHARS(depth), "" );
+ PerlIO_printf(f, "%*s|%4"UVuf"| %*s", REPORT_CODE_OFF, "", (UV)depth, INDENT_CHARS(depth), "" );
      result = PerlIO_vprintf(f, fmt, ap);
      va_end(ap);
      return result;
diff --git a/t/op/eval.t b/t/op/eval.t
index 14f9565..7b9fb17 100644
--- a/t/op/eval.t
+++ b/t/op/eval.t
@@ -6,7 +6,7 @@ BEGIN {
      set_up_inc('../lib');
  }

-plan(tests => 133);
+plan(tests => 134);

  eval 'pass();';

@@ -653,3 +653,15 @@ pass("eval in freed package does not crash");
      eval q{$@ = 2};
      ok(!$@, 'eval clearing $@');
  }
+
+# RT #127786
+# this used to give an assertion failure
+
+{
+ package DB {
+ sub f127786 { eval q/\$s/ }
+ }
+ my $s;
+ sub { $s; DB::f127786}->();
+ pass("RT #127786");
+}
diff --git a/warnings.h b/warnings.h
index 4ab2d1d..337bef3 100644
--- a/warnings.h
+++ b/warnings.h
@@ -115,8 +115,8 @@
  #define WARN_ALLstring "\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125"
  #define WARN_NONEstring "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"

-#define isLEXWARN_on (PL_curcop->cop_warnings != pWARN_STD)
-#define isLEXWARN_off (PL_curcop->cop_warnings == pWARN_STD)
+#define isLEXWARN_on cBOOL(PL_curcop->cop_warnings != pWARN_STD)
+#define isLEXWARN_off cBOOL(PL_curcop->cop_warnings == pWARN_STD)
  #define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE))
  #define isWARN_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)))
  #define isWARNf_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)+1))

--
Perl5 Master Repository

Search Discussions

Related Discussions

Discussion Navigation
viewthread | post
Discussion Overview
groupperl5-changes @
categoriesperl
postedMar 28, '16 at 2:55p
activeMar 28, '16 at 2:55p
posts1
users1
websiteperl.org

1 user in discussion

Dave Mitchell: 1 post

People

Translate

site design / logo © 2018 Grokbase