145 / 147 lines covered (98.6%)
1use BDD::Behave::Failures;2use BDD::Behave::Formatter;34unit class BDD::Behave::Formatter::JUnit does BDD::Behave::Formatter;56class TestCase {7 has Str $.classname is rw = '';8 has Str $.name is rw = '';9 has Str $.file is rw;10 has Int $.line is rw;11 has Real $.time is rw = 0e0;12 has Str $.status is rw = 'passed';13 has Str $.failure-type is rw;14 has Str $.failure-message is rw;15 has Str $.failure-body is rw;16 has Str $.skip-message is rw;17}1819class Testsuite {20 has Str $.name is rw = '';21 has Str $.file is rw;22 has TestCase @.cases;23 has Real $.time is rw = 0e0;24 has Instant $.started-at is rw;25}2627has @!description-stack;28has Testsuite $!current-suite;29has Testsuite @!suites;30has Bool $!multi-file = False;31has Bool $!emitted = False;32has Int $!failure-watermark = 0;33has Str $!pending-auto-description;34has Real $!total-time = 0e0;35has Int $!tests = 0;36has Int $!failures = 0;37has Int $!errors = 0;38has Int $!skipped = 0;3940method name(--> Str) { 'junit' }4142method suite-loading(Str :$file) { }4344method suite-start($suite, Bool :$multi-file = False) {45 $!multi-file = $multi-file;46 $!current-suite = Testsuite.new(47 :name($suite.description // $suite.file.basename),48 :file($suite.file.Str),49 :started-at(now.Instant),50 );51 @!suites.push: $!current-suite;52}5354method suite-end($suite) { }5556method group-start($group) {57 @!description-stack.push: $group.description;58}5960method group-end($group) {61 @!description-stack.pop;62}6364method group-around-skipped($group) { }6566method !classname(--> Str) {67 @!description-stack.grep(*.defined).join(' > ');68}6970method !ensure-suite($example) {71 unless $!current-suite.defined {72 $!current-suite = Testsuite.new(73 :name($example.file.basename),74 :file($example.file.Str),75 :started-at(now.Instant),76 );77 @!suites.push: $!current-suite;78 }79}8081method !push-case($example, Str $status, %extras = %()) {82 self!ensure-suite($example);83 my $description = $!pending-auto-description // $example.description;84 my $tc = TestCase.new(85 :classname(self!classname),86 :name($description),87 :file($example.file.Str),88 :line($example.line),89 :time($example.duration.defined ?? $example.duration.Real !! 0e0),90 :$status,91 );92 for %extras.kv -> $k, $v {93 given $k {94 when 'failure-type' { $tc.failure-type = $v.Str }95 when 'failure-message' { $tc.failure-message = $v.Str }96 when 'failure-body' { $tc.failure-body = $v.Str }97 when 'skip-message' { $tc.skip-message = $v.Str }98 when 'line' { $tc.line = $v.Int }99 }100 }101 $!current-suite.cases.push: $tc;102 $!tests++;103 $!total-time += $tc.time;104 if $!current-suite.defined {105 $!current-suite.time += $tc.time;106 }107}108109method example-start($example, Bool :$auto = False) {110 $!failure-watermark = Failures.list.elems;111 $!pending-auto-description = Str;112}113114method example-auto-description($example, Str :$description) {115 $!pending-auto-description = $description;116}117118method example-pass($example) {119 self!push-case($example, 'passed');120 $!pending-auto-description = Str;121}122123method example-fail($example, :$failure-info) {124 my $is-error = $failure-info.defined && $failure-info<exception>.defined;125 my $msg-type = $is-error ?? 'Exception' !! 'Expectation';126 my $msg = $is-error127 ?? $failure-info<exception>.message128 !! self!summarize-expectations;129 my $body = $is-error130 ?? $failure-info<exception>.gist131 !! self!format-expectations;132 my $fail-line = $failure-info.defined && $failure-info<line>.defined133 ?? $failure-info<line>134 !! $example.line;135 if $is-error {136 $!errors++;137 self!push-case($example, 'error',138 %( failure-type => $msg-type,139 failure-message => $msg,140 failure-body => $body,141 line => $fail-line ));142 } else {143 $!failures++;144 self!push-case($example, 'failed',145 %( failure-type => $msg-type,146 failure-message => $msg,147 failure-body => $body,148 line => $fail-line ));149 }150 $!pending-auto-description = Str;151}152153method example-pending($example) {154 $!skipped++;155 my $reason = $example.get-metadata('pending-reason') // 'pending';156 self!push-case($example, 'pending',157 %( skip-message => "pending: $reason" ));158}159160method example-skipped($example) {161 $!skipped++;162 self!push-case($example, 'skipped', %( skip-message => 'skipped' ));163}164165method example-around-skipped($example) {166 $!skipped++;167 self!push-case($example, 'skipped',168 %( skip-message => 'around-each did not invoke continuation' ));169}170171method example-slow($example, Real :$threshold) { }172173method !summarize-expectations(--> Str) {174 my $count = Failures.list.elems;175 return 'unknown failure' unless $count > $!failure-watermark;176 my $f = Failures.list[$!failure-watermark];177 my $given = $f.given.defined ?? $f.given.gist !! 'undefined';178 my $expected = $f.expected.defined ?? $f.expected.gist !! 'undefined';179 my $op = $f.negated ?? 'not to be' !! 'to be';180 $f.message.defined181 ?? $f.message.lines[0]182 !! "Expected $given $op $expected";183}184185method !format-expectations(--> Str) {186 my $count = Failures.list.elems;187 return '' unless $count > $!failure-watermark;188 my @parts;189 for Failures.list[$!failure-watermark .. $count - 1] -> $f {190 my @lines;191 @lines.push: "{$f.file}:{$f.line}";192 if $f.aggregation-label.defined {193 @lines.push: " aggregate: {$f.aggregation-label}";194 }195 if $f.message.defined {196 @lines.push: " $_" for $f.message.lines;197 } else {198 my $op = $f.negated ?? 'not to be' !! 'to be';199 @lines.push: " Expected: {$f.given.gist}";200 @lines.push: " $op: {$f.expected.gist}";201 }202 @parts.push: @lines.join("\n");203 }204 @parts.join("\n\n");205}206207method run-summary(208 $result,209 Bool :$aborted = False,210 Int :$fail-fast = 0,211 Str :$order = 'defined',212 Int :$seed,213) {214 return if $!multi-file;215 self!emit;216}217218method profile-summary(@records, Int :$limit) { }219220method benchmark-summary-section(221 @summaries, @regressions,222 Real :$threshold,223 Str :$format,224 IO::Path :$output,225 :$runner,226) { }227228method multi-file-overall($result, Str :$order = 'defined', Int :$seed) {229 self!emit;230}231232method multi-file-profile($runner, @records, Int :$limit) { }233method multi-file-benchmark(234 $runner,235 @summaries, @regressions,236 Real :$threshold,237 Str :$format,238 IO::Path :$output,239) { }240241method load-errors(@errors) { }242243method !xml-escape(Str $s --> Str) {244 return '' unless $s.defined;245 my $r = $s;246 $r = $r.subst('&', '&', :g);247 $r = $r.subst('<', '<', :g);248 $r = $r.subst('>', '>', :g);249 $r = $r.subst('"', '"', :g);250 $r = $r.subst("'", ''', :g);251 $r;252}253254method !cdata(Str $s --> Str) {255 return '<![CDATA[]]>' unless $s.defined;256 '<![CDATA[' ~ $s.subst(']]>', ']]]]><![CDATA[>', :g) ~ ']]>';257}258259method !render-case(TestCase $tc --> Str) {260 my $attrs = sprintf q[classname="%s" name="%s" file="%s" line="%d" time="%.6f"],261 self!xml-escape($tc.classname),262 self!xml-escape($tc.name),263 self!xml-escape($tc.file),264 ($tc.line // 0),265 $tc.time;266 given $tc.status {267 when 'passed' {268 return " <testcase $attrs/>";269 }270 when 'failed' {271 my $type = self!xml-escape($tc.failure-type // 'Expectation');272 my $message = self!xml-escape($tc.failure-message // '');273 my $body = self!cdata($tc.failure-body // '');274 return join("\n",275 " <testcase {$attrs}>",276 " <failure type=\"{$type}\" message=\"{$message}\">{$body}</failure>",277 ' </testcase>',278 );279 }280 when 'error' {281 my $type = self!xml-escape($tc.failure-type // 'Exception');282 my $message = self!xml-escape($tc.failure-message // '');283 my $body = self!cdata($tc.failure-body // '');284 return join("\n",285 " <testcase {$attrs}>",286 " <error type=\"{$type}\" message=\"{$message}\">{$body}</error>",287 ' </testcase>',288 );289 }290 when 'pending' | 'skipped' {291 my $message = self!xml-escape($tc.skip-message // '');292 return join("\n",293 " <testcase {$attrs}>",294 " <skipped message=\"{$message}\"/>",295 ' </testcase>',296 );297 }298 }299}300301method !render-suite(Testsuite $ts --> Str) {302 my $failures = $ts.cases.grep(*.status eq 'failed').elems;303 my $errors = $ts.cases.grep(*.status eq 'error').elems;304 my $skipped = $ts.cases.grep(*.status eq any('pending', 'skipped')).elems;305 my $tests = $ts.cases.elems;306307 my $timestamp = $ts.started-at.defined308 ?? DateTime.new($ts.started-at).Str309 !! DateTime.now.Str;310311 my $attrs = sprintf312 q[name="%s" tests="%d" failures="%d" errors="%d" skipped="%d" time="%.6f" timestamp="%s" file="%s"],313 self!xml-escape($ts.name),314 $tests, $failures, $errors, $skipped,315 $ts.time,316 $timestamp,317 self!xml-escape($ts.file // '');318319 my @lines;320 @lines.push: " <testsuite $attrs>";321 @lines.push: self!render-case($_) for $ts.cases;322 @lines.push: ' </testsuite>';323 @lines.join("\n");324}325326method !emit {327 return if $!emitted;328 $!emitted = True;329330 my $total-tests = @!suites.map({ .cases.elems }).sum;331 my $total-failures = @!suites.map({ .cases.grep(*.status eq 'failed').elems }).sum;332 my $total-errors = @!suites.map({ .cases.grep(*.status eq 'error').elems }).sum;333 my $total-skipped = @!suites.map({ .cases.grep(*.status eq any('pending','skipped')).elems }).sum;334 my $total-time = @!suites.map({ .time }).sum;335336 my $attrs = sprintf q[name="behave" tests="%d" failures="%d" errors="%d" skipped="%d" time="%.6f"],337 $total-tests, $total-failures, $total-errors, $total-skipped, $total-time;338339 say '<?xml version="1.0" encoding="UTF-8"?>';340 say "<testsuites $attrs>";341 for @!suites -> $ts { say self!render-suite($ts) }342 say '</testsuites>';343}