1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
package PPI::Token::Number;
# The perl numeric token are
# $n = 1234; # decimal integer
# $n = 0b1110011; # binary integer
# $n = 01234; # octal integer
# $n = 0x1234; # hexadecimal integer
# $n = 12.34e-56; # exponential notation ( currently not working )
use strict;
use UNIVERSAL 'isa';
use base 'PPI::Token';
use vars qw{$VERSION};
BEGIN {
$VERSION = '0.903';
}
sub _on_char {
my $class = shift;
my $t = shift;
my $char = substr( $t->{line}, $t->{line_cursor}, 1 );
# Allow underscores straight through
return 1 if $char eq '_';
# Handle the conversion from an unknown to known type.
# The regex covers "potential" hex/bin/octal number.
my $token = $t->{token};
if ( $token->{content} =~ /^-?0_*$/ ) {
# This could be special
if ( $char eq 'x' ) {
$token->{_subtype} = 'hex';
return 1;
} elsif ( $char eq 'b' ) {
$token->{_subtype} = 'binary';
return 1;
} elsif ( $char =~ /\d/ ) {
$token->{_subtype} = 'octal';
return 1;
} elsif ( $char eq '.' ) {
return 1;
} else {
# End of the number... its just 0
return $t->_finalize_token->_on_char( $t );
}
}
if ( ! $token->{_subtype} or $token->{_subtype} eq 'base256' ) {
# Handle the easy case, integer or real.
return 1 if $char =~ /\d/o;
if ( $char eq '.' ) {
if ( $token->{content} =~ /\.$/ ) {
# We have a .., which is an operator.
# Take the . off the end of the token..
# and finish it, then make the .. operator.
chop $t->{token}->{content};
$t->_new_token( 'Operator', '..' ) or return undef;
return 0;
} else {
# Will this be the first .?
if ( $token->{content} =~ /\./ ) {
return 1;
} else {
# Flag as a base256.
$token->{_subtype} = 'base256';
return 1;
}
}
}
} elsif ( $token->{_subtype} eq 'octal' ) {
# You cannot have 9s on octals
if ( $char eq '9' ) {
return $class->_error( "Illegal octal digit '9'" );
}
# Any other number is ok
return 1 if $char =~ /\d/o;
} elsif ( $token->{_subtype} eq 'hex' ) {
return 1 if $char =~ /[\da-f]/io;
# Error on other word chars
if ( $char =~ /\w/ ) {
return $class->_error( "Illegal hexidecimal character '$char'" );
}
} elsif ( $token->{_subtype} eq 'binary' ) {
return 1 if $char =~ /(?:1|0)/;
# Other bad characters
if ( $char =~ /[\w\d]/ ) {
return $class->_error( "Illegal binary character '$char'" );
}
} else {
return $class->_error( "Unknown number type '$token->{_subtype}'" );
}
# Doesn't fit a special case, or is after the end of the token
# End of token.
$t->_finalize_token->_on_char( $t );
}
1;
|
