marko10_000
/
wine-wine
forked from Mirrors/wine-wine
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Split routines that don't rely on C functions into winetest.pm so that 

they can be used from a normal Perl script.
oldstable
Alexandre Julliard 2002-07-31 23:18:31 +00:00
parent 4c5d562c30
commit 2a0904f68f
4 changed files with 351 additions and 314 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
programs/regedit/tests/regedit.pl
View File

@ -21,7 +21,7 @@
use strict;
use diagnostics;
use wine;
use winetest;
$main::orig_reg = './tests/orig.reg';

316
programs/winetest/include/wine.pm
View File

@ -24,9 +24,7 @@
package wine;
use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD $todo_level
$successes $failures $todo_successes $todo_failures
$winetest_report_success
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD
%return_types %prototypes %loaded_modules);
require Exporter;
@ -39,14 +37,6 @@ require Exporter;
@EXPORT = qw(
AUTOLOAD
alloc_callback
assert
hd
ok
todo
todo_wine
trace
wc
wclen
);
$VERSION = '0.01';
@ -54,17 +44,9 @@ bootstrap wine $VERSION;
# Global variables
$wine::err = 0;
$wine::exit_status = 0;
$wine::debug = defined($ENV{WINETEST_DEBUG}) ? $ENV{WINETEST_DEBUG} : 1;
$wine::platform = defined($ENV{WINETEST_PLATFORM}) ? $ENV{WINETEST_PLATFORM} : "windows";
$todo_level = 0;
$successes = 0;
$failures = 0;
$todo_successes = 0;
$todo_failures = 0;
%loaded_modules = ();
$winetest_report_success = defined($ENV{WINETEST_REPORT_SUCCESS}) ? $ENV{WINETEST_REPORT_SUCCESS} : 0;
# --------------------------------------------------------------
@ -76,7 +58,7 @@ $winetest_report_success = defined($ENV{WINETEST_REPORT_SUCCESS}) ? $ENV{WINETES
# | access to them. But I haven't worked it out |
# | yet ... |
# --------------------------------------------------------------
%return_types = (
%return_types = (
"void" => 0,
"int" => 1, "long" => 1,
"word" => 2,
@ -265,7 +247,7 @@ sub alloc_callback($@)
# ----------------------------------------------
my $sub_ref = shift;
my @callback_arg_types = @_;
# [todo] Check args
# [todo] Some way of specifying args passed to callback
@ -280,298 +262,6 @@ sub alloc_callback($@)
return alloc_thunk ($sub_ref, @callback_arg_types);
}
# ----------------------------------------------------------------------
# | Subroutine: hd |
# | |
# | Purpose: Display a hex dump of a string |
# | |
# | Usage: hd STR |
# | Usage: hd STR, LENGTH |
# | |
# | Returns: (none) |
# ----------------------------------------------------------------------
sub hd($;$)
{
# Locals
my ($buf, $length);
my $first;
my ($str1, $str2, $str, $t);
my ($c, $x);
# Begin sub hd
# --------------------------------------------------------------
# | Get args; if no BUF specified, blow |
# --------------------------------------------------------------
$buf = shift;
$length = (shift or length ($buf));
return
if ((not defined ($buf)) || ($length <= 0));
# --------------------------------------------------------------
# | Initialize |
# --------------------------------------------------------------
$first = 1;
$str1 = "00000:";
$str2 = "";
# --------------------------------------------------------------
# | For each character |
# --------------------------------------------------------------
for (0 .. ($length - 1))
{
$c = substr ($buf, $_, 1);
$x = sprintf ("%02x", ord ($c));
$str1 .= (" " . $x);
$str2 .= (((ord ($c) >= 33) && (ord ($c) <= 126)) ? $c : ".");
# --------------------------------------------------------------
# | Every group of 4, add an extra space |
# --------------------------------------------------------------
if
(
((($_ + 1) % 16) == 4) ||
((($_ + 1) % 16) == 12)
)
{
$str1 .= " ";
$str2 .= " ";
}
# --------------------------------------------------------------
# | Every group of 8, add a '-' |
# --------------------------------------------------------------
elsif
(
((($_ + 1) % 16) == 8)
)
{
$str1 .= " -";
$str2 .= " ";
}
# --------------------------------------------------------------
# | Every group of 16, dump |
# --------------------------------------------------------------
if
(
((($_ + 1) % 16) == 0) ||
($_ == ($length - 1))
)
{
$str = sprintf ("%-64s%s", $str1, $str2);
if ($first)
{
$t = ("-" x length ($str));
print " $t\n";
print " | $length bytes\n";
print " $t\n";
$first = 0;
}
print " $str\n";
$str1 = sprintf ("%05d:", ($_ + 1));
$str2 = "";
if ($_ == ($length - 1))
{
print " $t\n";
}
}
} # end for
# --------------------------------------------------------------
# | Exit point |
# --------------------------------------------------------------
return;
} # End sub hd
# ----------------------------------------------------------------------
# | Subroutine: wc |
# | |
# | Purpose: Generate unicode string |
# | |
# | Usage: wc ASCII_STRING |
# | |
# | Returns: string generated |
# ----------------------------------------------------------------------
sub wc($)
{
return pack("S*",unpack("C*",shift));
} # End sub wc
# ----------------------------------------------------------------------
# | Subroutine: wclen |
# | |
# | Purpose: Return length of unicode string |
# | |
# | Usage: wclen UNICODE_STRING |
# | |
# | Returns: string generated |
# ----------------------------------------------------------------------
sub wclen($)
{
# Locals
my $str = shift;
my ($c1, $c2, $n);
# Begin sub wclen
$n = 0;
while (length ($str) > 0)
{
$c1 = substr ($str, 0, 1, "");
$c2 = substr ($str, 0, 1, "");
(($c1 eq "\x00") && ($c2 eq "\x00")) ? last : $n++;
}
return ($n);
} # End sub wclen
# ----------------------------------------------------------------------
# Subroutine: ok
#
# Purpose: Print warning if something fails
#
# Usage: ok CONDITION [DESCRIPTION]
#
# Returns: (none)
# ----------------------------------------------------------------------
sub ok($;$)
{
my $assertion = shift;
my $description = shift;
my ($filename, $line) = (caller (0))[1,2];
if ($todo_level)
{
if ($assertion)
{
print STDERR ("$filename:$line: Test succeeded inside todo block" .
($description ? ": $description" : "") . "\n");
$todo_failures++;
}
else { $todo_successes++; }
}
else
{
if (!$assertion)
{
print STDERR ("$filename:$line: Test failed" .
($description ? ": $description" : "") . "\n");
$failures++;
}
else
{
print STDERR ("$filename:$line: Test succeeded\n") if ($winetest_report_success);
$successes++;
}
}
}
# ----------------------------------------------------------------------
# Subroutine: assert
#
# Purpose: Print error and die if something fails
#
# Usage: assert CONDITION [DESCRIPTION]
#
# Returns: (none)
# ----------------------------------------------------------------------
sub assert($;$)
{
my $assertion = shift;
my $description = shift;
my ($filename, $line) = (caller (0))[1,2];
unless ($assertion)
{
die ("$filename:$line: Assertion failed" . ($description ? ": $description" : "") . "\n");
}
}
# ----------------------------------------------------------------------
# Subroutine: trace
#
# Purpose: Print debugging traces
#
# Usage: trace format [arguments]
# ----------------------------------------------------------------------
sub trace($@)
{
return unless ($wine::debug > 0);
my $format = shift;
my $filename = (caller(0))[1];
$filename =~ s!.*/!!;
printf "trace:$filename $format", @_;
}
# ----------------------------------------------------------------------
# Subroutine: todo
#
# Purpose: Specify a block of code as todo for a given platform
#
# Usage: todo name coderef
# ----------------------------------------------------------------------
sub todo($$)
{
my ($platform,$code) = @_;
if ($wine::platform eq $platform)
{
$todo_level++;
eval &$code;
$todo_level--;
}
else
{
eval &$code;
}
}
# ----------------------------------------------------------------------
# Subroutine: todo_wine
#
# Purpose: Specify a block of test as todo for the Wine platform
#
# Usage: todo_wine { code }
# ----------------------------------------------------------------------
sub todo_wine(&)
{
my $code = shift;
todo( "wine", $code );
}
# ----------------------------------------------------------------------
# Subroutine: END
#
# Purpose: Called at the end of execution, print results summary
# ----------------------------------------------------------------------
END
{
return if $?; # got some other error already
if ($wine::debug > 0)
{
my $filename = (caller(0))[1];
printf STDERR ("%s: %d tests executed, %d marked as todo, %d %s.\n",
$filename, $successes + $failures + $todo_successes + $todo_failures,
$todo_successes, $failures + $todo_failures,
($failures + $todo_failures != 1) ? "failures" : "failure" );
}
$? = ($failures + $todo_failures < 255) ? $failures + $todo_failures : 255;
}
# Autoload methods go after =cut, and are processed by the autosplit program.
1;
__END__

346
programs/winetest/include/winetest.pm 100644
View File

@ -0,0 +1,346 @@
# --------------------------------------------------------------------
# Main routines for the Wine test environment
#
# Copyright 2001 John F Sturtz for Codeweavers
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
# --------------------------------------------------------------------
package winetest;
use strict;
use vars qw(@ISA @EXPORT @EXPORT_OK $todo_level
$successes $failures $todo_successes $todo_failures $winetest_report_success);
require Exporter;
@ISA = qw(Exporter);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(
assert
hd
ok
todo
todo_wine
trace
wc
wclen
);
# Global variables
$wine::debug = defined($ENV{WINETEST_DEBUG}) ? $ENV{WINETEST_DEBUG} : 1;
$wine::platform = defined($ENV{WINETEST_PLATFORM}) ? $ENV{WINETEST_PLATFORM} : "windows";
$todo_level = 0;
$successes = 0;
$failures = 0;
$todo_successes = 0;
$todo_failures = 0;
$winetest_report_success = defined($ENV{WINETEST_REPORT_SUCCESS}) ? $ENV{WINETEST_REPORT_SUCCESS} : 0;
# ----------------------------------------------------------------------
# | Subroutine: hd |
# | |
# | Purpose: Display a hex dump of a string |
# | |
# | Usage: hd STR |
# | Usage: hd STR, LENGTH |
# | |
# | Returns: (none) |
# ----------------------------------------------------------------------
sub hd($;$)
{
# Locals
my ($buf, $length);
my $first;
my ($str1, $str2, $str, $t);
my ($c, $x);
# Begin sub hd
# --------------------------------------------------------------
# | Get args; if no BUF specified, blow |
# --------------------------------------------------------------
$buf = shift;
$length = (shift or length ($buf));
return
if ((not defined ($buf)) || ($length <= 0));
# --------------------------------------------------------------
# | Initialize |
# --------------------------------------------------------------
$first = 1;
$str1 = "00000:";
$str2 = "";
# --------------------------------------------------------------
# | For each character |
# --------------------------------------------------------------
for (0 .. ($length - 1))
{
$c = substr ($buf, $_, 1);
$x = sprintf ("%02x", ord ($c));
$str1 .= (" " . $x);
$str2 .= (((ord ($c) >= 33) && (ord ($c) <= 126)) ? $c : ".");
# --------------------------------------------------------------
# | Every group of 4, add an extra space |
# --------------------------------------------------------------
if
(
((($_ + 1) % 16) == 4) ||
((($_ + 1) % 16) == 12)
)
{
$str1 .= " ";
$str2 .= " ";
}
# --------------------------------------------------------------
# | Every group of 8, add a '-' |
# --------------------------------------------------------------
elsif
(
((($_ + 1) % 16) == 8)
)
{
$str1 .= " -";
$str2 .= " ";
}
# --------------------------------------------------------------
# | Every group of 16, dump |
# --------------------------------------------------------------
if
(
((($_ + 1) % 16) == 0) ||
($_ == ($length - 1))
)
{
$str = sprintf ("%-64s%s", $str1, $str2);
if ($first)
{
$t = ("-" x length ($str));
print " $t\n";
print " | $length bytes\n";
print " $t\n";
$first = 0;
}
print " $str\n";
$str1 = sprintf ("%05d:", ($_ + 1));
$str2 = "";
if ($_ == ($length - 1))
{
print " $t\n";
}
}
} # end for
# --------------------------------------------------------------
# | Exit point |
# --------------------------------------------------------------
return;
} # End sub hd
# ----------------------------------------------------------------------
# | Subroutine: wc |
# | |
# | Purpose: Generate unicode string |
# | |
# | Usage: wc ASCII_STRING |
# | |
# | Returns: string generated |
# ----------------------------------------------------------------------
sub wc($)
{
return pack("S*",unpack("C*",shift));
} # End sub wc
# ----------------------------------------------------------------------
# | Subroutine: wclen |
# | |
# | Purpose: Return length of unicode string |
# | |
# | Usage: wclen UNICODE_STRING |
# | |
# | Returns: string generated |
# ----------------------------------------------------------------------
sub wclen($)
{
# Locals
my $str = shift;
my ($c1, $c2, $n);
# Begin sub wclen
$n = 0;
while (length ($str) > 0)
{
$c1 = substr ($str, 0, 1, "");
$c2 = substr ($str, 0, 1, "");
(($c1 eq "\x00") && ($c2 eq "\x00")) ? last : $n++;
}
return ($n);
} # End sub wclen
# ----------------------------------------------------------------------
# Subroutine: ok
#
# Purpose: Print warning if something fails
#
# Usage: ok CONDITION [DESCRIPTION]
#
# Returns: (none)
# ----------------------------------------------------------------------
sub ok($;$)
{
my $assertion = shift;
my $description = shift;
my ($filename, $line) = (caller (0))[1,2];
if ($todo_level)
{
if ($assertion)
{
print STDERR ("$filename:$line: Test succeeded inside todo block" .
($description ? ": $description" : "") . "\n");
$todo_failures++;
}
else { $todo_successes++; }
}
else
{
if (!$assertion)
{
print STDERR ("$filename:$line: Test failed" .
($description ? ": $description" : "") . "\n");
$failures++;
}
else
{
print STDERR ("$filename:$line: Test succeeded\n") if ($winetest_report_success);
$successes++;
}
}
}
# ----------------------------------------------------------------------
# Subroutine: assert
#
# Purpose: Print error and die if something fails
#
# Usage: assert CONDITION [DESCRIPTION]
#
# Returns: (none)
# ----------------------------------------------------------------------
sub assert($;$)
{
my $assertion = shift;
my $description = shift;
my ($filename, $line) = (caller (0))[1,2];
unless ($assertion)
{
die ("$filename:$line: Assertion failed" . ($description ? ": $description" : "") . "\n");
}
}
# ----------------------------------------------------------------------
# Subroutine: trace
#
# Purpose: Print debugging traces
#
# Usage: trace format [arguments]
# ----------------------------------------------------------------------
sub trace($@)
{
return unless ($wine::debug > 0);
my $format = shift;
my $filename = (caller(0))[1];
$filename =~ s!.*/!!;
printf "trace:$filename $format", @_;
}
# ----------------------------------------------------------------------
# Subroutine: todo
#
# Purpose: Specify a block of code as todo for a given platform
#
# Usage: todo name coderef
# ----------------------------------------------------------------------
sub todo($$)
{
my ($platform,$code) = @_;
if ($wine::platform eq $platform)
{
$todo_level++;
eval &$code;
$todo_level--;
}
else
{
eval &$code;
}
}
# ----------------------------------------------------------------------
# Subroutine: todo_wine
#
# Purpose: Specify a block of test as todo for the Wine platform
#
# Usage: todo_wine { code }
# ----------------------------------------------------------------------
sub todo_wine(&)
{
my $code = shift;
todo( "wine", $code );
}
# ----------------------------------------------------------------------
# Subroutine: END
#
# Purpose: Called at the end of execution, print results summary
# ----------------------------------------------------------------------
END
{
return if $?; # got some other error already
if ($wine::debug > 0)
{
my $filename = (caller(0))[1];
printf STDERR ("%s: %d tests executed, %d marked as todo, %d %s.\n",
$filename, $successes + $failures + $todo_successes + $todo_failures,
$todo_successes, $failures + $todo_failures,
($failures + $todo_failures != 1) ? "failures" : "failure" );
}
$? = ($failures + $todo_failures < 255) ? $failures + $todo_failures : 255;
}
1;

1
programs/winetest/tests/wine.pl
View File

@ -19,6 +19,7 @@
#
use wine;
use winetest;
use kernel32;