Added ok() function that doesn't stop the test on the first error.
Added trace() function for debugging tests.
Added support for todo functionality.
Moved wine.pm to include directory.
diff --git a/programs/winetest/wine.pm b/programs/winetest/include/wine.pm
similarity index 77%
rename from programs/winetest/wine.pm
rename to programs/winetest/include/wine.pm
index 3b13c2e..ddb73e7 100644
--- a/programs/winetest/wine.pm
+++ b/programs/winetest/include/wine.pm
@@ -1,14 +1,15 @@
-# --------------------------------------------------------------------------------
-# | Module: wine.pm |
-# | ---------------------------------------------------------------------------- |
-# | Purpose: Module to supply wrapper around and support for gateway to wine |
-# | API functions |
-# --------------------------------------------------------------------------------
+# --------------------------------------------------------------------
+# Module: wine.pm
+#
+# Purpose: Module to supply wrapper around and support for gateway to
+# Windows API functions
+# --------------------------------------------------------------------
package wine;
use strict;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD $todo_level
+ $successes $failures $todo_successes $todo_failures
%return_types %prototypes %loaded_modules);
require Exporter;
@@ -23,6 +24,10 @@
alloc_callback
assert
hd
+ ok
+ todo
+ todo_wine
+ trace
wc
wclen
);
@@ -32,8 +37,15 @@
# Global variables
$wine::err = 0;
-$wine::debug = 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 = ();
# --------------------------------------------------------------
@@ -87,7 +99,7 @@
# --------------------------------------------------------------
if (defined($prototypes{$func}))
{
- return call( $func, $wine::debug, @_ );
+ return call( $func, @_ );
}
die "Function '$func' not declared";
} # End AUTOLOAD
@@ -99,35 +111,36 @@
# | -------------------------------------------------------------------- |
# | Purpose: Call a wine API function |
# | |
-# | Usage: call FUNCTION, DEBUG, [ARGS ...]
+# | Usage: call FUNCTION, [ARGS ...]
# | |
# | Returns: value returned by API function called |
# ------------------------------------------------------------------------
-sub call
+sub call($@)
{
- my ($function,$debug,@args) = @_;
+ my ($function,@args) = @_;
my ($funcptr,$ret_type) = @{$prototypes{$function}};
- if ($debug)
+ if ($wine::debug > 1)
{
- print STDERR "==== [$function() / " . scalar (@args) . " arg(s)]";
+ print STDERR "==== Call $function(";
for (@args)
{
print STDERR " ", +(ref () ? ("(" . ${$_} . ")") : "$_");
}
- print STDERR " ====\n";
+ print STDERR " " if (scalar @args);
+ print STDERR ")\n";
}
# Now call call_wine_API(), which will turn around and call
# the appropriate wine API function.
- my ($err,$r) = call_wine_API( $funcptr, $ret_type, $debug, @args );
+ my ($err,$r) = call_wine_API( $funcptr, $ret_type, $wine::debug-1, @args );
- if ($debug)
+ if ($wine::debug > 1)
{
- my $z = "[$function()] -> ";
- $z .= defined($r) ? sprintf("[0x%x/%d]", $r, $r) : "[void]";
- if (defined($err)) { $z .= sprintf " err=%d", $err; }
- print STDERR "==== $z ====\n";
+ print STDERR "==== Ret $function()";
+ if (defined($r)) { printf STDERR " ret=0x%x", $r; }
+ if (defined($err)) { printf STDERR " err=%d", $err; }
+ print STDERR "\n";
}
# Pass the return value back
@@ -139,7 +152,7 @@
# ----------------------------------------------------------------------
# | Subroutine: declare
# ----------------------------------------------------------------------
-sub declare
+sub declare($%)
{
my ($module, %list) = @_;
my ($handle, $func);
@@ -180,7 +193,7 @@
# | really suitable for anything but to be passed to a wine API |
# | function ... |
# ------------------------------------------------------------------------
-sub alloc_callback
+sub alloc_callback($@)
{
# ----------------------------------------------
# | Locals |
@@ -215,7 +228,7 @@
# | |
# | Returns: (none) |
# ----------------------------------------------------------------------
-sub hd
+sub hd($;$)
{
# Locals
my ($buf, $length);
@@ -323,7 +336,7 @@
# | |
# | Returns: string generated |
# ----------------------------------------------------------------------
-sub wc
+sub wc($)
{
return pack("S*",unpack("C*",shift));
} # End sub wc
@@ -339,7 +352,7 @@
# | |
# | Returns: string generated |
# ----------------------------------------------------------------------
-sub wclen
+sub wclen($)
{
# Locals
my $str = shift;
@@ -362,26 +375,134 @@
# ----------------------------------------------------------------------
-# | Subroutine: assert |
-# | |
-# | Purpose: Print warning if something fails |
-# | |
-# | Usage: assert CONDITION |
-# | |
-# | Returns: (none) |
+# Subroutine: ok
+#
+# Purpose: Print warning if something fails
+#
+# Usage: ok CONDITION [DESCRIPTION]
+#
+# Returns: (none)
# ----------------------------------------------------------------------
-sub assert
+sub ok($;$)
{
- # Locals
- my $assertion = shift;
- my ($fn, $line);
+ 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 { $successes++; }
+ }
+}
-# Begin sub assert
- ($fn, $line) = (caller (0))[1,2];
- unless ($assertion) { print "Assertion failed [$fn, line $line]\n"; exit 1; }
+# ----------------------------------------------------------------------
+# 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");
+ }
+}
-} # End sub assert
+
+# ----------------------------------------------------------------------
+# 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.
diff --git a/programs/winetest/winetest.c b/programs/winetest/winetest.c
index 0543f0b..f58d6d8 100644
--- a/programs/winetest/winetest.c
+++ b/programs/winetest/winetest.c
@@ -111,7 +111,7 @@
unsigned long ret;
DWORD error, old_error;
- if (debug)
+ if (debug > 1)
{
int i;
fprintf(stderr," perl_call_wine(func=%p", proc);
