| # -------------------------------------------------------------------- |
| # 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; |
