73 / 80 lines covered (91.3%)
1unit module BDD::Behave::SpecTree::Core;23subset HookPhase of Str where { $_ eq any(<before-all after-all before-each after-each around-all around-each>) };45# Re-parenting any node invalidates every cached ancestry at once. The tree is6# built once and never changes afterwards, so the counter stops moving before7# the first example runs and the caches stay warm for the whole run.8my Int $tree-generation = 0;910our class SpecNode {11 has Str $.description is required;12 has IO::Path $.file is required;13 has Int $.line is required;14 has $!parent = Nil;15 has %.metadata = Hash.new;16 has List $!ancestry;17 has Int $!ancestry-generation = -1;1819 submethod BUILD(:$!description, :$file!, :$line!, :$parent, :%metadata = {}) {20 $!file = $file ~~ IO::Path ?? $file !! $file.IO;21 $!line = $line;22 $!parent = $parent if $parent.defined;23 %!metadata = %metadata.clone;24 }2526 method parent() is rw {27 Proxy.new(28 FETCH => -> $ { $!parent },29 STORE => -> $, $value { $!parent = $value; $tree-generation++ },30 );31 }3233 method location { "$!file:$!line" }3435 method root { self.ancestry[0] }3637 # Every effective-* lookup, `depth`, and `root` walks this, and the runner38 # calls four of them per example, so the walk is done once per tree.39 method ancestry(--> List) {40 # `.List` decontainerizes: returning the attribute itself hands back a41 # Scalar holding a List, which `for` then iterates as a single item.42 return $!ancestry.List43 if $!ancestry.defined && $!ancestry-generation == $tree-generation;4445 my @nodes;46 my $node = self;47 while $node.defined {48 @nodes.push($node);49 $node = $node.parent;50 }5152 $!ancestry-generation = $tree-generation;53 $!ancestry = @nodes.reverse.List;5455 $!ancestry.List;56 }5758 method set-metadata(*%pairs) {59 for %pairs.kv -> $key, $value {60 %!metadata{$key} = $value;61 }62 self;63 }6465 method get-metadata(Str:D $key, :$default) {66 %!metadata{$key} // $default;67 }6869 method tags(--> List) {70 my $stored = %!metadata<tags>;71 return ().List unless $stored.defined;72 $stored ~~ Positional ?? $stored.list.List !! ($stored,).List;73 }7475 method has-tag(Str:D $tag --> Bool) {76 self.tags.first(* eq $tag).defined;77 }7879 method effective-tags(--> List) {80 my @collected;81 for self.ancestry -> $node {82 @collected.append: $node.tags;83 }84 @collected.unique.List;85 }8687 method has-effective-tag(Str:D $tag --> Bool) {88 self.effective-tags.first(* eq $tag).defined;89 }9091 method effective-metadata-value(Str:D $key) {92 for self.ancestry.reverse -> $node {93 my %meta := $node.metadata;94 next unless %meta{$key}:exists;95 my $value = %meta{$key};96 return $value if $value.defined;97 }98 Nil;99 }100101 method skipped(--> Bool) { %!metadata<skipped> ?? True !! False }102103 method focused(--> Bool) { %!metadata<focused> ?? True !! False }104105 method effective-skipped(--> Bool) {106 self.ancestry.first(*.skipped).defined;107 }108109 method effective-focused(--> Bool) {110 self.ancestry.first(*.focused).defined;111 }112113 method depth { self.ancestry.elems - 1 }114115 method is-root { !self.parent.defined }116}117118our role Container {119 has SpecNode @.children;120121 method add-child(SpecNode $child --> SpecNode) {122 $child.parent = self;123 @!children.push($child);124 $child;125 }126}127128sub meta-value-matches($actual, $expected --> Bool) {129 return False unless $actual.defined;130 if $expected ~~ Positional {131 my @actual-list = $actual ~~ Positional ?? $actual.list !! ($actual,);132 for $expected.list -> $needle {133 return False unless @actual-list.first(* eq $needle).defined;134 }135 return True;136 }137 if $actual ~~ Positional {138 return $actual.list.first(* eq $expected).defined;139 }140 $actual eq $expected;141}142143our class Hook {144 has Callable $.callback is required;145 has @.include-tags;146 has @.exclude-tags;147 has %.meta;148149 method has-filter(--> Bool) {150 @!include-tags.elems > 0 || @!exclude-tags.elems > 0 || %!meta.elems > 0;151 }152153 method matches(SpecNode:D $node --> Bool) {154 return True unless self.has-filter;155156 my @effective-tags = $node.effective-tags;157158 for @!include-tags -> $tag {159 return False unless @effective-tags.first(* eq $tag).defined;160 }161162 for @!exclude-tags -> $tag {163 return False if @effective-tags.first(* eq $tag).defined;164 }165166 for %!meta.kv -> $key, $expected {167 my $actual = $node.effective-metadata-value($key);168 return False unless meta-value-matches($actual, $expected);169 }170171 True;172 }173}174175sub base-exports() {176 %(177 HookPhase => HookPhase,178 SpecNode => SpecNode,179 Container => Container,180 Hook => Hook,181 );182}183184sub EXPORT(:$ALL?) {185 my %exports = base-exports();186 %(187 DEFAULT => %exports,188 ALL => %exports,189 );190}