Split routines that don't rely on C functions into winetest.pm so that
they can be used from a normal Perl script.
diff --git a/programs/regedit/tests/regedit.pl b/programs/regedit/tests/regedit.pl
index 8072e7b..374d3ea 100644
--- a/programs/regedit/tests/regedit.pl
+++ b/programs/regedit/tests/regedit.pl
@@ -21,7 +21,7 @@
use strict;
use diagnostics;
-use wine;
+use winetest;
$main::orig_reg = './tests/orig.reg';
diff --git a/programs/winetest/include/wine.pm b/programs/winetest/include/wine.pm
index e6d890c..2ca244a 100644
--- a/programs/winetest/include/wine.pm
+++ b/programs/winetest/include/wine.pm
@@ -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 @@
@EXPORT = qw(
AUTOLOAD
alloc_callback
- assert
- hd
- ok
- todo
- todo_wine
- trace
- wc
- wclen
);
$VERSION = '0.01';
@@ -54,17 +44,9 @@
# 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 @@
# | 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 @@
# ----------------------------------------------
my $sub_ref = shift;
my @callback_arg_types = @_;
-
+
# [todo] Check args
# [todo] Some way of specifying args passed to callback
@@ -280,298 +262,6 @@
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__
diff --git a/programs/winetest/include/winetest.pm b/programs/winetest/include/winetest.pm
new file mode 100644
index 0000000..39e3b73
--- /dev/null
+++ b/programs/winetest/include/winetest.pm
@@ -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;
diff --git a/programs/winetest/tests/wine.pl b/programs/winetest/tests/wine.pl
index 17e5d9f..53ad230 100644
--- a/programs/winetest/tests/wine.pl
+++ b/programs/winetest/tests/wine.pl
@@ -19,6 +19,7 @@
#
use wine;
+use winetest;
use kernel32;
