Skip to content

Commit

Permalink
Fix spurious warnings with colonpaired longnames
Browse files Browse the repository at this point in the history
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.
  • Loading branch information
zoffixznet committed Jan 11, 2018
1 parent d93f805 commit c6b7012
Show file tree
Hide file tree
Showing 2 changed files with 21 additions and 12 deletions.
25 changes: 14 additions & 11 deletions src/Perl6/World.nqp
Expand Up @@ -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);
Expand Down Expand Up @@ -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;
Expand Down
8 changes: 7 additions & 1 deletion t/05-messages/10-warnings.t
Expand Up @@ -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;
Expand Down Expand Up @@ -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

0 comments on commit c6b7012

Please sign in to comment.