File Coverage

blib/lib/Verilog/Preproc.pm

Criterion	Covered	Total	%
statement	93	101	92.0
branch	20	28	71.4
condition	0	4	0.0
subroutine	18	22	81.8
pod	12	16	75.0
total	143	171	83.6

# Verilog - Verilog Perl Interface
# See copyright, etc in below POD section.
######################################################################

package Verilog::Preproc;
use Carp;
use Verilog::Getopt;

require DynaLoader;
use base qw(DynaLoader);
use strict;
use vars qw($VERSION);

$VERSION = '3.480';

######################################################################
#### Configuration Section

bootstrap Verilog::Preproc;

#In Preproc.xs:
# sub _new (class, keepcmt, linedir, pedantic, synthesis)
# sub _open (class)
# sub getall (class)
# sub getline (class)
# sub eof (class)
# sub filename (class)
# sub lineno (class)
# sub unreadback (class, text)

######################################################################
#### Accessors

sub new {
    my $class = shift;  $class = ref $class if ref $class;
    my $self = {keep_comments=>1,
		keep_whitespace=>1,
		line_directives=>1,
		ieee_predefined=>1,
		pedantic=>0,
		synthesis=>0,
		options=>Verilog::Getopt->new(),	# If the user didn't give one, still work!
		parent => undef,
		#include_open_nonfatal=>0,
		@_};
    bless $self, $class;
    # Sets $self->{_cthis}
    $self->{keep_comments} = 2 if ($self->{keep_comments} eq 'sub');
    $self->{keep_comments} = 3 if ($self->{keep_comments} eq 'expand'); #TBD
    $self->_new($self,
		$self->{keep_comments},
		$self->{keep_whitespace},
		$self->{line_directives},
		$self->{pedantic},
		$self->{synthesis},
		);
    if ($self->{synthesis}) {
	# Fourth argument 1 for cmdline - no `undefineall effect
	$self->define('SYNTHESIS',1,undef,1);
    }
    if ($self->{ieee_predefined}) {
	$self->define('SV_COV_START', 0,undef,1);
	$self->define('SV_COV_STOP', 1,undef,1);
	$self->define('SV_COV_RESET', 2,undef,1);
	$self->define('SV_COV_CHECK', 3,undef,1);
	$self->define('SV_COV_MODULE', 10,undef,1);
	$self->define('SV_COV_HIER', 11,undef,1);
	$self->define('SV_COV_ASSERTION', 20,undef,1);
	$self->define('SV_COV_FSM_STATE', 21,undef,1);
	$self->define('SV_COV_STATEMENT', 22,undef,1);
	$self->define('SV_COV_TOGGLE', 23,undef,1);
	$self->define('SV_COV_OVERFLOW', -2,undef,1);
	$self->define('SV_COV_ERROR', -1,undef,1);
	$self->define('SV_COV_NOCOV', 0,undef,1);
	$self->define('SV_COV_OK', 1,undef,1);
	$self->define('SV_COV_PARTIAL', 2,undef,1);
    }
    #use Data::Dumper; print Dumper($self);
    return $self;
}

sub DESTROY {
    my $self = shift;
    $self->_DESTROY;
}

sub STORABLE_freeze {
    my ($self, $cloning) = @_;
    # Prevent crash on Storable::store then retrieve
    delete $self->{_cthis};
    return;
}

sub open {
    my $self = shift;
    my %params = (
		  # filename =>
		  # open_nonfatal => 0,
		  );
    if ($#_ > 0) { %params=(@_); } else { $params{filename}=shift; }
    # We allow either open(name) or open(filename=>name);

    # Allow user to put `defined names on the command line instead of filenames,

    # then convert them properly.
    my $filename = $params{filename};
    $filename = $self->remove_defines($filename);
    printf ("Perl open $filename\n") if $self->{debug};
    $filename = $self->{options}->file_path($filename);
    printf ("Perl openfp $filename\n") if $self->{debug};
    if (!-r $filename) {
	if (!$params{open_nonfatal}) {
	    $self->error("Cannot open $filename");
	}
	return undef;
    } else {
	$self->_open($filename);
    }
    return $self;
}

sub debug {
    my $self = shift;
    my $level = shift;
    $self->{debug} = $level;
    $self->_debug($level);
}

sub parent {
    my $self = shift;
    return $self->{parent};
}

######################################################################
#### Utilities

sub remove_defines {
    my $self = shift;
    my $sym = shift;
    my $val = "x";
    while (defined $val) {
	last if $sym eq $val;
	(my $xsym = $sym) =~ s/^\`//;
	$val = $self->{options}->defvalue_nowarn($xsym);  #Undef if not found
	$sym = $val if defined $val;
    }
    return $sym;
}

sub fileline {
    my $self = shift;
    return ($self->filename||"").":".($self->lineno||"");
}

######################################################################
#### Called by the parser

sub error {
    my ($self,$text,$token)=@_;
    my $fileline = $self->filename.":".$self->lineno;
    croak ("%Error: $fileline: $text\n"
	   ."Stopped");
}

sub comment {}

sub def_substitute {
    my ($self, $out) = @_;
    return $out;
}
sub include {
    my ($self,$filename)=@_;
    print "INCLUDE $filename\n" if $self->{debug};
    $self->{options}->includes($self->filename, $filename);
    $self->open(filename => $filename,
		open_nonfatal => $self->{include_open_nonfatal},
		);
}

# Note rather than overriding these, a derived Verilog::Getopt class can
# accomplish the same thing.

sub undef {
    my $self = shift;
    $self->{options}->undef(@_);
}
sub undefineall {
    my $self = shift;
    $self->{options}->undefineall(@_);
}
sub define {
    my $self = shift;
    #print "DEFINE @_\n";
    $self->{options}->fileline($self->filename.":".$self->lineno);
    $self->{options}->define(@_);
}
sub def_params {
    # Return define parameters
    my $self = shift;
    my $val = $self->{options}->defparams(@_);
    #printf "DEFPARAMS @_ -> %s\n", $val if $self->{debug};
    $val = "" if !defined $val;
    return $val;
}
sub def_value {
    # Return value
    my $self = shift;
    #printf "DEFVALUE @_ -> %s\n", $self->{options}->defvalue_nowarn(@_);
    return $self->{options}->defvalue(@_);
}

######################################################################
#### Package return
1;
__END__