App-UnifdefPlus
view release on metacpan or search on metacpan
lib/UnifdefPlus.pm view on Meta::CPAN
}
if ( $line =~ m#$EXPR->{$lang}->{START_ML_COMMENT}#s ) {
# Treat multi-line comments as a single line
while ( $newLine = ( shift @{ $self->{inlines} } ) ) {
chomp $newLine;
$line = $line . "\n" . $newLine;
last if $newLine =~ m#$EXPR->{$lang}->{END_ML_COMMENT}#s;
}
}
if ( $line =~ /$EXPR->{$lang}->{IFDEF}/s ) {
$litExpr = $1;
$expression = $2;
#BIG TBD: this doesn't handle end of line comments...
#$macro = $expression =~ /^\s+(\S+)/s ;
my $macro = trim($expression);
print DBGOUT
"litExpr=$litExpr, expression=$expression, macro=.$macro.\n"
if $self->{dbg};
if ( $self->{defines}->{$macro} ) {
print DBGOUT "calling parseIf TRUE\n" if $self->{dbg};
$self->parseIf( $EXPR->{$lang}->{LIT_IF}, "$TRUE_RESOLVED", $keep, 1 );
$self->{wasModified}=1;
}
elsif ( $self->{undefines}->{$macro} ) {
print DBGOUT "calling parseIf FALSE\n" if $self->{dbg};
$self->parseIf( $EXPR->{$lang}->{LIT_IF}, "$FALSE_RESOLVED", $keep, 1 );
$self->{wasModified}=1;
}
else {
print DBGOUT "calling parseIf $expression\n" if $self->{dbg};
$self->parseIf( $litExpr, $expression, $keep, 0 );
}
}
elsif ( $line =~ /$EXPR->{$lang}->{IFNDEF}/s ) {
$litExpr = $1;
$expression = $2;
#BIG TBD: this doesn't handle end of line comments...
#$macro = $expression =~ /^\s+(\S+)/s ;
my $macro = trim($expression);
if ( $self->{defines}->{$macro} ) {
$self->parseIf( $EXPR->{$lang}->{LIT_IF}, "$FALSE_RESOLVED", $keep, 1 );
$self->{wasModified}=1;
}
elsif ( $self->{undefines}->{$macro} ) {
$self->parseIf( $EXPR->{$lang}->{LIT_IF}, "$TRUE_RESOLVED", $keep, 1 );
$self->{wasModified}=1;
}
else {
$self->parseIf( $litExpr, $expression, $keep, 0 );
}
}
elsif ( $line =~ /$EXPR->{$lang}->{IFEQ}/s ) {
# expression is assumed to be makefile here...
$litExpr = $1;
$expression = $2;
my $comment;
# TBD: preserve eol expressions in simplified expression...
my ($simplifiedExpr, $rss, $match) = $self->makefileCompareExprs($2);
my $wasSimplified = $rss==RSS_UNCHANGED?0:1;
$simplifiedExpr = $TRUE_RESOLVED if ($rss == RSS_RESOLVED && $match == MATCH_RESOLVED);
$simplifiedExpr = $FALSE_RESOLVED if ($rss == RSS_RESOLVED && $match == NO_MATCH_RESOLVED);
$self->parseIf( $litExpr, $simplifiedExpr, $keep, $wasSimplified );
}
elsif ( $line =~ /$EXPR->{$lang}->{IFNEQ}/s ) {
# expression is assumed to be makefile here...
$litExpr = $1;
$expression = $2;
my $comment;
# TBD: preserve eol expressions in simplified expression...
my ($simplifiedExpr, $rss, $match) = $self->makefileCompareExprs($2);
my $wasSimplified = $rss!=RSS_UNCHANGED;
$simplifiedExpr = $FALSE_RESOLVED if ($rss == RSS_RESOLVED && $match == MATCH_RESOLVED);
$simplifiedExpr = $TRUE_RESOLVED if ($rss == RSS_RESOLVED && $match == NO_MATCH_RESOLVED);
$self->parseIf( $litExpr, $simplifiedExpr, $keep, $wasSimplified );
}
elsif ( $line =~ /$EXPR->{$lang}->{IF}/s ) {
$litExpr = $1;
my $wasSimplified;
($expression, $wasSimplified) = $self->parseCondition($2);
$self->parseIf( $litExpr, $expression, $keep, $wasSimplified );
}
elsif ( $line =~ /$EXPR->{$lang}->{ELSEIF}/s ) {
return ( $1, $2 );
}
elsif ( $line =~ /$EXPR->{$lang}->{ELSE}/s ) {
return ( $1, $2 );
}
elsif ( $line =~ /$EXPR->{$lang}->{ENDIF}/s ) {
return ( $1, $2 );
}
#elsif ( $EXPR->{$lang}->{LANG_PTRNS} && $line =~ /$EXPR->{$lang}->{LANG_PTRNS}/s ) {
# my ($simplifiedStr, $wasSimplified) =
#
#}
else {
# replace stripped out line cont's:
$line =~ s/$LINE_CONT/\\\n/g;
print $OUTFILE $line . "\n" if $self->shouldPrint($keep);
}
}
}
## --------------------------------------------------------------------------
## MAKEFILE support:
##
sub makefileSimplifyOr {
my $self = shift;
my $prefix = shift;
my $paramsRef = shift;
my @params = @$paramsRef;
my $rss = RSS_UNCHANGED;
my @paramsOut=();
my $simplifiedExpr;
for my $paramRef (@params) {
$rss = max($rss, $paramRef->{rss});
if ($self->isMakefileExprBlank($paramRef->{simplified})) {
#param is empty -- remove it
} elsif ($self->isMakefileExprNonBlank($paramRef->{simplified})) {
#we're non-blank. All subsequent parameters are moot
push @paramsOut, $paramRef->{simplified};
last;
} else {
#param is made up of one or more unresolved symbols. Output as is, and continue.
push @paramsOut, $paramRef->{simplified};
}
}
$rss = max($rss, RSS_SIMPLIFIED) if ($#paramsOut < $#params);
lib/UnifdefPlus.pm view on Meta::CPAN
if($ifStmt =~ /^$EXPR->{$lang}->{IFDEF}|^$EXPR->{$lang}->{IFNDEF}/) {
#TBD: simplify expression?
my $negate = $ifStmt =~ /^$EXPR->{$lang}->{IFNDEF}/;
# TBD: we should expand any of the known variables, but for now, just don't simplify...:
return ($ifStmt, $condition, RSS_UNCHANGED) if $condition =~ /\$/;
my ($var) = $condition =~ /^(\w++)/;
if ( $self->{defines}->{$var} ) {
$condition = $negate?$FALSE_RESOLVED:$TRUE_RESOLVED;
$rss = RSS_RESOLVED;
} elsif ((exists $self->{defines}->{$var}) || (exists $self->{undefines}->{$var})) {
#should the above be exists instead of defined?
$condition = $negate?$TRUE_RESOLVED:$FALSE_RESOLVED;
$rss = RSS_RESOLVED;
}
} elsif ($ifStmt =~ /^$EXPR->{$lang}->{IFEQ}|^$EXPR->{$lang}->{IFNEQ}/) {
my $negate = $ifStmt =~ /^$EXPR->{$lang}->{IFNEQ}/;
my ($simplifiedExpr, $rssExprs, $match) = $self->makefileCompareExprs($condition);
if ($match == MATCH_RESOLVED ) {
$condition = $negate?$FALSE_RESOLVED:$TRUE_RESOLVED;
} elsif ($match == NO_MATCH_RESOLVED) {
$condition = $negate?$TRUE_RESOLVED:$FALSE_RESOLVED;
} else {
$condition = $simplifiedExpr
}
$rss = $rssExprs;
}
return ($ifStmt, $condition, $rss);
}
# makefileCompareExprs(self,exprs)
# exprs is in the form of:
# "expr1" "expr2" #optional comments
# 'expr1' 'expr2' #optional comments
# "expr1" 'expr2' #optional comments
# 'expr1' "expr2" #optional comments
# ( expr1 , expr2 ) #optional comments
# where whitespace around the comma and parens are ignored in the last case.
# neg is negate -- if this is set return opposite
# returns: ($simplifiedexpr, $rss, $match)
# where $match is one of:
# MATCH_RESOLVED - if expressions were resolved and match
# NO_MATCH_RESOLVED - if experssions were resolved and can not match
# MATCH_UNKNOWN - otherwise.
sub makefileCompareExprs() {
my $self = shift;
my $origExprsStr = shift;
my ($openBrace, $closeBrace, $comma) = ("","",""); #includes whitespace
my ($expr1Quote, $expr2Quote, $ws) = ("","","");
my ($expr1,$expr2);
my $remainder;
my $rss;
my $simplifiedStr ="";
my $exprsStr;
my $match = MATCH_UNKNOWN;
my $eolComment;
if ( $origExprsStr =~ /^\(/ ) {
($exprsStr,$eolComment) = extract_bracketed($origExprsStr, '(")');
$exprsStr =~ s/^\(|\)$//g;
($expr1,$expr2) = getParameterList($exprsStr);
# trim expressions, and store whitespace:
$expr1 =~ s/^(\s*)|(\s*)$//g;
my ($ws1,$ws2) = ($1 || "",$2 || "");
$expr2 =~ s/^(\s*)|(\s*)$//g;
my ($ws3,$ws4) = ($1 || "",$2 || "");
$openBrace = '('.$ws1;
$comma = "".$ws2.",".$ws3;
$closeBrace = "".$ws4.')';
} else {
# we have two space delimitted quoted strings..
($expr1, $remainder) = extract_delimited($origExprsStr,q{'"});
return if ( ! defined $expr1 );
#tbd: figure out how to do the following two lines in one...
$remainder =~ s/^(\s++)//;
$ws = $1;
($expr2, $remainder) = extract_delimited($remainder,q{'"});
$eolComment = $remainder;
($expr1Quote) = $expr1 =~ /^(["'])/;
($expr2Quote) = $expr2 =~ /^(["'])/;
$expr1 =~ s/^(["'])|["']$//g;
$expr2 =~ s/^(["'])|["']$//g;
}
die if ((! defined $expr1) || (! defined $expr2) );
# at this point we have expr1 and expr2 which are the expressions, without quotes/braces/commas.
# if openBrace/closeBrace are set, original expression was braced. Otherwise expr1Quote
# quote will be set.
# se1 = simpilfiedExpression1...
my ($se1,$dummy1,$rss1) = makefileSimplifyExpr($self, $expr1,$MAX_OP_PREC,0);
my ($se2,$dummy2,$rss2) = makefileSimplifyExpr($self, $expr2,$MAX_OP_PREC,0);
$rss = max($rss1,$rss2);
return ($origExprsStr, RSS_UNCHANGED, MATCH_UNKNOWN) if ($rss != RSS_RESOLVED);
if (($se1 !~ /\$/) && ($se2 !~ /\$/)) {
#both expressions are constants -- check if they're equal:
$match = ($se1 eq $se2) ? MATCH_RESOLVED : NO_MATCH_RESOLVED;
} else {
#TBD... this needs work -- how to tell if two expressions can potentially overlap?
# examples that cannot match:
# x$(FOO), y$(BAR)
# $(FOO)x, $(BAR)y
# $(FOO)x$(BAR), foo
# I think, we can:
# a) check if beginings are constant and match
# b) check if endings are constant and match
# c) check if one expression is constant, create regex from second expression
# and check if expression1 =~ regex...
#test if both start with constant, and if those are equal.
my ($p1) = $se1 =~ /^([^\$]*)/;
my ($p2) = $se2 =~ /^([^\$]*)/;
($p1,$p2) = ($p2,$p1) if (length $p1 > length $p2);
$match = NO_MATCH_RESOLVED if ($p2 !~ /^$p1/);
#tbd: add test for end of string if end of string is constant
#tbd: add test for middle of string if one term is constant and other is not.
}
$simplifiedStr = $openBrace.$se1.$comma.$se2.$closeBrace.$eolComment
if $openBrace;
$simplifiedStr = $openBrace.$expr1Quote.$se1.$expr1Quote.$ws.$expr2Quote.$se2.$expr2Quote.$eolComment
if $expr1Quote;
return ($simplifiedStr,$rss,$match);
}
#TBD: simplfiy obj-$(x) statements for kbuild makefiles...
## --------------------------------------------------------------------------
## KCONFIG support:
##
## Note: Kconfig work very differently than Makefiles or C files
##
##
# NOTE: if behaviour is actually simplified a bit: in reality, if appends a
# condition to all items inside of it. (So, if you had an
#
# if x
# source Kconfig.foo
# endif
#
# then source Kconfig.foo would still get expanded, only every entry in
# Kconfig.foo would have if x appended to its end. This code treats if
# differently, in that it would remove source Kconfig.foo entirely if x
# was false...
my $BRACE_MATCH;
#$BRACE_MATCH = qr/ (?: \w++ | \s++ | $QUOTE_TOKEN | [\|&!=\"\\]++ | \((??{$BRACE_MATCH})\))* /x;
$BRACE_MATCH = qr/ (?: \w++ | \s++ | [\|&!=\"\\]++ | \((??{$BRACE_MATCH})\))* /x;
sub kconfigSimplifyExprTop {
my $self = shift;
my $origExpr = shift;
my %realval = ( $Y => "y", $M => "m", $N => "n");
my $check = join '|', keys %realval;
my $expr = $self->kconfigSimplifyExpr($origExpr);
my $rtExpr = $expr;
$rtExpr =~ s/($check)/$realval{$1}/g;
$self->{wasModified} = 1 if ( $origExpr ne $rtExpr );
return (trim($rtExpr),trim($expr));
}
sub kconfigSimplifyExpr {
my $self = shift;
my $expr = shift;
my ($ws1, $ws2, $ws3, $ws4, $ws5, $ws6, $op1, $op2);
my ($ws11, $ws12, $ws21, $ws22);
my ($e1, $e2);
if ($expr =~ /^($BRACE_MATCH)\|\|($BRACE_MATCH)$/ ) {
($e1, $e2) = ($1,$2);
($ws11,$op1,$ws12) = trimWs($self->kconfigSimplifyExpr($e1));
($ws21,$op2,$ws22) = trimWs($self->kconfigSimplifyExpr($e2));
return $Y if ($op1 eq $Y || $op2 eq $Y);
return $M if (($op1 eq $M || $op1 eq $Y) && ($op2 eq $M || $op2 eq $Y));
lib/UnifdefPlus.pm view on Meta::CPAN
#special handling for help: it is multiline and ends when the
#first line of text has less indentation than the first.
$line =~ s/$LINE_SEP/\\\n/g;
push(@$outLinesRef, $line."\n");
my $line = shift(@{$self->{inlines}});
if (defined($line)) {
chomp($line);
if ($line =~ /^(\s+)/) {
# Grumble grumble: in at least one kernel Kconfig
# file, they mixed up tabs and spaces...:
my $blankLines = 0;
my $helpIndentLen = wslength($1);
$line =~ s/$LINE_SEP/\\\n/g;
push(@$outLinesRef, $line."\n");
while (1) {
my $line = shift(@{$self->{inlines}});
last unless defined($line);
chomp($line);
if (length($line) == 0) {
$blankLines++;
}
else {
$line =~ /^(\s*)/;
if (wslength($1) < $helpIndentLen) {
unshift(@{$self->{inlines}}, $line);
while($blankLines--) {unshift(@{$self->{inlines}}, "");};
last;
} else {
while($blankLines > 0) {$blankLines--; push(@$outLinesRef, "\n");};
$line =~ s/$LINE_SEP/\\\n/g;
push(@$outLinesRef, $line."\n");
}
}
}
}
else {
# Grumble grumle -- apperently it's possible to have empty
# help fields...
unshift(@{$self->{inlines}}, $line);
}
}
}
elsif ($line =~ /^(\s+depends on\s*)(.*)$/) {
my $tmp = $1;
my ($condition,$result) = $self->kconfigSimplifyExprTop($2);
if ($result eq $N) {
$isVisible = 0;
}
if ($result eq $Y || $result eq $M) {
#do not echo
}
else {
$condition =~ s/$LINE_SEP/\\\n/g;
push(@$outLinesRef, $tmp . $condition . "\n");
}
}
elsif ($line =~ /^(\s+(?:[^"]|(?:"(?:[^"\\]|\\.)*"))+)(\s+if\s+)(.*?)(\s*\#.*)?$/) {
my $term = $1;
my $ifTerm = $2;
my $eolComment = defined($4) ? $4 : "";
print DBGOUT " conditional statement: $3" if ($self->{dbg});
my ($condition,$result) = $self->kconfigSimplifyExprTop($3);
if ($result eq $N) {
}
elsif ($result eq $Y || $result eq $M) {
$term =~ s/$LINE_SEP/\\\n/g;
$eolComment =~ s/$LINE_SEP/\\\n/g;
push(@$outLinesRef, $term . $eolComment . "\n");
}
else {
$term =~ s/$LINE_SEP/\\\n/g;
$ifTerm =~ s/$LINE_SEP/\\\n/g;
$condition =~ s/$LINE_SEP/\\\n/g;
$eolComment =~ s/$LINE_SEP/\\\n/g;
push(@$outLinesRef, $term . $ifTerm . $condition . $eolComment ."\n");
}
}
elsif ($line =~ /^\s+(\w+)\s*(.*)$/) {
$line =~ s/$LINE_SEP/\\\n/g;
print DBGOUT " + - $line...\n" if ($self->{dbg});
push(@$outLinesRef, $line."\n");
}
else {
$self->{error} = "Error parsing Kconfig file ($line)";
print STDERR "".$self->{error}."\n" if($showErrs);
last;
}
}
return $isVisible;
}
# return 0 invisible entry, return 1 visible entry, 2 for end-block command
sub kconfigReadNextEntry {
my $self = shift;
my $outLinesRef = shift;
my $isVisible = 1;
my $hideEndif = 0;
my $line;
do {
$line = ( shift @{ $self->{inlines} } );
print DBGOUT " > $line...\n" if ($self->{dbg});
return 1 unless defined($line);
chomp($line);
# in the case of an unexpected endblock, push the endblock back onto the array,
# and return 2. The caller will process the endblock line.
if ($line =~ "\^endchoice" || $line =~ "\^endmenu" || $line =~ "\^endif") {
unshift(@{ $self->{inlines} }, $line."\n");
return 2;
}
push(@$outLinesRef, $line."\n");
} while( $line =~ /$COMMENT/ || $line =~ /$BLANK_LINE/);
if ( $line =~ /^source\s/ || $line =~ /^mainmenu\s/ ) {
return 1;
}
if ( $line =~ /^config\s/ || $line =~ /^menuconfig\s/ || $line =~ /^comment/
|| $line =~ /^choice/ || $line =~ /^menu/) {
#read attributes
my @entryAttributes = ();
$isVisible = $self->kconfigReadAttributes(\@entryAttributes);
$self->{wasModified} = 1 unless ($isVisible);
push(@$outLinesRef, @entryAttributes) if ($isVisible);
}
my $endStr = "";
$endStr = qw/endchoice/ if ($line =~ /^choice\s*$/);
$endStr = qw/endmenu/ if ($line =~ /^menu\s/);
$endStr = qw/endif/ if ($line =~ /^if\s/);
if ($endStr) {
$hideEndif = 0;
#special handling for if: we need to modify the condition
if ($line =~ /^if\s+(.*?)(\s*(?:\#.*$))?$/) {
my ($condition, $result, $eolComment) = ($self->kconfigSimplifyExprTop($1), $2);
$eolComment = "" if !defined($eolComment);
if ($condition ne $1) {
# expression changed -- rewriting
if ($result eq $N) {
$isVisible = 0 ;
$self->{wasModified} = 1;
} elsif ($result eq $Y || $result eq $M) {
#pop off if statement (if statement may be multiline...)
#print STDERR "condition: ".$condition." Y:".$Y."\n";
while (! (pop(@$outLinesRef) =~ /^if\s/) ) {};
$self->{wasModified} = 1;
$hideEndif = 1 ;
} else {
#pop off if statement (if statement may be multiline...)
while (! (pop(@$outLinesRef) =~ /^if\s/) ) {};
push(@$outLinesRef, "if ".$condition.$eolComment."\n");
}
}
}
#read block:
while(1) {
my @subEntryOutLines = ();
last if (scalar(@{$self->{inlines}}) <= 0);
my $isNextEntryVisible = $self->kconfigReadNextEntry(\@subEntryOutLines);
if ($isNextEntryVisible != 0) {
push(@$outLinesRef, @subEntryOutLines) if ($isVisible);
}
else {
$self->{wasModified} = 1;
}
if ($isNextEntryVisible == 2) {
#Get next entry found endmenu, endchoice or endif.
#Last line was unshifted back into inLines
my $closingLine = ( shift @{ $self->{inlines} } );
if (!defined($closingLine)) {
$self->{error} = "Internal Error (1)\n";
print STDERR "".$self->{error}."\n" if($showErrs);
return;
}
if ( $closingLine =~ /^$endStr/) {
push(@$outLinesRef, $closingLine) if ($isVisible && !$hideEndif);
last;
}
else {
$self->{error} = "Unexpected closing line: <".trim($closingLine)."> (expecting <$endStr>)\n";
print STDERR "".$self->{error}."\n" if($showErrs);
return;
}
}
}
}
return $isVisible;
}
1;
( run in 2.722 seconds using v1.01-cache-2.11-cpan-8f98c5d2c55 )