120 / 137 lines covered (87.6%)
1unit module BDD::Behave::Parallel::EventStream;23# Every event line from every worker is parsed here. The scan compares single4# characters rather than matching a regex per character, caches the length, and5# finds the end of a string with `index` so a string with no escape in it is cut6# out in one piece.7class MiniJsonParser {8 has Str $.text is required;9 has int $!pos = 0;10 has int $!len = 0;1112 submethod TWEAK { $!len = $!text.chars }1314 method !at(int $offset --> Str) {15 $offset < $!len ?? $!text.substr($offset, 1) !! '';16 }1718 method parse-value {19 self!skip-ws;20 die "unexpected end of input" if $!pos >= $!len;2122 my $ch = $!text.substr($!pos, 1);2324 return self!parse-object if $ch eq '{';25 return self!parse-array if $ch eq '[';26 return self!parse-string if $ch eq '"';27 return self!parse-number if $ch eq '-' || ('0' le $ch le '9');2829 given $ch {30 when 't' { self!parse-literal('true', True) }31 when 'f' { self!parse-literal('false', False) }32 when 'n' { self!parse-literal('null', Nil) }33 default { die "unexpected character '$ch' at $!pos" }34 }35 }3637 method !skip-ws {38 while $!pos < $!len {39 my $ch = $!text.substr($!pos, 1);40 last unless $ch eq ' ' || $ch eq "\t" || $ch eq "\n" || $ch eq "\r";41 $!pos++;42 }43 }4445 method !parse-literal(Str $word, $value) {46 if $!text.substr($!pos, $word.chars) eq $word {47 $!pos += $word.chars;48 return $value;49 }5051 die "expected '$word' at $!pos";52 }5354 method !parse-object {55 my %out;56 $!pos++;57 self!skip-ws;5859 if self!at($!pos) eq '}' { $!pos++; return %out }6061 loop {62 self!skip-ws;63 die "expected string key at $!pos" unless self!at($!pos) eq '"';6465 my $key = self!parse-string;66 self!skip-ws;6768 die "expected ':' at $!pos" unless self!at($!pos) eq ':';69 $!pos++;70 self!skip-ws;7172 %out{$key} = self.parse-value;73 self!skip-ws;7475 my $next = self!at($!pos);76 if $next eq ',' {77 $!pos++;78 } elsif $next eq '}' {79 $!pos++;80 return %out;81 } else {82 die "expected ',' or '\}' at $!pos (got '$next')";83 }84 }85 }8687 method !parse-array {88 my @out;89 $!pos++;90 self!skip-ws;9192 if self!at($!pos) eq ']' { $!pos++; return @out }9394 loop {95 self!skip-ws;96 @out.push(self.parse-value);97 self!skip-ws;9899 my $next = self!at($!pos);100 if $next eq ',' {101 $!pos++;102 } elsif $next eq ']' {103 $!pos++;104 return @out;105 } else {106 die "expected ',' or ']' at $!pos (got '$next')";107 }108 }109 }110111 # The closing quote and the first backslash are both found with `index`. When112 # no backslash comes first the whole string is one substr, and otherwise each113 # run between escapes is, so no path appends a character at a time.114 method !parse-string {115 die "expected '\"' at $!pos" unless self!at($!pos) eq '"';116 $!pos++;117118 my int $from = $!pos;119 my @pieces;120121 loop {122 my $quote = $!text.index('"', $from);123 die "unterminated string at $from" without $quote;124125 my $escape = $!text.index('\\', $from);126127 if !$escape.defined || $escape > $quote {128 $!pos = $quote + 1;129 my $tail = $!text.substr($from, $quote - $from);130131 return @pieces.elems ?? @pieces.join ~ $tail !! $tail;132 }133134 @pieces.push($!text.substr($from, $escape - $from));135136 my $esc = self!at($escape + 1);137 $from = $escape + 2;138139 given $esc {140 when '"' { @pieces.push('"') }141 when '\\' { @pieces.push('\\') }142 when '/' { @pieces.push('/') }143 when 'n' { @pieces.push("\n") }144 when 'r' { @pieces.push("\r") }145 when 't' { @pieces.push("\t") }146 when 'b' { @pieces.push("\b") }147 when 'f' { @pieces.push("\f") }148 when 'u' {149 @pieces.push(chr(:16($!text.substr($from, 4))));150 $from += 4;151 }152 default { die "bad escape '\\$esc' at {$escape + 1}" }153 }154 }155 }156157 method !parse-number {158 my int $start = $!pos;159 $!pos++ if self!at($!pos) eq '-';160161 self!skip-digits;162163 my Bool $is-float = False;164165 if self!at($!pos) eq '.' {166 $is-float = True;167 $!pos++;168 self!skip-digits;169 }170171 my $exponent = self!at($!pos);172 if $exponent eq 'e' || $exponent eq 'E' {173 $is-float = True;174 $!pos++;175176 my $sign = self!at($!pos);177 $!pos++ if $sign eq '-' || $sign eq '+';178179 self!skip-digits;180 }181182 my $raw = $!text.substr($start, $!pos - $start);183184 $is-float ?? $raw.Num !! $raw.Int;185 }186187 method !skip-digits {188 while $!pos < $!len {189 my $ch = $!text.substr($!pos, 1);190 last unless '0' le $ch le '9';191 $!pos++;192 }193 }194}195196sub parse-json-event(Str $line) is export {197 my $parser = MiniJsonParser.new(:text($line));198 $parser.parse-value;199}200201class JsonLineParser is export {202 has Str $!buffer = '';203204 # A chunk carrying N lines is walked with a moving offset and the remainder is205 # sliced once at the end, so the cost stays linear in the chunk rather than206 # re-copying what is left after every line.207 method feed(Str $chunk --> List) {208 my @events;209 return @events.List unless $chunk.defined && $chunk.chars;210211 $!buffer ~= $chunk;212213 my int $from = 0;214 loop {215 my $break = $!buffer.index("\n", $from);216 last without $break;217218 my $trimmed = $!buffer.substr($from, $break - $from).trim;219 $from = $break + 1;220221 next unless $trimmed.chars;222223 my $event = try parse-json-event($trimmed);224 @events.push: $event ~~ Associative ?? $event !! %( :type<parse-error>, :raw($trimmed) );225 }226227 $!buffer = $!buffer.substr($from) if $from;228229 @events.List;230 }231232 method flush(--> List) {233 my @events;234 my $trimmed = $!buffer.trim;235 $!buffer = '';236 if $trimmed.chars {237 my $event = try parse-json-event($trimmed);238 @events.push: $event ~~ Associative ?? $event !! %( :type<parse-error>, :raw($trimmed) );239 }240 @events.List;241 }242}