line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package PPI::Token::Number; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=pod |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 NAME |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
PPI::Token::Number - Token class for a number |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 SYNOPSIS |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
$n = 1234; # decimal integer |
12
|
|
|
|
|
|
|
$n = 0b1110011; # binary integer |
13
|
|
|
|
|
|
|
$n = 01234; # octal integer |
14
|
|
|
|
|
|
|
$n = 0x1234; # hexadecimal integer |
15
|
|
|
|
|
|
|
$n = 12.34e-56; # exponential notation ( currently not working ) |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 INHERITANCE |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
PPI::Token::Number |
20
|
|
|
|
|
|
|
isa PPI::Token |
21
|
|
|
|
|
|
|
isa PPI::Element |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
=head1 DESCRIPTION |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
The C class is used for tokens that represent numbers, |
26
|
|
|
|
|
|
|
in the various types that Perl supports. |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=head1 METHODS |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=cut |
31
|
|
|
|
|
|
|
|
32
|
65
|
|
|
65
|
|
481
|
use strict; |
|
65
|
|
|
|
|
130
|
|
|
65
|
|
|
|
|
1930
|
|
33
|
65
|
|
|
65
|
|
319
|
use PPI::Token (); |
|
65
|
|
|
|
|
114
|
|
|
65
|
|
|
|
|
31798
|
|
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
our $VERSION = '1.277'; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
our @ISA = "PPI::Token"; |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=pod |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
=head2 base |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
The C method is provided by all of the ::Number subclasses. |
44
|
|
|
|
|
|
|
This is 10 for decimal, 16 for hexadecimal, 2 for binary, etc. |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=cut |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub base() { 10 } |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=pod |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=head2 literal |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
Return the numeric value of this token. |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=cut |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
sub literal { |
59
|
4
|
|
|
4
|
1
|
76
|
return 0 + $_[0]->_literal; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
sub _literal { |
63
|
|
|
|
|
|
|
# De-sugar the string representation |
64
|
74
|
|
|
74
|
|
112
|
my $self = shift; |
65
|
74
|
|
|
|
|
202
|
my $string = $self->content; |
66
|
74
|
|
|
|
|
165
|
$string =~ s/^\+//; |
67
|
74
|
|
|
|
|
168
|
$string =~ s/_//g; |
68
|
74
|
|
|
|
|
252
|
return $string; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
##################################################################### |
76
|
|
|
|
|
|
|
# Tokenizer Methods |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub __TOKENIZER__on_char { |
79
|
31524
|
|
|
31524
|
|
49523
|
my $class = shift; |
80
|
31524
|
|
|
|
|
41430
|
my $t = shift; |
81
|
31524
|
|
|
|
|
57330
|
my $char = substr( $t->{line}, $t->{line_cursor}, 1 ); |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
# Allow underscores straight through |
84
|
31524
|
100
|
|
|
|
60514
|
return 1 if $char eq '_'; |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
# Handle the conversion from an unknown to known type. |
87
|
|
|
|
|
|
|
# The regex covers "potential" hex/bin/octal number. |
88
|
31118
|
|
|
|
|
42870
|
my $token = $t->{token}; |
89
|
31118
|
100
|
|
|
|
88807
|
if ( $token->{content} =~ /^-?0_*$/ ) { |
90
|
|
|
|
|
|
|
# This could be special |
91
|
3028
|
100
|
100
|
|
|
22792
|
if ( $char eq 'x' || $char eq 'X' ) { |
|
|
100
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
92
|
55
|
|
|
|
|
205
|
$t->{class} = $t->{token}->set_class( 'Number::Hex' ); |
93
|
55
|
|
|
|
|
221
|
return 1; |
94
|
|
|
|
|
|
|
} elsif ( $char eq 'b' || $char eq 'B' ) { |
95
|
29
|
|
|
|
|
111
|
$t->{class} = $t->{token}->set_class( 'Number::Binary' ); |
96
|
29
|
|
|
|
|
102
|
return 1; |
97
|
|
|
|
|
|
|
} elsif ( $char =~ /\d/ ) { |
98
|
|
|
|
|
|
|
# You cannot have 8s and 9s on octals |
99
|
40
|
100
|
100
|
|
|
252
|
if ( $char eq '8' or $char eq '9' ) { |
100
|
18
|
|
|
|
|
85
|
$token->{_error} = "Illegal character in octal number '$char'"; |
101
|
|
|
|
|
|
|
} |
102
|
40
|
|
|
|
|
156
|
$t->{class} = $t->{token}->set_class( 'Number::Octal' ); |
103
|
40
|
|
|
|
|
165
|
return 1; |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
# Handle the easy case, integer or real. |
108
|
30994
|
100
|
|
|
|
98415
|
return 1 if $char =~ /\d/o; |
109
|
|
|
|
|
|
|
|
110
|
18329
|
100
|
|
|
|
36588
|
if ( $char eq '.' ) { |
111
|
2474
|
|
|
|
|
7677
|
$t->{class} = $t->{token}->set_class( 'Number::Float' ); |
112
|
2474
|
|
|
|
|
7795
|
return 1; |
113
|
|
|
|
|
|
|
} |
114
|
15855
|
100
|
100
|
|
|
53652
|
if ( $char eq 'e' || $char eq 'E' ) { |
115
|
13
|
|
|
|
|
41
|
$t->{class} = $t->{token}->set_class( 'Number::Exp' ); |
116
|
13
|
|
|
|
|
43
|
return 1; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
# Doesn't fit a special case, or is after the end of the token |
120
|
|
|
|
|
|
|
# End of token. |
121
|
15842
|
|
|
|
|
34151
|
$t->_finalize_token->__TOKENIZER__on_char( $t ); |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
1; |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=pod |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
=head1 CAVEATS |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
Compared to Perl, the number tokenizer is too liberal about allowing |
131
|
|
|
|
|
|
|
underscores anywhere. For example, the following is a syntax error in |
132
|
|
|
|
|
|
|
Perl, but is allowed in PPI: |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
0_b10 |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=head1 TO DO |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
- Treat v-strings as binary strings or barewords, not as "base-256" |
139
|
|
|
|
|
|
|
numbers |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
- Break out decimal integers into their own subclass? |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
- Implement literal() |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
=head1 SUPPORT |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
See the L in the main module. |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
=head1 AUTHOR |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
Adam Kennedy Eadamk@cpan.orgE |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=head1 COPYRIGHT |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
Copyright 2001 - 2011 Adam Kennedy. |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
This program is free software; you can redistribute |
158
|
|
|
|
|
|
|
it and/or modify it under the same terms as Perl itself. |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
The full text of the license can be found in the |
161
|
|
|
|
|
|
|
LICENSE file included with this module. |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=cut |