view release on metacpan or  search on metacpan

t/Lexer.t  view on Meta::CPAN

#!perl

# $Id: Lexer.t,v 1.4 2013/07/27 00:34:39 Paulo Exp $

use 5.010;
use strict;
use warnings;

use Test::More;
use File::Slurp;
use Data::Dump 'dump';

use_ok 'Parse::FSM::Lexer';

#------------------------------------------------------------------------------
# Globals
my($lex, $file, $incfile);
my @TEMP; END { unlink @TEMP };
my $warn; $SIG{__WARN__} = sub {$warn = shift};

my @input = map {"$_\n"} 1..4;
my $input = join '', @input;

#------------------------------------------------------------------------------
sub tmpfile {
	my $file = "tmp~".scalar(@TEMP)."~";
	if (@_) {
		write_file($file, @_);
	}
	else {
		unlink $file; 
	}
	push @TEMP, $file;
	return $file;
}

#------------------------------------------------------------------------------
sub t_get {
	my($file, $line_nr, @tokens) = @_;
	my $id = "[line ".(caller)[2]."]";
	
	$file =~ s/\\/\//g if defined $file;
	
	if (@tokens) {
		while (my($type, $value) = splice(@tokens, 0, 2)) {
			is_deeply 	$lex->get_token, [$type, $value],
						"$id [".dump($type)." => ".dump($value)."]";
	
			my $lex_file = $lex->file;
			$lex_file =~ s/\\/\//g if defined $lex_file;
			
			is 			$lex_file, $file,			
						"$id file ".dump($file);
						
			is			$lex->line_nr, $line_nr,	
						"$id line_nr ".dump($line_nr);
		}
	}
	else {
		is	$lex->get_token, undef, "$id EOF";
		is	$lex->get_token, undef, "$id EOF";
	}
}

#------------------------------------------------------------------------------
sub t_error { 
	my($error_msg, $expected_message) = @_;
	my $line_nr = (caller)[2];
	my $test_name = "[line $line_nr]";

	(my $expected_error   = $expected_message) =~ s/XXX/Error/;
	(my $expected_warning = $expected_message) =~ s/XXX/Warning/;
	
	eval {	$lex->error($error_msg) };
	is		$@, $expected_error, "$test_name die()";
	
			$warn = "";
			$lex->warning($error_msg);
	is 		$warn, $expected_warning, "$test_name warning()";
	$warn = undef;
}

#------------------------------------------------------------------------------
# no input
$lex = new_ok('Parse::FSM::Lexer');
t_get();

#------------------------------------------------------------------------------
# no input file
$file = tmpfile();
eval { Parse::FSM::Lexer->new($file) };
is $@, "Error : unable to open input file '$file'\n";

$incfile = tmpfile();
$file = tmpfile("#include '$incfile'\n");
eval { Parse::FSM::Lexer->new($file)->get_token };
is $@, "Error at file '$file', line 1 : unable to open input file '$incfile'\n";

#------------------------------------------------------------------------------
# empty input file
$file = tmpfile("");
$lex = new_ok('Parse::FSM::Lexer', [$file]);
t_get();

#------------------------------------------------------------------------------
# file with Data
$file = tmpfile($input);
$lex = new_ok('Parse::FSM::Lexer');
$lex->from_file($file);
t_get($file, 1, NUM => 1);
t_get($file, 2, NUM => 2);
t_get($file, 3, NUM => 3);
t_get($file, 4, NUM => 4);
t_get();

#------------------------------------------------------------------------------
# file with Data, pass on constructor
$file = tmpfile($input);
$lex = new_ok('Parse::FSM::Lexer', [$file]);
t_get($file, 1, NUM => 1);
t_get($file, 2, NUM => 2);
t_get($file, 3, NUM => 3);
t_get($file, 4, NUM => 4);
t_get();

#------------------------------------------------------------------------------
# pass two files to constructor, read in correct order
$lex = new_ok('Parse::FSM::Lexer', ['t/Data/f01.asm', 't/Data/f02.asm']);