line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# $Id: Line.pm,v 1.11 2015/04/18 18:02:05 Paulo Exp $
|
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
package Asm::Preproc::Line;
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
#------------------------------------------------------------------------------
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
=head1 NAME
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
Asm::Preproc::Line - One line of text retrieved from the input
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=cut
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
#------------------------------------------------------------------------------
|
14
|
|
|
|
|
|
|
|
15
|
10
|
|
|
10
|
|
1534
|
use strict;
|
|
10
|
|
|
|
|
12
|
|
|
10
|
|
|
|
|
244
|
|
16
|
10
|
|
|
10
|
|
28
|
use warnings;
|
|
10
|
|
|
|
|
9
|
|
|
10
|
|
|
|
|
444
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
our $VERSION = '1.01';
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
#------------------------------------------------------------------------------
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 SYNOPSIS
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
use Asm::Preproc::Line;
|
25
|
|
|
|
|
|
|
my $line = Asm::Preproc::Line->new($text, $file, $line_nr);
|
26
|
|
|
|
|
|
|
$line->text; $line->rtext; $line->file; $line->line_nr;
|
27
|
|
|
|
|
|
|
my $line2 = $line->clone;
|
28
|
|
|
|
|
|
|
if ($line == $line2) {...}
|
29
|
|
|
|
|
|
|
if ($line != $line2) {...}
|
30
|
|
|
|
|
|
|
$line->error($message);
|
31
|
|
|
|
|
|
|
$line->warning($message);
|
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
=head1 DESCRIPTION
|
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
This module defines the object to represent one line of input text
|
36
|
|
|
|
|
|
|
to preprocess. It contains the actual text from the line, and the file name
|
37
|
|
|
|
|
|
|
and line number where the text was retrieved. It contains also utility methods
|
38
|
|
|
|
|
|
|
for error messages.
|
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
=head1 METHODS
|
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
=head2 new
|
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
Creates a new object with the given text, file name and line number.
|
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=head2 text
|
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
Get/set line text.
|
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=head2 rtext
|
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
Return reference to the text value.
|
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
=head2 file
|
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
Get/set file name.
|
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
=head2 line_nr
|
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
Get/set line number.
|
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=head2 clone
|
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
Creates an identical copy as a new object.
|
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=cut
|
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
#------------------------------------------------------------------------------
|
69
|
|
|
|
|
|
|
use Class::XSAccessor::Array {
|
70
|
10
|
|
|
|
|
70
|
accessors => {
|
71
|
|
|
|
|
|
|
text => 0,
|
72
|
|
|
|
|
|
|
file => 1,
|
73
|
|
|
|
|
|
|
line_nr => 2,
|
74
|
|
|
|
|
|
|
},
|
75
|
10
|
|
|
10
|
|
3733
|
};
|
|
10
|
|
|
|
|
25097
|
|
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
sub new {
|
78
|
|
|
|
|
|
|
#my($class, $text, $file, $line_nr) = @_;
|
79
|
205
|
|
|
205
|
1
|
18277
|
my $class = shift;
|
80
|
205
|
|
|
|
|
719
|
bless [@_], $class;
|
81
|
|
|
|
|
|
|
}
|
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
sub clone {
|
84
|
2
|
|
|
2
|
1
|
2
|
my $self = shift;
|
85
|
2
|
|
|
|
|
30
|
bless [@$self], ref($self);
|
86
|
|
|
|
|
|
|
}
|
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
#------------------------------------------------------------------------------
|
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
=head2 is_equal
|
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
if ($self == $other) { ... }
|
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
Compares two line objects. Overloads the '==' operator.
|
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=cut
|
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
#------------------------------------------------------------------------------
|
99
|
20
|
|
|
20
|
1
|
17
|
sub is_equal { my($self, $other) = @_;
|
100
|
10
|
|
|
10
|
|
1707
|
no warnings 'uninitialized';
|
|
10
|
|
|
|
|
12
|
|
|
10
|
|
|
|
|
887
|
|
101
|
20
|
|
100
|
|
|
140
|
return $self->text eq $other->text &&
|
102
|
|
|
|
|
|
|
$self->line_nr == $other->line_nr &&
|
103
|
|
|
|
|
|
|
$self->file eq $other->file;
|
104
|
|
|
|
|
|
|
}
|
105
|
|
|
|
|
|
|
|
106
|
10
|
|
|
10
|
|
912
|
use overload '==' => \&is_equal, fallback => 1;
|
|
10
|
|
|
|
|
642
|
|
|
10
|
|
|
|
|
68
|
|
107
|
|
|
|
|
|
|
#------------------------------------------------------------------------------
|
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=head2 is_different
|
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
if ($self != $other) { ... }
|
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
Compares two line objects. Overloads the '!=' operator.
|
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
=cut
|
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
#------------------------------------------------------------------------------
|
118
|
10
|
|
|
10
|
1
|
11
|
sub is_different { my($self, $other) = @_;
|
119
|
10
|
|
|
|
|
15
|
return ! $self->is_equal($other);
|
120
|
|
|
|
|
|
|
}
|
121
|
|
|
|
|
|
|
|
122
|
10
|
|
|
10
|
|
791
|
use overload '!=' => \&is_different, fallback => 1;
|
|
10
|
|
|
|
|
14
|
|
|
10
|
|
|
|
|
26
|
|
123
|
|
|
|
|
|
|
#------------------------------------------------------------------------------
|
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
=head2 error
|
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
Dies with the given error message, indicating the place in the input source file
|
128
|
|
|
|
|
|
|
where the error occured as:
|
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
FILE(LINE) : error: MESSAGE
|
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=cut
|
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
#------------------------------------------------------------------------------
|
135
|
|
|
|
|
|
|
sub error {
|
136
|
52
|
|
|
52
|
1
|
44
|
my($self, $message) = @_;
|
137
|
52
|
|
|
|
|
65
|
die $self->_error_msg("error", $message);
|
138
|
|
|
|
|
|
|
}
|
139
|
|
|
|
|
|
|
#------------------------------------------------------------------------------
|
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
=head2 warning
|
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
Warns with the given error message, indicating the place in the input source file
|
144
|
|
|
|
|
|
|
where the error occured as:
|
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
FILE(LINE) : warning: MESSAGE
|
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=cut
|
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
#------------------------------------------------------------------------------
|
151
|
45
|
|
|
45
|
1
|
2058
|
sub warning { my($self, $message) = @_;
|
152
|
45
|
|
|
|
|
49
|
warn $self->_error_msg("warning", $message);
|
153
|
|
|
|
|
|
|
}
|
154
|
|
|
|
|
|
|
#------------------------------------------------------------------------------
|
155
|
|
|
|
|
|
|
# error message for error() and warning()
|
156
|
|
|
|
|
|
|
sub _error_msg {
|
157
|
97
|
|
|
97
|
|
85
|
my($self, $type, $message) = @_;
|
158
|
|
|
|
|
|
|
|
159
|
10
|
|
|
10
|
|
1023
|
no warnings 'uninitialized';
|
|
10
|
|
|
|
|
12
|
|
|
10
|
|
|
|
|
915
|
|
160
|
|
|
|
|
|
|
|
161
|
97
|
|
|
|
|
97
|
my $file = $self->file;
|
162
|
97
|
100
|
|
|
|
165
|
my $line_nr = $self->line_nr ? '('.$self->line_nr.')' : '';
|
163
|
97
|
100
|
|
|
|
93
|
my $pos = "$file$line_nr"; $pos .= " : " if $pos;
|
|
97
|
|
|
|
|
123
|
|
164
|
|
|
|
|
|
|
|
165
|
97
|
|
|
|
|
203
|
$message =~ s/\s+$//; # in case message comes from die, has a "\n"
|
166
|
|
|
|
|
|
|
|
167
|
97
|
|
|
|
|
384
|
return "$pos$type: $message\n";
|
168
|
|
|
|
|
|
|
}
|
169
|
|
|
|
|
|
|
#------------------------------------------------------------------------------
|
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=head1 AUTHOR, BUGS, SUPPORT, LICENSE, COPYRIGHT
|
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
See L.
|
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=cut
|
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
#------------------------------------------------------------------------------
|
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
1;
|