From 5df99aa19dda6d1d0a24338e51682890efe37521 Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Wed, 11 May 2022 19:15:47 +0000 Subject: [PATCH] Win32: synch with CPAN version 0.59 As discussed in: https://www.nntp.perl.org/group/perl.perl5.porters/2022/05/msg263707.html --- cpan/Win32/Win32.pm | 27 ++++++++++++++++++++++----- cpan/Win32/Win32.xs | 21 +++++++++++++++++++++ cpan/Win32/t/Names.t | 9 +++++++-- 3 files changed, 50 insertions(+), 7 deletions(-) diff --git a/cpan/Win32/Win32.pm b/cpan/Win32/Win32.pm index ce6dee3ce640..2ad726a99a42 100644 --- 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 index dcffbd914d07..3166c295be74 100644 --- 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 index e28e4a46af3d..a71902041123 100644 --- 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