Generated: Tue Feb 2 17:54:58 2010 from tests2d.pl 2009/10/29 10.9 KB.
#!/perl -w # NAME: tests2d.pl # AIM: Just a test module use strict; use warnings; use Cwd; use File::Basename; unshift(@INC, 'C:/GTools/perl'); require 'fgutils02.pl' or die "Unable to load fgutils02.pl ...\n"; require 'fgdsphdrs03.pl' or die "Unable to load fgdsphdrs02.pl ...\n"; require 'fgscanvc03.pl' or die "Unable to load fgscanvc03.pl ...\n"; # *** OR *** #require 'scanvc.pl' or die "Unable to load scanvc.pl ...\n"; # log file stuff my ($LF); my $pgmname = $0; if ($pgmname =~ /\w{1}:\\.*/) { my @tmpsp = split(/\\/,$pgmname); $pgmname = $tmpsp[-1]; } my $perl_dir = 'C:\GTools\perl'; my $outfile = $perl_dir."\\temp.$pgmname.txt"; open_log($outfile); my $CMDSPEC2 = (exists $ENV{COMSPEC}) ? $ENV{COMSPEC} : "cMD"; # user variables my $load_log = 1; ### program variables my @warnings = (); my $cwd = cwd(); my $vsinstall = 'Unknown at this time'; 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 $itm (@warnings) { prt("$itm\n"); } prt("\n"); } else { prt( "\nNo warnings issued.\n\n" ); } } sub pgm_exit($$) { my ($val,$msg) = @_; show_warnings(); if (length($msg)) { $msg .= "\n" if (!($msg =~ /\n$/)); prt($msg) } close_log($outfile,$load_log); exit($val); } sub get_stgs_4_short_hr($) { my ($hr) = @_; my ($key,$val,$stg,$fil,$cnt); my %hash = (); $cnt = 0; foreach $key (keys %{$hr}) { $cnt++; $fil = "temp$cnt.txt"; $val = ${$hr}{$key}; prt( "$key => $val " ); if (get_dsp_header_text(\$stg,$val) ) { prt( "ok" ); $hash{$val} = $stg; write2file($stg,$fil); prt( ", written to $fil" ); } else { prt( "MISSED with [$val]" ); } prt("\n"); } return \%hash; } sub get_lines_hash($) { my ($hr) = @_; my ($key,$val,$cnt); my @arr = (); my %hash = (); foreach $key (keys %{$hr}) { $val = ${$hr}{$key}; @arr = split(/\n/,$val); $cnt = scalar @arr; prt("$key $cnt\n"); $hash{$key} = [ @arr ]; } return \%hash; } sub compare_lines($$) { my ($lns1,$lns2) = @_; my $cnt1 = scalar @{$lns1}; my $cnt2 = scalar @{$lns2}; prt( "Compare of $cnt1 with $cnt2\n" ); my $max = $cnt1; my ($ln1,$ln2,$diff,$i,$j); my ($num1,$num2); my (@arr1,@arr2,$ac1,$ac2,$sl,$k); $max = $cnt2 if ($cnt2 < $cnt1); $diff = 0; $j = 0; $sl = 0; for ($i = 0; $i < $cnt1; $i++) { $num1 = $i + 1; $ln1 = ${$lns1}[$i]; @arr1 = split(/\s/,$ln1); $ac1 = scalar @arr1; # search for SAME in 2 $j-- if ($j); for (; $j < $cnt2; $j++) { $num2 = $j + 1; $ln2 = ${$lns2}[$j]; @arr2 = split(/\s/,$ln2); $ac2 = scalar @arr2; $max = ($ac1 < $ac2) ? $ac1 : $ac2; $sl = 0; for ($k = 0; $k < $max; $k++) { if ($arr1[$k] eq $arr2[$k]) { if ($ac2 == 3) { if ($k == 2) { $sl = 1; last; } } elsif ($k == 3) { $sl = 1; last; } } else { last; } } last if ($sl); last if ($ln1 eq $ln2); } if ($ln1 ne $ln2) { prt("$num1: [$ln1]\n"); prt("$num2: [$ln2]\n"); $diff++; } } prt( "$diff different...\n" ); } sub show_diff_lines($) { my ($hr) = @_; my @arr = keys(%{$hr}); my $cnt = scalar @arr; prt( "Got $cnt line sets...\n" ); if ($cnt == 4) { my $lns1 = ${$hr}{$arr[0]}; my $lns2 = ${$hr}{$arr[1]}; my $lns3 = ${$hr}{$arr[2]}; my $lns4 = ${$hr}{$arr[3]}; compare_lines($lns1,$lns2); } } sub test4() { my @arr = (); my %h = (); my $t1 = ''; $t1 = get_dsp_console_rel(); @arr = split(/\n/,$t1); $h{1} = [ @arr ]; $t1 = get_dsp_console_dbg(); @arr = split(/\n/,$t1); $h{2} = [ @arr ]; $t1 = get_dsp_app_rel(); @arr = split(/\n/,$t1); $h{3} = [ @arr ]; $t1 = get_dsp_app_dbg(); @arr = split(/\n/,$t1); $h{4} = [ @arr ]; $t1 = get_dsp_slib_rel(); @arr = split(/\n/,$t1); $h{5} = [ @arr ]; $t1 = get_dsp_slib_dbg(); @arr = split(/\n/,$t1); $h{6} = [ @arr ]; $t1 = get_dsp_dynalib_rel(); @arr = split(/\n/,$t1); $h{7} = [ @arr ]; $t1 = get_dsp_dynalib_dbg(); @arr = split(/\n/,$t1); $h{8} = [ @arr ]; prt("Compare console rel with dbg\n"); compare_lines($h{1},$h{2}); prt("Compare app rel with dbg\n"); compare_lines($h{3},$h{4}); prt("Compare static lib rel with dbg\n"); compare_lines($h{5},$h{6}); prt("Compare dynalib rel with dbg\n"); compare_lines($h{7},$h{8}); prt("Compare console and app rel\n"); compare_lines($h{1},$h{3}); } sub add_3rd_config($) { my ($rh) = @_; my $confkey = sprintf("config-%03d-ReleaseSSE",3); my $rds = get_default_sub3(0); my $key = '-NEW_DEFS-'; if (defined ${$rds}{$key}) { ${$rds}{$key} .= " /D ASM_X86"; } else { prt( "oops, $key NOT DEFINED!\n" ); pgm_exit(1,"Missed definition\n" ); } ${$rh}{$confkey} = $rds; } sub get_sub_ref() { my $rh = get_default_sub_ref(1); my $of = 'tempdsp3.dsp'; my $dbg = -1; add_3rd_config($rh); my @vc_c_sources = (); my $var1 = get_def_src_grp(); my $var2 = get_def_src_filt(); my $last_src = 'test.cxx'; push(@vc_c_sources, [$last_src, $var1, $var2, 0] ); $last_src = 'test.c'; push(@vc_c_sources, [$last_src, $var1, $var2, 0] ); push(@vc_c_sources, ['newsrc.asm', 'Asm', 'nas;asm', 0] ); ${$rh}{'C_SOURCES'} = [@vc_c_sources]; $var1 = get_def_hdr_grp(); $var2 = get_def_hdr_filt(); my $hdr_src = 'test.hxx'; my @vc_h_sources = (); push(@vc_h_sources, [$hdr_src, $var1, $var2, 0] ); ${$rh}{'H_SOURCES'} = [@vc_h_sources]; return $rh; } sub test3() { my $rh = get_sub_ref(); my $dbg = 0; my $type = ''; my $conf1 = ''; ${$rh}{'PROJECT_FLAGS'}[0] = 0; ${$rh}{'PROJECT_FLAGS'}[1] = -1; my ($cnt,$i, $t1, $t2); my $key = 'APP_TYPE'; get_app_type_4_short('CA',\$type); # 'CA' => $app_console_stg, ${$rh}{$key} = $type; # = 'Console Application'; #sub get_configs_array($$$) { my ($rh,$rs,$name) = @_; ... } my $name = ''; if ( !get_project_name($rh, \$name) ) { prtw("WARNING: Unable to get project name!\n"); pgm_exit(1,"NO NAME IN HASH"); } get_configs_array($rh, \$conf1, $name); $key = "CONFIG_ARRAY"; if (defined ${$rh}{$key}) { my $rcfarr = ${$rh}{$key}; $cnt = scalar @{$rcfarr}; prt( "Show of CONFIG array ($cnt items) #1 = [$conf1]\n" ); for ($i = 0; $i < $cnt; $i++ ) { $t1 = ${$rcfarr}[$i][0]; $t2 = ${$rcfarr}[$i][2]; prt( "[$t1] [$t2]\n" ); } } else { prtw("WARNING: NO CONFIG ARRAY ADDED\n"); } show_hash_results3($rh); write_hash_to_DSP3( 'TEMPDSP3_1.DSP', $rh, $dbg ); get_app_type_4_short('WA',\$type); # 'WA' => $app_windows_stg, $key = 'APP_TYPE'; ${$rh}{$key} = $type; # = 'Application'; write_hash_to_DSP3( 'TEMPDSP3_2.DSP', $rh, $dbg ); get_app_type_4_short('DLL',\$type); # 'DLL' => $app_dynalib_stg, $key = 'APP_TYPE'; ${$rh}{$key} = $type; # = 'Dynamic-Link Library'; write_hash_to_DSP3( 'TEMPDSP3_3.DSP', $rh, $dbg ); get_app_type_4_short('SL',\$type); # 'SL' => $app_statlib_stg $key = 'APP_TYPE'; ${$rh}{$key} = $type; # = 'Static Library'; write_hash_to_DSP3( 'TEMPDSP3_4.DSP', $rh, $dbg ); } sub test6() { my $vsi = ''; if (get_vs_install_dir(\$vsi)) { prt( "VSINSTALLDIR=\"$vsi\"" ); if (-d $vsi) { prt(" ok"); } prt("\n"); } } ## %comspec% /k ""C:\Program Files\Microsoft Visual Studio 9.0\VC\vcvarsall.bat"" x86 sub test5() { my $msg = sprintf("%#X %d %#x", 0x1234, 0x1234, 4660); prt( "$msg\n" ); prt( "$CMDSPEC2\n" ); my $fil = 'tempvc.txt'; unlink $fil if (-f $fil); #$msg = '%COMSPEC% /k ""C:\Program Files\Microsoft Visual Studio 9.0\VC\vcvarsall.bat"" x86'; $msg = 'call "C:\Program Files\Microsoft Visual Studio 9.0\VC\vcvarsall.bat" x86'."\n"; $msg .= "echo \%VSINSTALLDIR\% > tempvc.txt\n"; $msg .= "pause\n"; $msg .= "type tempvc.txt\n"; $msg .= "pause\n"; write2file($msg,'tempvc.bat'); system('tempvc.bat'); if (open INF, "<$fil") { my @arr = <INF>; close INF; $vsinstall = $arr[0]; } else { prt("ERROR: Failed to write [$fil]!!!\n"); } prt( "Got VSINSTALLDIR=$vsinstall\n" ); } sub test_is_resource_file($) { my ($f) = shift; my @res_extents = qw( ico cur bmp dlg rc2 bin rgs gif jpg jpeg jpe ); foreach my $ext (@res_extents) { if ($f =~ /\.$ext$/i) { return 1; } } return 0; } sub test7() { my @files = qw ( icon.ico test.cur this.gif this.not northis.cxx ); foreach my $fil (@files) { my $msg = 'NO'; if (test_is_resource_file($fil)) { $msg = 'YES'; } prt( "Is file [$fil] a resource = $msg\n" ); } my $fnam = '<none>'; if ($fnam ne '<none>') { prt( "[$fnam] NOT none\n" ); } else { prt( "[$fnam] is none\n" ); } } sub test8() { my $in_file = 'C:\GTools\ConApps\test\testcon.vcproj'; my $rh = process_VCPROJ3($in_file); my $of = 'tempdsp3.dsp'; my $dbg = 0; my $name = ''; show_hash_results3($rh) if ($dbg); if (get_project_name($rh,\$name) && length($name)) { prt( "Writting project [$name] to [$of]...\n" ); write_hash_to_DSP3( $of, $rh, $dbg); # say ('tempvcscan.dsp', \%h, 0); prt( "Done file [$in_file]...\n" ); } else { prt("ERROR: NO PROJECT NAME!!!!\n"); show_hash_result3($rh); } } ######################################### ### MAIN ### prt( "$pgmname: in [$cwd]: Hello, World...\n" ); #my $hash_ref = get_app_type_hash_ref_short(); #my $hr2 = get_stgs_4_short_hr($hash_ref); #my $hr3 = get_lines_hash($hr2); # show_diff_lines($hr3); #test3(); #test4(); #test5(); #test6(); #test7(); test8(); pgm_exit(0,"Normal exit(0)"); ######################################## # eof - template.pl