From c6b7012a9c61133a7d2f9334453128dff30d1e5a Mon Sep 17 00:00:00 2001
From: Zoffix Znet <cpan@zoffix.com>
Date: Wed, 10 Jan 2018 20:21:20 -0500
Subject: [PATCH] Fix spurious warnings with colonpaired longnames
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Fixes RT#131305: https://rt.perl.org/Ticket/Display.html?id=131305

With a simple colonpair, like `infix:<+>` we have the value right
away and don't get warnings, but with things like `postfix:<[ ]>`
the value has a complex value that we compile-time compile when
figuring out what to stringify it into. When we NOT compiling core
setting, we evidently use the same machinery that makes
and—importantly—installs blocks/thunks. So with a `:<[ ]>` colonpair
in a longname, we ended up installing the Stmts with a List with two
`[` and `]` strings in it. The List was in sink context and it's that
List that was causing the spurious warnings seen in the ticket.

Fix by adding a :$no-install param to the block-making machinery and
setting it to true when compiling longname colonpairs, to avoid
installation of things we don't need.
---
 src/Perl6/World.nqp         | 25 ++++++++++++++-----------
 t/05-messages/10-warnings.t |  8 +++++++-
 2 files changed, 21 insertions(+), 12 deletions(-)

diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp
index 757627bf40d..3b0db588aee 100644
--- a/src/Perl6/World.nqp
+++ b/src/Perl6/World.nqp
@@ -2147,27 +2147,29 @@ class Perl6::World is HLL::World {
         $signature
     }
 
-    method compile_time_evaluate($/, $ast) {
+    method compile_time_evaluate($/, $ast, :$no-install) {
         return $ast.compile_time_value if $ast.has_compile_time_value;
-        my $thunk := self.create_thunk($/, $ast);
+        my $thunk := self.create_thunk($/, $ast, :$no-install);
         $thunk();
     }
 
     # Turn a QAST tree into a code object, to be called immediately.
-    method create_thunk($/, $to_thunk) {
+    method create_thunk($/, $to_thunk, :$no-install) {
         my $block := self.push_lexpad($/);
         $block.push($to_thunk);
         self.pop_lexpad();
-        self.create_simple_code_object($block, 'Code');
+        self.create_simple_code_object($block, 'Code', :$no-install);
     }
 
     # Creates a simple code object with an empty signature
-    method create_simple_code_object($block, $type) {
-        if $*WANTEDOUTERBLOCK {
-            $*WANTEDOUTERBLOCK[0].push($block);
-        }
-        else {
-            self.cur_lexpad()[0].push($block);
+    method create_simple_code_object($block, $type, :$no-install) {
+        unless $no-install {
+            if $*WANTEDOUTERBLOCK {
+                $*WANTEDOUTERBLOCK[0].push($block);
+            }
+            else {
+                self.cur_lexpad()[0].push($block);
+            }
         }
         my $sig := self.create_signature(nqp::hash('parameter_objects', []));
         return self.create_code_object($block, $type, $sig);
@@ -4291,7 +4293,8 @@ class Perl6::World is HLL::World {
                     }
                     else {
                         # Safe to evaluate it directly; no bootstrap issues.
-                        $cp_str := self.canonicalize_pair('',self.compile_time_evaluate($_, $_.ast));
+                        $cp_str := self.canonicalize_pair('',self.compile_time_evaluate:
+                          $_, $_.ast, :no-install);
                     }
                     if +@components {
                         @components[+@components - 1] := @components[+@components - 1] ~ $cp_str;
diff --git a/t/05-messages/10-warnings.t b/t/05-messages/10-warnings.t
index 984fde92d4a..520e7cacbbb 100644
--- a/t/05-messages/10-warnings.t
+++ b/t/05-messages/10-warnings.t
@@ -2,7 +2,7 @@ use lib <t/packages/>;
 use Test;
 use Test::Helpers;
 
-plan 3;
+plan 4;
 
 subtest 'Supply.interval with negative value warns' => {
     plan 2;
@@ -61,4 +61,10 @@ else {
     }
 }
 
+# RT #131305
+is-run ｢
+    sub prefix:<ᔑ> (Pair $p --> Pair) is tighter(&postcircumfix:<[ ]>) {};
+    print postcircumfix:<[ ]>(<foo bar ber>, 1)
+｣, :out<bar>, 'no spurious warnings when invoking colonpaired routine';
+
 # vim: ft=perl6 expandtab sw=4