From 5074c079e162f0e674b09fc106593f5fe52c6a84 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Wed, 30 Oct 2019 22:13:28 -0400 Subject: [PATCH] Additional tests for dynamic pseudo-packages Support for rakudo/rakudo#3272 --- S02-names/pseudo-6e.t | 234 +++++++++++++++++++++++++++++++++++++++++- 1 file changed, 233 insertions(+), 1 deletion(-) diff --git a/S02-names/pseudo-6e.t b/S02-names/pseudo-6e.t index ac5cd59a78..ac26b9f32f 100644 --- a/S02-names/pseudo-6e.t +++ b/S02-names/pseudo-6e.t @@ -5,7 +5,7 @@ use lib $?FILE.IO.parent(2).add("packages/Test-Helpers"); use lib $?FILE.IO.parent(2).add("packages/S02-names/lib"); use Test::Util; -plan 199; +plan 203; # I'm not convinced this is in the right place # Some parts of this testing (i.e. WHO) seem a bit more S10ish -sorear @@ -628,4 +628,236 @@ is_run q|BEGIN { UNIT; Nil }|, { :0status, :out(''), :err('') }, } } +# GH rakudo/rakudo#3270 +our $to-be-found-on-GLOBAL = "something unique"; +# Dynamic variables created via PROCESS or GLOBAL key assignment must have .VAR.dynamic set. +subtest "Dynamic flag", { + plan 4; + nok PROCESS::<$gh3270>:exists, "variable doesn't pre-exists"; + PROCESS::<$gh3270-proc> = 42; + ok $*gh3270-proc.VAR.dynamic, "container created via PROCESS is marked as dynamic"; + GLOBAL::<$gh3270-glob> = 0; + ok $*gh3270-glob.VAR.dynamic, "container created via GLOBAL is marked as dynamic"; + nok $to-be-found-on-GLOBAL.VAR.dynamic, "our-declared variable doesn't have dynamic flag"; +} + +# GH rakudo/rakudo#3257 +my module SymDumper { + sub dynamic-symbols(-->List()) is export { + DYNAMIC::.keys + } + + sub callers-symbols(-->List()) is export { + CALLERS::.keys + } + + sub lexical-symbols(-->List()) is export { + CALLER::LEXICAL::.keys + } +} + +sub is-containing($got, $expected, Str:D $msg) { + my $exp-set = $expected.list.Set; + my $got-set = $got.list.Set; + if $exp-set ⊆ $got-set { + pass $msg + } + else { + flunk $msg; + diag "expected: " ~ $exp-set.keys.list.gist; + diag "got : " ~ $got-set.keys.list.gist; + } +} + +subtest "Dynamic chain pseudo-packages use PROCESS" => { + plan 30; + + # Take measures as to not leave behind test symbols. + my $orig-syms = PROCESS::.keys.Set; + my sub cleanup-namespace { + for PROCESS::.keys { + PROCESS::{$_}:delete unless $_ ∈ $orig-syms; + } + } + + # Make sure a previously ran test didn't leave anything behind. + nok DYNAMIC::<$*foo>:exists, "a dynamic variable doesn't exists in DYNAMIC yet"; + nok LEXICAL::<$*foo>:exists, "a dynamic variable doesn't exists in LEXICAL yet"; + + my sub check-not-exists($name) { + nok CALLERS::{$name}:exists, "a dynamic variable doesn't exists in CALLERS yet"; + nok LEXICAL::{$name}:exists, "a dynamic variable doesn't exists in callee's LEXICAL yet"; + } + + check-not-exists '$*foo'; + check-not-exists '$*foo-constant'; + + # Instantiate a dynamic variable and a constant + PROCESS::<$foo> = 42; + PROCESS::<$foo-constant> := pi; + + ok DYNAMIC::<$*foo>:exists, "a dynamic variable now exists is DYNAMIC"; + ok DYNAMIC::<$*foo-constant>:exists, "a dynamic constant now exists is DYNAMIC"; + + my sub check-exists($name) { + ok CALLERS::{$name}:exists, "dynamic variable exists in CALLERS"; + ok LEXICAL::{$name}:exists, "dynamic variable exists in callee's LEXICAL"; + } + + check-exists('$*foo'); + check-exists('$*foo-constant'); + + is DYNAMIC::<$*foo>, 42, "DYNAMIC finds a variable in PROCESS"; + is DYNAMIC::<$*foo-constant>, pi, "DYNAMIC finds a constant in PROCESS"; + is LEXICAL::<$*foo>, 42, "LEXICAL finds a variable in PROCESS"; + is LEXICAL::<$*foo-constant>, pi, "LEXICAL finds a constant in PROCESS"; + + # Assignment to an existing symbol must change it where it is located. + DYNAMIC::<$*foo> = pi; + is $*foo, pi, "asignment via DYNAMIC changes the dynamic variable"; + is PROCESS::<$foo>, pi, "asignment via DYNAMIC changes the symbol on PROCESS"; + + # Assignment to a non-existing symbol must create it on PROCESS. + DYNAMIC::<$*new-foo> = "foo"; + DYNAMIC::<$*new-foo-constant> := "foo-constant"; + + ok PROCESS::<$new-foo>:exists, "creating a new dynamic variable on DYNAMIC creates it in PROCESS"; + ok PROCESS::<$new-foo-constant>:exists, "creating a new dynamic constant on DYNAMIC creates it in PROCESS"; + is PROCESS::<$new-foo>, "foo", "new dynamic variable value is correct"; + is PROCESS::<$new-foo-constant>, "foo-constant", "new dynamic constant value is correct"; + + is $*new-foo, "foo", "new dynamic variable is directly accessible"; + is $*new-foo-constant, "foo-constant", "new dynamic constant is directly accessible"; + + cleanup-namespace; + + import SymDumper; + my $level0; + sub lev3(&dumper) { + my $level3; # Won't be exposed + &dumper() + } + sub lev2(&dumper) { + my $*level2; + lev3(&dumper) + } + sub lev1(&dumper) { + my $*level1; + lev2(&dumper) + } + sub check-expected-syms($expected, $msg) { + is-containing lev1(&dynamic-symbols), $expected, "all expected symbols are met in DYNAMIC::.keys$msg"; + is-containing lev1(&callers-symbols), $expected, "all expected symbols are met in CALLERS::.keys$msg"; + is-containing lev1(&lexical-symbols), ($expected ∪ <$level3 $level0>), "all expected symbols are met in CALLER::LEXICAL::.keys$msg"; + } + check-expected-syms(<$*level1 $*level2>, ", nothing set on PROCESS"); + PROCESS::<$process-level> = 42; + check-expected-syms(<$*level1 $*level2 $*process-level>, ", including a symbol from PROCESS"); + + cleanup-namespace; +} + +subtest "Dynamic chain pseudo-packages use GLOBAL" => { + plan 20; + + # Take measures as to not leave behind test symbols. + my $orig-syms = GLOBAL::.keys.Set; + my sub cleanup-namespace { + for GLOBAL::.keys { + GLOBAL::{$_}:delete unless $_ ∈ $orig-syms; + } + } + + nok DYNAMIC::<$*foo>:exists, "a dynamic variable doesn't exists in DYNAMIC yet"; + nok LEXICAL::<$*foo>:exists, "a dynamic variable doesn't exists in LEXICAL yet"; + + my sub check-not-exists($name) { + nok CALLERS::{$name}:exists, "a dynamic variable doesn't exists in CALLERS yet"; + nok LEXICAL::{$name}:exists, "a dynamic variable doesn't exists in callee's LEXICAL yet"; + } + + check-not-exists '$*foo'; + + GLOBAL::<$foo> = 42; + GLOBAL::<$foo-constant> := pi; + + ok DYNAMIC::<$*foo>:exists, "a dynamic variable now exists is DYNAMIC"; + ok DYNAMIC::<$*foo-constant>:exists, "a dynamic constant now exists is DYNAMIC"; + + my sub check-exists($name) { + ok CALLERS::{$name}:exists, "dynamic variable exists in CALLERS"; + ok LEXICAL::{$name}:exists, "dynamic variable exists in callee's LEXICAL"; + } + + check-exists('$*foo'); + + is DYNAMIC::<$*foo>, 42, "DYNAMIC finds a variable in GLOBAL"; + is DYNAMIC::<$*foo-constant>, pi, "DYNAMIC finds a constant in GLOBAL"; + is LEXICAL::<$*foo>, 42, "LEXICAL finds a variable in GLOBAL"; + is LEXICAL::<$*foo-constant>, pi, "LEXICAL finds a constant in GLOBAL"; + + DYNAMIC::<$*foo> = pi; + is $*foo, pi, "asignment via DYNAMIC changes the dynamic variable"; + is GLOBAL::<$foo>, pi, "assigning via DYNAMIC changes the symbol on GLOBAL"; + + cleanup-namespace; + + import SymDumper; + my $level0; + sub lev3(&dumper) { + my $level3; # Won't be exposed + &dumper() + } + sub lev2(&dumper) { + my $*level2; + lev3(&dumper) + } + sub lev1(&dumper) { + my $*level1; + lev2(&dumper) + } + GLOBAL::<$global-level> = 42; + sub check-expected-syms($expected, $msg) { + is-containing lev1(&dynamic-symbols), $expected, "all expected symbols are met in DYNAMIC::.keys$msg"; + is-containing lev1(&callers-symbols), $expected, "all expected symbols are met in CALLERS::.keys$msg"; + is-containing lev1(&lexical-symbols), ($expected ∪ <$level3 $level0>), "all expected symbols are met in CALLER::LEXICAL::.keys$msg"; + } + check-expected-syms(<$*level1 $*level2 $*global-level>, ", including symbols from GLOBAL"); + + ok DYNAMIC::<$*to-be-found-on-GLOBAL>:exists, "our-declared variable can be found on DYNAMIC"; + is DYNAMIC::<$*to-be-found-on-GLOBAL>, "something unique", "value of our-declared variable taken via DYNAMIC"; + ok '$*to-be-found-on-GLOBAL' ∉ DYNAMIC::.keys, "our-declared value is not iterated over because it's not a real dynamic"; + + cleanup-namespace; +} + +subtest "Dynamic chain in a Promise" => { + plan 9; + + my $*out-of-promise = 1; + PROCESS::<$in-PROCESS> = "proc"; + GLOBAL::<$in-GLOBAL> = "glob"; + + await start { + my $*in-promise = 42; + await start { + # Testing for incomplete list of symbols just to see all layers are covered, including + is-containing DYNAMIC::.keys, + <$*in-promise $*out-of-promise $*in-PROCESS $*in-GLOBAL $*IN $*OUT $*PROMISE>, + "symbols outside of Promise wrapper are visible"; + ok DYNAMIC::<$*in-promise>:exists, "DYNAMIC can see symbols outside of current Promise wrapper"; + ok DYNAMIC::<$*out-of-promise>:exists, "DYNAMIC can see symbols outside of nested Promise wrappers"; + is DYNAMIC::<$*out-of-promise>, 1, "out of Promise dynamic symbol value"; + is DYNAMIC::<$*in-promise>, 42, "in-Promise dynamic symbol value"; + is DYNAMIC::<$*in-PROCESS>, "proc", "declared on PROCESS symbol value"; + is DYNAMIC::<$*in-GLOBAL>, "glob", "declared on GLOBAL symbol value"; + DYNAMIC::<$*out-of-promise> = pi; + DYNAMIC::<$*in-promise> = pi/2; + } + is $*in-promise, pi/2, "asignment via DYNAMIC inside a Promise-wrapped code, level 1"; + } + is $*out-of-promise, pi, "asignment via DYNAMIC inside a Promise-wrapped code, level 2"; +} + +done-testing; # vim: ft=perl6