RE: $Win32::VERSION problem
Jan Dubois [Wed, 7 Mar 2007 12:26:01 +0000 (04:26 -0800)]
From: "Jan Dubois" <jand@activestate.com>
Message-ID: <00b301c760f6$d28129d0$77837d70$@com>

Adds the tests from the dual-lived CPAN distribution Win32-0.27
and removes two old t/win32 tests which are now redundant

p4raw-id: //depot/perl@30516

MANIFEST
ext/Win32/t/ExpandEnvironmentStrings.t [new file with mode: 0644]
ext/Win32/t/GetFileVersion.t [new file with mode: 0644]
ext/Win32/t/GetFolderPath.t [new file with mode: 0644]
ext/Win32/t/GetFullPathName.t [new file with mode: 0644]
ext/Win32/t/GetLongPathName.t [moved from t/win32/longpath.t with 85% similarity, mode: 0644]
ext/Win32/t/GetOSVersion.t [moved from t/win32/getosversion.t with 53% similarity]
ext/Win32/t/GuidGen.t [new file with mode: 0644]

index 5b9f51c..429f9c1 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1214,6 +1214,13 @@ ext/Unicode/Normalize/t/test.t   Unicode::Normalize
 ext/Unicode/Normalize/t/tie.t  Unicode::Normalize
 ext/util/make_ext              Used by Makefile to execute extension Makefiles
 ext/Win32/Makefile.PL          Win32 extension makefile writer
+ext/Win32/t/ExpandEnvironmentStrings.t See if Win32 extension works
+ext/Win32/t/GetFileVersion.t   See if Win32 extension works
+ext/Win32/t/GetFolderPath.t    See if Win32 extension works
+ext/Win32/t/GetFullPathName.t  See if Win32 extension works
+ext/Win32/t/GetLongPathName.t  See if Win32 extension works
+ext/Win32/t/GetOSVersion.t     See if Win32 extension works
+ext/Win32/t/GuidGen.t          See if Win32 extension works
 ext/Win32/Win32.pm             Win32 extension Perl module
 ext/Win32/Win32.xs             Win32 extension external subroutines
 ext/Win32API/File/buffers.h    Win32API::File extension
@@ -3750,8 +3757,6 @@ t/uni/tr_sjis.t                   See if Unicode tr/// in sjis works
 t/uni/tr_utf8.t                        See if Unicode tr/// in utf8 works
 t/uni/upper.t                  See if Unicode casing works
 t/uni/write.t                  See if Unicode formats work
-t/win32/getosversion.t         Test if Win32::GetOSVersion() works
-t/win32/longpath.t             Test if Win32::GetLongPathName() works
 t/win32/system.t               See if system works in Win*
 t/win32/system_tests           Test runner for system.t
 t/x2p/s2p.t                    See if s2p/psed work
