From: Vincent Pit <vince@profvince.com>
Date: Mon, 16 Aug 2010 14:38:45 +0000 (+0200)
Subject: Get rid of the linestr check
X-Git-Tag: v0.22~3
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Findirect.git;a=commitdiff_plain;h=ce2df2b3143e49d1d1531f6f76e270b973dffad2

Get rid of the linestr check

It simplifies the code, remove some potential breakage if the linestr
changes inside an indirect expression, and allows for reporting indirect
constructs in quotelike environments.
---

diff --git a/indirect.xs b/indirect.xs
index 4ce10e5..7f234a0 100644
--- a/indirect.xs
+++ b/indirect.xs
@@ -62,12 +62,6 @@
 #define I_HAS_PERL(R, V, S) (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))
 
 #if I_HAS_PERL(5, 10, 0) || defined(PL_parser)
-# ifndef PL_lex_inwhat
-#  define PL_lex_inwhat PL_parser->lex_inwhat
-# endif
-# ifndef PL_linestr
-#  define PL_linestr PL_parser->linestr
-# endif
 # ifndef PL_bufptr
 #  define PL_bufptr PL_parser->bufptr
 # endif
@@ -75,12 +69,6 @@
 #  define PL_oldbufptr PL_parser->oldbufptr
 # endif
 #else
-# ifndef PL_lex_inwhat
-#  define PL_lex_inwhat PL_Ilex_inwhat
-# endif
-# ifndef PL_linestr
-#  define PL_linestr PL_Ilinestr
-# endif
 # ifndef PL_bufptr
 #  define PL_bufptr PL_Ibufptr
 # endif
@@ -212,11 +200,10 @@ typedef struct {
 
 typedef struct {
 #if I_THREADSAFE
- ptable     *tbl; /* It really is a ptable_hints */
- tTHX        owner;
+ ptable *tbl; /* It really is a ptable_hints */
+ tTHX    owner;
 #endif
- ptable     *map;
- const char *linestr;
+ ptable *map;
 } my_cxt_t;
 
 START_MY_CXT
@@ -422,18 +409,6 @@ STATIC void indirect_map_store(pTHX_ const OP *o, const char *src, SV *sv, line_
  STRLEN len;
  dMY_CXT;
 
- /* When lex_inwhat is set, we're in a quotelike environment (qq, qr, but not q)
-  * In this case the linestr has temporarly changed, but the old buffer should
-  * still be alive somewhere. */
-
- if (!PL_lex_inwhat) {
-  const char *pl_linestr = SvPVX_const(PL_linestr);
-  if (MY_CXT.linestr != pl_linestr) {
-   ptable_clear(MY_CXT.map);
-   MY_CXT.linestr = pl_linestr;
-  }
- }
-
  if (!(oi = ptable_fetch(MY_CXT.map, o))) {
   Newx(oi, 1, indirect_op_info_t);
   ptable_store(MY_CXT.map, o, oi);
@@ -464,9 +439,6 @@ STATIC const indirect_op_info_t *indirect_map_fetch(pTHX_ const OP *o) {
 #define indirect_map_fetch(O) indirect_map_fetch(aTHX_ (O))
  dMY_CXT;
 
- if (MY_CXT.linestr != SvPVX_const(PL_linestr))
-  return NULL;
-
  return ptable_fetch(MY_CXT.map, o);
 }
 
@@ -827,11 +799,10 @@ STATIC void indirect_setup(pTHX) {
  {
   MY_CXT_INIT;
 #if I_THREADSAFE
-  MY_CXT.tbl     = ptable_new();
-  MY_CXT.owner   = aTHX;
+  MY_CXT.tbl   = ptable_new();
+  MY_CXT.owner = aTHX;
 #endif
-  MY_CXT.map     = ptable_new();
-  MY_CXT.linestr = NULL;
+  MY_CXT.map   = ptable_new();
  }
 
  indirect_old_ck_const    = PL_check[OP_CONST];
@@ -899,10 +870,9 @@ PPCODE:
  }
  {
   MY_CXT_CLONE;
-  MY_CXT.map     = ptable_new();
-  MY_CXT.linestr = NULL;
-  MY_CXT.tbl     = t;
-  MY_CXT.owner   = aTHX;
+  MY_CXT.map   = ptable_new();
+  MY_CXT.tbl   = t;
+  MY_CXT.owner = aTHX;
  }
  reap(3, indirect_thread_cleanup, NULL);
  XSRETURN(0);
diff --git a/t/20-good.t b/t/20-good.t
index f883537..12a4a76 100644
--- a/t/20-good.t
+++ b/t/20-good.t
@@ -9,7 +9,7 @@ package main;
 use strict;
 use warnings;
 
-use Test::More tests => 80 * 8;
+use Test::More tests => 74 * 8;
 
 BEGIN { delete $ENV{PERL_INDIRECT_PM_DISABLE} }
 
@@ -241,18 +241,6 @@ $obj = "apple ${\($y->$meth)} pear"
 ####
 $obj = "apple @{[$y->$meth]} pear"
 ####
-$obj = "apple ${\(new Hlagh)} pear"
-####
-$obj = "apple @{[new Hlagh]} pear"
-####
-$obj = "apple ${\(new $x)} pear"
-####
-$obj = "apple @{[new $x]} pear"
-####
-$obj = "apple ${\(new $y)} pear"
-####
-$obj = "apple @{[new $y]} pear"
-####
 exec $x $x, @a;
 ####
 exec { $a[0] } @a;
diff --git a/t/21-bad.t b/t/21-bad.t
index f4231d7..09157e9 100644
--- a/t/21-bad.t
+++ b/t/21-bad.t
@@ -11,8 +11,8 @@ use warnings;
 
 my ($tests, $reports);
 BEGIN {
- $tests   = 61;
- $reports = 69;
+ $tests   = 70;
+ $reports = 82;
 }
 
 use Test::More tests => 3 * (4 * $tests + $reports) + 4;
@@ -98,7 +98,10 @@ SKIP:
     }
    }
 
+SKIP:
    {
+    skip 'No space tests on perl 5.11' => 4 + @expected
+                                                  if $] >= 5.011 and $] < 5.012;
     my $code = $code;
     $code =~ s/\$/\$ \n\t /g;
 
