Unescape results from PPI::Token::QuoteLike::Words::literal Perl-Crit…

…ic#124

lib/PPI/Token/QuoteLike/Words.pm

@@ -42,20 +42,29 @@ BEGIN {
 
 =head2 literal
 
-Returns the words contained.  Note that this method does not check the
+Returns the words contained as a list.  Note that this method does not check the
 context that the token is in; it always returns the list and not merely
 the last element if the token is in scalar context.
 
 =cut
 
 sub literal {
 	my $self    = shift;
-	my $section = $self->{sections}->[0];
-	return split ' ', substr(
-		$self->{content},
-		$section->{position},
-		$section->{size},
-	);
+
+	my @words;
+
+	my $content = $self->_section_content(0);
+	if ( defined $content ) {
+		# Undo backslash escaping of '\', the left delimiter,
+		# and the right delimiter.  The right delimiter will
+                # only exist with paired delimiters: qw() qw[] qw<> qw{}.
+		my ( $left, $right ) = ( $self->_delimiters, '', '' );
+		$content =~ s/\\([\Q$left$right\\\E])/$1/g;
+
+		@words = split ' ', $content;
+	}
+
+	return @words;
 }
 
 1;

lib/PPI/Token/_QuoteEngine/Full.pm

@@ -32,7 +32,7 @@ BEGIN {
 		's'   => { operator => 's',   braced => undef, separator => undef, _sections => 2, modifiers => 1 },
 		'tr'  => { operator => 'tr',  braced => undef, separator => undef, _sections => 2, modifiers => 1 },
 
-		# Y is the little used variant of tr
+		# Y is the little-used variant of tr
 		'y'   => { operator => 'y',   braced => undef, separator => undef, _sections => 2, modifiers => 1 },
 
 		'/'   => { operator => undef, braced => 0,     separator => '/',   _sections => 1, modifiers => 1 },

lib/PPI/Tokenizer.pm

@@ -739,7 +739,7 @@ my %OBVIOUS_CONTENT = (
 
 my %USUALLY_FORCES = map { $_ => 1 } qw( sub package use no );
 
-# Try to determine operator/operand context, is possible.
+# Try to determine operator/operand context, if possible.
 # Returns "operator", "operand", or "" if unknown.
 sub _opcontext {
 	my $self   = shift;

t/ppi_token_quotelike_words.t

@@ -10,7 +10,8 @@ BEGIN {
 	$PPI::XS_DISABLE = 1;
 	$PPI::Lexer::X_TOKENIZER ||= $ENV{X_TOKENIZER};
 }
-use Test::More tests => 13;
+use Test::More tests => 67;
+use Test::Deep;
 use Test::NoWarnings;
 use PPI;
 
@@ -55,3 +56,42 @@ END_PERL
 		is_deeply( [ $token->literal ], \@expected, '->literal matches expected' );
 	}
 }
+
+
+{
+	my $bs = '\\'; # a single backslash character
+	for my $test (
+		{ code => 'qw(a, b c,)', want => [ 'a,', 'b', 'c,' ] },
+		{ code => 'qw[a, b c,]', want => [ 'a,', 'b', 'c,' ] },
+		{ code => 'qw<a, b c,>', want => [ 'a,', 'b', 'c,' ] },
+		{ code => 'qw{a, b c,}', want => [ 'a,', 'b', 'c,' ] },
+		{ code => 'qw) a )', want => [ 'a' ] },
+		{ code => 'qw] a ]', want => [ 'a' ] },
+		{ code => 'qw> a >', want => [ 'a' ] },
+		{ code => 'qw} a }', want => [ 'a' ] },
+		{ code => "qw( $bs) )", want => [ ')' ] },
+		{ code => "qw( $bs( )", want => [ '(' ] },
+		{ code => 'qw(//)', want => [ '//' ] },
+		{ code => 'qw( () )', want => [ '()' ] },
+		{ code => 'qw( (( ) ) )', want => [ '((', ')', ')' ] },
+		{ code => 'qw( qw() )', want => [ 'qw()' ] },
+		{ code => 'qw( qw// )', want => [ 'qw//' ] },
+		{ code => "qw{ $bs} }", want => [ '}' ] },
+		{ code => "qw/ $bs/ /", want => [ '/' ] },
+		{ code => "qw' $bs' '", want => [ "'" ] },
+		{ code => 'qw" \\" "', want => [ '"' ] }, # 'code' contains a single backslash
+		{ code => 'qw 1a \\11', want => [ 'a', '1' ] },
+		{ code => 'qw# a #', want => [ 'a' ] },
+		{ code => 'qw# \# #', want => [ '#' ] },
+		{ code => "qw( $bs )", want => [ $bs ] },
+		{ code => "qw( $bs$bs )", want => [ $bs ] },
+		{ code => "qw$bs a $bs", want => [ 'a' ] },
+		{ code => 'qw  ( a )', want => [ 'a' ] },
+		{ code => "qw\n( a )", want => [ 'a' ] },
+	) {
+		my $d = PPI::Document->new( \$test->{code} );
+		isa_ok( $d, 'PPI::Document' );
+		is_deeply( [ $d->schild(0)->schild(0)->literal() ], $test->{want}, $test->{code} );
+	}
+}
+