Mercurial > hg > Others > Rakudo
view t/06-telemetry/04-threadpool.t @ 0:c341f82e7ad7 default tip
Rakudo branch in cr.ie.u-ryukyu.ac.jp
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Thu, 26 Dec 2019 16:50:27 +0900 |
parents | |
children |
line wrap: on
line source
use v6; # extensive tests for Telemetry::Instrument::ThreadPool # make sure we don't have any overrides BEGIN { %*ENV.DELETE-KEY($_) for < RAKUDO_REPORT_COLUMNS RAKUDO_REPORT_HEADER_REPEAT RAKUDO_REPORT_LEGEND RAKUDO_REPORT_CSV RAKUDO_TELEMETRY_INSTRUMENTS >; } use Test; use Telemetry; plan 104; # Check ways to create the T:I:ThreadPool instrument for 'ThreadPool', Telemetry::Instrument::ThreadPool -> \instrument { my $what = instrument.^name; is $*SAMPLER.set-instruments(instrument), Nil, "return Nil when setting with $what"; my @instruments = $*SAMPLER.instruments; is +@instruments, 1, "Was one instrument set with $what"; is @instruments[0], Telemetry::Instrument::ThreadPool, "do we get the right class when setting with $what"; } # Get the column names in alphabetic order my $instrument = $*SAMPLER.instruments[0]; my @columns = $instrument.columns; ok ([le] @columns), "are the columns in alphabetical order"; # Assume T:I:ThreadPool is only instrument from now on my $snap1 = $instrument.snap; my $snap-class = $snap1.WHAT; isa-ok $snap-class, Telemetry::Instrument::ThreadPool::Snap; # Test snap roundtripping my $snap2 = $snap1.perl.EVAL; isa-ok $snap2, $snap-class, "Did we get a {$_.^name} after roundtripping"; for @columns { is $snap2{$_}, $snap1{$_}, "did we get the same value for $_"; } # Initialize first set of values. The left-shift is needed because the x-rss # columns are right-shifted 10 before being returned on MacOS, because MacOS # returns the value in bytes rather than Kbytes. my @values1 = (1..10).map: * +< 10; # Initialize second set of values. Use higher values than in first set so # that we can guarantee a positive difference. my @values2 = (101..110).map: * +< 10; # Create a repeatable snap/telemetry for testing my $S1 = $snap-class.new( |@values1 ); isa-ok $S1, $snap-class, 'did we get a Snap object from first set of values'; my $T1 = Telemetry.new($S1); isa-ok $T1, Telemetry, 'did we get a Telemetry object from $S1'; # Test all columns for sanity, we don't know which value winds up in which column for @columns { ok $T1{$_}:exists, "does $_ exist in $T1.^name()?"; diag $T1{$_}.perl unless ok $T1{$_}, "did we get a non-zero value for $_ using AT-KEY"; diag $T1."$_"().perl unless ok $T1."$_"(), "did we get a non-zero value for $_ with a method"; is $T1{$_}, $T1."$_"(), 'did AT-KEY and method on T give the same value'; } # Create another repeatable snap/telemetry for testing. Use higher values than # before so that we can guarantee a positive difference. my $S2 = $snap-class.new( |@values2 ); isa-ok $S2, $snap-class, 'did we get a Snap object from second set of values'; my $T2 = Telemetry.new($S2); isa-ok $T2, Telemetry, 'did we get a Telemetry object from $S2'; # Create a repeatable period and check for resulting values my $P1 = $T2 - $T1; isa-ok $P1, Telemetry::Period, 'Did we get a T::Period'; for @columns { ok $P1{$_}:exists, "does $_ exist in $P1.^name()?"; ok $P1{$_} > 0, "did we get a positive value for $_ using AT-KEY"; ok $P1."$_"() > 0, "did we get a positive value for $_ using AT-KEY"; is $P1{$_}, $P1."$_"(), "did AT-KEY/method on T:P give same value for $_"; } # vim: ft=perl6 expandtab sw=4