Generated: Tue Feb 2 17:54:39 2010 from fixcasts.pl 2009/09/11 64.4 KB.
#!/perl -w # NAME: fixcasts.pl # AIM: An attempt at automating 'cast' fixing # 9/5/2009 - geoff mclane - http://geoffair.net/mperl/ use strict; use warnings; use File::Basename; unshift(@INC, 'C:/GTools/perl'); require 'logfile.pl' or die "Unable to load logfile.pl ...\n"; # log file stuff my ($LF); my $pgmname = $0; if ($pgmname =~ /\w{1}:\\.*/) { my @tmpsp = split(/\\/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = "temp.$pgmname.txt"; open_log($outfile); prt( "$0 ... Hello, World ...\n" ); #my $in_errors = 'fixcasts.txt'; my $in_errors = 'fixcast1.txt'; my $do_file_fixes = 1; my $write_temp_only = 0; # if do file fixes my $show_no_fixes = 0; # show files with NO fixes, when showing hash my $no_multi_line = 0; # inhibit multi-line fixes # features # FIX error C2440: '=' : cannot convert from 'void *' to 'short *' my $fix_2440_equ = 1; my $fix_2664_param = 1; my $dparams = '-u'; my $show_each_diff = 0; my $clear_warn_before_fix = 0; # debug my $dbg01 = 0; # 5; # show previous and next line my $dbg02 = 0; # show APPENDING and PREPENDING lines my $dbg03 = 0; # show MIN and MAX lines (logical values) my $dbg04 = 0; # show backup information my $dbg05 = 0; # show debug of sub after_func_insert_this_before_that(...) my $dbg06 = 0; # show getting parameters # program variables my @warnings = (); sub get_dbg_str() { my $s = ''; if ($dbg01) { $s .= "O1 "; } # 5; # show previous and next line if ($dbg02) { $s .= "O2 "; } # show APPENDING and PREPENDING lines if ($dbg03) { $s .= "O3 "; } # show MIN and MAX lines (logical values) if ($dbg04) { $s .= "O4 "; } # show backup information if ($dbg05) { $s .= "O5 "; } # show debug of sub after_func_insert_this_before_that(...) if ($dbg06) { $s .= "O6 "; } # show getting parameters return $s; } sub prtw($) { my ($txt) = shift; prt($txt); $txt =~ s/\n$//; push(@warnings,$txt); } sub show_warnings() { if (@warnings) { prt( "\nShowing WARNINGS: count=".scalar @warnings." WARNINGS...\n" ); foreach my $line (@warnings) { prt("$line\n" ); } } else { prt("\nNo warnings issued.\n"); } my $s = get_dbg_str(); prt( "WARNING: DEBUG ON [$s]\n" ) if length($s); prt("\n"); } sub pgm_exit($$) { my ($val,$msg) = @_; show_warnings(); prt($msg) if length($msg); close_log($outfile,1); exit($val); } sub my_exit($$) { my ($val,$msg) = @_; pgm_exit($val,$msg); } sub get_file_line_rh($$$) { my ($fn, $rh, $reth) = @_; # filenm); my ($rrh); if (defined ${$rh}{$fn}) { $rrh = ${$rh}{$fn}; ${$reth} = $rrh; return 1; } if (open INF, "<$fn") { my @lines = <INF>; close INF; $rrh = \@lines; ${$rh}{$fn} = $rrh; ${$reth} = $rrh; return 1; } else { prtw("WARNING: Unable to OPEN file [$fn]!\n"); pgm_exit(1,"WHERE IS THIS FILE? Aborting!\n" ); } return 0; } sub trim_line_head($) { my ($ln) = shift; $ln = substr($ln,1) while ($ln =~ /^\s/); return $ln; } sub trim_line_end($) { my ($ln) = shift; $ln = substr($ln,0,length($ln)-1) while ($ln =~ /\s$/); ##chomp $ln; ##$ln =~ s/\n$//; ##$ln =~ s/\r$//; return $ln; } sub trim_both_ends($) { my ($ln) = shift; $ln = trim_line_head($ln); return trim_line_end($ln); } # remove /* ... */ # and // to end of line sub remove_comments($) { my ($tln) = shift; my $len = length($tln); my ($j,$c,$nc); my $nln = ''; for ($j = 0; $j < $len; $j++) { $c = substr($tln,$j,1); $nc = (($j + 1) < $len) ? substr($tln,$j+1,1) : ''; if (($c eq '/')&&($nc eq '*')) { # stay and EAT comment until end comment $j += 2; for (; $j < $len; $j++) { $c = substr($tln,$j,1); $nc = (($j + 1) < $len) ? substr($tln,$j+1,1) : ''; if (($c eq '*')&&($nc eq '/')) { $j++; last; } } next; } elsif (($c eq '/')&&($nc eq '/')) { $j += 2; # stay and EAT comment until EOL for (; $j < $len; $j++) { $c = substr($tln,$j,1); if ($c eq "\n") { $j--; last; } } next; } $nln .= $c; # add char to 'new' line } return $nln; } sub is_semi_colon_termed($) { my ($tln) = shift; $tln = remove_comments($tln); $tln = trim_all($tln); if ($tln =~ /;$/) { return 1; } return 0; } # avoid error of this type # lines [ if ((c->work_buf = av_malloc(c->comp_size)) == NULL) { # av_log(avctx, AV_LOG_ERROR, "Can't allocate work buffer.\n");] sub is_complete_if_statement($) { my ($ln) = shift; if ($ln =~ /^\s*if\s*\(/) { # ok, it MIGHT be... my (@braks,$len,$j,$cc); @braks = (); $len = length($ln); for ($j = 0; $j < $len; $j++) { $cc = substr($ln,$j,1); if ($cc eq '(') { push(@braks,$j); } elsif ($cc eq ')') { if (@braks) { pop @braks; } else { return 0; # asymetrical brackets is FAILURE } } } if (@braks) { return 0; # some remaining bracket open } return 1; # it LOOKS like a complete statement } return 0; } # what about these lines # #endif /* _MSC_VER y/n */ # } else # zz_table = wmv1_scantable[1]; sub is_bare_else($) { my ($tst) = shift; $tst = remove_comments($tst); # remove any comments from this line $tst = trim_all($tst); # if ($tst eq 'else') { # 20090907 - but ' } else' is ALSO a bare else if (($tst eq 'else') || ($tst =~ /^\s*\}\s*else(\s|\{)*/)) { return 1; } return 0; } # check if this line is a statment termination # if it is BLANK # if it ends in ';' # if it ends in '{' # excluding comments /* ... */ or // to EOL sub get_res_string($) { my ($res) = shift; if ($res == 1) { return "blank"; } elsif ($res == 2) { return "comment"; } elsif ($res == 3) { return "semi-colon"; } elsif ($res == 4) { return "open brace {"; } elsif ($res == 5) { return "indented open brace {"; } elsif ($res == 6) { return "close brace }"; } elsif ($res == 7) { return "indented close brace }"; } elsif ($res == 8) { return "complete if statement"; } elsif ($res == 9) { return "is bare else"; } elsif ($res == 0) { return "incomplete statument"; } return "uncased res $res"; } # 20090908: stop on '[\s*]case statement: [/* comment */] sub is_termed_or_brace($) { my ($tln_in) = shift; my $tln = $tln_in; $tln = remove_comments($tln); $tln = trim_all($tln); my $len = length($tln); if ($len == 0) { # 20090907 - check if original is ALL blank also # if (length($tln_in)) $tln = trim_all($tln_in); if (length($tln)) { return 2; # this is an ALL comment line } return 1; # BLANK - spacey line } if ($tln =~ /;$/) { return 3; } if ($tln =~ /\{$/) { if ($tln_in =~ /^\s/) { return 5; # this is an INDENTED line } return 4; } # 20090907 - and closing braces if ($tln =~ /\}$/) { if ($tln_in =~ /^\s/) { return 7; # this is an INDENTED line } return 6; } return 8 if (is_complete_if_statement($tln_in)); return 9 if (is_bare_else($tln_in)); return 10 if ($tln =~ /^\s*case\s+(.+):/); return 0; } sub is_line_ifdef_begin($) { my ($t) = shift; if ($t =~ /^\s*#\s*if(\w*)\s+(.+)$/) { return 1; } return 0; } sub is_line_ifdef_else($) { my ($t) = shift; if ($t =~ /^\s*#\s*else\s*/) { # prt("Got an #else [$t]\n"); return 1; } return 0; } sub is_line_ifdef_endif($) { my ($t) = shift; if ($t =~ /^\s*#\s*endif\s*/) { # prt("Got an #endif [$t]\n"); return 1; } return 0; } sub is_line_an_ifdef_type($) { my ($t) = shift; if (is_line_ifdef_begin($t)) { return 1; } elsif (is_line_ifdef_else($t)) { return 2; } elsif (is_line_ifdef_endif($t)) { return 3; } return 0; } # This is an IMPORTANT back up the file, until SURE # we have a full termination line # If lucky, this can be # a BLANK line # a line terminated with a semi colon, ';' # but there are MANY other 'termination', like # say an open brace like # int foo() { # current line; # 20090908: stop on '[\s*]case statement: [/* comment */] sub get_previous_terminated_line($$$) { my ($lnn,$lnc,$rfh) = @_; my $plnn = $lnn; my ($tst, $res, $isifd, $lvl, $tmp); my @backup = (); $lvl = 0; while ($plnn > 0) { $plnn--; # backup ONE line $tst = trim_line_end(${$rfh}[$plnn]); # get the LINE (trimmed) $res = is_termed_or_brace($tst); $isifd = is_line_an_ifdef_type($tst); if ($dbg04) { $tmp = trim_all($tst); $tmp = remove_comments($tmp); my $rstg = get_res_string($res); prt( "[dbg04] $plnn: Backup [$tmp] res=$res(".$rstg.") isifd=$isifd full=[$tst] lvl=$lvl\n" ); } if ( !(( $res == 0 )||( $res == 2)) ) { # seems to be a good line termination $plnn++; # so go back to last if ($lvl && ($plnn < $lnn)) { # try to skip comments - and #ifdef stacked # and that line is a comment only # 0 1 2 3 push(@backup, [ $tst, $isifd, $res, $plnn ]); while ( $lvl && (( $backup[($lvl-1)][2] == 2 ) || ( $backup[($lvl-1)][1] > 0 ))) { $lvl--; if ( $backup[$lvl][2] == 2 ) { prt( "[dbg04] Avoid adding only a comment to line list - lvl=$lvl=[".$backup[$lvl][0]."]\n" ) if ($dbg04); $plnn++; } elsif ( $backup[$lvl][1] > 0 ) { prt( "[dbg04] Avoid adding only an #ifdef type to line list - lvl=$lvl=[".$backup[$lvl][0]."]\n" ) if ($dbg04); $plnn++; } else { prtw( "ERROR: Entered to drop line, BUT FAILED!\n" ); my_exit(5, "THIS SHOULD NEVER HAPPEN!!!\n" ); } } # try to skip comments - if only one line stacked #if ($lvl == 1) { # if ( $backup[0][2] == 2 ) { # prt( "[dbg04] Avoid adding only a comment to line list\n" ); # $plnn++; # } elsif ( $backup[0][1] == 1 ) { # prt( "[dbg04] Avoid adding only an #ifdef type to line list\n" ); # $plnn++; # } #} } $tst = trim_line_end(${$rfh}[$plnn]); # get the LINE (trimmed) prt( "[dbg04] Returning TOP line $plnn=[$tst]\n" ) if ($dbg04); return $plnn; # and return it } else { # 20090906 - deal with a bare else $tst = remove_comments($tst); # remove any comments from this line $tst = trim_all($tst); # if ($tst eq 'else') { # 20090907 - but ' } else' is ALSO a bare else if (($tst eq 'else') || ($tst =~ /^\s*\}\s*else\s*/)) { # got a BARE else above $plnn++; return $plnn; } } # 0 1 2 3 push(@backup, [ $tst, $isifd, $res, $plnn ]); $lvl++; } return $lnn; } sub get_error_lines($$$$$) { my ($lnn,$rfh,$rel,$rmin,$rmax) = @_; my $lns = ''; my $olnn = $lnn; my $lnc = scalar @{$rfh}; my ($tst, $minln, $maxln, $prlns); $minln = -1; $maxln = -1; if ($lnn < $lnc) { # get the LINE indicated by the LOGICAL line number # ------------------------------------------------- $lns = trim_line_end(${$rfh}[$lnn]); # end trimmed $maxln = $lnn; prt( "[dbg02] START LINE [$lns]\n") if ($dbg02); # 1 APPEND - ADD ANY NECESSARY FOLLOWING LINES = MAX IS SET # ================================================ # avoid error of this type # lines [ if ((c->work_buf = av_malloc(c->comp_size)) == NULL) { # av_log(avctx, AV_LOG_ERROR, "Can't allocate work buffer.\n");] if ( !is_semi_colon_termed($lns) && !is_complete_if_statement($lns) ) { # must add more lines - GOING DOWN $lnn++; while ($lnn < $lnc ) { $tst = trim_line_end(${$rfh}[$lnn]); prt( "[dbg02] APPENDING [$tst]\n") if ($dbg02); $lns .= "\n$tst"; $maxln++; # bump the MAX counter last if ( is_semi_colon_termed($tst) ); $lnn++; } } # 2 PREPEND - ADD ANY NECESSARY PRECEEDING LINES = MIN IS SET - MINIMUM - BACKUP # ==================================== $lnn = get_previous_terminated_line($olnn,$lnc,$rfh); $minln = $lnn; # 20090908 - EEK fix the prepending sequence # start with lowest line = $minln, and build to before original $prlns = ''; while ($lnn < $olnn) { $tst = trim_line_end(${$rfh}[$lnn]); prt( "[dbg02] PREPENDING [$tst]\n") if ($dbg02); $prlns .= "\n" if length($prlns); $prlns .= $tst; $lnn++; } if (length($prlns)) { $lns = $prlns."\n".$lns; # tack this LIST to the FRONT } ${$rel} = $lns; ${$rmax} = $maxln; ${$rmin} = $minln; prtw( "WARNING: MAX=$maxln IS LESS THAN MIN=$minln! FIX THIS\n" ) if ($maxln < $minln); if ($dbg03) { prt( "[dbg03] Showing (logical) MIN=$minln and MAX=$maxln\n" ); $tst = trim_line_end(${$rfh}[$minln]); prt( "[dbg03] MIN [$tst]ln(".($minln+1).")" ); if ($minln < $maxln) { $tst = trim_line_end(${$rfh}[$maxln]); prt( "\n[dbg03] MAX [$tst]ln(".($maxln+1).")" ); } elsif ($maxln < $minln) { prt( " WARNING: MAX=$maxln LESS THAN MIN" ); } else { prt( " MAX same as MIN" ); } prt("\n"); } return 1; } return 0; } sub show_line_range($$$) { my ($rng,$ll,$rfh) = @_; my $max = scalar @{$rfh}; my $from = $ll - $rng; my $to = $ll + $rng; $from = 0 if ($from < 0); $to = ($max - 1) if ($to > ($max - 1)); prt( "[dbg01] Showing Range -/+ $rng about $ll of $max... ie from $from to $to...\n" ); while ($from <= $to) { my $ll = trim_line_end(${$rfh}[$from]); $from++; prt( "$from: [$ll]\n" ); } } sub get_single_quoted($) { my ($res) = @_; my ($len,$c,$k,$itm); my @arr = (); $len = length($res); $itm = ''; for ($k = 0; $k < $len; $k++) { $c = substr($res,$k,1); if ($c eq "'") { $itm = ''; $k++; for (; $k < $len; $k++) { $c = substr($res,$k,1); last if ($c eq "'"); $itm .= $c; } push(@arr,$itm) if length($itm); } } return @arr; } # from sub conv_line($) sub is_line_convertable($) { my ($txt) = shift; if ($txt =~ /^(\s*)(\w+\s*\*)(\s*\w+\s*=\s*)(.+)(\s*;\s*)$/) { return 1; } elsif ($txt =~ /^(\s*)(\w+\s*\*)(\s*\w+)(\s+\w+\s*=\s*)(.+)(\s*;\s*)$/) { return 2; } elsif ($txt =~ /^(\s*)(\w+\s+)(\w+\s*\*)(\s*\w+\s*=\s*)(.+)(\s*;\s*)$/) { return 3; } elsif ($txt =~ /^(.+=)(\s*\w+\s*)(\(\s*sizeof\s*\()(\s*\w+\s*)(\)\s*\)\s*;\s*)$/) { return 4; } elsif ($txt =~ /^(.+=)(\s*\w+\s*)(\(.*sizeof\s*\()(\s*\w+\s*)(\)\s*\)\s*;\s*)$/) { return 5; } return 0; } sub return_conv_line($) { my ($txt_in) = shift; my ($ptr,$obj,$txt, $msg, $lds, $cbk, $tlb, $qal); $txt = $txt_in; $msg = ''; #if ($txt =~ /^\s*(\w+\s+\*)\s*\w+\s*=\s*(.+)\s*;\s*$/) { if ($txt =~ /^(\s*)(\w+\s*\*)(\s*\w+\s*=\s*)(.+)(\s*;\s*)$/) { $lds = $1; $ptr = $2; $cbk = $3; $obj = $4; $tlb = $5; prt( "OK 1 PTR[$ptr] = OBJ[$obj]\n" ); #$txt =~ s/$obj/\($ptr\)$obj/; $txt = $lds.$ptr.$cbk.'('.$ptr.')'.$obj.$tlb; prt( "In text [$txt_in]\n"); prt( "new text [$txt]\n" ); $msg = "#ifdef _MSC_VER /* add cast (1) */\n"; $msg .= "$txt\n"; $msg .= "#else /* !_MSC_VER */\n"; $msg .= "$txt_in\n"; $msg .= "#endif /* _MSC_VER y/n */\n"; ##Clipboard->copy($msg); ##prt( "Put on clipboard...\n" ); prt( $msg ); # lds ptr * qal cbk obj tlb } elsif ($txt =~ /^(\s*)(\w+\s*\*)(\s*\w+)(\s+\w+\s*=\s*)(.+)(\s*;\s*)$/) { # ASV1Context * const a = avctx->priv_data; $lds = $1; $ptr = $2; $qal = $3; $cbk = $4; $obj = $5; $tlb = $6; prt( "OK 2 LDS=[$lds] PTR[$ptr] QAL=[$qal] = OBJ[$obj]\n" ); #$txt =~ s/$obj/\($ptr\)$obj/; $txt = $lds.$ptr.$qal.$cbk.'('.$ptr.$qal.')'.$obj.$tlb; prt( "In text [$txt_in]\n"); prt( "new text [$txt]\n" ); $msg = "#ifdef _MSC_VER /* add cast (2) */\n"; $msg .= "$txt\n"; $msg .= "#else /* !_MSC_VER */\n"; $msg .= "$txt_in\n"; $msg .= "#endif /* _MSC_VER y/n */\n"; ##Clipboard->copy($msg); ##prt( "Put on clipboard...\n" ); prt( $msg ); # lds qal ptr * cbk obj tlb } elsif ($txt =~ /^(\s*)(\w+\s+)(\w+\s*\*)(\s*\w+\s*=\s*)(.+)(\s*;\s*)$/) { # const uint8_t *pi= in[ch]; $lds = $1; $ptr = $2; $qal = $3; $cbk = $4; $obj = $5; $tlb = $6; prt( "OK 3 LDS=[$lds] PTR=[$ptr] QAL=[$qal] CBK=[$cbk] OBJ=[$obj] TLB=[$tlb]\n" ); #$txt =~ s/$obj/\($ptr\)$obj/; $txt = $lds.$ptr.$qal.$cbk.'('.$ptr.$qal.')'.$obj.$tlb; prt( "In text [$txt_in]\n"); prt( "new text [$txt]\n" ); $msg = "#ifdef _MSC_VER /* add cast (3) */\n"; $msg .= "$txt\n"; $msg .= "#else /* !_MSC_VER */\n"; $msg .= "$txt_in\n"; $msg .= "#endif /* _MSC_VER y/n */\n"; ##Clipboard->copy($msg); ##prt( "Put on clipboard...\n" ); prt( $msg ); # 1 = 2 ( sizeof ( /w+ )); #} elsif ($txt =~ /^(\s*\w+\s*=)(\s*\w+\s*)(\(\s*sizeof\s*\()(\s*\w+\s*)(\)\s*\)\s*;\s*)$/) { # } elsif ($txt =~ /^(\s*\w+\s*=)(\s*\w+\s*)(\(.*sizeof\s*\()(\s*\w+\s*)(\)\s*\)\s*;\s*)$/) { } elsif ($txt =~ /^(.+=)(\s*\w+\s*)(\(\s*sizeof\s*\()(\s*\w+\s*)(\)\s*\)\s*;\s*)$/) { # ctx = av_malloc(sizeof(AVAudioConvert)); # prt( "1[$1]=2[$2]3[$3]4[$4]5[$5]\n" ); $lds = $1; $ptr = $2; $qal = $3; $cbk = $4; $obj = $5; prt( "OK 4 1[$lds] ($cbk *)2[$ptr]3[$qal]4[$cbk]5[$obj]\n" ); #$txt = $lds."($cbk *)".$ptr.$qal.$cbk.$obj; $txt = $lds; $txt .= ' ' if !($txt =~ /\s$/); $txt .= "($cbk *)"; $txt .= ' ' if !($ptr =~ /^\s/); $txt .= $ptr.$qal.$cbk.$obj; prt("In text [$txt_in]\n"); prt("New text [$txt]\n"); $msg = "#ifdef _MSC_VER /* add cast (4) */\n"; $msg .= "$txt\n"; $msg .= "#else /* !_MSC_VER */\n"; $msg .= "$txt_in\n"; $msg .= "#endif /* _MSC_VER y/n */\n"; ##Clipboard->copy($msg); ##prt( "Put on clipboard...\n" ); prt( $msg ); } elsif ($txt =~ /^(.+=)(\s*\w+\s*)(\(.*sizeof\s*\()(\s*\w+\s*)(\)\s*\)\s*;\s*)$/) { $lds = $1; $ptr = $2; $qal = $3; $cbk = $4; $obj = $5; prt( "OK 5 1[$lds] ($cbk *)2[$ptr]3[$qal]4[$cbk]5[$obj]\n" ); $txt = $lds; $txt .= ' ' if !($txt =~ /\s$/); $txt .= "($cbk *)"; $txt .= ' ' if !($ptr =~ /^\s/); $txt .= $ptr.$qal.$cbk.$obj; prt("In text [$txt_in]\n"); prt("New text [$txt]\n"); $msg = "#ifdef _MSC_VER /* add cast (5) */\n"; $msg .= "$txt\n"; $msg .= "#else /* !_MSC_VER */\n"; $msg .= "$txt_in\n"; $msg .= "#endif /* _MSC_VER y/n */\n"; ##Clipboard->copy($msg); ##prt( "Put on clipboard...\n" ); prt( $msg ); } else { prt("*** ERROR *** NO GO for line=[".trim_all($txt)."]\n"); $msg = ''; } return $msg; } sub insert_after_equals($$$$) { my ($eln, $itm, $rnln, $ecnt) = @_; my $nln = ''; my ($max, $k, $c, $ss, $ec, $qc); $max = length($eln); $ec = 0; for ($k = 0; $k < $max; $k++) { $c = substr($eln,$k,1); $nln .= $c; if ($c eq '=') { $k++; $ec++; if ($ec == $ecnt) { if ($k < $max) { $c = substr($eln,$k,1); if ($c =~ /\s/) { $nln .= $c; $k++; } } last; } } elsif (($c eq '"')||($c eq "'")) { $qc = $c; $k++; for (; $k < $max; $k++) { $c = substr($eln,$k,1); last if ($c eq $qc); } } } if ($k < $max) { $nln .= ' ' if !($nln =~ /\s$/); $nln .= "($itm)"; $ss = substr($eln,$k); $nln .= ' ' if !($ss =~ /^\s/); $nln .= $ss; ${$rnln} = $nln; return 1; } return 0; } sub insert_after_equals_simple($$$) { my ($eln, $itm, $rnln) = @_; my $nln = ''; my ($max, $k, $c, $ss); $max = length($eln); for ($k = 0; $k < $max; $k++) { $c = substr($eln,$k,1); $nln .= $c; if ($c eq '=') { $k++; if ($k < $max) { $c = substr($eln,$k,1); if ($c =~ /\s/) { $nln .= $c; $k++; } } last; } } if ($k < $max) { $nln .= ' ' if !($nln =~ /\s$/); $nln .= "($itm)"; $ss = substr($eln,$k); $nln .= ' ' if !($ss =~ /^\s/); $nln .= $ss; ${$rnln} = $nln; return 1; } return 0; } # fix for simple line line = 'avpkt.data = buf;' # only check for a single '=' sign sub is_simple_line_A_equ_B($) { my ($eln) = shift; my $ind = index($eln,'='); if ($ind > 0) { $eln = substr($eln,$ind+1); $ind = index($eln,'='); if ($ind > 0) { return 0; } return 1; } return 0; } # 20090908 - updated RENAME A FILE TO .OLD, or .BAK # 0 - do nothing if file does not exist. # 1 - rename to .OLD if .OLD does NOT exist # 2 - rename to .BAK, if .OLD already exists, # 3 - deleting any previous .BAK ... sub rename_2_old_bak($) { my ($fil) = shift; my $ret = 0; # assume NO SUCH FILE if ( -f $fil ) { # is there? my ($nm,$dir,$ext) = fileparse( $fil, qr/\.[^.]*/ ); my $nwext = '.old'; $dir = '' if ($dir eq ".\\"); my $nmbo = $dir . $nm . $nwext; $ret = 1; # assume renaming to OLD if ( -f $nmbo) { # does OLD exist $ret = 2; # yes - rename to BAK $nwext = '.bak'; $nmbo = $dir . $nm . $nwext; if ( -f $nmbo ) { $ret = 3; # 20090908 was just 'unlink $nmbo;' if (unlink($nmbo) == 0) { # success } else { if ( -f $nmbo ) { prtw("ERROR: unlink function FAILED!\n"); prtw("ERROR: can NOT delete [$nmbo] file! ABORTING\n"); pgm_exit( 2, "FAILED IN CRITICAL DELETE FUNCTION!\n" ); } } } } # 20090908 was just rename $fil, $nmbo; if ( rename( $fil, $nmbo ) ) { # success } else { #my $shtnm = $nm . $nwext; #if ( rename( $fil, $shtnm ) == 0 ) { # # success #} else { prtw("ERROR: rename function FAILED!\n"); ##prtw("ERROR: can NOT rename [$fil] to [$nmbo] nor [$shtnm]! ABORTING\n"); prtw("ERROR: can NOT rename [$fil] to [$nmbo]! ABORTING\n"); pgm_exit( 3, "FAILED IN CRITICAL RENAME FUNCTION!\n" ); #} } } return $ret; } sub get_old_or_bak($$$) { my ($res,$fil,$rnb) = @_; my ($nm,$dir,$ext) = fileparse( $fil, qr/\.[^.]*/ ); my ($nmbo); if ($res == 1) { $nmbo = $dir . $nm . '.old'; ${$rnb} = $nmbo; return $res; } elsif (($res == 2)||($res == 3)) { $nmbo = $dir . $nm . '.bak'; ${$rnb} = $nmbo; return $res; } return 0; } sub insert_after_return($$$) { my ($eln, $itm, $rnl) = @_; my $nl = ''; my ($len,$k,$c); $len = length($eln); for ($k = 0; $k < $len; $k++) { $c = substr($eln,$k,1); last if ( !($c =~ /\s/) ); $nl .= $c; } if ($k < $len) { $eln = substr($eln,$k); if ($eln =~ /^return\s+(.+)$/) { $len = length($eln); for ($k = 0; $k < $len; $k++) { $c = substr($eln,$k,1); $nl .= $c; last if ($c =~ /\s/); } $nl .= '('.$itm.')'; $k++; $eln = substr($eln,$k); $nl .= ' ' if !($eln =~ /^\s/); $nl .= $eln; ${$rnl} = $nl; return 1; } } return 0; } sub get_fix_key($) { my ($fn) = shift; my $k = '*FIX*'.$fn; return $k; } sub is_fix_key($) { my ($k) = shift; if ($k =~ /^\*FIX\*/) { return 1; } return 0; } # presently ONLY single line # avoids comments, and quoted items - single or double # 20090908 - also avoid say vb = av_malloc(vb_cap = BUFFER_PADDING_SIZE); sub get_equ_count($) { my ($eln) = shift; my $ecnt = 0; my ($len,$k,$cc,@br,$lvl,$tcnt); $eln = trim_all($eln); $eln = remove_comments($eln); $len = length($eln); $lvl = 0; @br = (); $tcnt = 0; for ($k = 0; $k < $len; $k++) { $cc = substr($eln,$k,1); if ($cc eq '"') { # stay until out of double quotes $k++; for (; $k < $len; $k++) { $cc = substr($eln,$k,1); last if ($cc eq '"'); } } elsif ($cc eq "'") { # stay until out of single quotes $k++; for (; $k < $len; $k++) { $cc = substr($eln,$k,1); last if ($cc eq "'"); } } elsif ($cc eq '(') { push(@br,$k); $lvl = scalar @br; } elsif ($cc eq ')') { if (@br) { pop @br; } $lvl = scalar @br; } elsif ($cc eq '=') { $tcnt++; $ecnt++ if ($lvl == 0); } } prt( "get_equ_count: Some '=' signs NOT counted! $ecnt vs $tcnt\n" ) if ($ecnt != $tcnt); return $ecnt; } # see '(' to ')' in this line, after the function name # 20090911 - but skip MACRO(this)(a, b, c,...); # --------------------------------------------- sub get_param_list($$) { my ($stg,$rplist) = @_; my ($len,$cc,$k,$lvl,@brak,$itm,$pcnt); $len = length($stg); $lvl = 0; @brak = (); my @arr = (); $itm = ''; prt("[dbg06] Getting param list from [$stg]\n") if ($dbg06); for ($k = 0; $k < $len; $k++) { $cc = substr($stg,$k,1); if (($cc eq ',') && ($lvl == 1)) { $itm = trim_both_ends($itm); push(@arr,$itm) if (length($itm)); $pcnt = scalar @arr; prt("[dbg06] $pcnt: Added param [$itm]\n") if ($dbg06 && length($itm)); $itm = ''; } elsif ($cc eq '(') { $itm .= $cc if ($lvl); push(@brak,$k); $lvl = scalar @brak; } elsif ($cc eq ')') { if (@brak) { pop @brak; $lvl = scalar @brak; if ($lvl == 0) { $itm = trim_both_ends($itm); push(@arr,$itm) if (length($itm)); $pcnt = scalar @arr; prt("[dbg06] $pcnt: Added param [$itm] last\n") if ($dbg06 && length($itm)); $itm = substr($stg,$k+1); prt( "get_param_list: skipped [$itm]\n" ) if (length(trim_all($itm))); $itm = ''; last; # 20090908 - ok, exit at this point } else { $itm .= $cc; # add closing bracket if NOT level 0 } } else { prtw( "WARNING: get_param_list: FAILED on 'bracket' decode\n" ); return 0; # failed on bracket decode } } elsif ($cc eq '"') { $itm .= $cc; $k++; # stay collecting double quoted item for (; $k < $len; $k++) { $cc = substr($stg,$k,1); $itm .= $cc; last if ($cc eq '"'); } next; } elsif ($cc eq "'") { $itm .= $cc; $k++; # stay collecting single quoted item for (; $k < $len; $k++) { $cc = substr($stg,$k,1); $itm .= $cc; last if ($cc eq "'"); } next; } elsif ($lvl) { if ($cc =~ /\s/) { $itm .= $cc if (length($itm) && !($itm =~ /\s$/)); } else { $itm .= $cc; } } } if (@brak || $lvl) { return 0; } if (@arr) { ${$rplist} = \@arr; return 1; } return 0; } # return any existing cast # 20090911 - Must be FIRST bracket only, since parameter may also be in brackets # and other items must follow sub got_current_cast($) { my ($el) = shift; my ($ll,@br,$k,$c,$lvl); $ll = length($el); @br = (); $lvl = 0; for ($k = 0; $k < $ll; $k++) { $c = substr($el,$k,1); if ($c eq '(') { push(@br,$k); $lvl = scalar @br; } elsif ($c eq ')') { if (@br) { pop @br; $lvl = scalar @br; if ($lvl == 0) { if (($k + 1) < $ll) { $c = substr($el,($k+1)); if ($c =~ /\w/) { return ($k + 1); # return LENGTH of cast } } } } else { return 0; # asymetric brackets } } elsif ($lvl == 0) { if ( !($c =~ /\s/) ) { # some OTHER char BEFORE first bracket return 0; } } } return 0; } sub eat_current_cast($$) { my ($el,$rnl) = @_; my $clen = got_current_cast($el); if ($clen) { ${$rnl} = substr($el,$clen); return 1; } return 0; # FAILED } sub after_func_insert_this_before_that($$$$$$) { my ($func, $this, $that, $eln, $rnl, $dsub) = @_; my ($len,$off,$neln); $len = length($func); prt( "[dbg05] after [$func], insert [$this], before [$that], in line [$eln]\n" ) if ($dbg05); if ( $len && length($this) ) { $off = index($eln,$func); # find the function if ($off >= 0) { my $nl = substr($eln,0,($off+$len)); # get the start $eln = substr($eln,($off+$len)); # reduce to balance #my $nl = substr($eln,0,($off+$len-1)); # get the start #$eln = substr($eln,($off+$len)); # reduce to balance prt( "[dbg05] Using off=$off, len=$len, split to [$nl] and [$eln]\n" ) if ($dbg05); $off = index($eln,$that); # find the 'that' to insert before if ($off > 0) { $nl .= substr($eln,0,$off); # get stuff BEFORE the 'that' $eln = substr($eln,$off); # get BALANCE of the line # $nl .= ' ' if ( !($nl =~ /\s$/) ); $nl .= ' ' if ( !($nl =~ /(\s|\()$/) ); # 20090909 - add space if not spacey or '(' if ($dsub) { $neln = ''; if ( eat_current_cast($eln, \$neln) && length($neln) ) { prt( "[dbg05] Taken cast off [$eln] to get [$neln]\n" ) if ($dbg05); $eln = $neln; } else { prtw("WARNING: Unable to remove current cast from [$eln]\n"); return 0; } } $nl .= '('.$this.')'; # 20090911 - but if the parameter being 'cast' if a multi-item, then must also # encase it in brackets, before adding # like say 'a ? a : NULL' to '(uint16_t *)(a ? a : NULL)' if (trim_both_ends($that) =~ /^\w+$/) { $nl .= $eln; # just add it AS IS } else { $eln = substr($eln,length($that)); # get AFTER the 'that' $nl .= "(".$that.")"; # put 'that' in brackets $nl .= $eln; # then add the balance } ${$rnl} = $nl; prt("[dbg05] Returning new line [$nl]\n") if ($dbg05); return 1; } else { prtw("WARNING: [$that] NOT found in line [$eln]\n"); } } else { prtw("WARNING: failed find of [$func] in [$eln]!\n"); } } else { prtw("WARNING: bad parameters passed [$func] or [$this]\n"); } return 0; } # look for foo(.+); like # 20090911 - and like 'M(a)(1,2,...);' # skip quotes, single, and double, comments /* ... */ and // to EOL sub looks_like_a_simple_function($) { my ($eln) = shift; my ($len,@br,$cc,$nc,$k,$qc,$lc,$lvl,$ind,$pc); $len = length($eln); @br = (); $cc = ''; $lc = ''; $lvl = 0; $ind = 0; for ($k = 0; $k < $len; $k++) { $pc = $cc; $cc = substr($eln,$k,1); $nc = (($k + 1) < $len) ? substr($eln,$k+1,1) : ''; if (($cc eq '/') && ($nc eq '*')) { # entered comment /* ... */ $k += 2; $cc = $nc; for (; $k < $len; $k++) { $pc = $cc; $cc = substr($eln,$k,1); $nc = (($k + 1) < $len) ? substr($eln,$k+1,1) : ''; if (($cc eq '/')&&($pc eq '*')) { last; # done comment } } } elsif (($cc eq '/') && ($nc eq '/')) { # entered comment // ... EOL $k += 2; $cc = $nc; for (; $k < $len; $k++) { $pc = $cc; $cc = substr($eln,$k,1); $nc = (($k + 1) < $len) ? substr($eln,$k+1,1) : ''; if ($cc eq "\n") { last; # done comment } } } elsif (($cc eq '"') && ($cc eq "'")) { # entered single or double quotes $k++; $qc = $cc; for (; $k < $len; $k++) { $pc = $cc; $cc = substr($eln,$k,1); $nc = (($k + 1) < $len) ? substr($eln,$k+1,1) : ''; if (($cc eq $qc) && !($pc eq '/')) { last; # done quotes } } } elsif ($cc eq '(') { # $ind = $k if (($lvl == 0)&&($ind == 0)); $ind = $k if ($lvl == 0); # 20090911 - skip over first 'MAC(abc)' in 'MAC(abc)(a, b, ...)' push(@br,$k); $lvl = scalar @br; } elsif ($cc eq ')') { if (@br) { pop @br; $lvl = scalar @br; } else { return 0; # failed due to bracket asymatry } } $lc = $cc if !($cc =~ /\s/); } if (($lc eq ';')&&($lvl == 0)) { return $ind; } return 0; } sub get_if_def_msg($$$) { my ( $nl, $el, $num ) = @_; my $m = "#ifdef _MSC_VER /* add cast ($num) */\n"; $m .= "$nl\n"; $m .= "#else /* !_MSC_VER */\n"; $m .= "$el\n"; $m .= "#endif /* _MSC_VER y/n */\n"; return $m; } sub split_on_comma_but_not_brackets($) { my ($eln) = shift; my (@a, $len, $k, $cc, @br, $qc, $nc, $pc, $blk, $lvl, $lc); @a = (); $len = length($eln); $cc = ''; $lvl = 0; $lc = ''; $blk = ''; for ($k = 0; $k < $len; $k++) { $pc = $cc; $cc = substr($eln,$k,1); $nc = (($k + 1) < $len) ? substr($eln,$k+1,1) : ''; if (($cc eq '/') && ($nc eq '*')) { # entered comment /* ... */ $k += 2; $blk .= $cc; $blk .= $nc; $cc = $nc; for (; $k < $len; $k++) { $pc = $cc; $cc = substr($eln,$k,1); $nc = (($k + 1) < $len) ? substr($eln,$k+1,1) : ''; $blk .= $cc; if (($cc eq '/')&&($pc eq '*')) { last; # done comment } } } elsif (($cc eq '/') && ($nc eq '/')) { # entered comment // ... EOL $k += 2; $blk .= $cc; $blk .= $nc; $cc = $nc; for (; $k < $len; $k++) { $pc = $cc; $cc = substr($eln,$k,1); $nc = (($k + 1) < $len) ? substr($eln,$k+1,1) : ''; $blk .= $cc; if ($cc eq "\n") { last; # done comment } } } elsif (($cc eq '"') && ($cc eq "'")) { # entered single or double quotes $k++; $blk .= $cc; $qc = $cc; for (; $k < $len; $k++) { $pc = $cc; $cc = substr($eln,$k,1); $nc = (($k + 1) < $len) ? substr($eln,$k+1,1) : ''; $blk .= $cc; if (($cc eq $qc) && !($pc eq '/')) { last; # done quotes } } } elsif ($cc eq '(') { push(@br,$k); $lvl = scalar @br; $blk .= $cc; } elsif ($cc eq ')') { $blk .= $cc; if (@br) { pop @br; } $lvl = scalar @br; } elsif ($cc eq ',') { push(@a,$blk); $blk = ''; } else { $blk .= $cc; } $lc = $cc if !($cc =~ /\s/); } push(@a,$blk) if length($blk); return @a; } sub combine_results_to_one($$$) { my ($msg,$cmsg,$rnmsg) = @_; my @arr1 = split("\n",$msg); my @arr2 = split("\n",$cmsg); my $ca1 = scalar @arr1; my $ca2 = scalar @arr2; if ($ca1 != $ca2) { prtw("WARNING: presently can NOT combine array of DIFF length $ca1 vs $ca2!\n"); return 0; } my @narr = (); for (my $k = 0; $k < $ca1; $k++) { my $ln1 = $arr1[$k]; my $ln2 = $arr2[$k]; if ($ln1 eq $ln2) { push(@narr,$ln1); } else { my @a1 = split_on_comma_but_not_brackets($ln1); my @a2 = split_on_comma_but_not_brackets($ln2); my $c1 = scalar @a1; my $c2 = scalar @a2; if ($c1 != $c2) { prtw("WARNING: presently can NOT combine array of DIFF length $c1 vs $c2!\n"); return 0; } my $nl = ''; for (my $j = 0; $j < $c1; $j++) { $nl .= ',' if length($nl); $ln1 = $a1[$j]; $ln2 = $a2[$j]; if ($ln1 eq $ln2) { $nl .= $ln1; } elsif (length($ln1) > length($ln2)) { $nl .= $ln1; } else { $nl .= $ln2; } } push(@narr,$nl); } } my $ntxt = join("\n",@narr); $ntxt .= "\n"; ${$rnmsg} = $ntxt; return 1; } sub process_error_file($) { my ($fil) = shift; my (@lines, $max, $i, $line); my ($filenm,$linnum,$errnum,$result); my ($rfh, $lncnt, $errlns, $llnnum, $cnt); my ($ok, @items, $icnt, $conv, $msg, $newln); my ($rmax, $rmin, $fstitm); my ($errcnt, $fixedcnt, $done, $param, $elncnt); my ($key,$equcnt); my ($from, $to, $errline, $off, @parlist, $pcnt, $rpa); my ($that, $cast, $ccast, $do_sub, $tmp, $res); my ($newfnd, $isrptln, $info); my ($ra, $cmsg, $pmin, $pmax, $perr, $acnt, $j); my %h = (); my %donefiles = (); my %errs = (); $cnt = 0; $errcnt = 0; $fixedcnt = 0; if (open INF, "<$fil") { @lines = <INF>; $max = scalar @lines; prt( "Processing $max lines, from $fil...\n" ); for ($i = 0; $i < $max; $i++) { $line = trim_line_end($lines[$i]); # file(99) : error C2440: 'initializing' : cannot convert from 'double (__cdecl *)(RateControlEntry *,double)' to 'double (__cdecl *const )(void *,double)' if ($line =~ /^(.+)\((\d+)\)\s+:\s+error C(\d+):\s+(.+)$/) { $filenm = $1; $linnum = $2; $errnum = $3; $result = $4; $lncnt = 'UNKNOWN'; $errlns = "MISSED"; $llnnum = $linnum - 1 if ($linnum); if (defined $errs{$errnum}) { $errs{$errnum}++; # bump count of this error } else { $errs{$errnum} = 1; } $ok = 0; $errcnt++; # processing an ERROR line $param = -1; if ($result =~ /.+parameter\s+(\d+)\s+/) { $param = $1; } # $done = "$filenm(".$linnum.") $errnum $param"; $done = "$filenm(".$linnum.") $errnum"; if (defined $donefiles{$done}) { prt("NOTE: REPEATED FILE LINE [$done]\nresult[$result]\n"); $isrptln = 1; } else { $donefiles{$done} = 1; $isrptln = 0; } $elncnt = -1; if ( get_file_line_rh($filenm, \%h, \$rfh) ) { $lncnt = scalar @{$rfh}; prt( "\nFile [$filenm] line=$linnum on $lncnt, err=$errnum\n" ); if ($linnum < $lncnt ) { $errline = trim_line_end( ${$rfh}[$llnnum] ); $rmin = -1; $rmax = -1; if ( get_error_lines($llnnum, $rfh, \$errlns, \$rmin, \$rmax ) ) { $elncnt = $rmax - $rmin; show_line_range($dbg01,$llnnum,$rfh) if ($dbg01); if ($no_multi_line) { if ($elncnt == 0) { $ok = 1; # ONLY single LINE fixes at this time } else { prt( "Presently NO fix for MULTI-LINES - no_multi_line is ON\n" ); } } else { $ok = 1; } } else { prtw("WARNING: Failed to get ERROR line(s)\n"); } } else { $errlns = "MISSED - $linnum GT $lncnt"; prtw("WARNING: Indicated line $linnum GT $lncnt!\nfile=[$filenm]\n"); } } @items = get_single_quoted($result); $fstitm = $items[0]; $icnt = scalar @items; $equcnt = get_equ_count($errlns); $from = 'Unknown(1)'; $to = 'Unknown(2)'; $from = $items[1] if ($icnt > 1); $to = $items[2] if ($icnt > 2); prt( "Line [$errline]\n" ); #indicated errant line prt( "Result [$result]\n" ); # what the compiler said prt( "Line(s)[$errlns]\n" ); # lines collected to complete statement prt( "Range MIN=$rmin MAX=$rmax cnt=$elncnt (log0=1) icnt=$icnt fst=[$fstitm] from=[$from] to=[$to] ok=$ok\n" ); if ($ok) { $ok = 0; if ($fix_2440_equ && ($errnum == 2440)) { if ($equcnt > 1) { if (($icnt == 3)&&($fstitm eq '=')) { $newln = ''; if ( insert_after_equals($errlns, $to, \$newln, $equcnt) && length($newln) ) { $msg = get_if_def_msg( $newln, $errlns, 'NEW 4' ); $ok = 1; } else { prtw("WARNING: line=[$errlns] INSERTION of [$to] FAILED!\n"); } } else { prt( "Presently NO fix MORE than 1 equal sign! icnt=$icnt fstitm=[$fstitm]\n" ); } } elsif ($icnt == 3) { if (($fstitm eq '=') || ($fstitm eq "initializing") ) { $conv = is_line_convertable($errlns); if ($conv) { $msg = return_conv_line($errlns); $ok = 1; } else { if ($errlns =~ /^(.+)=\s*av_malloc/) { $newln = ''; if ( insert_after_equals($errlns, $to, \$newln, $equcnt) && length($newln) ) { $msg = get_if_def_msg( $newln, $errlns, 'NEW 1' ); $ok = 1; } else { prtw("WARNING: line=[$errlns] INSERTION of $to FAILED!\n"); } } elsif ( is_simple_line_A_equ_B($errlns) ) { $newln = ''; if ( insert_after_equals($errlns, $to, \$newln, $equcnt) && length($newln) ) { $msg = get_if_def_msg( $newln, $errlns, 'NEW 2' ); $ok = 1; } else { prtw("WARNING: line=[$errlns] INSERTION of $to FAILED!\n"); } } else { prtw("WARNING: Line NOT convertable = [".trim_all($errlns)."]!\n res=[$result] line=$linnum, err=$errnum\n"); } } } elsif (( $fstitm eq 'return' ) && ($errlns =~ /\s*return\s+(.+);$/)) { $newln = ''; if ( insert_after_return($errlns, $to, \$newln ) && length($newln) ) { $msg = get_if_def_msg( $newln, $errlns, 'NEW 3' ); $ok = 1; } else { prtw("WARNING: 2440 result=[$result] FAILED to insert after 'return'!"); pgm_exit(1, "THIS SHOULD NOT FAIL!\n"); } } else { prtw("WARNING: 2440 result=[$result] NOT '=', 'initializing' or 'return'!\nError line=[$errlns]$elncnt\n"); } } else { prtw("WARNING: result=[$result] DID NOT YIELD 3 single quotes! icnt=$icnt\n"); } } elsif ($fix_2664_param && ($errnum == 2664) && ($icnt == 3)) { #$from = $items[1]; $to = $items[2]; # this is not good enough - if ($errlns =~ /$fstitm\s*\((.+)\)/) { $off = index($errlns,$fstitm); # try index if (($off < 0) && ($fstitm =~ /^_/)) { $that = substr($fstitm,1); prt("Changed FIRST item to [$that], from [$fstitm]\n"); $fstitm = $that; $off = index($errlns,$fstitm); # try index again } if ($off >= 0) { $newln = substr($errlns,($off + length($fstitm))); $newln = remove_comments($newln); # take out any comments prt( "params=[".trim_all($newln)."] param=$param\n" ); if ( get_param_list( $newln, \$rpa)) { $pcnt = scalar @{$rpa}; prt( "PARAMS:$pcnt: " ); $off = 0; $that = ''; $do_sub = 0; foreach $msg (@{$rpa}) { $off++; $info = "$off"."[$msg]"; if ($off == $param) { $info = "\n$info* "; $res = got_current_cast($msg); if (($res > 2) && ($msg =~ /\s*\((.+)\)(.+)$/)) { # 20090909 - try to ADD cast substition # already has a cast - is it a case of cast substitution only $ccast = $1; $tmp = substr($msg,0,$res); $tmp =~ s/^\((.+)\)$/$1/; if ($tmp eq $from) { prt( "NOTE:1: Has cast [$ccast](per from)! Just NEED substitution?\n" ); $do_sub = 1; $that = ${$rpa}[$off-1]; } elsif ($ccast eq $from) { prt( "NOTE:2: Has cast [$ccast](per from)! Just NEED substitution? tmp[$tmp] CHECKME\n" ); $do_sub = 1; $that = ${$rpa}[$off-1]; } else { prtw( "WARNING: Eek: has cast [$ccast]! Can I substitute [$from]?\n" ); } } else { $that = ${$rpa}[$off-1]; } # if (trim_both_ends($that) =~ /\s/) { if (trim_both_ends($that) =~ /^\w+$/) { $info .= " to [($to)$that]\n"; } else { $info .= " to [($to)($that)]\n"; } } prt("$info "); } prt("\n"); $newln = ''; if (length($that) && after_func_insert_this_before_that($fstitm, $to, $that, $errlns, \$newln, $do_sub) && length($newln)) { $msg = get_if_def_msg( $newln, $errlns, 'NEW 4' ); $ok = 1; } } else { prt("FAILED to get parameter list from [$newln]\n"); } } else { if (($elncnt == 0) || !$no_multi_line ) { # try harder is just one line, or multi-lines too $res = looks_like_a_simple_function($errlns); if ($res) { $newln = substr($errlns,$res); $newfnd = trim_line_head(substr($errlns,0,$res)); $newln = remove_comments($newln); # take out any comments prt( "params=[".trim_all($newln)."] param=$param newfnd=[$newfnd]\n" ); if ( get_param_list( $newln, \$rpa)) { $pcnt = scalar @{$rpa}; prt( "PARAM2:$pcnt: " ); $off = 0; $that = ''; $do_sub = 0; foreach $msg (@{$rpa}) { $off++; $info = "$off"."[$msg]"; if ($off == $param) { $info = "\n*Change $info*"; $res = got_current_cast($msg); if (($res > 2) && ($msg =~ /\s*\((.+)\)(.+)$/)) { # 20090909 - try to ADD cast substition # already has a cast - is it a case of cast substitution only $ccast = $1; $tmp = substr($msg,0,$res); $tmp =~ s/^\((.+)\)$/$1/; if ($tmp eq $from) { prt( "NOTE:1: Has cast [$ccast](per from)! Just NEED substitution?\n" ); $do_sub = 1; $that = ${$rpa}[$off-1]; } elsif ($ccast eq $from) { prt( "NOTE:2: Has cast [$ccast](per from)! Just NEED substitution? tmp[$tmp] CHECKME\n" ); $do_sub = 1; $that = ${$rpa}[$off-1]; } else { prtw( "WARNING: has cast [$ccast]! Can I substitute [$from]?\n" ); } } else { $that = ${$rpa}[$off-1]; } # if (trim_both_ends($that) =~ /\s/) if (trim_both_ends($that) =~ /^\w+$/) { $info .= " to [($to)$that]\n"; } else { $info .= " to [($to)($that)]\n"; } } prt("$info "); } prt("\n"); if (length($that) && after_func_insert_this_before_that($newfnd, $to, $that, $errlns, \$newln, $do_sub) && length($newln)) { $msg = get_if_def_msg( $newln, $errlns, 'NEW 5' ); $ok = 1; } } } } if (!$ok) { prt("FAILED to find [$fstitm] in [$errlns]! - index=$off\n"); } } if (!$ok) { prt( "error C$errnum: Presently fix NOT complete for param $param, from [$from], to [$to]...\n" ); } } else { prt( "Presently NO fix for this error number...\n" ); } if ($ok) { prt( "INSERT into file REPLACING RANGE min=$rmin max=$rmax\n$msg" ); } } if ($ok) { if ($isrptln) { $ok = 0; $key = get_fix_key($filenm); if (defined $h{$key}) { $ra = $h{$key}; $acnt = scalar @{$ra}; $info = ''; for ($j = 0; $j < $acnt; $j++) { $pmin = ${$ra}[$j][1]; $pmax = ${$ra}[$j][2]; $info .= "+" if length($info); $info .= "[".$pmin."-".$pmax."]"; last if ($rmin == $pmin); } if ($j < $acnt) { $cmsg = ${$ra}[$j][0]; $pmax = ${$ra}[$j][2]; $perr = ${$ra}[$j][3]; if ($rmax == $pmax) { if ($errlns eq $perr) { prt("Must COMBINE \n[$msg] with\n[$cmsg]\n"); my $nmsg = ''; if (combine_results_to_one($msg,$cmsg,\$nmsg) && length($nmsg)) { prt("DID_IT!\n[$nmsg]"); ${$ra}[$j][0] = $nmsg; $h{$key} = $ra; $ok = 1; } else { prtw("WARNING: Combination FAILED!\n"); } } else { prtw("WARNING: Combining NOT POSSIBLE\n[$errlns] NOT EQUAL \n[$perr]\n"); } } else { prtw("WARNING: Combining NOT POSSIBLE rmax=$rmax NOT EQUAL [$pmax\n"); } } else { prtw("WARNING: Combining NOT POSSIBLE rmin=$rmin NOT FOUND!\nRanges $info\n"); } } else { prtw("ERROR: can NOT locate key [$key]!\n"); } if (!$ok) { prtw( "WARNING: Got 'fix' BUT repeated line fixes NOT presently coded line=$linnum, err=$errnum param=$param!\n" ); my_exit(1,"TEMP EXIT\n"); } } else { $fixedcnt++; $key = get_fix_key($filenm); if (defined $h{$key}) { $ra = $h{$key}; push(@{$ra}, [$msg, $rmin, $rmax, $errlns] ); $h{$key} = $ra; prt( "Added fix as ".(scalar @{$ra}). " for this file.\n" ); } else { my @a = (); push(@a, [$msg, $rmin, $rmax, $errlns]); $h{$key} = \@a; prt( "Set fix as FIRST for this file.\n" ); } } } else { prtw( "WARNING: No 'fix' available for this line=$linnum, err=$errnum ERROR!\n" ); } $cnt++; #if ($cnt > 4) { # pgm_exit(1, "TEMP EXIT\n"); #} } } $icnt = scalar keys(%errs); prt( "\nProcessed $max lines, from $fil errorcnt=$errcnt, fixedcnt=$fixedcnt...\n" ); prt( "Errors: $icnt: counts: " ); $cnt = 0; foreach $key (keys %errs) { $cnt++; if ($cnt > 8) { $cnt = 0; prt("\n "); } prt( "$key=".$errs{$key}." " ); } prt("\n"); } else { prtw( "WARNING: Unable to OPEN error [$fil]!\n" ); } return \%h; } sub show_hash($) { my ($rh) = @_; prt( "Showing hash RESULTS...\n" ); my ($fcnt,$fxcnt,$cnt,$k,$fwfixes,$key,$rfarr,$acnt,$tcnt,$rlarr,$lcnt,$tlcnt); $cnt = scalar keys(%{$rh}); $fcnt = 0; $fxcnt = 0; $fwfixes = 0; $acnt = 0; $tcnt = 0; $tcnt = 0; foreach $k (keys %{$rh}) { # if ($k =~ /^\*FIX\*/) if ( is_fix_key($k) ) { $fxcnt++; $rfarr = ${$rh}{$k}; $acnt = scalar @{$rfarr}; $tcnt += $acnt; } else { $fcnt++; $rlarr = ${$rh}{$k}; $lcnt = scalar @{$rlarr}; $tlcnt += $lcnt; $key = get_fix_key($k); if (defined ${$rh}{$key}) { $fwfixes++; } else { prt( "No fixes for [$k]!\n" ) if ($show_no_fixes); } } } prt( "Got $cnt items in the hash, $fcnt files, $tlcnt lines, with $fxcnt ($fwfixes) fixes, $tcnt total...\n" ); } sub write_new_file($$) { my ($fil,$rla) = @_; my ($txt,@arr,$dtxt,$res,$nfil); my $tmp_diff = 'tempdiff.txt'; $txt = join("\n", @{$rla}); $txt .= "\n"; @arr = (); if ($write_temp_only) { $nfil = 'tempnew.c'; prt( "NOTE: Fixes only being applied to a TEMPORARY file [$nfil]...\n" ); $res = rename_2_old_bak($nfil); write2file($txt,$nfil); prt( "Written [$nfil] - Doing 'diff $dparams $fil $nfil'...\n" ); if (open (DIFF, "diff $dparams $fil $nfil|")) { @arr = <DIFF>; close DIFF; $dtxt = join("",@arr); } else { prt("ERROR: FAILED to get DIFF text!\n"); pgm_exit(1, "PREMATURE ERROR EXIT!\n"); } prt( "Done [$nfil]\n" ); } else { prt( "Fixes being written to [$fil]...\n" ); $res = rename_2_old_bak($fil); if ( get_old_or_bak($res,$fil,\$nfil) ) { write2file($txt,$fil); prt( "Written file - Doing 'diff $dparams $nfil $fil'...\n" ); if (open (DIFF, "diff $dparams $nfil $fil|")) { @arr = <DIFF>; close DIFF; $dtxt = join("",@arr); } else { prt("ERROR: FAILED to get DIFF text!\n"); pgm_exit(1, "PREMATURE ERROR EXIT!\n"); } } else { prt( "ERROR: FAILED to get OLD/BAK name with $res value!\n" ); pgm_exit(1, "PREMATURE ERROR EXIT!\n"); } prt( "Done [$fil]\n" ); } if ($show_each_diff) { write2file($dtxt,$tmp_diff); system($tmp_diff); } else { prt("=============================================================================\n"); prt("$dtxt\n"); prt("=============================================================================\n"); } } sub perform_fixes_from_hash($) { my ($rh) = @_; prt( "Performing FIXES...\n" ); my ($fcnt,$fxcnt,$cnt,$k,$fwfixes,$key,$rfarr,$acnt,$tcnt,$rlarr,$lcnt,$tlcnt); $cnt = scalar keys(%{$rh}); my ($line, $msg, $minln, $l, $f, $dcnt, $maxln); my ($orgln, @outarr, @marr, $dnln, $chg, $mln, $mnln, $fixnum); $fcnt = 0; $fxcnt = 0; $fwfixes = 0; $acnt = 0; $tcnt = 0; $tcnt = 0; $dcnt = 0; $fixnum = 0; foreach $k (keys %{$rh}) { # if ($k =~ /^\*FIX\*/) if ( is_fix_key($k) ) { $fxcnt++; $rfarr = ${$rh}{$k}; $acnt = scalar @{$rfarr}; $tcnt += $acnt; } else { $fcnt++; $rlarr = ${$rh}{$k}; $lcnt = scalar @{$rlarr}; $tlcnt += $lcnt; $key = get_fix_key($k); if (defined ${$rh}{$key}) { $rfarr = ${$rh}{$key}; $acnt = scalar @{$rfarr}; # ok have the line array, and the fixes array $fwfixes++; @outarr = (); $chg = 0; for ($l = 0; $l < $lcnt; $l++) { $line = trim_line_end(${$rlarr}[$l]); $dnln = 0; for ($f = 0; $f < $acnt; $f++) { # 0 1 2 3 # push(@a, [$msg, $rmin, $rmax, $errlns]); $minln = ${$rfarr}[$f][1]; $maxln = ${$rfarr}[$f][2]; if ($minln == $l) { # got the start line $fixnum++; # found matching line number $msg = ${$rfarr}[$f][0]; # extract substitution $mnln = $minln; while (($mnln < $maxln) && ($l < $lcnt)) { $l++; # bump to NEXT file line $line .= "\n".trim_line_end(${$rlarr}[$l]); $mnln++; } $orgln = trim_line_end(${$rfarr}[$f][3]); if ($line eq $orgln) { $chg++; prt("$fixnum:$chg:$l: Lines ok. Doing substitution...\n"); @marr = split("\n",$msg); foreach $mln (@marr) { $mln = trim_line_end($mln); push(@outarr,$mln); $dnln++; } $dcnt++; } else { # if just one line, out of curioisity search up and down a little if ($minln == $maxln) { my $tstcnt = 3; my $tfl1 = ($minln > $tstcnt) ? $minln - $tstcnt : 0; my $tfl2 = (($maxln + $tstcnt) < $lcnt) ? $maxln + $tstcnt : $lcnt - 1; while ($tfl1 < $tfl2) { my $tstln = trim_line_end(${$rlarr}[$tfl1]); last if ($tstln eq $orgln); $tfl1++; } if ($tfl1 < $tfl2) { prtw("WARNING: HELP: Found matching line at line $tfl1! How did $minln get wrong?\n"); } else { prtw("WARNING:DOUBLED! Line not found in +/- $tstcnt!!!\n"); } } prtw( "WARNING:$fixnum:$chg:$l: Lines NOT EQUAL! MIN=$minln MAX=$maxln WHY?\n[$line](len=".length($line).")\n[$orgln](len=".length($orgln).")\n" ); } } } if (!$dnln) { push(@outarr,$line); } } write_new_file($k,\@outarr) if ($chg > 0); } else { prt( "No fixes for [$k]!\n" ); } } } prt( "Got $cnt items in the hash, $fcnt files, $tlcnt lines, with $fxcnt ($fwfixes) fixes, $tcnt total done $dcnt...\n" ); } my $ref_hash = process_error_file($in_errors); show_hash($ref_hash); if ($do_file_fixes) { if ($clear_warn_before_fix) { show_warnings(); @warnings = (); } perform_fixes_from_hash($ref_hash) ; } pgm_exit(0, "Normal end\n"); # eof