Win32: synch with CPAN version 0.59

As discussed in: https://www.nntp.perl.org/group/perl.perl5.porters/2022/05/msg263707.html
Perl · May 14, 2022 · 042c826 · 042c826
1 parent c8326bf
commit 042c826
Show file tree

Hide file tree

Showing 3 changed files with 50 additions and 7 deletions.
diff --git a/cpan/Win32/Win32.pm b/cpan/Win32/Win32.pm
@@ -8,7 +8,7 @@ package Win32;
     require DynaLoader;
 
     @ISA = qw|Exporter DynaLoader|;
-    $VERSION = '0.58';
+    $VERSION = '0.59';
     $XS_VERSION = $VERSION;
     $VERSION = eval $VERSION;
 
@@ -306,6 +306,8 @@ sub PRODUCT_EDUCATION_N                      () { 0x7A } # Windows 10 Education
 
 sub PRODUCT_UNLICENSED                       () { 0xABCDABCD } # product has not been activated and is no longer in the grace period
 
+sub PROCESSOR_ARCHITECTURE_ARM64   ()   { 12 }     # ARM64
+sub PROCESSOR_ARCHITECTURE_ARM     ()   { 5 }      # ARM
 sub PROCESSOR_ARCHITECTURE_AMD64   ()   { 9 }      # x64 (AMD or Intel)
 sub PROCESSOR_ARCHITECTURE_IA64    ()   { 6 }      # Intel Itanium Processor Family (IPF)
 sub PROCESSOR_ARCHITECTURE_INTEL   ()   { 0 }      # x86
@@ -319,6 +321,14 @@ sub _GetProcessorArchitecture {
 	2200 => PROCESSOR_ARCHITECTURE_IA64,
 	8664 => PROCESSOR_ARCHITECTURE_AMD64,
     }->{Win32::GetChipName()};
+
+    if (!defined($arch)) {
+        $arch = {
+            5 => PROCESSOR_ARCHITECTURE_ARM,
+            12 => PROCESSOR_ARCHITECTURE_ARM64,
+        }->{Win32::GetChipArch()};
+    }
+
     return defined($arch) ? $arch : PROCESSOR_ARCHITECTURE_UNKNOWN;
 }
 
@@ -890,10 +900,17 @@ $ENV{PROCESSOR_ARCHITECTURE}.  This might not work on Win9X.
 
 =item Win32::GetChipName()
 
-Returns the processor type: 386, 486 or 586 for x86 processors, 8664
-for the x64 processor and 2200 for the Itanium.  Since it returns the
-native processor type it will return a 64-bit processor type even when
-called from a 32-bit Perl running on 64-bit Windows.
+Returns the processor type: 386, 486 or 586 for x86 processors, 8664 for the x64
+processor and 2200 for the Itanium. For arm/arm64 processor, the value is marked
+as "Reserved" (not specified, but usually 0) in Microsoft documentation, so it's
+better to use GetChipArch(). Since it returns the native processor type it will
+return a 64-bit processor type even when called from a 32-bit Perl running on
+64-bit Windows.
+
+=item Win32::GetChipArch()
+
+Returns the processor architecture: 0 for x86 processors, 5 for arm, 6 for
+Itanium, 9 for x64 and 12 for arm64, and 0xFFFF for unknown architecture.
 
 =item Win32::GetConsoleCP()
 

diff --git a/cpan/Win32/Win32.xs b/cpan/Win32/Win32.xs
@@ -671,6 +671,26 @@ XS(w32_GetArchName)
     XSRETURN_PV(getenv("PROCESSOR_ARCHITECTURE"));
 }
 
+XS(w32_GetChipArch)
+{
+    dXSARGS;
+    SYSTEM_INFO sysinfo;
+    HMODULE module;
+    PFNGetNativeSystemInfo pfnGetNativeSystemInfo;
+    if (items)
+	Perl_croak(aTHX_ "usage: Win32::GetChipArch()");
+
+    Zero(&sysinfo,1,SYSTEM_INFO);
+    module = GetModuleHandle("kernel32.dll");
+    GETPROC(GetNativeSystemInfo);
+    if (pfnGetNativeSystemInfo)
+        pfnGetNativeSystemInfo(&sysinfo);
+    else
+        GetSystemInfo(&sysinfo);
+
+    XSRETURN_IV(sysinfo.wProcessorArchitecture);
+}
+
 XS(w32_GetChipName)
 {
     dXSARGS;
@@ -2021,6 +2041,7 @@ BOOT:
     newXS("Win32::RegisterServer", w32_RegisterServer, file);
     newXS("Win32::UnregisterServer", w32_UnregisterServer, file);
     newXS("Win32::GetArchName", w32_GetArchName, file);
+    newXS("Win32::GetChipArch", w32_GetChipArch, file);
     newXS("Win32::GetChipName", w32_GetChipName, file);
     newXS("Win32::GuidGen", w32_GuidGen, file);
     newXS("Win32::GetFolderPath", w32_GetFolderPath, file);

diff --git a/cpan/Win32/t/Names.t b/cpan/Win32/t/Names.t
@@ -7,7 +7,7 @@ BEGIN {
 }
 use Win32;
 
-my $tests = 14;
+my $tests = 16;
 $tests += 2 if Win32::IsWinNT();
 
 plan tests => $tests;
@@ -28,10 +28,15 @@ my $archname = eval { Win32::GetArchName() };
 is( $@, '', "Win32::GetArchName()" );
 cmp_ok( length($archname), '>=', 3, "  - checking returned architecture name" );
 
+# test Win32::GetChipArch()
+my $chiparch = eval { Win32::GetChipArch() };
+is( $@, '', "Win32::GetChipArch()" );
+like( $chiparch, '/^(0|5|6|9|12)$/', " - checking returned chip arch" );
+
 # test Win32::GetChipName()
 my $chipname = eval { Win32::GetChipName() };
 is( $@, '', "Win32::GetChipName()" );
-cmp_ok( length($chipname), '>=', 3, "  - checking returned chip name" );
+like( $chipname, '/^(0|386|486|586|2200|8664)$/', " - checking returned chip name");
 
 # test Win32::GetOSName()
 #  - scalar context