This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Win32 from CPAN (from 0.40 to 0.41)
authorJan Dubois <jand@activestate.com>
Sat, 11 Dec 2010 01:45:30 +0000 (17:45 -0800)
committerJan Dubois <jand@activestate.com>
Sat, 11 Dec 2010 01:45:30 +0000 (17:45 -0800)
Porting/Maintainers.pl
cpan/Win32/Changes
cpan/Win32/Win32.pm
cpan/Win32/Win32.xs
cpan/Win32/t/GetOSName.t

index 239dbde..d6d87a2 100755 (executable)
@@ -1588,7 +1588,7 @@ use File::Glob qw(:case);
     'Win32' =>
        {
        'MAINTAINER'    => 'jand',
-       'DISTRIBUTION'  => "JDB/Win32-0.40.tar.gz",
+       'DISTRIBUTION'  => "JDB/Win32-0.41.tar.gz",
        'FILES'         => q[cpan/Win32],
        'UPSTREAM'      => 'cpan',
        },
index 7dd8986..24235aa 100644 (file)
@@ -1,17 +1,31 @@
 Revision history for the Perl extension Win32.\r
 \r
+0.41   [2010-12-10]\r
+       - Fix Win32::GetChipName() to return the native processor type when\r
+         running 32-bit Perl on 64-bit Windows (WOW64).  This will also\r
+         affect the values returned by Win32::GetOSDisplayName() and\r
+         Win32::GetOSName(). [rt#63797]\r
+       - Fix Win32::GetOSDisplayName() to return the correct values for\r
+         all products even when a service pack has been installed. (This\r
+         was only an issue for some "special" editions).\r
+       - The display name for "Windows 7 Business Edition" is actually\r
+         "Windows 7 Professional".\r
+       - Fix t/GetOSName.t tests to avoid using the values returned by\r
+         GetSystemMetrics() when the test template didn't specify any\r
+         value at all.\r
+\r
 0.40   [2010-12-08]\r
        - Add Win32::GetSystemMetrics function.\r
        - Add Win32::GetProductInfo() function.\r
        - Add Win32::GetOSDisplayName() function.\r
        - Detect "Windows Server 2008 R2" as "Win2008" in Win32::GetOSName()\r
-         (used to return "Win7" before).\r
+         (used to return "Win7" before). [rt#57172]\r
        - Detect "Windows Home Server" as "WinHomeSvr" in Win32::GetOSName()\r
          (used to return "Win2003" before).\r
-       - Added "R2", "Media Center", "Tablet PC", "Starter Edition" etc.\r
+       - Add "R2", "Media Center", "Tablet PC", "Starter Edition" etc.\r
          tags to the description returned by Win32::GetOSName() in\r
          list context.\r
-       - Rewrote the t/GetOSName.t tests\r
+       - Rewrite the t/GetOSName.t tests\r
 \r
 0.39   [2009-01-19]\r
        - Add support for Windows 2008 Server and Windows 7 in\r
index cef6271..d2eb1ad 100644 (file)
@@ -8,7 +8,7 @@ package Win32;
     require DynaLoader;\r
 \r
     @ISA = qw|Exporter DynaLoader|;\r
-    $VERSION = '0.40';\r
+    $VERSION = '0.41';\r
     $XS_VERSION = $VERSION;\r
     $VERSION = eval $VERSION;\r
 \r
@@ -275,11 +275,12 @@ sub GetOSDisplayName {
     # Calling GetOSDisplayName() with arguments is for the test suite only!\r
     my($name,$desc) = @_ ? @_ : GetOSName();\r
     $name =~ s/^Win//;\r
-    if ($desc eq "Windows Home Server" || $desc eq "Windows XP Professional x64 Edition") {\r
+    if ($desc =~ /^Windows Home Server\b/ || $desc =~ /^Windows XP Professional x64 Edition\b/) {\r
        ($name, $desc) = ($desc, "");\r
     }\r
-    elsif ($desc =~ s/\s*(Windows (.*) Server( \d+)?)$//) {\r
-       ($name, $desc) = ("$1 $name", $desc);\r
+    elsif ($desc =~ s/\s*(Windows (.*) Server( \d+)?)//) {\r
+       $name = "$1 $name";\r
+       $desc =~ s/^\s+//;\r
     }\r
     else {\r
        for ($name) {\r
@@ -300,9 +301,10 @@ sub GetOSDisplayName {
 \r
 sub _GetSystemMetrics {\r
     my($index,$metrics) = @_;\r
+    return Win32::GetSystemMetrics($index) unless ref $metrics;\r
     return $metrics->{$index} if ref $metrics eq "HASH" && defined $metrics->{$index};\r
     return 1 if ref $metrics eq "ARRAY" && grep $_ == $index, @$metrics;\r
-    return Win32::GetSystemMetrics($index);\r
+    return 0;\r
 }\r
 \r
 sub _GetOSName {\r
@@ -472,7 +474,8 @@ sub _GetOSName {
                $desc .= " Enterprise";\r
             }\r
             elsif ($productinfo == PRODUCT_BUSINESS) {\r
-               $desc .= " Business";\r
+              # "Windows 7 Business" had a name change to "Windows 7 Professional"\r
+               $desc .= $minor == 0 ? " Business" : "Professional";\r
             }\r
             elsif ($productinfo == PRODUCT_STARTER) {\r
                $desc .= " Starter";\r
@@ -704,8 +707,10 @@ $ENV{PROCESSOR_ARCHITECTURE}.  This might not work on Win9X.
 \r
 =item Win32::GetChipName()\r
 \r
-Returns the processor type: 386, 486 or 586 for x86 processors,\r
-8664 for the x64 processor and 2200 for the Itanium.\r
+Returns the processor type: 386, 486 or 586 for x86 processors, 8664\r
+for the x64 processor and 2200 for the Itanium.  Since it returns the\r
+native processor type it will return a 64-bit processor type even when\r
+called from a 32-bit Perl running on 64-bit Windows.\r
 \r
 =item Win32::GetCwd()\r
 \r
@@ -856,6 +861,10 @@ being used.  It returns names like these (random samples):
    Windows Vista Ultimate (32-bit)\r
    Windows Small Business Server 2008 R2 (64-bit)\r
 \r
+The display name describes the native Windows version, so even on a\r
+32-bit Perl this function may return a "Windows ... (64-bit)" name\r
+when running on a 64-bit Windows.\r
+\r
 This function should only be used to display the actual OS name to the\r
 user; it should not be used to determine the class of operating systems\r
 this system belongs to.  The Win32::GetOSName(), Win32::GetOSVersion,\r
index 2799290..f6d96b4 100644 (file)
@@ -39,6 +39,7 @@ typedef BOOL (__stdcall *PFNEqualSid)(PSID, PSID);
 typedef void* (__stdcall *PFNFreeSid)(PSID);\r
 typedef BOOL (__stdcall *PFNIsUserAnAdmin)(void);\r
 typedef BOOL (WINAPI *PFNGetProductInfo)(DWORD, DWORD, DWORD, DWORD, DWORD*);\r
+typedef void (WINAPI *PFNGetNativeSystemInfo)(LPSYSTEM_INFO lpSystemInfo);\r
 \r
 #ifndef CSIDL_MYMUSIC\r
 #   define CSIDL_MYMUSIC              0x000D\r
@@ -792,9 +793,17 @@ XS(w32_GetChipName)
 {\r
     dXSARGS;\r
     SYSTEM_INFO sysinfo;\r
+    HMODULE module;\r
+    PFNGetNativeSystemInfo pfnGetNativeSystemInfo;\r
 \r
     Zero(&sysinfo,1,SYSTEM_INFO);\r
-    GetSystemInfo(&sysinfo);\r
+    module = GetModuleHandle("kernel32.dll");\r
+    GETPROC(GetNativeSystemInfo);\r
+    if (pfnGetNativeSystemInfo)\r
+        pfnGetNativeSystemInfo(&sysinfo);\r
+    else\r
+        GetSystemInfo(&sysinfo);\r
+\r
     /* XXX docs say dwProcessorType is deprecated on NT */\r
     XSRETURN_IV(sysinfo.dwProcessorType);\r
 }\r
@@ -1659,7 +1668,7 @@ XS(w32_GetSystemMetrics)
     if (items != 1)\r
        Perl_croak(aTHX_ "usage: Win32::GetSystemMetrics($index)");\r
 \r
-    XSRETURN_IV(GetSystemMetrics(SvIV(ST(0))));\r
+    XSRETURN_IV(GetSystemMetrics((int)SvIV(ST(0))));\r
 }\r
 \r
 XS(w32_GetProductInfo)\r
index 8c29d30..32a43df 100644 (file)
@@ -11,7 +11,7 @@ use Win32;
 # The "display name" value is the same as the $pretty field,\r
 # prefixed by "Windows ", with all "[]{}" characters removed.\r
 \r
-# $pretty, $os $id, $major, $minor, $sm, $pt, $metric, $tag\r
+# $pretty, $os $id, $major, $minor, $sm, $pt, $metric\r
 \r
 my @intel_tests = (\r
 ["Win32s",                          "Win32s",  0                     ],\r
@@ -94,6 +94,7 @@ my @dual_tests = (
 ["7 [Starter]",                     "7",       2, 6, 1, 0x0b         ],\r
 ["7 [Home Basic]",                  "7",       2, 6, 1, 0x02         ],\r
 ["7 [Home Premium]",                "7",       2, 6, 1, 0x03         ],\r
+["7 [Professional]",                "7",       2, 6, 1, 0x06         ],\r
 ["7 [Professional]",                "7",       2, 6, 1, 0x30         ],\r
 ["7 [Enterprise]",                  "7",       2, 6, 1, 0x04         ],\r
 ["7 [Ultimate]",                    "7",       2, 6, 1, 0x01         ],\r
@@ -109,20 +110,18 @@ my @ia64_tests = (
 ["2003 [Enterprise Edition for Itanium-based Systems]", "2003", 2, 5, 2, 0x0002, 2, 0],\r
 );\r
 \r
-plan tests => 3 * (@intel_tests + @amd64_tests + 2*@dual_tests + @ia64_tests);\r
+plan tests => 6 * (@intel_tests + @amd64_tests + 2*@dual_tests + @ia64_tests);\r
 \r
 # Test internal implementation function\r
 sub check {\r
     my($test, $arch) = @_;\r
-    my($pretty, $expect, $id, $major, $minor, $sm, $pt, $metrics, $tag) = @$test;\r
+    my($pretty, $expect, $id, $major, $minor, $sm, $pt, $metrics) = @$test;\r
     $metrics = [$metrics] if defined($metrics) && not ref $metrics;\r
-    $tag ||= "";\r
 \r
-    unless ($tag) {\r
-       ($pretty, $tag) = ("$1$2$3", "$2") if $pretty =~ /^(.*)\[(.*)\](.*)$/;\r
-       ($pretty, $tag) = ("$1$2$3", "Windows $2") if $pretty =~ /^(.*)\{(.*)\}(.*)$/;\r
-       $tag = "R2 $tag" if $tag !~ /R2/ && $pretty =~ /R2$/;\r
-    }\r
+    my $tag = "";\r
+    ($pretty, $tag) = ("$1$2$3", "$2") if $pretty =~ /^(.*)\[(.*)\](.*)$/;\r
+    ($pretty, $tag) = ("$1$2$3", "Windows $2") if $pretty =~ /^(.*)\{(.*)\}(.*)$/;\r
+    $tag = "R2 $tag" if $tag !~ /R2/ && $pretty =~ /R2$/;\r
 \r
     # All display names start with "Windows";\r
     # and 2003/2008 start with "Windows Server"\r
@@ -150,7 +149,17 @@ sub check {
     note($pretty);\r
     is($display, $pretty);\r
     is($os, "Win$expect", "os:   $os");\r
-    is($desc, $tag,       "desc: $desc");\r
+    is($desc, $tag, "desc: $desc");\r
+\r
+    my $sp = "Service Pack 42";\r
+    ($os, $desc) = Win32::_GetOSName($sp, $major||0, $minor||0, 0,\r
+                                    $id, $sm||0, $pt||1, $sm||0, $arch, $metrics);\r
+    $display = Win32::GetOSDisplayName($os, $desc);\r
+\r
+    is($display, "$pretty $sp", "display: $display");\r
+    is($os,      "Win$expect",  "os:      $os");\r
+    $expect = length($tag) ? "$tag $sp" : $sp;\r
+    is($desc,    $expect,       "desc:    $desc");\r
 }\r
 \r
 check($_, Win32::PROCESSOR_ARCHITECTURE_INTEL) for @intel_tests, @dual_tests;\r