tests2d.pl to HTML.

index -|- end

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

index -|- top