93 / 95 lines covered (97.9%)
1unit module BDD::Behave::Parallel::Distribution;23need BDD::Behave::SpecTree;45constant Suite = BDD::Behave::SpecTree::Suite;6constant ExampleGroup = BDD::Behave::SpecTree::ExampleGroup;7constant Example = BDD::Behave::SpecTree::Example;89class Bucket {10 has Str $.id is required;11 has Str $.file is required;12 has @.examples;13 has Bool $.serial is rw = False;1415 method cost(--> Int) { @!examples.elems }1617 method locations(--> List) {18 @!examples.map({ "{$_.file.absolute}:{$_.line}" }).List;19 }2021 method add(Example $example) {22 @!examples.push($example);23 }24}2526sub effective-serial($node --> Bool) is export {27 my $value = $node.effective-metadata-value('serial');28 ?$value;29}3031sub allow-split($group --> Bool) is export {32 ?$group.effective-metadata-value('parallel-split');33}3435sub collect-buckets(Suite $suite --> List) is export {36 my @buckets;37 my $prefix = "{$suite.file.absolute}#";38 visit-children($suite, @buckets, $prefix, 0);39 @buckets.List;40}4142sub visit-children($container, @buckets, Str $prefix, Int $depth) {43 for $container.children -> $child {44 given $child {45 when Example {46 my $bucket = Bucket.new(47 :id($prefix ~ "ex:{$child.line}"),48 :file($child.file.absolute),49 );50 $bucket.add($child);51 $bucket.serial = effective-serial($child);52 @buckets.push($bucket);53 }54 when ExampleGroup {55 if allow-split($child) {56 visit-children($child, @buckets, $prefix ~ "g{$depth}:{$child.line}/", $depth + 1);57 } else {58 my $bucket = Bucket.new(59 :id($prefix ~ "g{$depth}:{$child.line}"),60 :file($child.file.absolute),61 );62 collect-examples($child, $bucket);63 $bucket.serial = group-has-only-serial($bucket);64 @buckets.push($bucket);65 }66 }67 }68 }69}7071sub collect-examples($node, Bucket $bucket) {72 given $node {73 when Example {74 $bucket.add($node);75 }76 when ExampleGroup | Suite {77 for $node.children -> $child {78 collect-examples($child, $bucket);79 }80 }81 }82}8384sub group-has-only-serial(Bucket $bucket --> Bool) {85 return False unless $bucket.examples.elems;86 for $bucket.examples -> $ex {87 return False unless effective-serial($ex);88 }89 True;90}9192sub coalesce-by-file(@buckets --> List) is export {93 my %by-file;94 my @order;9596 for @buckets -> $b {97 unless %by-file{$b.file}:exists {98 %by-file{$b.file} = Bucket.new(:id($b.file), :file($b.file));99 @order.push: $b.file;100 }101102 %by-file{$b.file}.add($_) for $b.examples;103 }104105 @order.map({ %by-file{$_} }).List;106}107108sub split-parallel-and-serial(@buckets --> List) is export {109 my @parallel;110 my @serial;111 for @buckets -> $b {112 if $b.serial {113 @serial.push($b);114 } else {115 my @serial-examples;116 my @parallel-examples;117 for $b.examples -> $ex {118 if effective-serial($ex) {119 @serial-examples.push($ex);120 } else {121 @parallel-examples.push($ex);122 }123 }124 if @parallel-examples.elems {125 my $par-bucket = Bucket.new(:id($b.id), :file($b.file));126 $par-bucket.add($_) for @parallel-examples;127 @parallel.push($par-bucket);128 }129 if @serial-examples.elems {130 my $ser-bucket = Bucket.new(:id($b.id ~ '#serial'), :file($b.file));131 $ser-bucket.add($_) for @serial-examples;132 $ser-bucket.serial = True;133 @serial.push($ser-bucket);134 }135 }136 }137 (@parallel.List, @serial.List).List;138}139140sub distribute-lpt(@buckets, Int $worker-count --> List) is export {141 die "worker-count must be a positive integer (got: $worker-count)"142 if $worker-count < 1;143144 my @assignments;145 @assignments.push([]) for ^$worker-count;146 my @loads = (0 xx $worker-count).Array;147148 my @sorted = @buckets.sort({ $^b.cost <=> $^a.cost });149 for @sorted -> $b {150 my $min-idx = 0;151 for 1 ..^ $worker-count -> $i {152 $min-idx = $i if @loads[$i] < @loads[$min-idx];153 }154 @assignments[$min-idx].push($b);155 @loads[$min-idx] += $b.cost;156 }157158 @assignments.map(*.List).List;159}160161sub fnv1a-hash(Str $s --> Int) {162 my $h = 0x811c9dc5;163 for $s.encode('utf-8').list -> $byte {164 $h = (($h +^ $byte) * 0x01000193) +& 0xFFFFFFFF;165 }166 $h;167}168169sub bucket-stable-key(Bucket $b, Int $seed --> Int) is export {170 my $h = fnv1a-hash($b.id);171172 my $s = $seed.abs +& 0xFFFFFFFF;173174 for ^4 -> $i {175 my $byte = ($s +> (8 * $i)) +& 0xFF;176 $h = (($h +^ $byte) * 0x01000193) +& 0xFFFFFFFF;177 }178179 $h;180}181182sub distribute-stable(@buckets, Int $worker-count, Int $seed --> List) is export {183 die "worker-count must be a positive integer (got: $worker-count)"184 if $worker-count < 1;185186 my @sorted = @buckets.sort({187 bucket-stable-key($^a, $seed) <=> bucket-stable-key($^b, $seed)188 || $^a.id leg $^b.id189 });190191 my @assignments;192 @assignments.push([]) for ^$worker-count;193194 for @sorted.kv -> $idx, $b {195 @assignments[$idx % $worker-count].push($b);196 }197198 @assignments.map(*.List).List;199}