dslinux/user/perl/t/win32 getosversion.t longpath.t system.t system_tests
cayenne
dslinux_cayenne at user.in-berlin.de
Tue Dec 5 05:27:28 CET 2006
Update of /cvsroot/dslinux/dslinux/user/perl/t/win32
In directory antilope:/tmp/cvs-serv7729/t/win32
Added Files:
getosversion.t longpath.t system.t system_tests
Log Message:
Adding fresh perl source to HEAD to branch from
--- NEW FILE: system.t ---
#!perl
BEGIN {
chdir 't' if -d 't';
# We need '../../lib' as well as '../lib' because parts of Config are
# delay-loaded, after we've chdir()'ed into $testdir.
@INC = ('../lib', '../../lib');
# XXX this could be further munged to enable some parts on other
# platforms
unless ($^O =~ /^MSWin/) {
print "1..0 # skipped: windows specific test\n";
exit 0;
}
}
use File::Path;
use File::Copy;
use Config;
use Cwd;
use strict;
$| = 1;
my $cwd = cwd();
my $testdir = "t e s t";
my $exename = "showav";
my $plxname = "showargv";
rmtree($testdir);
mkdir($testdir);
die "Could not create '$testdir':$!" unless -d $testdir;
open(my $F, ">$testdir/$exename.c")
or die "Can't create $testdir/$exename.c: $!";
print $F <<'EOT';
#include <stdio.h>
#ifdef __BORLANDC__
#include <windows.h>
#endif
int
main(int ac, char **av)
{
int i;
#ifdef __BORLANDC__
char *s = GetCommandLine();
int j=0;
av[0] = s;
if (s[0]=='"') {
for(;s[++j]!='"';)
;
av[0]++;
}
else {
for(;s[++j]!=' ';)
;
}
s[j]=0;
#endif
for (i = 0; i < ac; i++)
printf("[%s]", av[i]);
printf("\n");
return 0;
}
EOT
open($F, ">$testdir/$plxname.bat")
or die "Can't create $testdir/$plxname.bat: $!";
print $F <<'EOT';
@rem = '--*-Perl-*--
@echo off
if "%OS%" == "Windows_NT" goto WinNT
EOT
print $F <<EOT;
"$^X" -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
goto endofperl
:WinNT
"$^X" -x -S %0 %*
EOT
print $F <<'EOT';
if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
if %errorlevel% == 9009 echo You do not have Perl in your PATH.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
print "[$_]" for ($0, @ARGV);
print "\n";
__END__
:endofperl
EOT
close $F;
# build the executable
chdir($testdir);
END {
chdir($cwd) && rmtree("$cwd/$testdir") if -d "$cwd/$testdir";
}
if (open(my $EIN, "$cwd/win32/${exename}_exe.uu")) {
print "# Unpacking $exename.exe\n";
my $e;
{
local $/;
$e = unpack "u", <$EIN>;
close $EIN;
}
open my $EOUT, ">$exename.exe" or die "Can't write $exename.exe: $!";
binmode $EOUT;
print $EOUT $e;
close $EOUT;
}
else {
my $minus_o = '';
if ($Config{cc} eq 'gcc')
{
$minus_o = "-o $exename.exe";
}
print "# Compiling $exename.c\n# $Config{cc} $Config{ccflags} $exename.c\n";
if (system("$Config{cc} $Config{ccflags} $minus_o $exename.c >log 2>&1") != 0) {
print "# Could not compile $exename.c, status $?\n"
."# Where is your C compiler?\n"
."1..0 # skipped: can't build test executable\n";
exit(0);
}
unless (-f "$exename.exe") {
if (open(LOG,'<log'))
{
while(<LOG>) {
print "# ",$_;
}
}
else {
warn "Cannot open log (in $testdir):$!";
}
}
}
copy("$plxname.bat","$plxname.cmd");
chdir($cwd);
unless (-x "$testdir/$exename.exe") {
print "# Could not build $exename.exe\n"
."1..0 # skipped: can't build test executable\n";
exit(0);
}
open my $T, "$^X -I../lib -w win32/system_tests |"
or die "Can't spawn win32/system_tests: $!";
my $expect;
my $comment = "";
my $test = 0;
while (<$T>) {
chomp;
if (/^1\.\./) {
print "$_\n";
}
elsif (/^#+\s(.*)$/) {
$comment = $1;
}
elsif (/^</) {
$expect = $_;
$expect =~ tr/<>/[]/;
$expect =~ s/\Q$plxname\E]/$plxname.bat]/;
}
else {
if ($expect ne $_) {
print "# $comment\n" if $comment;
print "# want: $expect\n";
print "# got : $_\n";
print "not ";
}
++$test;
print "ok $test\n";
}
}
close $T;
--- NEW FILE: system_tests ---
#!perl
use Config;
use Cwd;
use strict;
$| = 1;
my $cwdb = my $cwd = cwd();
$cwd =~ s,\\,/,g;
$cwdb =~ s,/,\\,g;
my $testdir = "t e s t";
my $exename = "showav";
my $plxname = "showargv";
my $exe = "$testdir/$exename";
my $exex = $exe . ".exe";
(my $exeb = $exe) =~ s,/,\\,g;
my $exebx = $exeb . ".exe";
my $bat = "$testdir/$plxname";
my $batx = $bat . ".bat";
(my $batb = $bat) =~ s,/,\\,g;
my $batbx = $batb . ".bat";
my $cmdx = $bat . ".cmd";
my $cmdb = $batb;
my $cmdbx = $cmdb . ".cmd";
my @commands = (
$exe,
$exex,
$exeb,
$exebx,
"./$exe",
"./$exex",
".\\$exeb",
".\\$exebx",
"$cwd/$exe",
"$cwd/$exex",
"$cwdb\\$exeb",
"$cwdb\\$exebx",
$bat,
$batx,
$batb,
$batbx,
"./$bat",
"./$batx",
".\\$batb",
".\\$batbx",
"$cwd/$bat",
"$cwd/$batx",
"$cwdb\\$batb",
"$cwdb\\$batbx",
$cmdx,
$cmdbx,
"./$cmdx",
".\\$cmdbx",
"$cwd/$cmdx",
"$cwdb\\$cmdbx",
[$^X, $batx],
[$^X, $batbx],
[$^X, "./$batx"],
[$^X, ".\\$batbx"],
[$^X, "$cwd/$batx"],
[$^X, "$cwdb\\$batbx"],
);
my @av = (
undef,
"",
" ",
"abc",
"a b\tc",
"\tabc",
"abc\t",
" abc\t",
"\ta b c ",
["\ta b c ", ""],
["\ta b c ", " "],
["", "\ta b c ", "abc"],
[" ", "\ta b c ", "abc"],
['" "', 'a" "b" "c', "abc"],
);
print "1.." . (@commands * @av * 2) . "\n";
for my $cmds (@commands) {
for my $args (@av) {
my @all_args;
my @cmds = defined($cmds) ? (ref($cmds) ? @$cmds : $cmds) : ();
my @args = defined($args) ? (ref($args) ? @$args : $args) : ();
print "######## [@cmds]\n";
print "<", join('><',
$cmds[$#cmds],
map { my $x = $_; $x =~ s/"//g; $x } @args),
">\n";
if (system(@cmds, at args) != 0) {
print "Failed, status($?)\n";
if ($Config{ccflags} =~ /\bDDEBUGGING\b/) {
print "Running again in debug mode\n";
$^D = 1; # -Dp
system(@cmds, at args);
}
}
$^D = 0;
my $cmdstr = join " ", map { /\s|^$/ && !/\"/
? qq["$_"] : $_ } @cmds, @args;
print "######## '$cmdstr'\n";
if (system($cmdstr) != 0) {
print "Failed, status($?)\n";
if ($Config{ccflags} =~ /\bDDEBUGGING\b/) {
print "Running again in debug mode\n";
$^D = 1; # -Dp
system($cmdstr);
}
}
$^D = 0;
}
}
--- NEW FILE: getosversion.t ---
#!perl -w
# tests for Win32::GetOSVersion()
$^O =~ /^MSWin/ or print("1..0 # not win32\n" ), exit;
print "1..1\n";
my $scalar = Win32::GetOSVersion();
my @array = Win32::GetOSVersion();
print "not " unless $scalar == $array[4];
print "ok 1\n";
--- NEW FILE: longpath.t ---
#!perl -w
# tests for Win32::GetLongPathName()
$^O =~ /^MSWin/ or print("1..0 # not win32\n" ), exit;
my @paths = qw(
/
//
.
..
c:
c:/
c:./
c:/.
c:/..
c:./..
//./
//.
//..
//./..
);
push @paths, map { my $x = $_; $x =~ s,/,\\,g; $x } @paths;
push @paths, qw(
../\
c:.\\../\
c:/\..//
c://.\/./\
\\.\\../\
//\..//
//.\/./\
);
my $drive = $ENV{SystemDrive};
if ($drive) {
for (@paths) {
s/^c:/$drive/;
}
push @paths, $ENV{SystemRoot} if $ENV{SystemRoot};
}
my %expect;
@expect{@paths} = map { my $x = $_; $x =~ s,(.[/\\])[/\\]+,$1,g; $x } @paths;
print "1.." . @paths . "\n";
my $i = 1;
for (@paths) {
my $got = Win32::GetLongPathName($_);
print "# '$_' => expect '$expect{$_}' => got '$got'\n";
print "not " unless $expect{$_} eq $got;
print "ok $i\n";
++$i;
}
More information about the dslinux-commit
mailing list