The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

# Unit testing for PPI::Token::Quote::Literal

use lib 't/lib';
use PPI::Test::pragmas;
use Test::More tests => 14 + ( $ENV{AUTHOR_TESTING} ? 1 : 0 );
use B 'perlstring';

use PPI;


STRING: {
	my $Document = PPI::Document->new( \"print q{foo}, q!bar!, q <foo>;" );
	isa_ok( $Document, 'PPI::Document' );
	my $literal = $Document->find('Token::Quote::Literal');
	is( scalar(@$literal), 3, '->find returns three objects' );
	isa_ok( $literal->[0], 'PPI::Token::Quote::Literal' );
	isa_ok( $literal->[1], 'PPI::Token::Quote::Literal' );
	isa_ok( $literal->[2], 'PPI::Token::Quote::Literal' );
	is( $literal->[0]->string, 'foo', '->string returns as expected' );
	is( $literal->[1]->string, 'bar', '->string returns as expected' );
	is( $literal->[2]->string, 'foo', '->string returns as expected' );
}


LITERAL: {
	my $Document = PPI::Document->new( \"print q{foo}, q!bar!, q <foo>;" );
	isa_ok( $Document, 'PPI::Document' );
	my $literal = $Document->find('Token::Quote::Literal');
	is( $literal->[0]->literal, 'foo', '->literal returns as expected' );
	is( $literal->[1]->literal, 'bar', '->literal returns as expected' );
	is( $literal->[2]->literal, 'foo', '->literal returns as expected' );
}

test_statement(
	"use 'SomeModule';",
	[
		'PPI::Statement::Include'   => "use 'SomeModule';",
		'PPI::Token::Word'          => 'use',
		'PPI::Token::Quote::Single' => "'SomeModule'",
		'PPI::Token::Structure'     => ';',
	]
);

test_statement(
	"use q{OtherModule.pm};",
	[
		'PPI::Statement::Include'     => 'use q{OtherModule.pm};',
		'PPI::Token::Word'            => 'use',
		'PPI::Token::Word'            => 'q',
		'PPI::Structure::Constructor' => '{OtherModule.pm}',
		'PPI::Token::Structure'       => '{',
		'PPI::Statement'              => 'OtherModule.pm',
		'PPI::Token::Word'            => 'OtherModule',
		'PPI::Token::Operator'        => '.',
		'PPI::Token::Word'            => 'pm',
		'PPI::Token::Structure'       => '}',
		'PPI::Token::Structure'       => ';',
	],
	"invalid syntax is identified correctly",
);

sub one_line_explain {
	my ( $data ) = @_;
	my @explain = explain $data;
	s/\n//g for @explain;
	return join "", @explain;
}

sub main_level_line {
	return "" if not $TODO;
	my @outer_final;
	my $level = 0;
	while ( my @outer = caller( $level++ ) ) {
		@outer_final = @outer;
	}
	return "l $outer_final[2] - ";
}

sub test_statement {
	local $Test::Builder::Level = $Test::Builder::Level + 1;
	my ( $code, $expected, $msg ) = @_;
	$msg = perlstring $code if !defined $msg;

	my $d = PPI::Document->new( \$code );
	my $tokens = $d->find( sub { $_[1]->significant } );
	$tokens = [ map { ref( $_ ), $_->content } @$tokens ];

	if ( $expected->[0] !~ /^PPI::Statement/ ) {
		$expected = [ 'PPI::Statement', $code, @$expected ];
	}
	my $ok = is_deeply( $tokens, $expected, main_level_line . $msg );
	if ( !$ok ) {
		diag ">>> $code -- $msg\n";
		diag one_line_explain $tokens;
		diag one_line_explain $expected;
	}

	return;
}