#!/usr/bin/perl
# Formal unit tests for specific PPI::Token classes
use strict;
BEGIN {
no warnings 'once';
$| = 1;
$PPI::XS_DISABLE = 1;
$PPI::Lexer::X_TOKENIZER ||= $ENV{X_TOKENIZER};
}
# Execute the tests
use Test::More tests => 307;
use Test::NoWarnings;
use File::Spec::Functions ':ALL';
use List::MoreUtils ();
use t::lib::PPI;
use PPI;
#####################################################################
# Code/Dump Testing
# ntests = 2 + 12 * nfiles
t::lib::PPI->run_testdir( catdir( 't', 'data', '07_token' ) );
#####################################################################
# PPI::Token::Symbol Unit Tests
# Note: braces and the symbol() method are tested in regression.t
SCOPE: {
# Test both creation methods
my $Token = PPI::Token::Symbol->new( '$foo' );
isa_ok( $Token, 'PPI::Token::Symbol' );
# Check the creation of a number of different values
my @symbols = (
'$foo' => '$foo',
'@foo' => '@foo',
'$ foo' => '$foo',
'$::foo' => '$main::foo',
'@::foo' => '@main::foo',
'$foo::bar' => '$foo::bar',
'$ foo\'bar' => '$foo::bar',
);
while ( @symbols ) {
my ($value, $canon) = ( shift(@symbols), shift(@symbols) );
my $Symbol = PPI::Token::Symbol->new( $value );
isa_ok( $Symbol, 'PPI::Token::Symbol' );
is( $Symbol->content, $value, "Symbol '$value' returns ->content '$value'" );
is( $Symbol->canonical, $canon, "Symbol '$value' returns ->canonical '$canon'" );
}
}
#####################################################################
# PPI::Token::Number Unit Tests
SCOPE: {
my @examples = (
# code => base | '10f' | '10e'
'0' => 10,
'1' => 10,
'10' => 10,
'1_0' => 10,
'.0' => '10f',
'.0_0' => '10f',
'-.0' => '10f',
'0.' => '10f',
'0.0' => '10f',
'0.0_0' => '10f',
'1_0.' => '10f',
'.0e0' => '10e',
'-.0e0' => '10e',
'0.e1' => '10e',
'0.0e-1' => '10e',
'0.0e+1' => '10e',
'0.0e-10' => '10e',
'0.0e+10' => '10e',
'0.0e100' => '10e',
'1_0e1_0' => '10e', # Known to fail on 5.6.2
'0b' => 2,
'0b0' => 2,
'0b10' => 2,
'0b1_0' => 2,
'00' => 8,
'01' => 8,
'010' => 8,
'01_0' => 8,
'0x' => 16,
'0x0' => 16,
'0x10' => 16,
'0x1_0' => 16,
'0.0.0' => 256,
'.0.0' => 256,
'127.0.0.1' => 256,
'1.1.1.1.1.1' => 256,
);
while ( @examples ) {
my $code = shift @examples;
my $base = shift @examples;
if ( $] >= 5.006 and $] < 5.008 and $code eq '1_0e1_0' ) {
SKIP: {
skip( 'Ignoring known-bad case on Perl 5.6.2', 5 );
}
next;
}
my $exp = $base =~ s/e//;
my $float = $exp || $base =~ s/f//;
my $T = PPI::Tokenizer->new( \$code );
my $token = $T->get_token;
is("$token", $code, "'$code' is a single token");
is($token->base, $base, "base of '$code' is $base");
if ($float) {
ok($token->isa('PPI::Token::Number::Float'), "'$code' is ::Float");
} else {
ok(!$token->isa('PPI::Token::Number::Float'), "'$code' not ::Float");
}
if ($exp) {
ok($token->isa('PPI::Token::Number::Exp'), "'$code' is ::Exp");
} else {
ok(!$token->isa('PPI::Token::Number::Exp'), "'$code' not ::Exp");
}
if ($base != 256) {
$^W = 0;
my $literal = eval $code;
if ($@) {
is($token->literal, undef, "literal('$code'), $@");
} else {
cmp_ok($token->literal, '==', $literal, "literal('$code')");
}
}
}
}
foreach my $code ( '1.0._0', '1.0.0.0_0' ) {
my $T = PPI::Tokenizer->new( \$code );
my $token = $T->get_token;
isnt("$token", $code, 'tokenize bad version');
}
foreach my $code ( '08', '09', '0778', '0779' ) {
my $T = PPI::Tokenizer->new( \$code );
my $token = $T->get_token;
isa_ok($token, 'PPI::Token::Number::Octal');
is("$token", $code, "tokenize bad octal '$code'");
ok($token->{_error} && $token->{_error} =~ m/octal/i,
'invalid octal number should trigger parse error');
is($token->literal, undef, "literal('$code') is undef");
}
foreach my $code ( '0b2', '0b012' ) {
my $T = PPI::Tokenizer->new( \$code );
my $token = $T->get_token;
isa_ok($token, 'PPI::Token::Number::Binary');
is("$token", $code, "tokenize bad binary '$code'");
ok($token->{_error} && $token->{_error} =~ m/binary/i,
'invalid binary number should trigger parse error');
is($token->literal, undef, "literal('$code') is undef");
}
foreach my $code ( '0xg', '0x0g' ) {
my $T = PPI::Tokenizer->new( \$code );
my $token = $T->get_token;
isa_ok($token, 'PPI::Token::Number::Hex');
isnt("$token", $code, "tokenize bad hex '$code'");
ok(!$token->{_error}, 'invalid hexadecimal digit triggers end of token');
is($token->literal, 0, "literal('$code') is 0");
}