@@ -368,6 +371,38 @@ Hlagh->new(meh $x)
 ----
 [ 'meh', '$x' ]
 ####
+$obj = "apple ${\(new Hlagh)} pear"
+----
+[ 'new', 'Hlagh' ]
+####
+$obj = "apple @{[new Hlagh]} pear"
+----
+[ 'new', 'Hlagh' ]
+####
+$obj = "apple ${\(new $x)} pear"
+----
+[ 'new', '$x' ]
+####
+$obj = "apple @{[new $x]} pear"
+----
+[ 'new', '$x' ]
+####
+$obj = "apple ${\(new $y)} pear"
+----
+[ 'new', '$y' ]
+####
+$obj = "apple @{[new $y]} pear"
+----
+[ 'new', '$y' ]
+####
+$obj = "apple ${\(new $x qq|${\(stuff $y)}|)} pear"
+----
+[ 'stuff', '$y' ], [ 'new', '$x' ]
+####
+$obj = "apple @{[new $x qq|@{[stuff $y]}|]} pear"
+----
+[ 'stuff', '$y' ], [ 'new', '$x' ]
+####
 meh { };
 ----
 [ 'meh', '{' ]
@@ -404,3 +439,7 @@ meh { feh $y; 1; };
 meh { feh $x; 1; } new Hlagh, feh $y;
 ----
 [ 'feh', '$x' ], [ 'new', 'Hlagh' ], [ 'feh', '$y' ], [ 'meh', '{' ]
+####
+$obj = "apple @{[new { feh $x; meh $y; 1 }]} pear"
+----
+[ 'feh', '$x' ], [ 'meh', '$y' ], [ 'new', '{' ]