Perl harmonized errors

CHANGELOG.md

@@ -13,6 +13,9 @@ This document is formatted according to the principles of [Keep A CHANGELOG](htt
 - [Perl] Fix release packaging
 - [Perl] Include CHANGELOG.md in tarball
 - [Perl] Upgrade messages to v22
+- [Perl] Harmonized error reporting with mainstream implementations;
+  errors are now converted to messages and reported in the message stream
+  ([#31](https://github.com/cucumber/gherkin/issues/31))
 
 ### Added
 - (i18n) Add Malayalam localization

perl/Makefile

@@ -43,7 +43,7 @@ clean: ## Remove all build artifacts and files generated by the acceptance tests
 
 .DELETE_ON_ERROR:
 
-acceptance: .built $(TOKENS) $(ASTS) $(PICKLES) $(SOURCES) #$(ERRORS) ## Build acceptance test dir and compare results with reference
+acceptance: .built $(TOKENS) $(ASTS) $(PICKLES) $(SOURCES) $(ERRORS) ## Build acceptance test dir and compare results with reference
 
 .built: perl5 $(SOURCE_FILES)
 	touch $@
@@ -77,7 +77,7 @@ acceptance/testdata/%.source.ndjson: ../testdata/% ../testdata/%.source.ndjson
 	$(GHERKIN) --no-ast --no-pickles --predictable-ids $< | jq --sort-keys --compact-output "." > $@
 	diff --unified <(jq "." $<.source.ndjson) <(jq "." $@)
 
-#acceptance/testdata/%.errors.ndjson: ../testdata/% ../testdata/%.errors.ndjson
-#	mkdir -p $(@D)
-#	$(GHERKIN) --no-source --predictable-ids $< | jq --sort-keys --compact-output "." > $@
-#	diff --unified <(jq "." $<.errors.ndjson) <(jq "." $@)
+acceptance/testdata/%.errors.ndjson: ../testdata/% ../testdata/%.errors.ndjson
+	mkdir -p $(@D)
+	$(GHERKIN) --no-source --predictable-ids $< | jq --sort-keys --compact-output "." > $@
+	diff --unified <(jq "." $<.errors.ndjson) <(jq "." $@)

perl/lib/Gherkin.pm

@@ -3,6 +3,7 @@ package Gherkin;
 use strict;
 use warnings;
 use Encode qw(encode_utf8 find_encoding);
+use Scalar::Util qw( blessed );
 
 use Cucumber::Messages;
 
@@ -83,6 +84,22 @@ sub _parse_source_encoding_header {
     }
 }
 
+sub _parser_error_message {
+    my ( $error, $uri ) = @_;
+    return Cucumber::Messages::Envelope->new(
+        parse_error => Cucumber::Messages::ParseError->new(
+            source => Cucumber::Messages::SourceReference->new(
+                uri => $uri,
+                location => Cucumber::Messages::Location->new(
+                    line => $error->location->{line},
+                    column => $error->location->{column},
+                ),
+            ),
+            message => $error->stringify,
+        )
+    );
+}
+
 sub from_source {
     my ($self, $envelope, $id_generator, $sink) = @_;
 
@@ -97,11 +114,32 @@ sub from_source {
             Gherkin::AstBuilder->new($id_generator)
             );
         my $data = $source->data;
-        my $ast_msg = $parser->parse( \$data, $source->uri);
-        $sink->($ast_msg) if $self->include_ast;
 
-        if ($self->include_pickles) {
-            Gherkin::Pickles::Compiler->compile($ast_msg, $id_generator, $sink);
+        local $@;
+        my $ast_msg;
+        if (eval { $ast_msg = $parser->parse( \$data, $source->uri); 1 }) {
+            $sink->($ast_msg) if $self->include_ast;
+
+            if ($self->include_pickles) {
+                Gherkin::Pickles::Compiler->compile(
+                    $ast_msg,
+                    $id_generator,
+                    $sink);
+            }
+        }
+        else {
+            if ( blessed $@ ) {
+                if ( $@->isa( 'Gherkin::Exceptions::CompositeParser' ) ) {
+                    $sink->( _parser_error_message( $_, $source->uri ) )
+                        for ( @{ $@->errors } );
+                    return;
+                }
+                elsif ( $@->isa( 'Gherkin::Exceptions::SingleParser' ) ) {
+                    $sink->( _parser_error_message( $@, $source->uri ) );
+                    return;
+                }
+            }
+            die $@; # rethrow
         }
     }
 }

perl/lib/Gherkin/Exceptions.pm

@@ -3,11 +3,7 @@ use warnings;
 
 package Gherkin::Exceptions;
 
-use overload
-    q{""}    => 'stringify',
-    fallback => 1;
-
-sub stringify { my $self  = shift; $self->message . "\n" }
+sub stringify { my $self  = shift; $self->message }
 sub throw     { my $class = shift; die $class->new(@_) }
 
 # Parent of single and composite exceptions
@@ -40,7 +36,12 @@ sub throw { my $class = shift; die $class->new(@_) }
 package Gherkin::Exceptions::SingleParser;
 
 use base 'Gherkin::Exceptions::Parser';
-use Class::XSAccessor accessors => [qw/location/];
+use Class::XSAccessor accessors => [qw/detailed_message location/];
+
+sub new {
+    my ( $class, %args ) = @_;
+    bless { %args }, $class;
+}
 
 sub message {
     my $self = shift;

perl/lib/Gherkin/Line.pm

@@ -4,7 +4,7 @@ use strict;
 use warnings;
 
 use Class::XSAccessor accessors =>
-  [ qw/line_text line_number indent _trimmed_line_text/, ];
+  [ qw/line_text line_number indent _trimmed_line_text _tag_error/, ];
 
 sub new {
     my ( $class, $options ) = @_;
@@ -137,11 +137,27 @@ sub tags {
     my @items = split( /@/, $items_line );
     shift(@items);    # Blank first item
 
-    for my $item (@items) {
-        my $original_item = $item;
+    for my $untrimmed (@items) {
+        my $item = $untrimmed;
         $item =~ s/^\s*//;
         $item =~ s/\s*$//;
-
+        next if length($item) == 0;
+
+        if ($item !~ /^\S+$/) {
+            # Cache the error we're throwing: this line may
+            # be evaluated for tokens again, in which case we
+            # need to throw the *same* error to prevent in from
+            # being reported twice... (yes, ugh!)
+            $self->{'_tag_error'} ||=
+                Gherkin::Exceptions::SingleParser->new(
+                    detailed_message => 'A tag may not contain whitespace',
+                    location => {
+                        line   => $self->line_number,
+                        column => $column,
+                    },
+                );
+            die $self->{'_tag_error'};
+        }
         push(
             @tags,
             {
@@ -150,7 +166,7 @@ sub tags {
             }
         );
 
-        $column += length($original_item) + 1;
+        $column += length($untrimmed) + 1;
     }
 
     return \@tags;

perl/lib/Gherkin/ParserContext.pm

@@ -3,6 +3,8 @@ package Gherkin::ParserContext;
 use strict;
 use warnings;
 
+use List::Util qw( uniq );
+
 use Class::XSAccessor accessors =>
   [ qw/token_scanner token_matcher token_queue _errors/, ];
 
@@ -15,7 +17,10 @@ sub new {
 
 sub add_tokens { my $self = shift; push( @{ $self->token_queue }, @_ ); }
 sub errors     { my $self = shift; return @{ $self->_errors } }
-sub add_errors { my $self = shift; push( @{ $self->_errors },     @_ ); }
+sub add_errors {
+    my $self = shift;
+    $self->_errors( [ uniq( @{ $self->_errors }, @_ ) ] );
+}
 
 sub read_token {
     my ($self) = shift();