File Coverage

blib/lib/Verilog/Netlist/Port.pm
Criterion Covered Total %
statement 45 52 86.5
branch 19 26 73.0
condition 4 12 33.3
subroutine 10 13 76.9
pod 3 8 37.5
total 81 111 72.9


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::Netlist::Port;
6              
7 8     8   53 use Verilog::Netlist;
  8         13  
  8         223  
8 8     8   37 use Verilog::Netlist::Subclass;
  8         24  
  8         372  
9 8     8   43 use vars qw($VERSION @ISA);
  8         11  
  8         406  
10 8     8   43 use strict;
  8         16  
  8         5923  
11             @ISA = qw(Verilog::Netlist::Port::Struct
12             Verilog::Netlist::Subclass);
13              
14             $VERSION = '3.476';
15              
16             structs('_new_base',
17             'Verilog::Netlist::Port::Struct'
18             =>[name => '$', #' # Name of the port
19             filename => '$', #' # Filename this came from
20             lineno => '$', #' # Linenumber this came from
21             userdata => '%', # User information
22             attributes => '%', #' # Misc attributes for systemperl or other processors
23             #
24             direction => '$', #' # Direction (in/out/inout)
25             data_type => '$', #' # SystemVerilog Type (logic/integer etc)
26             comment => '$', #' # Comment provided by user
27             array => '$', #' # Vectorization
28             module => '$', #' # Module entity belongs to
29             # below only after links()
30             net => '$', #' # Net port connects
31             # below only after autos()
32             sp_autocreated => '$', #' # Created by /*AUTOINOUT*/
33             ]);
34              
35             sub new {
36 690     690 0 974 my $class = shift;
37 690         3381 my %params = (@_);
38 690 50       1667 $params{data_type} = $params{type} if defined $params{type}; # Backward compatibility
39 690 50       1335 if ($params{direction}) { # Correct common mistakes; plus the parser itself needs this conversion
40 690 100       1538 $params{direction} = 'in' if $params{direction} eq 'input';
41 690 100       1469 $params{direction} = 'out' if $params{direction} eq 'output';
42             }
43 690         11749 return $class->_new_base(%params);
44             }
45              
46             sub delete {
47 603     603 0 734 my $self = shift;
48 603         8069 my $h = $self->module->_ports;
49 603         7739 delete $h->{$self->name};
50 603         1245 return undef;
51             }
52              
53             ######################################################################
54              
55 0     0 0 0 sub netlist { return $_[0]->module->netlist; }
56              
57 0     0 1 0 sub logger { return $_[0]->netlist->logger; }
58              
59             sub type { # Backward compatibility only
60 0     0 1 0 my $self=shift;
61 0 0       0 if ($#_ >= 0) { $self->data_type(@_); }
  0         0  
62 0   0     0 return ($self->data_type || ($self->net && $self->net->type))||'';
63             }
64              
65             sub _link {
66 182     182   237 my $self = shift;
67 182 100       2277 if (!$self->net) {
68 88         1149 my $net = $self->module->find_net($self->name);
69 88 100       189 if (!$net) {
70 2         5 my $msb;
71             my $lsb;
72 2 50       28 if (defined $self->data_type) {
73 2         38 $self->data_type =~ /\[([^:]+)(:(.*))?\]$/;
74 2         5 $msb = $1;
75 2 50       7 $lsb = defined($3) ? $3 : $1;
76             }
77 2         28 $net = $self->module->new_net
78             (name=>$self->name,
79             filename=>$self->filename, lineno=>$self->lineno,
80             decl_type=>"port", net_type=>"wire",
81             data_type=>$self->data_type, array=>$self->array,
82             comment=>undef, msb=>$msb, lsb=>$lsb,
83             );
84 2         33 $net->attributes($self->attributes); # Copy attributes across
85             }
86 88 50 33     1237 if ($net && $net->port && $net->port != $self) {
      33        
87 0         0 $self->error("Port redeclares existing port: ",$self->name,"\n");
88             }
89 88         1203 $self->net($net);
90 88         1070 $self->net->port($self);
91             # A input to the module is actually a "source" or thus "out" of the net.
92 88 100       1110 $self->net->_used_in_inc() if ($self->direction() eq 'out');
93 88 100       1076 $self->net->_used_out_inc() if ($self->direction() eq 'in');
94 88 100       1072 $self->net->_used_inout_inc() if ($self->direction() eq 'inout');
95             }
96             }
97       72 0   sub lint {}
98              
99             sub verilog_text {
100 71     71 0 89 my $self = shift;
101 71         916 return $self->name;
102             }
103              
104             sub dump {
105 110     110 1 189 my $self = shift;
106 110   50     196 my $indent = shift||0;
107 110   50     1712 print " "x$indent,"Port:",$self->name()," Dir:",$self->direction()
108             ," DataT:",$self->data_type()," Array:",$self->array()||"","\n";
109             }
110              
111             ######################################################################
112             #### Package return
113             1;
114             __END__