From 3995e42354373de7c8ded3d723ca3118df50bc45 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 29 Oct 2018 22:11:23 +0100 Subject: [PATCH] Always conditionally add objects to the serialization context So we don't run the risk of having another case of R#2400. --- src/Perl6/Actions.nqp | 16 +++++++------- src/Perl6/Grammar.nqp | 2 +- src/Perl6/Optimizer.nqp | 4 ++-- src/Perl6/World.nqp | 46 ++++++++++++++++++++--------------------- 4 files changed, 34 insertions(+), 34 deletions(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index 98a161272e7..faf5140c90a 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -3202,7 +3202,7 @@ class Perl6::Actions is HLL::Actions does STDActions { :op, :name, :returns($*W.find_symbol(['Slang'])), QAST::Var.new( :name, :scope )); my $g := $/.slang_grammar($desigilname); - $*W.add_object($g); + $*W.add_object_if_no_sc($g); my $a := $/.slang_actions($desigilname); if !nqp::isnull($g) { my $wval := QAST::WVal.new( :value($g) ); @@ -3244,7 +3244,7 @@ class Perl6::Actions is HLL::Actions does STDActions { } if $name eq '$?LANG' { my $cursor := $/; - $*W.add_object($cursor); + $*W.add_object_if_no_sc($cursor); $past := QAST::WVal.new(:value($cursor)); } elsif $name eq '$?LINE' { @@ -3263,7 +3263,7 @@ class Perl6::Actions is HLL::Actions does STDActions { if $resources { $past := QAST::WVal.new( :value($resources) ); if nqp::isnull(nqp::getobjsc($resources)) { - $*W.add_object($resources); + $*W.add_object_if_no_sc($resources); } } else { @@ -5804,7 +5804,7 @@ class Perl6::Actions is HLL::Actions does STDActions { if $*NEGATE_VALUE { my $neg-op := $*W.find_symbol(['&prefix:<->']); $val := $neg-op($val); - $*W.add_object($val); + $*W.add_object_if_no_sc($val); } %*PARAM_INFO := $val.WHAT; @@ -8214,7 +8214,7 @@ class Perl6::Actions is HLL::Actions does STDActions { method version($/) { my $v := $*W.find_symbol(['Version']).new(~$); - $*W.add_object($v); + $*W.add_object_if_no_sc($v); make QAST::WVal.new( :value($v) ); } @@ -8932,7 +8932,7 @@ class Perl6::Actions is HLL::Actions does STDActions { my $past := $.ast.ann('past_block').pop; nqp::bindattr($quasi_ast, $ast_class, '$!past', $past); nqp::bindattr($quasi_ast, $ast_class, '$!Str', $/.Str()); - $*W.add_object($quasi_ast); + $*W.add_object_if_no_sc($quasi_ast); my $throwaway_block := QAST::Block.new(); my $quasi_context := block_closure( reference_to_code_object( @@ -10467,7 +10467,7 @@ class Perl6::QActions is HLL::Actions does STDActions { if $thisq.has_compile_time_value { try { my $result := $*W.find_symbol(['&val'])($thisq.compile_time_value); - $*W.add_object($result); + $*W.add_object_if_no_sc($result); nqp::push(@results, QAST::WVal.new(:value($result), :node($/))); CATCH { nqp::push(@results, $thisq) } @@ -10483,7 +10483,7 @@ class Perl6::QActions is HLL::Actions does STDActions { } elsif $qast.has_compile_time_value { # a single string that we can handle try { my $result := $*W.find_symbol(['&val'])($qast.compile_time_value); - $*W.add_object($result); + $*W.add_object_if_no_sc($result); $qast := QAST::WVal.new(:value($result)); CATCH { } diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index 37a0b7389c3..b3d8d2cd9cf 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -1447,7 +1447,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { my str $prematch := nqp::substr($orig, $from > 20 ?? $from - 20 !! 0, $from > 20 ?? 20 !! $from); my str $postmatch := nqp::substr($orig, $to, 20); my $label := $*W.find_symbol(['Label']).new( :name($*LABEL), :$line, :$prematch, :$postmatch ); - $*W.add_object($label); + $*W.add_object_if_no_sc($label); $*W.install_lexical_symbol($*W.cur_lexpad(), $*LABEL, $label); } } diff --git a/src/Perl6/Optimizer.nqp b/src/Perl6/Optimizer.nqp index 83e8c95a444..36aa983690d 100644 --- a/src/Perl6/Optimizer.nqp +++ b/src/Perl6/Optimizer.nqp @@ -1785,7 +1785,7 @@ class Perl6::Optimizer { } if $survived && self.constant_foldable_type($ret_value) { return $NULL if $!void_context && !$!in_declaration; - $*W.add_object($ret_value); + $*W.add_object_if_no_sc($ret_value); my $wval := QAST::WVal.new(:value($ret_value)); if $op.named { $wval.named($op.named); @@ -2171,7 +2171,7 @@ class Perl6::Optimizer { my $meth := $pkg.HOW.find_private_method($pkg, $name); if nqp::defined($meth) && $meth { if nqp::isnull(nqp::getobjsc($meth)) { - try $*W.add_object($meth); + try $*W.add_object_if_no_sc($meth); } unless nqp::isnull(nqp::getobjsc($meth)) { my $call := QAST::WVal.new( :value($meth) ); diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 77a1eaa95d4..849763aefa7 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -1321,7 +1321,7 @@ class Perl6::World is HLL::World { $RMD(" Pre-compiling '$module_name'") if $RMD; my $opt_hash := QAST::Op.new( :op('hash') ); for %opts { - self.add_object($_.value); + self.add_object_if_no_sc($_.value); $opt_hash.push(QAST::SVal.new( :value($_.key) )); my $Str := self.find_symbol(['Str'], :setting-only); if nqp::isstr($_.value) || nqp::istype($_.value, $Str) { @@ -1363,7 +1363,7 @@ class Perl6::World is HLL::World { :version-matcher(%opts // $true), :source-line-number($line) ); - self.add_object($spec); + self.add_object_if_no_sc($spec); my $registry := self.find_symbol(['CompUnit', 'RepositoryRegistry'], :setting-only); my $comp_unit := $registry.head.need($spec); my $globalish := $comp_unit.handle.globalish-package; @@ -1573,7 +1573,7 @@ class Perl6::World is HLL::World { method install_lexical_symbol($block, str $name, $obj, :$clone) { # Install the object directly as a block symbol. if nqp::isnull(nqp::getobjsc($obj)) { - self.add_object($obj); + self.add_object_if_no_sc($obj); } if $block.symbol($name) { for @($block[0]) { @@ -1670,7 +1670,7 @@ class Perl6::World is HLL::World { method create_container_descriptor($of, $name, $default = $of, $dynamic = nqp::chars($name) > 2 && nqp::eqat($name, '*', 1)) { my $cd_type := self.find_symbol(['ContainerDescriptor'], :setting-only); my $cd := $cd_type.new( :$of, :$name, :$default, :$dynamic ); - self.add_object($cd); + self.add_object_if_no_sc($cd); $cd } @@ -1711,7 +1711,7 @@ class Perl6::World is HLL::World { # Builds a container and adds it to the SC. method build_container_and_add_to_sc(%cont_info, $descriptor) { my $cont := self.build_container(%cont_info, $descriptor); - self.add_object($cont); + self.add_object_if_no_sc($cont); $cont; } @@ -2002,7 +2002,7 @@ class Perl6::World is HLL::World { # Create parameter object now. my $par_type := self.find_symbol(['Parameter'], :setting-only); my $parameter := nqp::create($par_type); - self.add_object($parameter); + self.add_object_if_no_sc($parameter); # Calculate flags. my int $flags := 0; @@ -2254,7 +2254,7 @@ class Perl6::World is HLL::World { my $sig_type := self.find_symbol(['Signature'], :setting-only); my $signature := nqp::create($sig_type); my @parameters := %signature_info; - self.add_object($signature); + self.add_object_if_no_sc($signature); # Set parameters. nqp::bindattr($signature, $sig_type, '@!params', @parameters); @@ -2338,7 +2338,7 @@ class Perl6::World is HLL::World { my $type_obj := self.find_symbol([$type], :setting-only); my $code := nqp::create($type_obj); self.context().push_code_object($code); - self.add_object($code); + self.add_object_if_no_sc($code); $code } @@ -2447,7 +2447,7 @@ class Perl6::World is HLL::World { # If we clone the stub, then we must remember to do a fixup # of it also. @compstuff[2] := sub ($orig, $clone) { - self.add_object($clone); + self.add_object_if_no_sc($clone); self.context().add_cleanup_task(sub () { nqp::bindattr($clone, $code_type, '@!compstuff', nqp::null()); }); @@ -2504,7 +2504,7 @@ class Perl6::World is HLL::World { method add_quasi_fixups($quasi_ast, $block) { $quasi_ast := nqp::decont($quasi_ast); - self.add_object($quasi_ast); + self.add_object_if_no_sc($quasi_ast); unless $quasi_ast.is_quasi_ast { return ""; } @@ -2639,7 +2639,7 @@ class Perl6::World is HLL::World { method derive_dispatcher($proto) { # Immediately do so and add to SC. my $derived := $proto.derive_dispatcher(); - self.add_object($derived); + self.add_object_if_no_sc($derived); return $derived; } @@ -2661,7 +2661,7 @@ class Perl6::World is HLL::World { method scalar_wrap($obj) { my $scalar_type := self.find_symbol(['Scalar'], :setting-only); my $scalar := nqp::create($scalar_type); - self.add_object($scalar); + self.add_object_if_no_sc($scalar); nqp::bindattr($scalar, $scalar_type, '$!value', $obj); $scalar; } @@ -2835,7 +2835,7 @@ class Perl6::World is HLL::World { } # Add to SC. - self.add_object($constant); + self.add_object_if_no_sc($constant); # Build QAST for getting the boxed constant from the constants # table, but also annotate it with the constant itself in case @@ -2889,7 +2889,7 @@ class Perl6::World is HLL::World { my $the_whatever := self.context().whatever(); unless nqp::isconcrete($the_whatever) { $the_whatever := nqp::create(self.find_symbol(['Whatever'], :setting-only)); - self.add_object($the_whatever); + self.add_object_if_no_sc($the_whatever); self.context().set_whatever($the_whatever); } QAST::WVal.new( :value($the_whatever), :returns($the_whatever.WHAT) ) @@ -2899,7 +2899,7 @@ class Perl6::World is HLL::World { my $the_hyper_whatever := self.context().hyper_whatever(); unless nqp::isconcrete($the_hyper_whatever) { $the_hyper_whatever := nqp::create(self.find_symbol(['HyperWhatever'], :setting-only)); - self.add_object($the_hyper_whatever); + self.add_object_if_no_sc($the_hyper_whatever); self.context().set_hyper_whatever($the_hyper_whatever); } QAST::WVal.new( :value($the_hyper_whatever), :returns($the_hyper_whatever.WHAT) ) @@ -3066,7 +3066,7 @@ class Perl6::World is HLL::World { %args := %extra; } my $mo := $how.new_type(|%args); - self.add_object($mo); + self.add_object_if_no_sc($mo); # Result is just the object. return $mo; @@ -3084,7 +3084,7 @@ class Perl6::World is HLL::World { my $cont := self.build_container(%cont_info, $descriptor); my $attr := $meta_attr.new(:auto_viv_container($cont), |%args); $obj.HOW.add_attribute($obj, $attr); - self.add_object($attr); + self.add_object_if_no_sc($attr); $attr } @@ -3855,7 +3855,7 @@ class Perl6::World is HLL::World { my %args := hash(:refinee($refinee), :refinement($refinement)); if nqp::defined($name) { %args := $name; } my $mo := $how.new_type(|%args); - self.add_object($mo); + self.add_object_if_no_sc($mo); return $mo; } @@ -3865,7 +3865,7 @@ class Perl6::World is HLL::World { # Create the meta-object and add to root objects. my $mo := $how.new_type(:$base_type, :$definite); - if nqp::isnull(nqp::getobjsc($mo)) { self.add_object($mo); } + if nqp::isnull(nqp::getobjsc($mo)) { self.add_object_if_no_sc($mo); } return $mo; } @@ -3877,7 +3877,7 @@ class Perl6::World is HLL::World { nqp::bindattr($val, $enum_type_obj, '$!key', $key); nqp::bindattr($val, $enum_type_obj, '$!value', $value); nqp::bindattr_i($val, $enum_type_obj, '$!index', $index); - self.add_object($val); + self.add_object_if_no_sc($val); # Add to meta-object. $enum_type_obj.HOW.add_enum_value($enum_type_obj, $val); @@ -3891,7 +3891,7 @@ class Perl6::World is HLL::World { method create_coercion_type($/, $target, $constraint) { self.ex-handle($/, { my $type := $/.how('coercion').new_type($target, $constraint); - if nqp::isnull(nqp::getobjsc($type)) { self.add_object($type); } + if nqp::isnull(nqp::getobjsc($type)) { self.add_object_if_no_sc($type); } $type }) } @@ -3985,7 +3985,7 @@ class Perl6::World is HLL::World { my $W := $*W; my $cur_handle := $W.handle; if $cur_handle ne $!resolver { - $W.add_object($code); + $W.add_object_if_no_sc($code); $W.add_fixup_task(:deserialize_ast(QAST::Op.new( :op('callmethod'), :name('update'), QAST::WVal.new( :value(self) ), @@ -4017,7 +4017,7 @@ class Perl6::World is HLL::World { # Create a list and put it in the SC. my $fixup_list := nqp::create(FixupList); - self.add_object($fixup_list); + self.add_object_if_no_sc($fixup_list); nqp::bindattr($fixup_list, FixupList, '$!list', nqp::list()); nqp::bindattr($fixup_list, FixupList, '$!resolver', self.handle());