File Coverage

blib/lib/Verilog/Parser.pm
Criterion Covered Total %
statement 105 125 84.0
branch 20 38 52.6
condition 7 13 53.8
subroutine 24 28 85.7
pod 14 20 70.0
total 170 224 75.8


line stmt bran cond sub pod time code
1             # Verilog - Verilog Perl Interface
2             # See copyright, etc in below POD section.
3             ######################################################################
4              
5             package Verilog::Parser;
6 11     11   103870 use Carp;
  11         28  
  11         2435  
7 11     11   5408 use Verilog::Getopt;
  11         30  
  11         404  
8 11     11   6088 use Verilog::Language;
  11         37  
  11         538  
9 11     11   4911 use Verilog::Std;
  11         33  
  11         490  
10              
11             require DynaLoader;
12 11     11   70 use base qw(DynaLoader);
  11         19  
  11         917  
13              
14 11     11   66 use strict;
  11         180  
  11         284  
15 11     11   50 use vars qw($VERSION $Debug);
  11         132  
  11         15251  
16              
17             $VERSION = '3.478';
18              
19             #$Debug sets the default value for debug. You're better off with the object method though.
20              
21             our @_Callback_Names = qw(
22             attribute
23             endparse
24             keyword
25             number
26             operator
27             preproc
28             string
29             symbol
30             );
31              
32             ######################################################################
33             #### Configuration Section
34              
35             bootstrap Verilog::Parser;
36              
37             #In Parser.xs:
38             # sub _new (class, sigparser)
39             # sub _open (class)
40             # sub _debug (class, level)
41             # sub _prologe (class, flag)
42             # sub _callback_master_enable
43             # sub _use_cb (class, name, flag)
44             # sub parse (class)
45             # sub eof (class)
46             # sub filename (class, [setit])
47             # sub lineno (class, [setit])
48             # sub unreadback (class, [setit])
49             # sub unreadbackCat (class, add)
50              
51             ######################################################################
52             #### Constructors
53              
54             sub new {
55 490 50   490 1 2039 my $class = shift; $class = ref $class if ref $class;
  490         1375  
56 490         4738 my $self = {_sigparser=>0,
57             symbol_table=>[], # .xs will init further for us
58             use_vars => 1,
59             use_unreadback => 1, # Backward compatibility
60             use_protected => 1, # Backward compatibility
61             use_pinselects => 0, # Backward compatibility
62             use_std => undef, # Undef = silent
63             #use_cb_{callback-name} => 0/1
64             #
65             #_debug # Don't set, use debug() accessor to change level
66             @_};
67              
68 490         1098 bless $self, $class;
69             # Sets $self->{_cthis}
70             $self->_new($self,
71             # Options go here
72             $self->{symbol_table},
73             $self->{_sigparser},
74             $self->{use_unreadback},
75             $self->{use_protected},
76             $self->{use_pinselects}, # Undocumented as for use in SigParser only
77 490         17850 );
78              
79 490 50       2361 $self->{use_cb_contassign} = $self->{use_vars} if !exists $self->{use_cb_contassign};
80 490 50       1633 $self->{use_cb_defparam} = $self->{use_vars} if !exists $self->{use_cb_defparam};
81 490 50       1386 $self->{use_cb_pin} = $self->{use_vars} if !exists $self->{use_cb_pin};
82 490 50       1438 $self->{use_cb_port} = $self->{use_vars} if !exists $self->{use_cb_port};
83 490 50       1395 $self->{use_cb_var} = $self->{use_vars} if !exists $self->{use_cb_var};
84              
85 490         729 foreach my $key (keys %{$self}) {
  490         3424  
86 9994 100       20752 if ($key =~ /^use_cb_(.*)/) {
87 4123         12906 $self->_use_cb($1, $self->{$key});
88             }
89             }
90              
91 490         2322 $self->language(Verilog::Language::language_standard());
92 490 50       1171 $self->debug($Debug) if $Debug;
93 490         1176 return $self;
94             }
95              
96             sub DESTROY {
97 490     490   90808 my $self = shift;
98 490         44729 $self->_DESTROY;
99             }
100              
101             ######################################################################
102             #### Accessors
103              
104             sub callback_names {
105 2     2 1 7341 my @out = sort @_Callback_Names;
106 2         8 return @out;
107             }
108              
109             sub debug {
110 1447     1447 0 2082 my $self = shift;
111 1447         1770 my $level = shift;
112 1447 100       2710 if (defined $level) {
113 459         1846 $self->{_debug} = $level;
114 459         1926 $self->_debug($level);
115             }
116 1447         2594 return $self->{_debug};
117             }
118              
119             sub fileline {
120 0     0 0 0 my $self = shift;
121 0   0     0 return ($self->filename||"").":".($self->lineno||"");
      0        
122             }
123              
124 0     0 0 0 sub line { return lineno(@_); } # Old, now undocumented
125              
126             #######################################################################
127             #### Methods
128              
129             sub reset {
130 489     489 0 851 my $self = shift;
131 489         1458 $self->std;
132             }
133              
134             sub std {
135 515     515 0 800 my $self = shift;
136 515   66     2557 my $quiet = !defined $self->{use_std} && $self->{_sigparser};
137 515 100 66     3221 if (!$self->{symbol_table}[2]->{std} # Not in the symbol table yet
      100        
138             && ($self->{use_std} || $quiet)
139             ) {
140 459 50       995 print "Including std::\n" if $self->{_debug};
141 459         1231 my $olddbg = $self->debug;
142 459 50       1022 if ($quiet) {
143 459 50       1040 print "Disabling debug during std:: loading\n" if $self->{_debug};
144 459         1152 $self->debug(0);
145 459         1223 $self->_callback_master_enable(0); # //verilog-perl callbacks off
146             }
147 459         65977 $self->eof; #Flush user code before callback disable
148 459         2346 $self->parse(Verilog::Std::std);
149 459         260184 $self->eof;
150 459 50       2760 if ($quiet) {
151 459         1718 $self->_callback_master_enable(1); # //verilog-perl callbacks on
152 459         1207 $self->debug($olddbg);
153             }
154             }
155             }
156              
157             sub parse_file {
158             # Read a file and parse
159 0 0   0 1 0 @_ == 2 or croak 'usage: $parser->parse_file($filename)';
160 0         0 my $self = shift;
161 0         0 my $filename = shift;
162              
163 0         0 my $fh = new IO::File;
164 0 0       0 $fh->open($filename) or croak "%Error: $! $filename";
165 0         0 $self->reset();
166 0         0 $self->filename($filename);
167 0         0 $self->lineno(1);
168 0         0 while (defined(my $line = $fh->getline())) {
169 0         0 $self->parse($line);
170             }
171 0         0 $self->eof;
172 0         0 $fh->close;
173 0         0 return $self;
174             }
175              
176             sub parse_preproc_file {
177             # Read a preprocess file and parse
178 463 50   463 1 2471 @_ == 2 or croak 'usage: $parser->parse_file(Verilog::Preproc_object_ref)';
179 463         834 my $self = shift;
180 463         610 my $pp = shift;
181              
182 463 50       1288 ref($pp) or croak "%Error: not passed a Verilog::Preproc object";
183 463         1541 $self->reset();
184              
185             # Chunk size of ~32K determined experimentally with t/49_largeish.t
186 463         254443 while (defined(my $text = $pp->getall(31*1024))) {
187 487         115564 $self->parse($text);
188             }
189 463         41328 $self->eof;
190 463         11792 return $self;
191             }
192              
193             ######################################################################
194             #### Called by the parser
195              
196             sub error {
197 0     0 0 0 my ($self,$text,$token)=@_;
198 0         0 my $fileline = $self->filename.":".$self->lineno;
199 0         0 croak("%Error: $fileline: $text\n"
200             ."Stopped");
201             }
202              
203             sub attribute {
204             # Default Internal callback
205 153     153 1 362 my $self = shift; # Parser invoked
206 153         290 my $token = shift; # What token was parsed
207 153         1072 $self->unreadbackCat($token);
208             }
209              
210             sub comment {
211             # Default Internal callback
212 3950     3950 1 4989 my $self = shift; # Parser invoked
213 3950         4568 my $token = shift; # What token was parsed
214 3950         30225 $self->unreadbackCat($token);
215             }
216              
217             sub string {
218             # Default Internal callback
219 1039     1039 1 2076 my $self = shift; # Parser invoked
220 1039         1392 my $token = shift; # What token was parsed
221 1039         6436 $self->unreadbackCat($token);
222             }
223              
224             sub keyword {
225             # Default Internal callback
226 64129     64129 1 151121 my $self = shift; # Parser invoked
227 64129         77219 my $token = shift; # What token was parsed
228 64129         402947 $self->unreadbackCat($token);
229             }
230              
231             sub symbol {
232             # Default Internal callback
233 73618     73618 1 139802 my $self = shift; # Parser invoked
234 73618         79619 my $token = shift; # What token was parsed
235 73618         519657 $self->unreadbackCat($token);
236             }
237              
238             sub operator {
239             # Default Internal callback
240 131317     131317 1 251100 my $self = shift; # Parser invoked
241 131317         135898 my $token = shift; # What token was parsed
242 131317         807960 $self->unreadbackCat($token);
243             }
244              
245             sub preproc {
246             # Default Internal callback
247 1704     1704 1 17640 my $self = shift; # Parser invoked
248 1704         2374 my $token = shift; # What token was parsed
249 1704 50       5163 if (Verilog::Language::is_keyword($token)) {
250 0         0 $self->keyword($token); # Do this for backward compatibility with Version 2.*
251             } else {
252 1704         3747 $self->symbol($token); # Do this for backward compatibility with Version 2.*
253             }
254             }
255             sub number {
256             # Default Internal callback
257 21977     21977 1 36915 my $self = shift; # Parser invoked
258 21977         23600 my $token = shift; # What token was parsed
259 21977         101321 $self->unreadbackCat($token);
260             }
261              
262             sub sysfunc {
263             # Default Internal callback - note the default action
264 1655     1655 1 22688 my $self = shift; # Parser invoked
265 1655         1959 my $token = shift; # What token was parsed
266 1655         3406 $self->symbol($token); # Do this for backward compatibility with Version 2.*
267             }
268              
269             sub endparse {
270             # Default Internal callback
271 486     486 1 2943 my $self = shift; # Parser invoked
272 486         1071 my $token = shift; # What token was parsed
273 486         2171 $self->unreadbackCat($token);
274             }
275              
276             ######################################################################
277             #### Package return
278             1;
279             __END__