diff --git a/ext/Win32/t/ExpandEnvironmentStrings.t b/ext/Win32/t/ExpandEnvironmentStrings.t
new file mode 100644 (file)
index 0000000..b57b47c
--- /dev/null
@@ -0,0 +1,7 @@
+use strict;
+use Test;
+use Win32;
+
+plan tests => 1;
+
+ok(Win32::ExpandEnvironmentStrings("%WINDIR%"), $ENV{WINDIR});
diff --git a/ext/Win32/t/GetFileVersion.t b/ext/Win32/t/GetFileVersion.t
new file mode 100644 (file)
index 0000000..dc0c541
--- /dev/null
@@ -0,0 +1,16 @@
+use strict;
+use Test;
+use Win32;
+
+unless (defined &Win32::BuildNumber) {
+    print "1..0 # Skip: Only ActivePerl seems to set the perl.exe fileversion\n";
+    exit;
+}
+
+plan tests => 2;
+
+my @version = Win32::GetFileVersion($^X);
+my $version = $version[0] + $version[1] / 1000 + $version[2] / 1000000;
+
+ok($version, $]);
+ok($version[3], Win32::BuildNumber());
diff --git a/ext/Win32/t/GetFolderPath.t b/ext/Win32/t/GetFolderPath.t
new file mode 100644 (file)
index 0000000..c010c25
--- /dev/null
@@ -0,0 +1,8 @@
+use strict;
+use Test;
+use Win32;
+
+plan tests => 1;
+
+# "windir" exists back to Win9X; "SystemRoot" only exists on WinNT and later.
+ok(Win32::GetFolderPath(Win32::CSIDL_WINDOWS), $ENV{WINDIR});
diff --git a/ext/Win32/t/GetFullPathName.t b/ext/Win32/t/GetFullPathName.t
new file mode 100644 (file)
index 0000000..ec716d1
--- /dev/null
@@ -0,0 +1,34 @@
+use strict;
+use Test;
+use Win32;
+
+plan tests => 16;
+
+my $cwd = Win32::GetCwd;
+my @cwd = split/\\/, $cwd;
+my $file = pop @cwd;
+my $dir = join('\\', @cwd);
+
+ok(scalar Win32::GetFullPathName('.'), $cwd);
+ok((Win32::GetFullPathName('.'))[0], "$dir\\");
+ok((Win32::GetFullPathName('.'))[1], $file);
+
+ok((Win32::GetFullPathName('./'))[0], "$cwd\\");
+ok((Win32::GetFullPathName('.\\'))[0], "$cwd\\");
+ok((Win32::GetFullPathName('./'))[1], "");
+
+ok(scalar Win32::GetFullPathName($cwd), $cwd);
+ok((Win32::GetFullPathName($cwd))[0], "$dir\\");
+ok((Win32::GetFullPathName($cwd))[1], $file);
+
+ok(scalar Win32::GetFullPathName(substr($cwd,2)), $cwd);
+ok((Win32::GetFullPathName(substr($cwd,2)))[0], "$dir\\");
+ok((Win32::GetFullPathName(substr($cwd,2)))[1], $file);
+
+ok(scalar Win32::GetFullPathName('/Foo Bar/'), substr($cwd,0,2)."\\Foo Bar\\");
+
+chdir($dir);
+ok(scalar Win32::GetFullPathName('.'), $dir);
+
+ok((Win32::GetFullPathName($file))[0], "$dir\\");
+ok((Win32::GetFullPathName($file))[1], $file);
old mode 100755 (executable)
new mode 100644 (file)
similarity index 85%
rename from t/win32/longpath.t
rename to ext/Win32/t/GetLongPathName.t
index d31a5b4..22a2f02
@@ -1,8 +1,6 @@
-#!perl -w
-
-# tests for Win32::GetLongPathName()
-
-$^O =~ /^MSWin/ or print("1..0 # not win32\n" ), exit;
+use strict;
+use Test;
+use Win32;
 
 my @paths = qw(
     /
@@ -41,7 +39,8 @@ if ($drive) {
 my %expect;
 @expect{@paths} = map { my $x = $_; $x =~ s,(.[/\\])[/\\]+,$1,g; $x } @paths;
 
-print "1.." . @paths . "\n";
+plan tests => scalar(@paths);
+
 my $i = 1;
 for (@paths) {
     my $got = Win32::GetLongPathName($_);
similarity index 53%
rename from t/win32/getosversion.t
rename to ext/Win32/t/GetOSVersion.t
index 2a708cb..cb3f364 100644 (file)
@@ -1,10 +1,8 @@
-#!perl -w
+use strict;
+use Test;
+use Win32;
 
-# tests for Win32::GetOSVersion()
-
-$^O =~ /^MSWin/ or print("1..0 # not win32\n" ), exit;
-
-print "1..1\n";
+plan tests => 1;
 
 my $scalar = Win32::GetOSVersion();
 my @array  = Win32::GetOSVersion();
diff --git a/ext/Win32/t/GuidGen.t b/ext/Win32/t/GuidGen.t
new file mode 100644 (file)
index 0000000..7011e2f
--- /dev/null
@@ -0,0 +1,15 @@
+use strict;
+use Test;
+use Win32;
+
+plan tests => 3;
+
+my $guid1 = Win32::GuidGen();
+my $guid2 = Win32::GuidGen();
+
+# {FB9586CD-273B-43BE-A20C-485A6BD4FCD6}
+ok($guid1, qr/^{\w{8}(-\w{4}){3}-\w{12}}$/);
+ok($guid2, qr/^{\w{8}(-\w{4}){3}-\w{12}}$/);
+
+# Every GUID is unique
+ok($guid1 ne $guid2);