Generated: Sun Apr 15 11:45:58 2012 from cmp2dsps03.pl 2012/04/05 67.8 KB.
#!/bin/perl -w # NAME: cmp2dsps03.pl # AIM: Comparison of TWO DSP files - show different SOURCE files, and configurations... # 05/04/2012 - add -vN # 07/01/2011 - small fix in space_split_with_quotes to add last item, if any... # 26/09/2010 - Review, and improve - add use File::Spec; to convert relative inputs to absolute # 04/07/2010 - Make the MISSED1: output list, ready for DSP insertion # 02/06/2010 - Do better compare of CONFIGS... # 2010/05/08 - Kill get_rel_path() warning, by ensuring $dir is set correctly... # 2010/01/14 - Reduce output to MINIMUM, unless 'verbose' set... # 2009/10/28 - Use references, and add a command line # 20090828 - BUG squashed ;=)) This was '$i1', which is WRONG $v6_srcs2[$i2][4] = $i1 + 1; # 20090827 - Some improvements in configuration compare # # 13/08/2008 geoff mclane http://geoffair.net/mperl # Only compares SOURCE lists. Still to compare config parameters ... use strict; use warnings; use File::Basename; use File::stat; # to get the file date use File::Spec; # File::Spec->rel2abs($rel); # we are IN the SLN directory, get ABSOLUTE from RELATIVE use Cwd; # 2010/05/08 - to get cwd() unshift(@INC, 'C:/GTools/perl'); ###require 'logfile.pl' or die "Unable to load logfile.pl ...\n"; require 'fgutils02.pl' or die "Unable to load fgutils02.pl ...\n"; # log file stuff my $perl_base = "C:\\GTools\\perl"; # perl directory my ($LF); my $pgmname = $0; if ($pgmname =~ /\w{1}:\\.*/) { my @tmpsp = split(/\\/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = $perl_base."\\temp.$pgmname.txt"; open_log($outfile); ### prt( "$0 ... Hello, World ...\n" ); # options my $minlen1 = 40; my $minlen2 = 64; my $verbose = 0; my $load_log = 0; # features my $compconfig = 1; # not completed - compare config stuff my $max_cfg_ln = 50; my $dbg_ds01 = 0; # prt("[01] SOURCE=[$src]\n"); my $dbg_ds02 = 0; # prt("[02] HEADER=[$src]\n"); and more... my $dbg_ds03 = 0; # prt("[03] OTHER=[$src]\n") my $dbg_ds04 = 0; # show CPP and LINK config %v6_conf like [04] ADD key=[$key] [$item] my $dbg_ds05 = 0; # show Defined items - %v6_defs my $dbg_ds06 = 0; # show !IF, !ELSEIF switching my $dbg_ds07 = 0; # show %v6_conf listing my $dbg_ds08 = 0; # show VC6 Filter and Group Name my $dbg_ds09 = 0; # [09] $scnt v6_srcs: $src, $ffnr, $grpname, $filter, ... $prjname\n" ) EACH VC6 source pushed my $dbg_ds10 = 0; # show prt( "NO MATCH of 1 [$ff1] in 2\n" ) if ($dbg_ds10); my $dbg_ds11 = 0; # prt("[dbg_ds11] cmp:defines: [$v1] with [$v2] in [$src]\n") if ($dbg_ds11); my $dbg_ds12 = 0; # prt("[dbg_ds12] cmp:configs:[$src] [$v1] with [$v2]\n"); my $dbg_ds13 = 0; # prt("[13] Given [$itm1] + [$itm2],\nreturn [$res]\n"); my $dbg_ds14 = 0; # prt( "[14] MSVC Version $1 ...\n" ) if ($dbg_ds14); and more... my $dbg_ds15 = 0; # show missed source in DSP form, for easy cut and paste my $dbg_max_val = 15; my $ds_dbg_base = 'dbg_ds'; sub ds_get_dbg_val_var($) { my $val = shift; my $var = $ds_dbg_base; if ($val < 10) { $var .= "0$val"; } else { $var .= "$val"; } return $var; } sub ds_get_dbg_var($) { my $val = shift; my $var = ds_get_dbg_val_var($val); my $res = -1; # from : http://perldoc.perl.org/functions/eval.html if (eval "defined \$$var") { $res = eval "\$$var"; } return $res; } sub ds_set_dbg_var($) { my $val = shift; my $var = ds_get_dbg_val_var($val); # from : http://perldoc.perl.org/functions/eval.html # NOT $$var++; # does not work! if (eval "defined \$$var") { eval "\$$var++"; } else { #print "ERROR: \$$var does NOT exist\n"; return 0; } return 1; } sub ds_get_dbg_range() { my ($i,$res); for ($i = 1; ;$i++) { $res = ds_get_dbg_var($i); last if ($res == -1); } return $i - 1; } sub ds_get_dbg_stg() { my $s = ''; my ($i,$res,$i2); for ($i = 1; ;$i++) { $res = ds_get_dbg_var($i); last if ($res == -1); if ($i < 10) { $i2 = "0$i"; } else { $i2 = "$i"; } if ($res > 0) { $s .= "$i2 "; } } return $s; } sub VERB1() { return ($verbose > 0); } sub VERB2() { return ($verbose > 1); } sub VERB3() { return ($verbose > 2); } sub VERB4() { return ($verbose > 3); } sub VERB5() { return ($verbose > 4); } sub VERB9() { return ($verbose > 8); } # compiler flags my %compile_flags = ( 'nologo' => 0, 'W3' => 0, 'Gm' => 0, 'GR' => 0, 'GX' => 0, 'ZI' => 0, 'Od' => 0, 'MTd' => 0, 'I' => 1, 'D' => 1, 'FD' => 0, 'GZ' => 0, 'c' => 0, 'O2' => 0, 'MT' => 0 ); my @warnings = (); my %v6_defs = (); my %v6_conf = (); # file 1 stuff my %v6_defs1 = (); my %v6_conf1 = (); # file 2 stuff my %v6_defs2 = (); my %v6_conf2 = (); my $in_file2 = ''; my $in_file1 = ''; my $debug_on = 0; my $def_file2 = 'tempsd.dsp'; my $def_file1 = 'C:\Projects\fltk-1.3\ide\MSVC\tile.dsp'; #my $def_file2 = 'temp.pthread.dsp'; #my $def_file1 = 'c:\FG\32\pthreads\pthread.dsp'; #my $def_file1 = 'temp.testcon.dsp'; #my $def_file2 = 'temp.FlightGear.dsp'; #my $def_file1 = 'C:\FG\32\FlightGear\FlightGear.dsp'; #my $def_file1 = 'C:\GTools\ConApps\test\testcon.dsp'; #my $def_file2 = 'tempdsp3.dsp'; my $root_dir = '.'; my $projname = 'testcon'; #my $in_file1 = 'temp.libavcodec.dsp'; #my $in_file2 = 'C:\Projects\hb\ffmpeg\build\msvc\libavcodec.dsp'; #my $root_dir = 'C:\Projects\hb\ffmpeg\build\msvc'; #my $projname = 'libavcodec'; #my $in_file1 = 'temp.Map.dsp'; #my $in_file2 = 'C:\FG\27\Atlas-04\build\msvc\Map.dsp'; #my $in_file1 = 'temp.Atlas.dsp'; #my $in_file2 = 'C:\FG\27\Atlas-04\build\msvc\Atlas.dsp'; #my $root_dir = 'C:\FG\27\Atlas-04\build\msvc'; #my $projname = 'Atlas'; #my $in_file1 = 'temp.#Win32.libtar.dsp'; #my $in_file2 = 'C:\Projects\tar120\Win32\libtar.dsp'; #my $root_dir = "C:\\Projects\\tar120\\Win32\\"; #my $projname = 'libtar'; #my $in_file1 = 'temp.xmlrpc.dsp'; #my $in_file2 = 'C:\FG\FGCOMXML\xmlrpc-c\Windows\xmlrpc.dsp'; #my $root_dir = "C:\\FG\\FGCOMXML\\xmlrpc-c\\Windows\\"; #my $projname = 'xmlrpc'; my @discarded_dupes = (); my @lines1 = (); my @lines2 = (); my $lncnt1 = 0; my $lncnt2 = 0; # forward reference sub is_same_source_file($$); sub prtw($) { my ($tx) = shift; $tx =~ s/\n$//; prt("$tx\n"); push(@warnings,$tx); } sub show_warnings() { if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS ...\n" ); foreach my $line (@warnings) { prt("$line\n" ); } prt("\n"); } else { prt("No warnings issued.\n") if (VERB5()); } } sub pgm_exit($$) { my ($val,$msg) = @_; show_warnings(); #my $dbs = get_dbg_stg(); #if (length($dbs)) { # prt("WARNING: Debug is ON for [$dbs], in fgscanvc03.pl\n" ); #} if (length($msg)) { $msg .= "\n" if ( !($msg =~ /\n$/) ); prt($msg) if ($val || VERB5()); } $load_log = 1 if (VERB5()); close_log($outfile,$load_log); # unlink($outfile); # delete output file exit($val); } # extracted from utils.pl sub unix_2_dos($) { my ($f) = shift; $f =~ s/\//\\/g; return $f; } sub clear_load { #@v6_srcs = (); # relnm full group filter %v6_defs = (); %v6_conf = (); } sub split_rsc_items($) { my ($itm) = @_; # made up of /l ["]...["], and /d ["]...["] my @arr = split(/\s/,$itm); my $ac = scalar @arr; my ($par,$ra); my %hash = (); for (my $i = 0; $i < $ac; $i++) { my $tx = trim_all($arr[$i]); if ($tx =~ /\/l/) { if (($i + 1) < $ac) { $i++; $par = trim_all($arr[$i]); if (defined $hash{'l'}) { $ra = $hash{'l'}; push(@{$ra},$par); $hash{'l'} = $ra; } else { $hash{'l'} = [ $par ]; } } else { pgm_exit(1,"ERROR: Nothing following [$tx]\n"); } } elsif ($tx =~ /\/d/) { if (($i + 1) < $ac) { $i++; $par = trim_all($arr[$i]); if (defined $hash{'d'}) { $ra = $hash{'d'}; push(@{$ra},$par); $hash{'d'} = $ra; } else { $hash{'d'} = [ $par ]; } } else { pgm_exit(1,"ERROR: Nothing following [$tx]\n"); } } else { pgm_exit(1,"ERROR: Uncased [$tx]\n"); } } return \%hash; } sub combine_rsc_items($$) { my ($itm1,$itm2) = @_; # ( ${$rconf}{$key}, $item ); my $rh1 = split_rsc_items($itm1); my $rh2 = split_rsc_items($itm2); my $res = ''; my ($k,%h1,$ra1,$ra2); if (defined ${$rh1}{'l'}) { $ra1 = ${$rh1}{'l'}; if (defined ${$rh2}{'l'}) { $ra2 = ${$rh2}{'l'}; # combine two arrays %h1 = (); foreach $k (@{$ra1}) { $h1{$k} = 1; } foreach $k (@{$ra2}) { $h1{$k} = 1; } foreach $k (keys %h1) { $res .= ' ' if (length($res)); $res .= "/l $k"; } } else { foreach $k (@{$ra1}) { $res .= ' ' if (length($res)); $res .= "/l $k"; } } } if (defined ${$rh1}{'d'}) { $ra1 = ${$rh1}{'d'}; if (defined ${$rh2}{'d'}) { $ra2 = ${$rh2}{'d'}; # combine two arrays %h1 = (); foreach $k (@{$ra1}) { $h1{$k} = 1; } foreach $k (@{$ra2}) { $h1{$k} = 1; } foreach $k (keys %h1) { $res .= ' ' if (length($res)); $res .= "/d $k"; } } else { foreach $k (@{$ra1}) { $res .= ' ' if (length($res)); $res .= "/d $k"; } } } prt("[13] Given [$itm1] + [$itm2],\nreturn [$res]\n") if ($dbg_ds13); return $res; #return "$itm1 | $itm2"; } sub process_DSP { my ($user_proj, $fil) = @_; my ($line, $prjname, $grpname, $filter, $ff, $src, $chr, $tmp, $conf, $ffnr); my ($itm1, $itm2, $key, $targtype, $i); my $scnt = 0; my @dsp_lines = (); my %src_list = (); # 20090828 - avoid adding simple DUPLICATES my $inanif = 0; # in an !IF block my $ins = 0; # in a source block my $inproj = 0; # in project portion of file my $intarget = 0; my $ingroup = 0; my $incustom = 0; my $sline = ''; my $inspecial = 0; my ($gotbase,$gotadd,$gotsub); # line has BASE ADD SUB my %prop_nh = (); my %add_nh = (); my @tmparr = (); my ($item); my @v6_srcs = (); my $rdefs = \%v6_defs; my $rconf = \%v6_conf; my $rsrcs = \@v6_srcs; my %hash = (); $prjname = $user_proj; prt( "\nProcess DSP file $fil ... " ) if (VERB2()); if ( -f $fil ) { my $sb = stat($fil); prt( "dated ".scalar localtime($sb->mtime).", size ".$sb->size." bytes.\n" ) if (VERB9()); $hash{'FILE_NAME'} = $fil; $hash{'FILE_TIME'} = $sb->mtime; $hash{'FILE_SIZE'} = $sb->size; my ($in_name,$in_dir) = fileparse($fil); #$in_dir = trim_all($in_dir); #$in_dir = $root_dir if ((length($in_dir) == 0)||($in_dir eq ".\\")); $in_dir = cwd() if ($in_dir =~ /^\.(\\|\/)$/); # 2010/05/08 - use CWD if none $in_dir .= "\\" if !($in_dir =~ /[\\\/]$/); # 20090827 - ensure ends with '\' $in_dir = unix_2_dos($in_dir); if ( open IF, "<$fil" ) { @dsp_lines = <IF>; close IF; my $lncnt = scalar @dsp_lines; prt( "Got $lncnt lines, from file [$fil], to process ...\n" ) if (VERB9()); # process DSP line, by line for ($i = 0; $i < $lncnt; $i++) { $line = $dsp_lines[$i]; $line = trim_all($line); next if (length($line) == 0); $chr = substr($line, 0, 1); # get FIRST char of LINE if( $chr eq '#' ) { $gotbase = ($line =~ /\s+BASE\s+/) ? 1 : 0; $gotadd = ($line =~ /\s+ADD\s+/) ? 1 : 0; $gotsub = ($line =~ /\s+SUBTRACT\s+/) ? 1 : 0; # line begins with SHARP $sline = trim_all(substr($line,1)); # line without sharp # [# Microsoft Developer Studio Project File - Name="" - Package Owner=<4>] # if ($line =~ /\s+Microsoft Developer Studio Project File - Name=\"([\.\w\s]+)+/) { if ($line =~ /\s+Microsoft Developer Studio Project File - Name="([\.\w\s]+)*" - Package/) { $prjname = $1; $prjname = '<no project name>' if (length($prjname) == 0); # $v6_defs{'PROJECT_NAME'} = $prjname; ${$rdefs}{'PROJECT_NAME'} = $prjname; prt( "Project NAME = [$prjname]\n" ) if (VERB9()); } elsif ($line =~ /\s+Microsoft Developer Studio Generated Build File, Format Version ([\d\.]+)/) { prt( "[14] MSVC Version $1 ...\n" ) if ($dbg_ds14); #} elsif ($line =~ /\s*TARGTYPE\s+\"(.+)\"\s+/) { # Win32 (x86) Console Application" 0x0103 } elsif ($line =~ /\s*TARGTYPE\s+"(.+)"\s+/) { # Win32 (x86) Console Application" 0x0103 $targtype = $1; prt( "TARGTYPE: [$targtype], name=[$prjname]\n" ); #$v6_defs{'PROJECT_TYPE'} = $targtype; ${$rdefs}{'PROJECT_TYPE'} = $targtype; } elsif ($sline =~ /^PROP\s+/) { $sline =~ s/^PROP\s+//; $sline =~ s/^BASE\s+//; if ($line =~ /PROP\s+Default_Filter\s+\"([\w;]+)+\"/ ) { $filter = $1; prt( "[08] Begin Filter group $grpname, filter $filter\n" ) if ($dbg_ds08); } elsif ($line =~ /PROP\s+Default_Filter\s+\"\"/ ) { $filter = ''; prt( "[08] Begin Filter group $grpname, with blank filter\n" ) if ($dbg_ds08); } elsif ($sline =~ /^Use_MFC/) { # *TBD* if needed } elsif ($sline =~ /^Scc_ProjName/) { # *TBD* if needed } elsif ($sline =~ /^AllowPerConfigDependencies/) { # *TBD* if needed } elsif ($sline =~ /^Output_Dir/) { # *TBD* if needed } elsif ($sline =~ /^Scc_LocalPath/) { # *TBD* if needed } elsif ($sline =~ /^Intermediate_Dir/) { # *TBD* if needed } elsif ($sline =~ /^Use_Debug_Libraries/) { # *TBD* if needed } elsif ($sline =~ /^Ignore_Export_Lib/) { # *TBD* if needed } elsif ($sline =~ /^Exclude_From_Build/) { # *TBD* if needed } elsif ($sline =~ /^Target_Dir/) { # *TBD* if needed } else { prtw( "WARNING: PROP NOT HANDLED! [$sline] [$line]\n" ); @tmparr = split(/\s/,$sline); $item = $tmparr[0]; $prop_nh{$item} = 1; } } elsif ( $sline =~ /^ADD\s+/ ) { $sline =~ s/^ADD\s+//; $sline =~ s/^BASE\s+//; if ( $line =~ /ADD BASE CPP (.+)/ ) { $item = $1; # ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /Yu"stdafx.h" /FD /c $key = 'CPP '.$conf; prt( "[04] ADD BASE key=[$key] [$item]\n" ) if ($dbg_ds04); #$v6_conf{$key} = $item; ${$rconf}{$key} = $item; } elsif ( $line =~ /ADD CPP (.+)/ ) { $item = $1; # ADD CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /FD /c $key = 'CPP '.$conf; prt( "[04] ADD key=[$key] [$item]\n" ) if ($dbg_ds04); #$v6_conf{$key} = $item; ${$rdefs}{$key} = $item; } elsif ( $line =~ /ADD BASE LINK32 (.+)/ ) { $item = $1; # ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /machine:I386 $key = 'LINK '.$conf; prt( "[04] ADD BASE key=[$key] [$item]\n" ) if ($dbg_ds04); #$v6_conf{$key} = $item; ${$rconf}{$key} = $item; } elsif ( $line =~ /ADD LINK32 (.+)/ ) { $item = $1; $key = 'LINK '.$conf; # ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /machine:I386 prt( "[04] ADD key=[$key] [$item]\n" ) if ($dbg_ds04); #$v6_conf{$key} = $item; ${$rconf}{$key} = $item; } elsif ($sline =~ /^RSC\s+(.+)/) { # 2010-01-19 IS NEEDED - like # c:\FG\32\zips\temp\pthread.dsp # # ADD BASE RSC /l 0x809 /d "NDEBUG" # # ADD RSC /l 0x809 /d "NDEBUG" /d "PTW32_RC_MSC" # OR LIKE - c:\FG\32\lpng\projects\visualc6\libpng.dsp # # ADD RSC /l 0x409 /i "..\.." /d "_DEBUG" /d PNG_DEBUG=1 # # ADD RSC /l 0x409 /i "..\.." /d "NDEBUG" /d PNG_LIBPNG_SPECIALBUILD=""""Use MMX instructions"""" # # ADD RSC /l 0x409 /i "..\.." /d "NDEBUG" /dPNG_LIBPNG_DLLFNAME_POSTFIX=""""VB"""" /dPNG_LIBPNG_SPECIALBUILD=""""__stdcall calling convention used for exported functions"""" $item = $1; $key = 'RSC '.$conf; if (defined ${$rconf}{$key}) { if ($gotbase) { ${$rconf}{$key} = $item; } elsif ($gotsub) { prtw("WARNING: SUBTRACT NOT HANDLED YET!\n"); } else { ${$rconf}{$key} = combine_rsc_items( ${$rconf}{$key}, $item ); } } else { ${$rconf}{$key} = $item; } } elsif ($sline =~ /^BSC32/) { # *TBD* if needed } elsif ($sline =~ /^LIB32/) { # *TBD* if needed } elsif ($sline =~ /^MTL/) { # *TBD* if needed } else { prtw( "WARNING: ADD NOT HANDLED! [$sline] [$line]\n" ); @tmparr = split(/\s/,$sline); $item = $tmparr[0]; $add_nh{$item} = 1; } } elsif ( $sline =~ /\*\*\s+DO\s+NOT\s+EDIT\s+\*\*/) { # ignore this line } elsif ( $sline =~ /^Name\s+(.+)$/) { # Name "testcon - Win32 ReleaseSSE"] } elsif ( $sline =~ /^SUBTRACT\s+/ ) { # ignore for now } elsif ( $line =~ /Begin\s+Project/ ) { $inproj = 1; } elsif ( $line =~ /End\s+Project/ ) { $inproj = 0; } elsif ( $line =~ /Begin\sTarget/ ) { $intarget = 1; } elsif ( $line =~ /End\sTarget/ ) { $intarget = 0; } elsif ($line =~ /Begin Group \"([\s\w]+)+/ ) { $grpname = $1; prt( "[14] Begin group ... $grpname\n" ) if ($dbg_ds14); $ingroup = 1; } elsif ($line =~ /End\s+Group/) { $ingroup = 0; } elsif ($line =~ /Begin\s+Source\s+File/) { $ins = 1; prt( "[14] Begin source ... $ins ...\n" ) if ($dbg_ds14); } elsif ($line =~ /End\s+Source\s+File/) { $ins = 0; prt( "[14] End source ... $ins ...\n" ) if ($dbg_ds14); } elsif ($line =~ /Begin\s+Custom\s+Build/) { $incustom = 1; } elsif ($line =~ /End\s+Custom\s+Build/) { $incustom = 0; } elsif ($line =~ /Begin\s+Special\s+Build\s+Tool/) { $inspecial = 1; } elsif ($line =~ /End\s+Special\s+Build\s+Tool/) { $inspecial = 0; } else { prtw( "WARNING: Line beginning with SHARP(#) NOT HANDLED [$line]\n" ); } } elsif ( $chr eq '!' ) { # line beginning with '!' char $sline = substr($line,1); if ($line =~ /^!IF\s+(.+)/i ) { prt( "[06] Entering IF $1 ...\n" ) if ($dbg_ds06); prtw( "WARNING: !IF found BUT aready in an !IF block!\n" ) if ( $inanif ); $inanif = 1; if ($line =~ /!IF\s+(.+) == (.+)/i) { $itm1 = $1; $itm2 = $2; $itm1 =~ s/\"//g; $itm2 =~ s/\"//g; prt( "[06] Got [$itm1] [$itm2]...\n" ) if ($dbg_ds06); if ($itm1 =~ /^\$\((.+)\)/ ) { #if (defined $v6_defs{$1}) { # if ($v6_defs{$1} eq $itm2) { $item = $1; if (defined ${$rdefs}{$item}) { if (${$rdefs}{$item} eq $itm2) { $tmp = "TRUE"; } else { $tmp = "FALSE"; } if( $item eq 'CFG' ) { $conf = $itm2; } #prt( "[06] and [$item] defined as \"$v6_defs{$item}\" ... $tmp $conf\n" ) if ($dbg_ds06); prt( "[06] and [$item] defined as \"${$rdefs}{$item}\" ... $tmp $conf\n" ) if ($dbg_ds06); } else { prt( "NOT DEFINED [$item] ...\n" ); } } } else { prt( "FAILED IF == [$line]\n" ); } } elsif ( $line =~ /^!ELSE\s+/i ) { prt( "[06] Entering ELSE ...\n" ) if ($dbg_ds06); prtw( "WARNING: !ELSE found NOT in an !IF block!\n" ) if ( ! $inanif ); } elsif ( $line =~ /^!ELSEIF\s+(.+)/i ) { prt( "[06] Entering ELSEIF $1 ...\n" ) if ($dbg_ds06); prtw( "WARNING: !ELSEIF found NOT in an !IF block!\n" ) if ( ! $inanif ); if ($line =~ /!ELSEIF\s+(.+) == (.+)/i) { $itm1 = $1; $itm2 = $2; $itm1 =~ s/\"//g; $itm2 =~ s/\"//g; prt( "[06] Got [$itm1] [$itm2]...\n" ) if ($dbg_ds06); if ($itm1 =~ /^\$\((.+)\)/ ) { $item = $1; #if (defined $v6_defs{$item}) { # if ($v6_defs{$item} eq $itm2) { if (defined ${$rdefs}{$item}) { if (${$rdefs}{$item} eq $itm2) { $tmp = "TRUE"; } else { $tmp = "FALSE"; } if( $item eq 'CFG' ) { $conf = $itm2; } #prt( "[06] and [$item] defined as \"$v6_defs{$item}\" ... $tmp $conf\n" ) if ($dbg_ds06); prt( "[06] and [$item] defined as \"${$rdefs}{$item}\" ... $tmp $conf\n" ) if ($dbg_ds06); } else { prt( "NOT DEFINED [$item] ...\n" ); } } } else { prt( "FAILED ELSEIF == [$line]\n" ); } } elsif ( $line =~ /^!ENDIF\s*/i ) { prt( "[06] Out ENDIF ...\n" ) if ($dbg_ds06); prtw( "WARNING: !ENDIF found NOT in an !IF block!\n" ) if ( ! $inanif ); $inanif = 0; # end the !IF } elsif ( $line =~ /^!MESSAGE/) { # ignore MESSAGE lines for now... } else { prtw( "WARNING: Line beginning with ! NOT HANDLED [$line]\n" ); } } else { #if ($line =~ /SOURCE=([\.\\\w-]+)+/ ) { # $src = $1; if ($line =~ /^SOURCE=/ ) { $src = substr($line,7); ### $dir .= "\\" if !($dir =~ /[\\\/]$/); # 20090827 - ensure ends with '\' $ff = $in_dir.$src; $ffnr = fix_rel_path1($ff,'process_DSP'); ###prt( "fixed=$ffnr, src=[$src], dir=[$dir]\n" ); if ($ins) { # had 'Begin Source File', and before 'End Source File' in DSP prt( "[14] SOURCE = $src ($ff)... $ins \n" ) if ($dbg_ds14); if (is_c_source($src)) { prt("[01] SOURCE=[$src]\n") if ($dbg_ds01); } elsif (is_h_source($src)) { prt("[02] HEADER=[$src]\n") if ($dbg_ds02); } elsif (is_h_special($src)) { prt("[02] HEADER=[$src]\n") if ($dbg_ds02); } else { prt("[03] OTHER=[$src]\n") if ($dbg_ds03); } if (defined $src_list{$src}) { prt( "NOTE: Avoiding DUPLICATED SOURCE [$src]\n" ); # 2010-09-26 simple note; 20090828 - do NOT add duplicates } else { $src_list{$src} = 1; # 0 1 2 3 4 5 6 #push(@v8_srcs,[$src, $ffnr, $filtname,$filttype, 0, 0, $projname] ); push(@v6_srcs, [$src, $ffnr, $grpname, $filter, 0, 0, $prjname] ); $scnt++; prt( "[09] $scnt v6_srcs: $src, $ffnr, $grpname, $filter, 0, 0, $prjname\n" ) if ($dbg_ds09); } } else { # another place where 'SOURCE=<path>' is in # # Begin Special Build Tool, where $inspecial = 1; if ( !$inspecial ) { prtw( "SOURCE=$src ($ff) OUTSIDE 'in source' or 'special' CHECKME!!\n" ); } } } elsif ( $line =~ /(.*)=(.*)/ ) { $itm1 = $1; $itm2 = $2; #$v6_defs{$itm1} = $itm2; ${$rdefs}{$itm1} = $itm2; prt( "[05] Defined [$itm1] = [$itm2] ...\n" ) if ($dbg_ds05); } else { if ($incustom) { # just a custom build line } else { prtw( "WARNING: Skipped line [$line]\n" ); } } } } prt( "End DSP - got $scnt source files ...\n" ) if (VERB9()); if ($dbg_ds07) { #foreach $key (keys %v6_conf) { prt( "Config $key = [$v6_conf{$key}]\n" ); } foreach $key (keys %{$rconf}) { prt( "Config $key = [${$rconf}{$key}]\n" ); } } @tmparr = keys(%prop_nh); if (@tmparr) { prt( "PROPs NOT HANDLED...\n" ); foreach $key (@tmparr) { prt( "elsif (\$sline =~ /^$key/) {\n" ); } } @tmparr = keys(%add_nh); if (@tmparr) { prt( "ADDs NOT HANDLED... add following if ok\n" ); foreach $key (@tmparr) { prt( "} elsif (\$sline =~ /^$key/) {\n" ); } } $hash{'DEFINITIONS'} = { %{$rdefs} }; $hash{'CONFIGS'} = { %{$rconf} }; $hash{'SOURCES'} = [ @{$rsrcs} ]; } else { prt( "ERROR: FAILED TO OPEN $fil FILE!\n" ); pgm_exit(1,"NO FILE $fil OPENNED!"); } } else { prt( "*** DOES NOT EXIST ***\n" ); pgm_exit(1,"NO FILE $fil FOUND!"); } return \%hash; } ############################################################################### sub fix_rel_path1 { my ($path,$caller) = @_; my @a = split(/\\/, $path); my $npath = ''; my $max = scalar @a; my @na = (); for (my $i = 0; $i < $max; $i++) { my $p = $a[$i]; if ($p eq '.') { # ignore this } elsif ($p eq '..') { if (@na) { pop @na; # discard previous } else { prt( "WARNING:1:$caller: Got relative .. without previous!!! path=$path\n" ); } } else { push(@na,$p); } } foreach my $pt (@na) { $npath .= "\\" if length($npath); $npath .= $pt; } return $npath; } ### utitlity subs sub c2_is_c_source { my $f = shift; if ( ($f =~ /\.c$/i) || ($f =~ /\.cpp$/i) || ($f =~ /\.cxx$/i) ) { return 1; } ##if (!is_h_source($f)) { ## prt( "Item [$f] IS NOT C/C++ SOURCE!\n" ); ##} return 0; } sub c2_is_h_special { my $f = shift; if (($f =~ /osg/i)||($f =~ /OpenThreads/i)||($f =~ /Producer/i)) { return 1; } return 0; } sub c2_is_h_source { my $f = shift; if ( ($f =~ /\.h$/i) || ($f =~ /\.hpp$/i) || ($f =~ /\.hxx$/i) ) { return 1; } ##if (!is_c_source($f)) { ## prt( "Item [$f] IS NOT C/C++ SOURCE!\n" ); ##} return 0; } sub compare_defines_for($$$$) { my ($src, $v1, $v2, $dsp) = @_; prt("[11] cmp:defines: [$v1] with [$v2] in [$src]\n") if ($dbg_ds11); if ($v1 eq $v2) { return 1; } my $itm = ''; my $ch1 = ''; my $ch2 = ''; my ($i); my $rv1 = space_split_to_rh($v1); my $rv2 = space_split_to_rh($v2); $i = 0; foreach $itm (keys %{$rv1}) { next if (defined ${$rv2}{$itm}); $ch1 .= ' ' if (length($ch1)); $ch1 .= $itm; $i++; } foreach $itm (keys %{$rv2}) { next if (defined ${$rv1}{$itm}); $ch2 .= ' ' if (length($ch2)); $ch2 .= $itm; $i++; } return 1 if ($i == 0); if ($dsp) { prt("1:Diff:[$ch1] in 1, not in 2.\n") if (length($ch1)); prt("2:Diff:[$ch2] in 2, not in 1.\n") if (length($ch2)); } return 0; } sub not_in_arrayi { my ($t,@a) = @_; my $lct = lc($t); foreach my $i (@a) { my $lci = lc($i); if ($lct eq $lci) { return 0; } } return 1; } sub not_in_arrayi_2r { my ($n,$t,$a) = @_; my $lct = lc($t); my $max = scalar @{$a}; for (my $j = 0; $j < $max; $j++) { my $i2 = ${$a}[$j][0]; my $n2 = ${$a}[$j][1]; my $lci = lc($i2); if (($lct eq $lci)&&($n == $n2)) { return 0; # already GOT this file and file number } } return 1; # not got this file and file number } sub ensure_unique { my ($num, @ba) = @_; my @na = (); foreach my $itm (@ba) { if ( not_in_arrayi($itm,@na) ) { push(@na,$itm); # store new unique item } elsif ( not_in_arrayi_2r($num, $itm, \@discarded_dupes) ) { push(@discarded_dupes,[$itm,$num]); # store a discarded item } } return @na; } sub space_split_with_quotes { my ($txt) = shift; my @a = (); my $ll = length($txt); my ($j, $c, $wd, $inq, $pc); $wd = ''; $inq = 0; $c = ''; for ($j = 0; $j < $ll; $j++) { $pc = $c; $c = substr($txt,$j,1); #// char by char if ($inq) { $inq = 0 if ($c eq '"'); } elsif ($c eq '"') { $inq = 1; } if ($c =~ /\s/) { # if a SPACEY char if ($inq) { $wd .= $c; # keep spaces, if IN double quotes } else { push(@a,$wd) if length($wd); # stack word, if any $wd = ''; # and clear word } } else { $wd .= $c; # store it } } push(@a,$wd) if length($wd); # stack word, if any (added 20110107) return @a; } sub cmp_sw_hashes { my ($src, $rh1, $rh2 ) = @_; my ($ct1,$ct2, $key, $val1, $val2, $val11, $val22, $fnd); $ct1 = scalar keys(%{$rh1}); $ct2 = scalar keys(%{$rh2}); prt( "Compare switch hashes $ct1 vs $ct2 for [$src]\n" ); foreach $key (keys %{$rh1}) { if (defined ${$rh2}{$key}) { $val1 = ${$rh1}{$key}; $val2 = ${$rh2}{$key}; if (($key eq 'D')||($key eq 'I')) { # got an array of items $ct1 = scalar @{$val1}; $ct2 = scalar @{$val2}; if ($ct1 != $ct2) { prt( "Switch $key: items $ct1 vs $ct2...\n" ); } foreach $val11 (@{$val1}) { $fnd = 0; foreach $val22 (@{$val2}) { if ($val11 eq $val22) { $fnd = 1; last; } } if (!$fnd) { prt( "Switch $key: item [$val11] NOT found in 2...\n" ); } } foreach $val22 (@{$val2}) { $fnd = 0; foreach $val11 (@{$val1}) { if ($val11 eq $val22) { $fnd = 1; last; } } if (!$fnd) { prt( "Switch $key: item [$val22] NOT found in 1...\n" ); } } } } else { prt( "Key [$key] in 1, but NOT in 2\n" ); } } foreach $key (keys %{$rh2}) { if (!defined ${$rh1}{$key}) { prt( "Key [$key] in 2, but NOT in 1\n" ); } } } sub compare_configs_for { my ($src, $v1, $v2) = @_; my ($ct1, $ct2, $i, $j, $it1, $val1, $it2, $val2, $fnd); my (@sar1, @sar2, @a, $tmp); if ($dbg_ds12) { if ((length($v1) > $max_cfg_ln)||(length($v2) > $max_cfg_ln)) { prt("[12] cmp:configs:[$src]\n [$v1] with\n [$v2]\n"); } else { prt("[12] cmp:configs:[$src] [$v1] with [$v2]\n"); } } # try for an easy compare if ($v1 eq $v2) { return 1; } # need to break up the config, and compare each items #my @ar1 = split(/\s/,$v1); #my @ar2 = split(/\s/,$v2); my @ar1 = space_split_with_quotes($v1); my @ar2 = space_split_with_quotes($v2); if ($src =~ /^LINK\s+/) { #prt( "Config compare diff get uniques ..." ); @ar1 = ensure_unique(1, @ar1); @ar2 = ensure_unique(2, @ar2); #prt( "done\n" ); } elsif ($src =~ /^CPP\s+/) { $ct1 = scalar @ar1; $ct2 = scalar @ar2; $fnd = 0; my %h1 = (); my %h2 = (); prt("Doing switch hashes... src[$src]\n" ); for ($i = 0; $i < $ct1; $i++) { $it1 = $ar1[$i]; if ($it1 =~ /^[\/-]{1}/) { $it2 = substr($it1,1); if (defined $compile_flags{$it2}) { if ($compile_flags{$it2}) { # need NEXT param $i++; # take next if (defined $h1{$it2}) { $val1 = $h1{$it2}; push(@{$val1}, $ar1[$i]); $h1{$it2} = $val1; } else { @a = (); push(@a, $ar1[$i]); $h1{$it2} = [@a]; } } else { if (defined $h1{$it2}) { prt( "Repeated switch [$it2]\n" ); $h1{$it2}++; } else { $h1{$it2} = 1; } } } elsif ($it2 =~ /^Yu"(\w|\.|-)+"/) { $tmp = $1; $it2 = 'Yu'; # we have a like [Yu"stdafx.h"] if (defined $h1{$it2}) { prt( "Repeated switch [$it2] got [".$h1{$it2}."], and now [$tmp]\n" ); } else { $h1{$it2} = $tmp; } } else { prt("1:WHAT is THIS switch [$it2]? full [$it1]!!!\n"); } } else { prt("1:WHAT is THIS [$it1] non switch?\n"); } } for ($j = 0; $j < $ct2; $j++) { $it1 = $ar2[$j]; if ($it1 =~ /^[\/-]{1}/) { $it2 = substr($it1,1); if (defined $compile_flags{$it2}) { if ($compile_flags{$it2}) { $j++; # take next if (defined $h2{$it2}) { $val1 = $h2{$it2}; push(@{$val1}, $ar2[$j]); $h2{$it2} = $val1; } else { @a = (); push(@a, $ar2[$j]); $h2{$it2} = [@a]; } } else { if (defined $h2{$it2}) { prt( "Repeated switch [$it2]\n" ); $h2{$it2}++; } else { $h2{$it2} = 1; } } } elsif ($it2 =~ /^Yu"(\w|\.|-)+"/) { # we have a like [Yu"stdafx.h"] $tmp = $1; $it2 = 'Yu'; # we have a like [Yu"stdafx.h"] if (defined $h2{$it2}) { prt( "Repeated switch [$it2] got [".$h2{$it2}."], and now [$tmp]\n" ); } else { $h2{$it2} = $tmp; } } else { prt("2:WHAT is THIS switch [$it2]? full [$it1]\n"); } } else { prt("2:WHAT is THIS [$it1] non switch?\n"); } } prt("Done switch hashes... src[$src]\n" ); cmp_sw_hashes( $src, \%h1, \%h2 ); } @sar1 = sort @ar1; @sar2 = sort @ar2; $ct1 = scalar @sar1; $ct2 = scalar @sar2; if ($ct1 != $ct2) { prt( "src=[$src] Diff array lengths $ct1 vs $ct2 ... line len ".length($v1)." vs ".length($v2)." chars\n" ); } #prt( "Config compare diff length $ct1 ...\n" ); for ($ct1 = 0; $ct1 < $ct2; $ct1++) { my $lc1 = lc($sar1[$ct1]); my $lc2 = lc($sar2[$ct1]); if ($lc1 ne $lc2) { prt( "src=[$src] Config compare diff [$lc1] with [$lc2] ...\n" ); return 0; } } # everything is the SAME (except maybe for case, and duplicates)... return 1; } # compare the LINK string sub show_link_diff { my ($cnt, $src, $v1, $v2) = @_; my ($ct1, $ct2); prt( "$cnt:1: $src = $v1\n" ); prt( "$cnt:2: $src = $v2\n" ); my @notin2 = (); my @notin1 = (); my @ar1 = split(/\s/,$v1); my @ar2 = split(/\s/,$v2); if ($src =~ /^LINK\s+/) { #prt( "Config compare diff get uniques ..." ); @ar1 = ensure_unique(1, @ar1); @ar2 = ensure_unique(2, @ar2); #prt( "done\n" ); } my @sar1 = sort @ar1; my @sar2 = sort @ar2; $ct1 = scalar @sar1; $ct2 = scalar @sar2; #prt( "Config compare diff length $ct1 ...\n" ); for ($ct2 = 0; $ct2 < $ct1; $ct2++) { my $lc1 = lc($sar1[$ct2]); if ( not_in_arrayi($lc1,@sar2) ) { if ( not_in_arrayi($lc1,@notin2) ) { push(@notin2,$sar1[$ct2]); } } } $ct2 = scalar @sar2; for ($ct1 = 0; $ct1 < $ct2; $ct1++) { my $lc2 = lc($sar2[$ct1]); if ( not_in_arrayi($lc2,@sar1) ) { if ( not_in_arrayi($lc2,@notin1) ) { push(@notin1,$sar2[$ct1]); } } } if (@notin2) { prt("Found ".join(" ",@notin2)." in 1, not in 2\n"); } if (@notin1) { prt("Found ".join(" ",@notin1)." in 2, not in 1\n"); } } sub show_link_diff_simp { my ($cnt, $src, $v1, $v2) = @_; prt( "L:$cnt:1: $src = $v1\n" ); prt( "L:$cnt:2: $src = $v2\n" ); } sub get_dsp_block { my ($src) = shift; my $dsp = <<EOF; # Begin Source File SOURCE=$srcc # End Source File EOF return $dsp; } # $missed{$src1} = get_file_type($src1); sub get_file_type($) { my ($src) = @_; return 4 if (is_text_ext_file($src)); return 8 if (is_resource_file($src)); return 1 if (is_c_source_extended($src)); return 2 if (is_h_source_extended($src)); return 0; } sub compare_dsp_with_dsp($$$$) { my ($file1,$file2,$rh1,$rh2) = @_; my ($i1, $i2, $fnd, $matched); my ($src1, $ff1, $fnm1, $typ1, $flg1); my ($src2, $ff2, $fnm2, $typ2, $flg2); my ($nm1, $pth1, $suf1); my ($nm2, $pth2, $suf2); my ($added, $subed, $miss1, $miss2, $min, $adddsp, $extra_dbg); my $msg = ''; my ($min1,$min2,$len); my ($nam1,$dir1) = fileparse($file1); my ($nam2,$dir2) = fileparse($file2); #my $rsrcs1 = \@v6_srcs1; #my $rsrcs2 = \@v6_srcs2; # 0 1 2 3 4 5 6 # push(@v6_srcs, [$src, $ffnr, $grpname, $filter, 0, 0, $prjname] ); my $rsrcs1 = ${$rh1}{'SOURCES'}; my $rsrcs2 = ${$rh2}{'SOURCES'}; $extra_dbg = 0; # compare SOURCES ############################### #my $v6_tot1 = scalar @v6_srcs1; #my $v6_tot2 = scalar @v6_srcs2; my $v6_tot1 = scalar @{$rsrcs1}; my $v6_tot2 = scalar @{$rsrcs2}; prt("\n") if (VERB2()); prt( "Compare of sources MSVC6 totals $v6_tot1, with $v6_tot2 ...\n" ); $fnd = 0; $matched = 0; #for ($i1 = 0; $i1 < $v6_tot1; $i1++) { $v6_srcs1[$i1][4] = 0; } # clear matched #for ($i2 = 0; $i2 < $v6_tot2; $i2++) { $v6_srcs2[$i2][4] = 0; } # clear matched for ($i1 = 0; $i1 < $v6_tot1; $i1++) { ${$rsrcs1}[$i1][4] = 0; } # clear matched for ($i2 = 0; $i2 < $v6_tot2; $i2++) { ${$rsrcs2}[$i2][4] = 0; } # clear matched # for EACH in file 1 # ==================== for ($i1 = 0; $i1 < $v6_tot1; $i1++) { #$src1 = $v6_srcs1[$i1][0]; #$ff1 = $v6_srcs1[$i1][1]; #$fnm1 = $v6_srcs1[$i1][2]; #$typ1 = $v6_srcs1[$i1][3]; #$flg1 = $v6_srcs1[$i1][4]; $src1 = ${$rsrcs1}[$i1][0]; $ff1 = ${$rsrcs1}[$i1][1]; $fnm1 = ${$rsrcs1}[$i1][2]; $typ1 = ${$rsrcs1}[$i1][3]; $flg1 = ${$rsrcs1}[$i1][4]; $fnd = 0; # extra if ($src1 =~ /testtest\.c/) { prt("extra_dbg: Doing file [$ff1]...\n"); $extra_dbg = 1; } # --------------- # find in file2 # ============= for ($i2 = 0; $i2 < $v6_tot2; $i2++) { #$src2 = $v6_srcs2[$i2][0]; #$ff2 = $v6_srcs2[$i2][1]; #$fnm2 = $v6_srcs2[$i2][2]; #$typ2 = $v6_srcs2[$i2][3]; #$flg2 = $v6_srcs2[$i2][4]; $src2 = ${$rsrcs2}[$i2][0]; $ff2 = ${$rsrcs2}[$i2][1]; $fnm2 = ${$rsrcs2}[$i2][2]; $typ2 = ${$rsrcs2}[$i2][3]; $flg2 = ${$rsrcs2}[$i2][4]; #if (is_same_file($ff1,$ff2)) { #if ( is_same_source_file($ff1,$ff2) ) { if ( is_same_source_file($src1,$src2) ) { # 2009/10/29 - only compare RELATIVE source names #$v6_srcs2[$i2][4] = $i1 + 1; # 20090828 - This was '$i1', which is WRONG #$v6_srcs1[$i1][4] = $i2 + 1; ${$rsrcs2}[$i2][4] = ($i1 + 1); # 20090828 - This was '$i1', which is WRONG ${$rsrcs1}[$i1][4] = ($i2 + 1); $fnd = 1; last; } } if ($extra_dbg) { prt( "extra_dbg: Find = $fnd - offsets $i1 of $v6_tot1, $i2 of $v6_tot2...\n" ); $extra_dbg = 0; } if ($fnd) { $matched++; } else { prt( "[10] NO MATCH of 1 [$ff1] in 2!\n" ) if ($dbg_ds10); } } $added = $v6_tot1 - $matched; $subed = $v6_tot2 - $matched; prt( "In the compare of -\n" ) if (VERB9()); #prt( "FILE1: [$file1] $v6_tot1 sources, with\n" ); #prt( "FILE2: [$file2] $v6_tot2 sources...\n" ); prt( "FILE1: [$nam1] $v6_tot1 sources, in [$dir1], with\n" ) if (VERB3()); prt( "FILE2: [$nam2] $v6_tot2 sources, in [$dir2]...\n" ) if (VERB3()); prt( "Matched $matched of $v6_tot1, with $matched of $v6_tot2 ...\n" ) if (VERB5()); # get sources NOT matched in file1 $miss1 = 0; $min1 = 0; $min2 = 0; my %missed0 = (); # unknown my %missed1 = (); # source my %missed2 = (); # headers my %missed4 = (); # text my %missed8 = (); # resource for ($i1 = 0; $i1 < $v6_tot1; $i1++) { # if ($v6_srcs1[$i1][4] == 0) { if (${$rsrcs1}[$i1][4] == 0) { # NOT matched $miss1++; $src1 = ${$rsrcs1}[$i1][0]; $len = length($src1); $min1 = $len if ($len > $min1); $ff1 = ${$rsrcs1}[$i1][1]; $len = length($ff1); $min2 = $len if ($len > $min2); # store in a TYPED hash $i2 = get_file_type($src1); if ($i2 == 1) { $missed1{$src1} = 0; } elsif ($i2 == 2) { $missed2{$src1} = 0; } elsif ($i2 == 4) { $missed4{$src1} = 0; } elsif ($i2 == 8) { $missed8{$src1} = 0; } else { $missed0{$src1} = 0; } } } if ($miss1) { prt( "MISSED1: [$file1] contains $miss1 files, NOT in file 2 ...\n" ); for ($i1 = 0; $i1 < $v6_tot1; $i1++) { $i2 = ${$rsrcs1}[$i1][4]; # = ($i2 + 1); # if ($v6_srcs1[$i1][4] == 0) { # if (${$rsrcs1}[$i1][4] == 0) { if ($i2 == 0) { #$src1 = $v6_srcs1[$i1][0]; #$ff1 = $v6_srcs1[$i1][1]; $src1 = ${$rsrcs1}[$i1][0]; $ff1 = ${$rsrcs1}[$i1][1]; $msg = "$src1 "; $min = $min1; $msg .= ' ' while (length($msg) < $min); if (VERB9()) { $msg .= "($ff1) "; $min += 3 + $min2; $msg .= ' ' while (length($msg) < $min); } if (-f $ff1) { $msg .= "ok" if (VERB1()); } else { $ff2 = fix_rel_path1($dir2.$src1,'compare_dsp_with_dsp(1)'); if (-f $ff2) { $msg .= "ok2" if (VERB1()); } else { $msg .= "MISSING? 1[$ff1] and 2[$ff2]!!!"; } } prt( "$msg\n" ); } } if ($dbg_ds15) { # got list in %missed{key}, with type foreach $src1 (keys %missed1) { prt("# Begin Source File\n"); prt("SOURCE=$src1\n"); prt("# End Source File\n"); } foreach $src1 (keys %missed2) { prt("# Begin Source File\n"); prt("SOURCE=$src1\n"); prt("# End Source File\n"); } foreach $src1 (keys %missed4) { prt("# Begin Source File\n"); prt("SOURCE=$src1\n"); prt("# End Source File\n"); } foreach $src1 (keys %missed8) { prt("# Begin Source File\n"); prt("SOURCE=$src1\n"); prt("# End Source File\n"); } } } else { prt( "MISSED1: NONE: [$file1] list has no missed files...\n" ) if (VERB2()); } # get sources NOT matched in file2 $miss2 = 0; $min1 = 0; $min2 = 0; for ($i2 = 0; $i2 < $v6_tot2; $i2++) { #if ($v6_srcs2[$i2][4] == 0) { if (${$rsrcs2}[$i2][4] == 0) { $miss2++; $src1 = ${$rsrcs2}[$i2][0]; $len = length($src1); $min1 = $len if ($len > $min1); $ff1 = ${$rsrcs2}[$i2][1]; $len = length($ff1); $min2 = $len if ($len > $min2); } } if ($miss2) { prt( "MISSED2: [$file2] contains $miss2 files, NOT in file 1 ...\n" ); $adddsp = ''; for ($i2 = 0; $i2 < $v6_tot2; $i2++) { #if ($v6_srcs2[$i2][4] == 0) { # $src2 = $v6_srcs2[$i2][0]; # $ff2 = $v6_srcs2[$i2][1]; if (${$rsrcs2}[$i2][4] == 0) { $src2 = ${$rsrcs2}[$i2][0]; $ff2 = ${$rsrcs2}[$i2][1]; $msg = "$src2 "; $min = $min1; $msg .= ' ' while (length($msg) < $min); if (VERB9()) { $msg .= "($ff2) "; $min += 3 + $min2; $msg .= ' ' while (length($msg) < $min); } if (-f $ff2) { $msg .= "ok" if (VERB1()); $adddsp .= get_dsp_block($src2); } else { $ff1 = fix_rel_path1($dir1.$src2,'compare_dsp_with_dsp(2)'); if (-f $ff1) { $msg .= "ok2" if (VERB1()); } else { $msg .= "MISSING?"; } } prt( "$msg\n" ); } } if (length $adddsp) { prt( "Suggested ADDITIONS to $file1...\nbut take care they are not included in other files if C source\n$adddsp" ); } } else { prt( "MISSED2: NONE: [$file2] list has no missed files...\n" ) if (VERB2()); } prt("\n") if (VERB2()); if ($compconfig) { # also should COMPARE # %v6_defs1 with %v6_defs2, and # %v6_conf1 with %v6_conf2 my ($val1, $val2, $tcnt, $cnt, $hdr); my $samecount = 0; my $missingcount = 0; my $isthesame = 0; my %done1 = (); my %done2 = (); # DEFINES COMPARE # =============== $tcnt = scalar keys(%v6_defs1); $hdr = "Compare of $tcnt defines..."; $cnt = 0; foreach $src1 (keys %v6_defs1) { $cnt++; $val1 = $v6_defs1{$src1}; if (defined $v6_defs2{$src1}) { $val2 = $v6_defs2{$src1}; if (compare_defines_for($src1, $val1, $val2, 0)) { $samecount++; } else { # different } $done1{$src1} = 1; } else { $missingcount++; } } $isthesame = 1 if ($cnt == $samecount); if ($isthesame) { prt("End compare of $tcnt defines, and THEY are ALL the same...\n") if (VERB1()); } else { $cnt = 0; prt("$hdr\n") if (length($hdr)); $hdr = ''; foreach $src1 (keys %v6_defs1) { $cnt++; $val1 = $v6_defs1{$src1}; if (defined $v6_defs2{$src1}) { $val2 = $v6_defs2{$src1}; if (compare_defines_for($src1, $val1, $val2, 1)) { prt( "$cnt: $src1 = $val1 and value 2 is the same\n" ) if (VERB2()); $samecount++; } else { prt( "$cnt:1: $src1 = $val1\n" ); prt( "$cnt:2: $src1 = $val2\n" ); } $done1{$src1} = 1; } else { prt( "$cnt:1: $src1 = $val1\n" ); prt( "$cnt:2: $src1 = NOT AVAILABLE\n" ); $missingcount++; } } } foreach $src2 (keys %v6_defs2) { if ( ! defined $done1{$src2}) { $val2 = $v6_defs2{$src1}; prt( "M2: $src1 = $val2\n" ); } } # CONFIG COMPARE # ============== $tcnt = scalar keys(%v6_conf1); $hdr = "Compare of $tcnt config items..."; $samecount = 0; $missingcount = 0; $isthesame = 0; $cnt = 0; foreach $src1 (keys %v6_conf1) { $cnt++; $val1 = $v6_conf1{$src1}; if (defined $v6_conf2{$src1}) { $val2 = $v6_conf2{$src1}; if (compare_configs_for($src1, $val1, $val2)) { #prt( "$cnt: $src1 = $val1,\nand value 2 is the SAME!\n" ); $samecount++; } else { #if ($src1 =~ /^LINK\s+/) { # show_link_diff($cnt, $src1, $val1, $val2); #} else { # #prt( "$cnt:1: $src1 = $val1\n" ); # #prt( "$cnt:2: $src1 = $val2\n" ); #} } $done2{$src1} = 1; } else { $missingcount++; } } $isthesame = 1 if ($cnt == $samecount); if ($isthesame) { prt("End compare of $tcnt config items, and THEY are the same...\n"); } else { $cnt = 0; prt("$hdr\n") if (length($hdr)); $hdr = ''; foreach $src1 (keys %v6_conf1) { $cnt++; $val1 = $v6_conf1{$src1}; if (defined $v6_conf2{$src1}) { $val2 = $v6_conf2{$src1}; if (compare_configs_for($src1, $val1, $val2)) { prt( "$cnt: $src1 = $val1,\nand value 2 is the SAME!\n" ); } else { if ($src1 =~ /^LINK\s+/) { show_link_diff($cnt, $src1, $val1, $val2); } else { prt( "$cnt:1: $src1 = $val1\n" ); prt( "$cnt:2: $src1 = $val2\n" ); } } $done2{$src1} = 1; } else { prt( "$cnt:1: $src1 = $val1\n" ); prt( "$cnt:2: $src1 = NOT AVAILABLE\n" ); } } } foreach $src2 (keys %v6_conf2) { if ( ! defined $done2{$src2} ) { $val2 = $v6_conf2{$src2}; prt( "M2: $src2 = $val2\n" ); } } } return ($added + $subed); # return CHANGE counter } sub is_same_source_file($$) { my ($f1, $f2) = @_; my ($nam1, $dir1, $ext1) = fileparse($f1, qr/\.[^.]*/ ); my ($nam2, $dir2, $ext2) = fileparse($f2, qr/\.[^.]*/ ); # scrunch to all lower case # 2009/10/28 - remove any '.\' or './' from the directory $dir1 =~ s/^\.(\\|\/)//; $dir2 =~ s/^\.(\\|\/)//; my $lcnm1 = lc($nam1); my $lcex1 = lc($ext1); my $lcnm2 = lc($nam2); my $lcex2 = lc($ext2); # 2009/10/28 - added DIRECTORY compare as well my $lcdi1 = lc($dir1); my $lcdi2 = lc($dir2); if (($lcnm1 eq $lcnm2) && ($lcex1 eq $lcex2) && ($lcdi1 eq $lcdi2)) { return 2; } if (($lcnm1 eq $lcnm2) && ($lcex1 eq $lcex2)) { return 1; } return 0; } sub is_same_file { my ($f1, $f2) = @_; my $len = length($f1); my $len2 = length($f2); if ($len != $len2) { ###prt( "NOT SAME LENGTH [$f1]($len) vs [$f2]($len2)\n" ); return 0; # not the SAME } $f1 =~ s/\//\\/g; $f2 =~ s/\//\\/g; my $lcf1 = lc($f1); my $lcf2 = lc($f2); my $i = 0; my $ch1 = ''; my $ch2 = ''; while ($i < $len) { $ch1 = substr($lcf1,$i,1); $ch2 = substr($lcf2,$i,1); if ($ch1 ne $ch2) { ###prt( "FAILED at char ".($i + 1)." $ch1 vs $ch2 [$f1]($len) & [$f2]($len2)\n" ); return 0; } $i++; } return 1; # they ARE the SAME } sub sub_common_folder { my ($f1, $f2) = @_; my $off = 0; my $df1 = lc(unix_2_dos($f1)); my $df2 = lc(unix_2_dos($f2)); while ( substr($df1,$off,1) && substr($df2,$off,1) && ( substr($df1,$off,1) eq substr($df2,$off,1) ) ) { $off++; } return substr($f1,$off); } sub set_dbg_show_sources { $dbg_ds01 = 1; $dbg_ds02 = 1; $dbg_ds03 = 1; } sub do_sanity_check() { pgm_exit(1,"ERROR: Problem with DEBUG!\n") if (ds_get_dbg_range() != $dbg_max_val); } ############################################################ ###### MAIN ##### do_sanity_check(); parse_args(@ARGV); if (open INF1, "<$in_file1") { @lines1 = <INF1>; close INF1; $lncnt1 = scalar @lines1; } else { pgm_exit(1,"ERROR: Can NOT open file [$in_file1]!\n"); } if (open INF2, "<$in_file2") { @lines2 = <INF2>; close INF2; $lncnt2 = scalar @lines2; } else { pgm_exit(1,"ERROR: Can NOT open file [$in_file2]!\n"); } my $form = "%4d"; prt( "Comparing ".sprintf($form,$lncnt1).", from [$in_file1],\n". " with ".sprintf($form,$lncnt2).", from [$in_file2]...\n" ); if (!$lncnt1 || !$lncnt2) { pgm_exit(1, "No lines found in one or both files!\n"); } if (VERB5()) { set_dbg_show_sources(); } # load FILE 1 clear_load(); # clear config and defines my $ref_hash1 = process_DSP( $projname, $in_file1 ); %v6_defs1 = %v6_defs; %v6_conf1 = %v6_conf; # load FILE 2 clear_load(); # clear config and defines my $ref_hash2 = process_DSP( $projname, $in_file2 ); %v6_defs2 = %v6_defs; %v6_conf2 = %v6_conf; # compare SOURCES, and CONFIGS compare_dsp_with_dsp($in_file1, $in_file2, $ref_hash1, $ref_hash2); prt("\n"); if (@discarded_dupes) { my $ddc = scalar @discarded_dupes; prt("WARNING: discarded $ddc dupes... " ); if (VERB1()) { prt("["); for (my $di = 0; $di < $ddc; $di++) { prt(" ") if ($di); prt( $discarded_dupes[$di][0]."(".$discarded_dupes[$di][1].")" ); } prt("]"); } prt("\n"); } pgm_exit(0,"Normal Exit"); ############################################################ sub show_dbg_ranges() { my ($max,$tmp); $max = ds_get_dbg_range(); prt(" --dbg <num> (-d) = Set DEBUG flag of this value, 1 to $max\n"); $tmp = ds_get_dbg_stg(); prt(" Presently [$tmp] are ON in $pgmname.\n") if (length($tmp)); prt(" Additional text setting are 'all', 'none', 'extra', and 'help'.\n"); } sub show_dbg_help() { my $file = $0; my ($line,$max,$tmp,$cnt,$tmp2); show_dbg_ranges(); if (open INF, "<$file") { my @lines = <INF>; close INF; prt(" Detailed list, with some 'notes' indicating what each does.\n"); $cnt = 0; my @ds_dbg = (); foreach $line (@lines) { $line = trim_all($line); if ($line =~ /^my\s+\$dbg_ds(\d+)\s*=\s*\d+\s*;\s*\#(.+)$/) { $tmp = $1; $tmp2 = $2; push(@ds_dbg,"$tmp: $tmp2"); $cnt++; } } if ($cnt) { if (@ds_dbg) { $cnt = scalar @ds_dbg; prt("For DEBUG ... 1 to $cnt\n"); foreach $tmp (@ds_dbg) { prt(" $tmp\n"); } } else { prt("PROBLEM: NO lib_acscan ADDITIONAL debug HELP!\n"); } prt("NOTE: Adding DEBUG output only serves to DEBUG what the script 'saw', and 'did'!\n"); } else { prt("\nPROBLEM: Found no \$dbg?? vars in file [$file], so NO DEBUG ADDITIONAL HELP!\n"); } } else { prt("ERROR: Unable to open file [$file], so NO ADDITIONAL DEBUG HELP!\n"); } } sub ds_set_all_dbg_on() { my ($i,$res); for ($i = 1; ;$i++) { $res = ds_set_dbg_var($i); last if (!$res); } } sub ds_set_all_dbg_off() { my ($i,$res); for ($i = 1; ;$i++) { $res = ds_clear_dbg_var($i); last if (!$res); } } sub ds_set_max_debug_on() { ds_set_all_dbg_on(); $verbose = 10; } sub need_arg { my ($arg,@av) = @_; pgm_exit(1,"ERROR: [$arg] must have following argument!\n") if (!@av); } sub parse_args { my (@av) = @_; my $cnt = 0; my ($arg,$sarg,$tmp,$rng); while (@av) { $cnt++; $arg = $av[0]; if ($arg =~ /^-/) { $sarg = substr($arg,1); $sarg = substr($sarg,1) if ($sarg =~ /^-/); if (($sarg =~ /^h/i)||($sarg eq '?')) { give_help(); pgm_exit(0,"Help exit."); } elsif ($sarg =~ /^d/i) { need_arg(@av); shift @av; $sarg = $av[0]; #$conf_string .= "$arg $sarg\n"; if ($sarg =~ /^(\d+)$/) { $tmp = $1; $rng = ds_get_dbg_range(); if (($tmp >= 1) && ($tmp <= $rng)) { if (ds_set_dbg_var($tmp)) { prt("Set Debug $tmp ON!\n"); } else { pgm_exit(1,"ERROR: FAILED to set Debug $tmp ON!\n"); } } else { pgm_exit(1,"ERROR: Invalid argument [$arg $sarg]! Is numerical, but not range 1 to $rng!\n"); } } else { if ($sarg =~ /^help$/i) { show_dbg_help(); #$conf_string = ""; pgm_exit(0,"DEBUG Help exit(0)\n"); } elsif ($sarg =~ /^all$/i) { prt("Setting ALL debug ON!\n"); ds_set_all_dbg_on(); } elsif ($sarg =~ /^none$/i) { prt("Setting ALL debug OFF!\n"); ds_set_all_dbg_off(); #} elsif ($sarg =~ /^dry-run$/i) { # prt("Setting DRY RUN ONLY!\n"); # $only_dry_run = 1; } elsif ($sarg =~ /^extra$/i) { prt("Setting ALL debug ON, plus EXTRA!\n"); ds_set_max_debug_on(); } else { pgm_exit(1,"ERROR: Invalid argument [$arg $sarg]! Not numerical, nor 'all', 'none', or 'help' !\n"); } } } elsif ($sarg =~ /^l/i) { $load_log = 1; } elsif ($sarg =~ /^v(.*)$/i) { $sarg = $1; if ((defined $sarg) && ($sarg =~ /^\d+$/)) { $verbose = $sarg; } elsif ((defined $sarg) && ($sarg =~ /^v/)) { $verbose++; $sarg = substr($sarg,1); while ($sarg =~ /^v/) { $verbose++; $sarg = substr($sarg,1); } } else { $verbose++; } prt("Bumped verbosity [$verbose].\n") if (VERB1()); } else { pgm_exit(1,"ERROR: Unknown argmument [$arg]! Aborting...\n"); } } else { # assume an INPUT file if ($cnt == 1) { #$in_file1 = $arg; $in_file1 = File::Spec->rel2abs($arg); prt("Set input file 1 to [$in_file1]\n"); } elsif ($cnt == 2) { #$in_file2 = $arg; $in_file2 = File::Spec->rel2abs($arg); prt("Set input file 2 to [$in_file2]\n"); } else { prt("ERROR: Unknown argument [$arg]!\n"); prt("Only arguments are in_file1 in_file2\n"); pgm_exit(1,"ERROR IN COMMAND ARGUMENTS!"); } } shift @av; } if ((length($in_file1) == 0) && $debug_on) { $in_file1 = File::Spec->rel2abs($def_file1); prt("Set input file 1 to DEFAULT [$in_file1]\n"); } if ((length($in_file2) == 0) && $debug_on) { $in_file2 = File::Spec->rel2abs($def_file2); prt("Set input file 2 to DEFAULT [$in_file2]\n"); } if (length($in_file1) == 0) { pgm_exit(1,"ERROR: NO input file 1 found in command\n"); } if (length($in_file2) == 0) { pgm_exit(1,"ERROR: NO input file 2 found in command\n"); } if ( ! -f $in_file1) { pgm_exit(1,"ERROR: Can NOT locate input file 1 [$in_file1]! Check name, location...\n"); } if ( ! -f $in_file2) { pgm_exit(1,"ERROR: Can NOT locate input file 2 [$in_file2]! Check name, location...\n"); } } sub give_help { prt("$pgmname: version 0.3.1 2010-09-26\n"); prt("Usage: $pgmname [options] in-file1 in-file2\n"); prt("Options:\n"); prt(" --help (-h or -?) = This help, and exit 0.\n"); show_dbg_ranges(); prt(" --load-log (-l) = Load log at end. (def=".($load_log ? "On" : "Off")."\n"); prt(" --verbose (-v) = Bump (or set) verbosity. (def=$verbose).\n"); prt("Purpose:\n"); prt(" To compare the two given input files as MSVC6 DSP files, and\n"); prt(" show the difference.\n"); } # eof - cmp2dsps03.pl