File Coverage

blib/lib/Asm/Preproc/Line.pm
Criterion Covered Total %
statement 40 40 100.0
branch 4 4 100.0
condition 3 3 100.0
subroutine 14 14 100.0
pod 6 6 100.0
total 67 67 100.0


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;