From bb1b5f3a563814005aa08f9d278e5aa81471b502 Mon Sep 17 00:00:00 2001
From: =?utf8?q?Sven=20Sch=C3=B6ling?= <s.schoeling@linet-services.de>
Date: Tue, 17 Oct 2017 14:38:45 +0200
Subject: [PATCH] =?utf8?q?Test=20f=C3=BCr=20"$foo::$bar"=20Parsinguntersch?=
 =?utf8?q?iede?=
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

Seieh https://rt.perl.org/Public/Bug/Display.html?id=128478
---
 t/structure/double_colon_interpolation.t | 57 ++++++++++++++++++++++++
 1 file changed, 57 insertions(+)
 create mode 100644 t/structure/double_colon_interpolation.t

diff --git a/t/structure/double_colon_interpolation.t b/t/structure/double_colon_interpolation.t
new file mode 100644
index 000000000..2b0dce0fb
--- /dev/null
+++ b/t/structure/double_colon_interpolation.t
@@ -0,0 +1,57 @@
+use strict;
+use threads;
+use lib 't';
+use Support::Files;
+use Sys::CPU;
+use Test::More;
+use Thread::Pool::Simple;
+
+if (eval { require PPI; 1 }) {
+  plan tests => scalar(@Support::Files::testitems);
+} else {
+  plan skip_all => "PPI not installed";
+}
+
+my @testitems = @Support::Files::testitems;
+
+sub test_file {
+  my ($file) = @_;
+
+  my $clean = 1;
+  my $source;
+  {
+    local $^W = 0; # don't care about invalid chars in comments
+    local $/ = undef;
+    open my $fh, '<:utf8', $file or die $!;
+    $source = <$fh>;
+  }
+
+  my $doc = PPI::Document->new(\$source) or do {
+    print "?: PPI error for file $file: " . PPI::Document::errstr() . "\n";
+    ok 0, $file;
+    next;
+  };
+  my $stmts = $doc->find(sub { $_[1]->isa('PPI::Token::Quote::Double') || $_[1]->isa('PPI::Token::Quote::Interpolate') });
+
+  for my $stmt (@{ $stmts || [] }) {
+    my $content = $stmt->content;
+
+    if ($content =~ /(\$\w+::)\$/) {
+      print "?: @{[ $stmt->content ]} contains $1 \n";
+      $clean = 0;
+    }
+  }
+
+  ok $clean, $file;
+}
+
+my $pool = Thread::Pool::Simple->new(
+  min    => 2,
+  max    => Sys::CPU::cpu_count() + 1,
+  do     => [ \&test_file ],
+  passid => 0,
+);
+
+$pool->add($_) for @testitems;
+
+$pool->join;
-- 
2.20.1